r394 - dev/geode/ac97

Author: wmb
Date: 2007-05-17 05:57:49 +0200 (Thu, 17 May 2007)
New Revision: 394

Modified:
   dev/geode/ac97/ac97.bth
   dev/geode/ac97/ac97.fth
   dev/geode/ac97/selftest.fth
Log:
ac97 - cleaned up selftest and added a "tone ( freq -- )" method to generate tones of specific frequencies.

Modified: dev/geode/ac97/ac97.bth
===================================================================
--- dev/geode/ac97/ac97.bth	2007-05-17 01:16:03 UTC (rev 393)
+++ dev/geode/ac97/ac97.bth	2007-05-17 03:57:49 UTC (rev 394)
@@ -9,6 +9,7 @@

FCode-version2
 fload ${BP}/dev/geode/ac97/ac97.fth
+fload ${BP}/forth/lib/isin.fth
 fload ${BP}/dev/geode/ac97/selftest.fth
 end0

Modified: dev/geode/ac97/ac97.fth
===================================================================
--- dev/geode/ac97/ac97.fth	2007-05-17 01:16:03 UTC (rev 393)
+++ dev/geode/ac97/ac97.fth	2007-05-17 03:57:49 UTC (rev 394)
@@ -239,8 +239,8 @@
    0 set-master-volume
 \   0 set-mono-volume
    h# 0f0f set-headphone-volume
-   h# 808 set-pcm-gain		\ enable line-out
-   h# 808 h# 38 codec!		\ enable surround out (headphones)
+   h# 606 set-pcm-gain		\ enable line-out
+   h# 606 h# 38 codec!		\ enable surround out (headphones)
    h# 000 h# 76 codec!  	\ Route mixer out to headphones
 ;
 : close-out  ( -- )

Modified: dev/geode/ac97/selftest.fth
===================================================================
--- dev/geode/ac97/selftest.fth	2007-05-17 01:16:03 UTC (rev 393)
+++ dev/geode/ac97/selftest.fth	2007-05-17 03:57:49 UTC (rev 394)
@@ -23,7 +23,7 @@
    record-base  record-len  audio-in drop
 ;

-h# 0 value plevel
+h# 606 value plevel   \ -9 dB, highest gain without digital clipping
 : set-plevel  ( db -- )
    dup 0>  if  drop 0  then
    negate  1+ 2* 3 /  dup bwjoin  to plevel
@@ -40,77 +40,6 @@
    record-base  record-len  audio-out drop  write-done
 ;

-[ifdef] notdef
-create sin-half
-d#     0 w,
-d#  3212 w,
-d#  6393 w,
-d#  9512 w,
-d# 12539 w,
-d# 15446 w,
-d# 18204 w,
-d# 20787 w,
-d# 23170 w,
-d# 25329 w,
-d# 27245 w,
-d# 28898 w,
-d# 30273 w,
-d# 31356 w,
-d# 32137 w,
-d# 32609 w,
-d# 32767 w,
-d# 32609 w,
-d# 32137 w,
-d# 31356 w,
-d# 30273 w,
-d# 28898 w,
-d# 27245 w,
-d# 25329 w,
-d# 23170 w,
-d# 20787 w,
-d# 18204 w,
-d# 15446 w,
-d# 12539 w,
-d# 9512 w,
-d# 6393 w,
-d# 3212 w,
-
-
-
-0 value wave
-: wave++  ( -- wave )
-   wave h# 800 + dup h# 7fff and 0= if negate then dup to wave
-;
-: cycle  ( adr -- adr' )
-   d# 32  0  do                   ( adr )
-      sin-half i wa+ w@  over w!  ( adr value )
-      la1+                        ( adr' )
-   loop                           ( adr )
-   d# 32  0  do                   ( adr )
-      sin-half i wa+ w@ negate  over w!   ( adr value )
-      la1+                        ( adr' )
-   loop                           ( adr' )
-;
-
-: make-wave  ( -- )
-   \ Start with everything quiet
-   record-base record-len erase
-
-   \ Add a sine wave to the left channel for the first half of the time
-   record-base record-len 2/  bounds      ( endadr startadr )
-   begin  2dup u>  while  cycle  repeat   ( endadr startadr )
-   2drop
-
-   \ Add a sine wave to the right channel for the last half of the time
-   record-base record-len bounds          ( endadr startadr )
-   record-len 2/ + wa1+
-   begin  2dup u>  while  cycle  repeat   ( endadr startadr )
-   2drop
-;
-[then]
-
-fload ${BP}/forth/lib/isin.fth
-
 d# 500 value tone-freq

: /cycle  ( -- #bytes )  #cycle /l*  ;
@@ -127,13 +56,12 @@
    /cycle +
 ;

-: make-tone-wave  ( -- )
+: make-tone  ( freq -- )
+   sample-rate to fs  ( freq )  set-freq
+
    \ Start with everything quiet
    record-base record-len erase

-   sample-rate to fs
-   tone-freq set-freq
-
    record-base  make-cycle  drop

\ Copy the wave template into the left channel
@@ -147,6 +75,13 @@
    /cycle +loop
 ;

+: tone  ( freq -- )
+   record-len la1+  alloc-mem to record-base
+   make-tone
+   d# -9 set-glevel  play
+   record-base record-len la1+  free-mem
+;
+
 : copy-cycle  ( adr #copies -- adr' )
    1  ?do                      ( adr )
       dup  /cycle -  over      ( adr adr- adr )
@@ -155,7 +90,7 @@
    loop                        ( adr' )
 ;

-: make-wave  ( -- )
+: make-sweep  ( -- )
    \ Start with everything quiet
    record-base record-len erase

@@ -169,6 +104,7 @@
    -1 +loop
    drop

+\   record-base   record-base record-len 2/ + wa1+  record-len 2/ /w -  move
    \ Copy the left channel into the right channel in reverse order
    record-base   record-len /w -  bounds   ( end start )
    begin  2dup u>  while                   ( end start )
@@ -181,43 +117,29 @@

: selftest-args  ( -- arg$ )  my-args ascii : left-parse-string 2drop  ;

-: ?play-wav-file  ( -- )
+: wav-test  ( -- )
    selftest-args dup 0=  if  2drop exit  then
    " $play-wav-loop" $find 0=  if  2drop  else  catch drop  then
 ;

-d#  -8 value wav-plevel
-d# -12 value wav-glevel
-: wav-test  ( -- )
-   wav-plevel set-plevel  wav-glevel set-glevel
-   ?play-wav-file
+: sweep-test  ( -- )
+   ." Playing sweep" cr
+   make-sweep
+   d# -9 set-glevel  play
 ;

-d#  -8 value tone-plevel
-d# -12 value tone-glevel
-
-: tone-test  ( -- )
-   ." Playing tone" cr
-   \ Onset of clipping in the P domain is -7
-   tone-plevel set-plevel  tone-glevel set-glevel
-   make-wave play
-;
-
-d# -8 value rec-plevel
-d# -3 value rec-glevel
 : mic-test  ( -- )
    ." Recording ..." cr
-   rec-plevel set-plevel  rec-glevel set-glevel
    record
    ." Playing ..." cr
-   play
+   d# -3 set-glevel  play
 ;

: selftest  ( -- error? )
    open 0=  if  ." Failed to open /audio" cr true exit  then
    wav-test
    record-len la1+  alloc-mem to record-base
-   tone-test
+   sweep-test
    mic-test
    record-base record-len la1+  free-mem
    close false