(*
  :Program.       Beeper
  :Author.        Philippe Gressly (Volker Rudolph)
  :Address.       Näfenhaus CH 8926 Kappel a/A
  :Phone.         
  :ShortCut.      [Philu]
  :Version.       1.0
  :Date.          1.10.1989
  :Copyright.     PD
  :Language.      Modula-II
  :Translator.    M2Amiga 3.2d
  :Imports.       ExecSupport, Hardware, DOS;
  :Contents.      Die Tasten melden sich akkustisch.
*)



MODULE Beeper;
              (* $S- *)


FROM Arts        IMPORT TermProcedure, Assert, Terminate, CurrentLevel;
FROM Exec        IMPORT OpenDevice, CloseDevice, DoIO, Forbid, Permit,
                        AllocSignal, FreeSignal, Signal, FindTask, Wait,
                        Interrupt, IOStdReqPtr, MsgPortPtr, TaskPtr,
                        MemReqs, MemReqSet, AllocMem, FreeMem, Byte;
FROM ExecSupport IMPORT CreatePort, CreateStdIO, DeletePort, DeleteStdIO;
FROM Input       IMPORT inputName, addHandler, remHandler;
FROM InputEvent  IMPORT InputEventPtr, Qualifiers, QualifierSet, Class;
FROM SYSTEM      IMPORT ADR, ADDRESS, LONGSET, INLINE, REG, SETREG;
FROM DOS IMPORT Delay;
FROM Hardware IMPORT Custom, custom, DmaFlagSet, DmaFlags;



VAR handlerStuff:Interrupt;
    inputPort:MsgPortPtr;
    inputReq:IOStdReqPtr;
    sigNum:LONGINT;
    signal:LONGSET;
    myTask:TaskPtr;
    Ende: BOOLEAN; (* CTRL F10 pressed. Quit the program now. *)
    Wave0 : POINTER TO ARRAY [0..1] OF Byte;
    sig: LONGSET;


  PROCEDURE InputHandler():InputEventPtr;
  VAR
    event:InputEventPtr;
  BEGIN
    event := ADDRESS(REG(8));  (* a0:InputEventPtr *)
    Forbid;
    WITH event^ DO
     IF (class = rawkey) AND (code < 60H) THEN
       Signal(myTask,signal)
     END; (* IF *)
     IF (class = rawkey) AND (code = 59H) AND (control IN qualifier) THEN
        Ende := TRUE
     END;
    END; (* WITH *)
    Permit;
    RETURN event;
  END InputHandler;



  (* $E- *)
  PROCEDURE InputHandlerInterface;
  BEGIN
    INLINE(048E7H, 03F3EH);       (* movem.l  d2-d7/a2-a6,-(sp) *)
    SETREG(0,InputHandler());     (* d0 : InputHandler()        *)
    INLINE(04CDFH, 07CFCH);       (* movem.l  (sp)+,d2-d7/a2-a6 *)
    INLINE(04E75H);               (* rts                        *)
  END InputHandlerInterface;




  PROCEDURE RemHandler;
  BEGIN
    IF inputReq # NIL THEN
      WITH inputReq^ DO
        IF device # NIL THEN
          command := remHandler;
          data := ADR(handlerStuff);
          DoIO(inputReq);
          CloseDevice(inputReq);
        END; (* IF *)
      END; (* WITH *)
      DeleteStdIO(inputReq);
      inputReq := NIL;
    END; (* IF *)
    IF inputPort # NIL THEN
      DeletePort(inputPort);
      inputPort := NIL;
    END; (* IF *)
    IF signal # LONGSET{} THEN
      FreeSignal(sigNum);
      signal := LONGSET{};
    END; (* IF *)
  END RemHandler;



BEGIN (* beeper main routine *)
  Ende := FALSE;
  myTask := FindTask(NIL);
  TermProcedure(RemHandler);

  (* einfache Rechteckskurve *)
  Wave0 := AllocMem(2, MemReqSet{chip});
  Assert(Wave0 # NIL, ADR("No Chip Mem left"));
  Wave0^[0] := 127; Wave0^[1] := -127;
 
  inputPort := CreatePort(ADR("BeepKey.port"),0);
  inputReq := CreateStdIO(inputPort);
  OpenDevice(ADR(inputName),0,inputReq,LONGSET{});
  Assert(inputReq^.error = 0,ADR("AddHandler: Can't open input.device"));
  WITH handlerStuff DO
     code := InputHandlerInterface;
     node.pri := 60;
     node.name := ADR("BeepKey.handler");;
  END; (* WITH *)
  inputReq^.command := addHandler;
  inputReq^.data := ADR(handlerStuff);
  DoIO(inputReq);
  Assert(inputReq^.error = 0,ADR("AddHandler: Can't add handler"));
  sigNum := AllocSignal(-1);
  Assert(sigNum # -1,ADR("AddHandler: Can't get signal"));
  signal := LONGSET{sigNum};
    
    
  REPEAT
     sig := Wait(signal);

     (* Sound *)
     custom.aud[1].acptr := Wave0;
     custom.aud[1].aclen := 1;
     custom.aud[1].acvol := 64;
     custom.aud[1].acper := 650;
     Forbid;
     custom.dmacon := DmaFlagSet{dmaSet, master, aud1};
     Delay(2);
     custom.dmacon := DmaFlagSet{aud1};
     Permit
  UNTIL Ende;
  RemHandler;
  FreeMem(Wave0, 1);
  custom.dmacon := DmaFlagSet{aud1}; (* Sound off in case... *)
  Terminate(CurrentLevel())
END Beeper.