home *** CD-ROM | disk | FTP | other *** search
/ Dave Lowe: S5 Stereo Sound Sampler / Lowe_S5StereoSoundSampler.adf / Progs / Forth / s5.demo2 < prev   
Encoding:
Text File  |  1987-04-29  |  2.0 KB  |  76 lines
  1. \ *******************************************************************
  2.  
  3. \            Sophus  S5   CSI Multi-Forth Support
  4.  
  5. \            Demo2  -  More complex example of S5 Library useage
  6.  
  7. \ *******************************************************************
  8.  
  9. \   This program performs the same function as SrPlayer in the
  10. \   library but goes through all the steps that S5Player uses,
  11. \   to show the way Frags are used, with other routines.
  12.  
  13. anew demo       \ marker
  14.  
  15. include s5.calls
  16. include s5.symbols    \  needed definitions
  17.  
  18. \  define two pointer variables for the frag addresses
  19.  
  20. variable leftfrag
  21. variable rightfrag
  22.  
  23. \  success variable
  24. variable success
  25. create buff 256 allot    \ filename buffer
  26.  
  27. : grablib 0" s5.library" 0 s5number open.lib
  28.   dup success ! not if abort" Library fault."   \  Open the library
  29.  then ;
  30.  
  31. :  player
  32.    cr
  33.    ." File to play: "
  34.    buff 255 input.string
  35.    0 buff c@ buff + c!   \  add null instead of LF
  36.  
  37.    buff c@ 0> if
  38.    100 FRAG_CHIP S5AllocateFrag leftfrag !
  39.    100 FRAG_CHIP S5AllocateFrag rightfrag !  \ ask for frag structures
  40.  
  41.    leftfrag @ rightfrag @ | 0= if abort" Memory problems." cr then
  42.  
  43.    \  If we get here we have our frags set up
  44.  
  45.    leftfrag @ buff 1+ 0 S5LoadIFF  dup success !    \ try a default IFF load
  46.    success @ dup E_FORMAT = swap E_OK =  |
  47.    if
  48.    
  49.    E_FORMAT = if                       \ not iff
  50.    leftfrag @ rightfrag @ buff 1+ 0 S5Loadsop2   success !
  51.                                        \ so try sop2 format
  52.               then
  53.    success @  E_OK = if                \  play it
  54.    cr ." File read okay."
  55.    leftfrag @ rightfrag @ 0 S5StereoStart
  56.    E_OK = if
  57.           ." Playing it....." cr
  58.           0 S5WaitForEnd
  59.           1 S5WaitForEnd
  60.           ." Played it......" cr
  61.           then
  62.                     then
  63.    else ." File error. " cr drop
  64.    then
  65.    leftfrag @ S5DeallocateFrag
  66.    rightfrag @  S5DeallocateFrag
  67.    then
  68.    ;
  69. grablib
  70. : prompter  success @ if
  71. ."  To run, type Player.   To forget type forget demo." cr cr
  72. else cr then ;
  73. prompter
  74.  
  75.  
  76.