(*---------------------------------------------------------------------------
    :Program.    PlayKeys.mod
    :Author.     Fridtjof Siebert
    :Address.    Nobileweg 67, D-7-Stgt-40
    :Shortcut.   [fbs]
    :Version.    1.0
    :Date.       19-Sep-88
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga
    :Imports.    IFF8SVXLoad [fbs], MemSystem [bne]
    :UpDate.     none.
    :Contents.   Program to play a sampled Sound with different samplerates.
    :Remark.     Usage: PlayKeys <iff-soundfile>
---------------------------------------------------------------------------*)

MODULE PlayKeys;

FROM SYSTEM      IMPORT ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST;

FROM Arts        IMPORT Terminate, Assert;

FROM Arguments   IMPORT NumArgs, GetArg;

FROM Dos         IMPORT Delay;

FROM Exec        IMPORT GetMsg, WaitPort, ReplyMsg;

FROM Intuition   IMPORT DisplayBeep, NewWindow, WindowPtr, WindowFlags,
                        WindowFlagSet, ScreenFlags, ScreenFlagSet,
                        IDCMPFlags, IDCMPFlagSet, OpenWindow, CloseWindow,
                        IntuiMessagePtr;

FROM IFF8SVXLoad IMPORT Read8SVX, Dealloc8SVX, IFF8SVXInfoPtr, PlaySample,
                        OpenAudio, CloseAudio, WaitPlay, AllChannels;


CONST
  ProgName = "PlayKeys, © 1988 by Fridtjof Siebert [Amok]";


VAR
  Name: ARRAY[0..79] OF CHAR; (* the Sound's Name                          *)
  length: INTEGER;            (* dummy for receiving Name's Length         *)
  Info: IFF8SVXInfoPtr;       (* Sound's Data                              *)
  Window: WindowPtr;
  NuWindow: NewWindow;
  Samples: CARDINAL;          (* IFF's samplespersec                       *)
  s: LONGINT;                 (* My SamplesPerSec                          *)
  Msg: IntuiMessagePtr;
  Channel: CARDINAL;          (* Active Channel                            *)


BEGIN

(*------  Get Name:  ------*)

  IF NumArgs()#0 THEN
    GetArg(1,Name,length);
  ELSE
    Terminate(0);
  END;

(*------  Open Window:  ------*)

  WITH NuWindow DO
    leftEdge := 80;
    topEdge  := 40;
    width    := 320;
    height   := 80;
    detailPen:= 0;
    blockPen := 1;
    idcmpFlags := IDCMPFlagSet{closeWindow,vanillaKey};
    flags := WindowFlagSet{windowSizing, windowDrag, windowDepth,
                           windowClose, activate};
    firstGadget := NIL;
    checkMark := NIL;
    title := ADR("Press some Keys !!!");
    screen := NIL;
    bitMap := NIL;
    minWidth := 30;
    minHeight := 16;
    maxWidth := -1;
    maxHeight := -1;
    type := ScreenFlagSet{wbenchScreen};
  END;
  Window := OpenWindow(NuWindow);
  Assert(Window#NIL,ADR("Shit!"));

(*------  Read and Play Sound:  ------*)

  Info := Read8SVX(Name,16000,FALSE);       (* load sound  *)

  IF Info#NIL THEN

    IF OpenAudio(4,0) THEN                  (* open audio  *)

      Samples := Info^.VHDR.samplesPerSec;

      Channel := 0;

      LOOP
        WaitPort(Window^.userPort);
        Msg := GetMsg(Window^.userPort);
        IF closeWindow IN Msg^.class THEN EXIT END;
        s :=  LONGINT(Samples) * LONGINT(Msg^.code) DIV 64;
        ReplyMsg(Msg);
        IF (s<20000) AND (s>200) THEN
          Info^.VHDR.samplesPerSec := s;
          IF NOT(PlaySample(Info,0,1,Channel)) THEN END;
          IF Channel<3 THEN
            INC(Channel);
          ELSE
            Channel:= 0;
          END;
        END;
      END;
      ReplyMsg(Msg);

      CloseAudio();                         (* close audio *)

    ELSE
      DisplayBeep(NIL);
    END;

    Dealloc8SVX(Info);                      (* free sound  *)

  ELSE
    DisplayBeep(NIL);                       (* error       *)
  END;

  CloseWindow(Window);

END PlayKeys.