(*---------------------------------------------------------------------------
    :Program.    Sound.mod
    :Author.     Bernd Preusing (concept stolen from [fbs])
    :Address.    Gerhardstr. 16  D-2200 Elmshorn
    :Phone.      04121/22486
    :Shortcut.   [bep]
    :Version.    1.0
    :Date.       29-Dec-1988
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga
    :UpDate.     V 1.1 adapted to level concept
    :Contents.   play one note at a time
    :Remark.     schabadudadu, don't worry, be happy!
---------------------------------------------------------------------------*)
IMPLEMENTATION MODULE Sound;

FROM SYSTEM	IMPORT ADR, ADDRESS, LONGSET, INLINE;
FROM Arts	IMPORT Assert, TermProcedure, CurrentLevel;
FROM Audio	IMPORT audioName, pervol, IOAudio, IOAudioPtr;
FROM Exec	IMPORT WaitIO, OpenDevice, CloseDevice, IOFlagSet,
		       MsgPortPtr, Byte, write, CopyMem;
FROM ExecSupport IMPORT BeginIO, CreatePort, DeletePort;
FROM Heap	IMPORT AllocMem, Allocate, Deallocate;


CONST errMsg = 'Sound: Out of memory!';
      DATALENGTH = 64;

TYPE
      wPtr = POINTER TO ARRAY rNote OF CARDINAL;

VAR
  myPort: MsgPortPtr;
  myReq: IOAudioPtr;
  allocArr: LONGCARD; (* 4 bytes *)
  open: BOOLEAN;
  i: rOctave;
  len:CARDINAL;
  ptr:ADDRESS;
  dataPtr: ADDRESS;
  Periods: wPtr;
  OctaveData: ARRAY rOctave OF ADDRESS;
  OctaveLength: ARRAY rOctave OF CARDINAL;
  StartLevel: INTEGER;

(* $R- $V- *)

PROCEDURE Sound(Note:rNote; Octave:rOctave; Duration:rDuration);
VAR len,per:CARDINAL;
BEGIN
  WITH myReq^ DO
    request.message.node.pri:=90; (* Annunciators: 80..90 *)
    request.message.replyPort:=myPort;
    data:=ADR(allocArr);
    length:=4;
  END;
  OpenDevice(ADR(audioName),0,myReq,LONGSET{});
  IF myReq^.request.error=0 THEN
    open:=TRUE;
    len:=OctaveLength[Octave];
    per:=Periods^[Note];
    WITH myReq^ DO
      request.command:=write;
      request.flags:=pervol;
      data:=OctaveData[Octave];
      length:=len;
      period:=per; (* min: 124, max:256 *)
      cycles:=(3579545 / (len*per))*Duration / 1000;
      IF cycles=0 THEN cycles:=1 END; (* at least one!! *)
      volume:=64;
    END;
    BeginIO(myReq);
    WaitIO(myReq);
    CloseDevice(myReq);
    open:=FALSE;
  END
END Sound;

PROCEDURE CleanUp();
BEGIN
  IF CurrentLevel() <= StartLevel THEN
    IF open        THEN CloseDevice(myReq) END;
    IF myReq#NIL   THEN Deallocate(myReq) END;
    IF myPort#NIL  THEN DeletePort(myPort) END;
    IF dataPtr#NIL THEN Deallocate(dataPtr) END;
  END;
END CleanUp;

(* $E- *)
PROCEDURE Per();
BEGIN
  INLINE(
	254, 240, 226, 214, 202, 190, 180, 170, 160, 151, 143, 135
	)
END Per;

(* $E- *)
PROCEDURE Data(); (* DATALENGTH bytes triangle wave *)
BEGIN
  INLINE(
  00810H, 01820H, 02830H, 03840H,
  04850H, 05860H, 06870H, 0787FH,
  07870H, 06860H, 05850H, 04840H,
  03830H, 02820H, 01810H, 00800H,
  0F8F0H, 0E8E0H, 0D8D0H, 0C8C0H,
  0B8B0H, 0A8A0H, 09890H, 08880H,
  08890H, 098A0H, 0A8B0H, 0B8C0H,
  0C8D0H, 0D8E0H, 0E8F0H, 0F800H,

  01020H, 03040H, 05060H, 0707FH,
  07060H, 05040H, 03020H, 01000H,
  0F0E0H, 0D0C0H, 0B0A0H, 09080H,
  090A0H, 0B0C0H, 0D0E0H, 0F000H,

  02040H, 0607FH, 06040H, 02000H,
  0E0C0H, 0A081H, 0A0C0H, 0E000H,

  0407FH, 04000H, 0C081H, 0C000H,

  07F00H, 08100H,

  07F81H
  )
END Data;

BEGIN
  StartLevel:=CurrentLevel();
  allocArr:=01080204H; (* fill in 4 bytes quickly *)
  myPort:=NIL;
  myReq:=NIL;
  dataPtr:=NIL;
  open:=FALSE;
  TermProcedure(CleanUp);
  AllocMem(dataPtr,DATALENGTH*2,TRUE);
  Assert(dataPtr#NIL,ADR(errMsg));
  CopyMem(ADR(Data),dataPtr,DATALENGTH*2);
  len:=DATALENGTH;
  ptr:=dataPtr;
  FOR i:=0 TO MAX(rOctave) DO
    OctaveLength[i]:=len;
    OctaveData[i]:=ptr;
    INC(ptr,len);
    len:=len DIV 2;
  END;
  Periods:=ADR(Per);
  myPort:=CreatePort(NIL,0);
  Assert(myPort#NIL,ADR(errMsg));
  Allocate(myReq,SIZE(IOAudio));
  Assert(myReq#NIL,ADR(errMsg));
END Sound.mod