(*---------------------------------------------------------------------------
    :Program.    Beep
    :Author.     Fridtjof Siebert
    :Address.    Nobileweg 67, D-7-Stgt-40
    :Shortcut.   [fbs]
    :Version.    3.141593
    :Date.       15-Dez-88
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga
    :Contents.   Procedure to "Beep"
---------------------------------------------------------------------------*)

IMPLEMENTATION MODULE Beep;

FROM SYSTEM      IMPORT ADR, LONGSET;

FROM Arts        IMPORT TermProcedure, Assert;

FROM Audio       IMPORT IOAudioPtr, audioName, allocFailed, perVol;

FROM Exec        IMPORT FindTask, MsgPortPtr, DevicePtr, UByte, Byte,
                        MsgPortAction, NodeType, write, IOFlagSet, ReplyMsg,
                        sigAbort, GetMsg, OpenDevice, Wait, CloseDevice,
                        TaskPtr, AddTask, RemTask, WaitIO;

FROM ExecSupport IMPORT CreatePort, DeletePort, BeginIO;

FROM Heap        IMPORT AllocMem, Allocate, Deallocate;


CONST
  RectTableSize   = 32;
  OpenFail        = -1;    (* Where can this be imported from ??? *)

VAR
  AllocPort:  MsgPortPtr;
  AllocIOB:   IOAudioPtr;
  AllocationMap: ARRAY[0..3] OF Byte;
  Open: BOOLEAN;
  RectTable:  POINTER TO ARRAY[0..RectTableSize-1] OF Byte;
  i: INTEGER;

(*------  Beep:  ------*)

PROCEDURE Beep(low: BOOLEAN);

BEGIN

(*------  Allocation Precedence and Channel:  ------*)

  AllocIOB^.request.message.node.pri := -40;
  AllocIOB^.request.message.replyPort := AllocPort;

  AllocationMap[0] := 1;
  AllocationMap[1] := 8;
  AllocationMap[2] := 2;
  AllocationMap[3] := 4;
  AllocIOB^.data   := ADR(AllocationMap);
  AllocIOB^.length := SIZE(AllocationMap);

(*------  Open Audio-Device:  ------*)

  OpenDevice(ADR(audioName),0,AllocIOB,LONGSET{});

  CASE AllocIOB^.request.error OF
  OpenFail,allocFailed: |
  ELSE (* no error ! *)
    Open := TRUE;
    WITH AllocIOB^ DO
      request.command := write;
      request.flags   := IOFlagSet{4}; (* perVol *)
      data            := RectTable;
      length          := RectTableSize;
      IF low THEN
        period          := 600;
        cycles          := 100;
      ELSE
        period          := 200;
        cycles          := 200;
      END;
      volume          := 64;
    END;
    BeginIO(AllocIOB);
    WaitIO(AllocIOB);
    CloseDevice(AllocIOB);
    Open := FALSE;
  END;

END Beep;

(*------  CleanUp:  ------*)

PROCEDURE CleanUp();

BEGIN
  IF Open THEN CloseDevice(AllocIOB) END;
  IF AllocIOB #NIL THEN Deallocate(AllocIOB ) END;
  IF AllocPort#NIL THEN DeletePort(AllocPort) END;
END CleanUp;

BEGIN

  AllocPort := NIL; AllocIOB  := NIL; Open := FALSE;
  TermProcedure(CleanUp);

  AllocMem(RectTable,RectTableSize,TRUE);
  Assert(RectTable#NIL,ADR("Out Of Memory"));
  FOR i:=0 TO RectTableSize/2 DO
    RectTable^[i] := -128;
    RectTable^[RectTableSize-i-1] := 127;
  END;

  AllocPort := CreatePort(ADR("Beep"),0);
  Assert(AllocPort#NIL,ADR("Out of Memory!"));
  Allocate(AllocIOB,SIZE(AllocIOB^));
  Assert(AllocIOB#NIL,ADR("Out of memory!"));

END Beep.