writesusp.lsp

Audacity是一款用於錄音和編輯聲音的、免費的開放源碼軟體。它可以執行於Mac OS X、Microsoft Windows、GNU/Linux和其它作業系統

    ;	    if (to_stop < togo) {
    ;		if (to_stop == 0) {
    ;		    if (cnt) {
    ;			togo = 0;
    ;			break;
    ;		    } else /* keep togo as is: since cnt == 0, we
    ;			    * can set the logical stop flag on this
    ;			    * output block
    ;			    */
    ;			susp->logically_stopped = true;
    ;		} else /* limit togo so we can start a new
    ;			* block at the LST
    ;			*/
    ;		    togo = to_stop;
    ;   	      }	    
    ;	}
    ;----------------
    (cond (logical-stop
           (print-strings '(
     "\n\t/* don't run past logical stop time */\n"
     "\tif (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) {\n"
     "\t    int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt);\n"
     "\t    /* break if to_stop == 0 (we're at the logical stop)\n"
     "\t     * AND cnt > 0 (we're not at the beginning of the\n"
     "\t     * output block).\n"
     "\t     */\n"
     "\t    if (to_stop < togo) {\n"
     "\t\tif (to_stop == 0) {\n"
     "\t\t    if (cnt) {\n"
     "\t\t\ttogo = 0;\n"
     "\t\t\tbreak;\n"
     "\t\t    } else /* keep togo as is: since cnt == 0, we\n"
     "\t\t            * can set the logical stop flag on this\n"
     "\t\t            * output block\n"
     "\t\t            */\n"
     "\t\t\tsusp->logically_stopped = true;\n"
     "\t\t} else /* limit togo so we can start a new\n"
     "\t\t        * block at the LST\n"
     "\t\t        */\n"
     "\t\t    togo = to_stop;\n"
     "\t    }\n"
     "\t}\n\n")
                          stream)))

    (cond (outer-loop
           (print-strings outer-loop stream)
           (format stream "~%")))

    ;----------------------------
    ; n = togo;
    ; *WATCH*: printf("ALG %x starting inner loop, n %d\n", susp, n);
    ;----------------------------

    (format stream "\tn = togo;~%")
    (if *watch* 
      (format stream
              "\tprintf(\"~A %x starting inner loop, n %d\\n\", susp, n);~%"
              name))

    (dotimes (n (length interp))
       (let ((name (nth n sound-names))
             (method (nth n interp)))
          (cond ((eq method 'NONE))
                 ;-----------------
                 ;  NONE:
                 ;-----------------
                ((eq method 'RAMP))
                ;-----------------
                ; RAMP:
                ;-----------------
                ((and (eq method 'INTERP) (eq n 0))
                ;-----------------
                ; INTERP (first arg only)
;		;	susp->NAME_cnt -= togo;
                ;-----------------
;	  	 (format stream "\tsusp->~A_cnt -= togo;~%" name)
                 ))))

    (print-strings (get-slot alg 'register-init) stream)
    ;----------------------------
    ; if (n) do  { /* inner loop */
    ;----------------------------

    (format stream
            "\tif (n) do { /* the inner sample computation loop */~%")

    ;;----------------------------
    ;; write local declarations supplied by user
    ;;----------------------------

    (print-strings (get-slot alg 'inner-loop-locals) stream)

    ;;----------------------------
    ;; declare temps that depend on signals
    ;;----------------------------

    (dotimes (n (length interp))
      (let ((method (nth n interp))
            interpolate-samples
            (name (nth n sound-names)))
        (setf interpolate-samples
              (not (member (name-to-symbol name) step-function)))
        (cond ((or (member method '(NONE SCALE))
                   interpolate-samples)
               (dolist (dep depends)
                (cond ((and (equal (cadr dep) name)
                            (eq (cadddr dep) 'TEMP))
                       (format stream "\t    ~A ~A;~%" (car (cddddr dep)) 
                                      (car dep)))))))))

    ;; this loop writes code that runs in the INNER-LOOP and checks to see
    ;; if we need to advance to the next pair of interpolated points for
    ;; each interpolated sound
    (dotimes (n (length interp))
      (let ((name (nth n sound-names))
            interpolate-samples
            (method (nth n interp)))
        (setf interpolate-samples
              (not (member (name-to-symbol name) step-function)))

        (cond ((and interpolate-samples (eq method 'INTERP))
                ;-----------------
                ; INTERP:
                ;
                ;    if (susp->NAME_pHaSe >= 1.0)  { 
                ;          NAME_x1_sample_reg =NAME_x2_sample_reg;
                ;       /* pick up next sample as NAME_x2_sample */
                ;       susp->NAME_ptr++;
                ;        susp_took(NAME_cnt, 1);
                                     ;        susp->NAME_pHaSe -= 1.0;
                ;       susp_check_XX_samples_break(NAME, NAME_ptr, NAME_cnt, NAME_x2_sample);
                ; }
                ; <maintenance of depends variables>
                ;-----------------
                (format stream "\t    if (~A_pHaSe_ReG >= 1.0) {~%" name)
                (format stream "\t\t~A_x1_sample_reg = ~A_x2_sample;~%"
                                name name)
                (format stream "\t\t/* pick up next sample as ~A_x2_sample: */~%" name)
                (format stream "\t\tsusp->~A_ptr++;~%" name)
                (format stream "\t\tsusp_took(~A_cnt, 1);~%" name)
                (format stream "\t\t~A_pHaSe_ReG -= 1.0;~%" name)
                (format stream "\t\t~A_break(~A, ~A_ptr, ~A_cnt, ~A_x2_sample);~%"
                        (susp-check-fn name alg) name name name name)
;                (format stream "\t\t~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%"
;                        name name name)

                ;     show_samples(2, susp->NAME_x2, susp->NAME_x2_ptr -
                ;			NAME_x2->block->samples);
                ;-----------------

;		(if *WATCH* 
;		    (format stream "\t\tshow_samples(2,susp->~A_x2,susp->~A_x2_ptr - susp->~A_x2->block->samples);~%"
;		    		name name name)
;                )
                ;-----------------
                ;      }
                ;-----------------
                (format stream "\t    }~%")
              )
              ((eq method 'INTERP)
                ;-----------------
                ; STEP FUNCTION:
                ;
                ;    if (susp->NAME_pHaSe >= 1.0)  { 
                ; 	<optional depends/fixup declarations>
                ;       /* pick up next sample as NAME_x1_sample */
                ;       susp->NAME_ptr++;
                ;        susp_took(NAME_cnt, 1);
                ;        susp->NAME_pHaSe -= 1.0;
                ;       susp_check_XX_samples_break(NAME, NAME_ptr, NAME_cnt, NAME_x1_sample);
                ;        NAME_x1_sample_reg = susp_current_sample(NAME, NAME_ptr);
                ; 	<optional depends/fixup code>
                ; }
                ;-----------------
                (format stream "\t    if (~A_pHaSe_ReG >= 1.0) {~%" name)
                (fixup-depends alg stream name)
                (format stream "\t\t/* pick up next sample as ~A_x1_sample: */~%" name)
                (format stream "\t\tsusp->~A_ptr++;~%" name)
                (format stream "\t\tsusp_took(~A_cnt, 1);~%" name)
                (format stream "\t\t~A_pHaSe_ReG -= 1.0;~%" name)
                (format stream "\t\t~A_break(~A, ~A_ptr, ~A_cnt, ~A_x1_sample_reg);~%"
                        (susp-check-fn name alg) name name name name)
                (format stream "\t\t~A_x1_sample_reg = susp_current_sample(~A, ~A_ptr);~%"
                        name name name)

                ;     show_samples(2, susp->NAME_x2, susp->NAME_x2_ptr -
                ;			NAME_x2->block->samples);
                ;-----------------

;		(if *WATCH* 
;		    (format stream "\t\tshow_samples(2,susp->~A_x2,susp->~A_x2_ptr - susp->~A_x2->block->samples);~%"
;		    		name name name)
;                )
                (let ((fixup-code (get-slot alg 'fixup-code)))
                  (if fixup-code (format stream fixup-code)))

                ;-----------------
                ;      }
                ;-----------------
                (format stream "\t    }~%")))))

    (write-inner-loop alg stream)
    (print-strings (get-slot alg 'register-cleanup) stream)

    ;; this loop calls loop tail computations on all sounds
    (dotimes (n (length interp))
      (let ((name (nth n sound-names))
            interpolate-samples
            (method (nth n interp)))
        (setf interpolate-samples
              (not (member (name-to-symbol name) step-function)))

        (cond ((member method '(NONE SCALE))
               ;-----------------
               ; NONE:
               ;    susp_took(NAME_cnt, togo - n);
               ;-----------------
               (format stream "\tsusp_took(~A_cnt, togo);~%" name))
              ((eq method 'INTERP))
              ((eq method 'RAMP)
                ;-----------------
                ; RAMP:
                ;	susp->NAME_pHaSe += togo * susp->NAME_pHaSe_iNcR;
                ;	susp->NAME_n -= togo; 
                ;-----------------
                (format stream
                 "\tsusp->~A_pHaSe += togo * susp->~A_pHaSe_iNcR;~%"
                 name name)
                (format stream "\tsusp->~A_n -= togo;~%" name)
               ))))
    ;-----------------------------
    ;     cnt += togo;
    ;    } /* outer loop */
    ; 
    ; snd_list->block_len = cnt;
    ;-----------------------------

    (format stream "~A~%~A~%~%" "\tcnt += togo;"
                   "    } /* outer loop */")
    ;-----------------------------
    ; if terminate is not NONE (infinite), check for it as follows:
    ;    /* test for termination */
    ;    if (togo == 0 && cnt == 0) {
    ;        snd_list_terminate(snd_list);
    ;   *WATCH*: printf("NAME %x terminated\n", susp);
    ;    } else {
    ;       snd_list->block_len = cnt;
    ;       susp->susp.current += cnt;
    ;    }
    ;-----------------------------
    (cond ((terminate-possible terminate alg)
           (print-strings '(
             "    /* test for termination */\n"
             "    if (togo == 0 && cnt == 0) {\n"
             "\tsnd_list_terminate(snd_list);\n")
            stream)
           (if *watch*
             (format stream "\tprintf(\"~A %x terminated.\\n\", susp);~%" name))
           (print-strings '(
             "    } else {\n"
             "\tsnd_list->block_len = cnt;\n"
             "\tsusp->susp.current += cnt;\n"
             "    }\n") stream))
          (t
    ;----------------
    ; OTHERWISE (no termination test):
    ;    snd_list->block_len = cnt;
    ;    susp->susp.current += cnt;
    ;----------------
           (print-strings '(
             "    snd_list->block_len = cnt;\n"
             "    susp->susp.current += cnt;\n") stream)))

     ;----------------
     ; if logical-stop is not the default check for it as follows:
     ;    /* test for logical stop */
     ;    if (susp->logically_stopped) {
     ;      snd_list-> logically_stopped = true;
     ;    } else if (susp->susp.log_stop_cnt == susp->susp.current) {
     ;      susp->logically_stopped = true;
     ;    }
     ;----------------
    (cond ((logical-stop-check-needed logical-stop)
           (print-strings '(
    "    /* test for logical stop */\n"
    "    if (susp->logically_stopped) {\n"
    "\tsnd_list->logically_stopped = true;\n"
    "    } else if (susp->susp.log_stop_cnt == susp->susp.current) {\n"
    "\tsusp->logically_stopped = true;\n"
    "    }\n") stream)))

     ;----------------
     ;  } /* name_encoding_fetch */
     ;----------------
    (format stream "} /* ~A_~A_fetch */~%" name encoding)))

(print 'write-susp)

; terminate-check-needed -- see if this is either a terminate clause
; that specifies MIN or AT, or is NIL (meaning none-specified so take
; the default) and there are signal parameters
;
(defun terminate-check-needed (terminate alg)
  (cond (terminate
         (cond ((listp terminate)
                (cond ((member (car terminate) '(MIN AT AFTER)) t)
                      (t nil)))
               ((member terminate '(COMPUTED NONE)) nil)
               (t
                (error "TERMINATE clause should specify a list"))))
        ((get alg 'sound-args) t)))

          
; same as terminate-check-needed, but also returns true for COMPUTED 
; termination
;
(defun terminate-possible (terminate alg)
  (cond (terminate
         (cond ((listp terminate)
                (cond ((member (car terminate) '(MIN AT AFTER COMPUTED)) t)
                      (t nil)))
               ((eq terminate 'NONE) nil)
               ((eq terminate 'COMPUTED) t)
               (t
                (error "TERMINATE clause should specify a list"))))
        ((get alg 'sound-args) t)))