(*---------------------------------------------------------------------------
  :Program.     Lichtorgel.mod
  :Contents.    Simulation einer 8-Kanal Lichtorgel
  :Author.      Christian Stiens
  :Address.     Heustiege 2, W-4710 Lüdinghausen
  :Copyright.   Freeware, All Rights Reserved, © 1992 by cs-soft
  :Language.    Oberon-2
  :Translator.  Amiga Oberon V2.42d (inofficial ß-version)
  :History.     V1.0, 07-Sep-92
  :Imports.     Menu (AMOK #59), FFT (AMOK #68)
---------------------------------------------------------------------------*)

(* $StackChk-  weil wenig lokale Variablen und keine Rekursion *)

MODULE Lichtorgel;

  IMPORT
    au := Audio,
    e  := Exec,
    es := ExecSupport,
          FFT,
    g  := Graphics,
    hw := Hardware,
    I  := Intuition,
          Misc,
    m  := Menu,
    rq := Requests,
    ol := OberonLib,
    sys:= SYSTEM;

  CONST
    ver = "\o$VER: lichtorgel 1.0 (7.9.92)\n\r";
    oom = "Speichermangel";

  CONST
    n = 16;           (* 16 Punkt FFT *)

  VAR
    nw       : I.NewWindow;
    win      : I.WindowPtr;
    scr      : I.ScreenPtr;
    menu     : I.MenuPtr;
    ioa      : au.IOAudioPtr;
    mes      : I.IntuiMessage;
    pp,pb    : e.APTR;
    chan     : SHORTINT;
    col      : ARRAY 16 OF INTEGER;
    i,w,x,y  : INTEGER;
    shift    : INTEGER;
    rp       : g.RastPortPtr;
    vp       : g.ViewPortPtr;
    hold     : ARRAY 8 OF INTEGER;
    xreal,
    ximag    : ARRAY n OF INTEGER;
    sintab ["_sintab_1024x16"] : ARRAY 1024 OF INTEGER;

(*---------------------------------------------------------------------*)

  TYPE InitProc = PROCEDURE(ioReq: e.MessagePtr);

  PROCEDURE OpenDev (name   : ARRAY OF CHAR;
                     unit   : LONGINT;
                     flags  : LONGSET;
                     ioSize : INTEGER;
                     ioInit : InitProc): e.MessagePtr; (* $CopyArrays- *)
    VAR
      port: e.MsgPortPtr;
      ioReq: e.IORequestPtr;

  BEGIN
    port := es.CreatePort("",0);
    IF port = NIL THEN RETURN NIL END;
    IF ioSize = 0 THEN ioSize := SIZE(e.IOStdReq) END;
    ioReq := es.CreateExtIO(port,ioSize);
    IF ioReq = NIL THEN es.DeletePort(port); RETURN NIL END;
    IF ioInit # NIL THEN ioInit(ioReq) END;
    IF e.OpenDevice(name,unit,ioReq,flags) # 0 THEN
      es.DeleteExtIO(ioReq);
      es.DeletePort(port);
      RETURN NIL
    END;
    RETURN ioReq;
  END OpenDev;

  PROCEDURE CloseDev (ioReq: e.MessagePtr);
    VAR port: e.MsgPortPtr;
  BEGIN
    port := ioReq.replyPort;
    e.CloseDevice(ioReq);
    es.DeleteExtIO(ioReq);
    es.DeletePort(port);
  END CloseDev;

(*---------------------------------------------------------------------*)

  PROCEDURE MakeTmpRas (rp: g.RastPortPtr);
    VAR tmpRas : g.TmpRasPtr;
        buffer : e.ADDRESS;
        size   : LONGINT;
  BEGIN
    size := LONG(rp.bitMap.bytesPerRow) * LONG(rp.bitMap.rows);
    INCL(ol.MemReqs,e.chip);
    ol.New(buffer,size);
    EXCL(ol.MemReqs,e.chip);
    NEW(tmpRas);
(*  rq.Assert((buffer # NIL) & (tmpRas # NIL),oom);   macht OberonLib v2.42 *)
    g.InitTmpRas(tmpRas^,buffer,size);
    rp.tmpRas := tmpRas;
  END MakeTmpRas;

  PROCEDURE MakeArea (rp: g.RastPortPtr; maxvectors: INTEGER);
    VAR areaInfo : g.AreaInfoPtr;
        buffer   : e.ADDRESS;
  BEGIN
    ol.New(buffer,maxvectors * 5);
    NEW(areaInfo);
    g.InitArea(areaInfo^,buffer,maxvectors);
    rp.areaInfo := areaInfo;
  END MakeArea;

(*---------------------------------------------------------------------*)

  PROCEDURE Record;
    VAR i,j: INTEGER;
        prb: SHORTINT;
        audci: SHORTINT;
  BEGIN
    (* $RangeChk- $OvflChk- $NilChk- *)

    audci := hw.aud0i + chan;

    (* Audio-Kanal für's Timing benutzen: *)

    hw.custom.intena := {audci};        (* Audio-Interrupt sperren *)

    hw.custom.aud[chan].ptr := NIL;
    hw.custom.aud[chan].len := 1;       (* 1 Wort *)
    hw.custom.aud[chan].per := 83;      (* Sampl.Freq = ca. 21 kHz *)
    hw.custom.aud[chan].vol := 0;

    hw.custom.dmacon := {hw.aud0+chan}; (* DMA aus *)

    e.Disable;                          (* No interrupts, please *)

    hw.custom.intreq := {audci};
    hw.custom.aud[chan].dat := 0;
    prb := sys.VAL(SHORTINT,hw.ciaa.prb) + sys.VAL(SHORTINT,-128);
     (* grrr, blöder Compiler, man muß ihn zwingen, zu glauben,
        daß -128 noch SHORTINT ist :-( *)

    FOR i := 0 TO n-1 DO

      REPEAT UNTIL audci IN hw.custom.intreqr; (* Auf Audio-Interrupt warten *)
      hw.custom.intreq := {audci};             (* Interrupt-Bit zurücksetzen *)
      hw.custom.aud[chan].dat := 0;

      (* Parallel-Port lesen: *)

      prb := sys.VAL(SHORTINT,hw.ciaa.prb) + sys.VAL(SHORTINT,-128);

      xreal[i] := LONG(prb);

    END;

    e.Enable;

    (* Mit Hammingfunktion gewichten: *)

    FOR i := 0 TO n-1 DO
      j := (i * (1024 DIV n) + 768) MOD 1024;
      xreal[i] := xreal[i] * (sintab[j] DIV 512 + 64);
      ximag[i] := 0;
    END;

    (* $RangeChk= $OvflChk= $NilChk= *)

  END Record;

(*---------------------------------------------------------------------*)

  PROCEDURE Analyse;
  BEGIN
    FFT.FFT(xreal,ximag,n);  (* Fast-Fourier-Transform aufrufen *)
    FFT.Abs(xreal,ximag,9);  (* Absolutwerte der komplexen Zahlen berechnen *)
  END Analyse;

(*---------------------------------------------------------------------*)

  PROCEDURE Muls(x{0},y{1}: INTEGER): LONGINT; (* $EntryExitCode- *)
  BEGIN
    sys.INLINE(0C1C1H,04E75H);
  END Muls;

(*---------------------------------------------------------------------*)

  PROCEDURE SetCols;

    TYPE
      Eq = ARRAY 8 OF INTEGER;

    CONST
      eq = Eq(64,256,297,341,384,427,469,512);  (* Equalizer: Alle Lampen
                                                   sollen im Durchschnitt
                                                   gleich hell sein *)
    VAR
      i,c: INTEGER;
      s: SET;

  BEGIN
    FOR i := 0 TO 7 DO
      w := 0;
      s := sys.VAL(SET,i);
      IF s = {} THEN s := {0,2} END;
      c := SHORT(ASH(Muls(xreal[i+1],eq[i]),shift));
      IF c > 15 THEN c := 15 END;
      IF c > hold[i] THEN hold[i] := c
                     ELSE c := hold[i] END;
      IF 0 IN s THEN INC(w,c) END; c := ASH(c,4);
      IF 1 IN s THEN INC(w,c) END; c := ASH(c,4);
      IF 2 IN s THEN INC(w,c) END;
      col[i+4] := w;
      DEC(hold[i]);
    END;
    g.LoadRGB4(vp,col,12);
  END SetCols;

(*---------------------------------------------------------------------*)

  PROCEDURE MakeMenu(win: I.WindowPtr);
  BEGIN
    m.StartMenu(win);

    m.NewMenu("Projekt");
    m.NewItem("Über...","U");
    m.NewItem("Ende","E");

    m.NewMenu("Kanal");
    m.NewItem("Links","L");
    m.NewItem("Rechts","R");

    m.NewMenu("Pegel");
    m.NewItem("Niedrig","1");
    m.NewItem("Mittel","2");
    m.NewItem("Hoch","3");

    menu := m.EndMenu();
    IF I.SetMenuStrip(win,menu^) THEN END;
  END MakeMenu;

(*---------------------------------------------------------------------*)

  PROCEDURE GetIMsg(win: I.WindowPtr; VAR mes: I.IntuiMessage);
    VAR msg: I.IntuiMessagePtr;
  BEGIN
    msg := e.GetMsg(win.userPort);
    IF msg # NIL THEN
      mes := msg^;
      e.ReplyMsg(msg)
    ELSE
      mes.class := LONGSET{}
    END
  END GetIMsg;

(*---------------------------------------------------------------------*)

  PROCEDURE Flag(s: LONGSET): INTEGER;
    VAR i: INTEGER;
  BEGIN
    IF s = LONGSET{} THEN RETURN 0
    ELSE i := -1; REPEAT INC(i) UNTIL i IN s; RETURN i END;
  END Flag;

(*---------------------------------------------------------------------*)

  PROCEDURE HandleMessage(VAR mes: I.IntuiMessage);

    VAR
      item: I.MenuItemPtr; itemNum:INTEGER; menuCode: INTEGER;

  BEGIN

    CASE Flag(mes.class) OF

    | 0:
      RETURN;

    | I.closeWindow:
      HALT(0);

    | I.menuPick:

      menuCode := mes.code;
      WHILE menuCode # I.menuNull DO
        item := I.ItemAddress(menu^,menuCode);
        itemNum := I.ItemNum(menuCode);
        CASE I.MenuNum(menuCode) OF

        | 0: (* Projekt *)

          CASE itemNum OF

          | 0: IF rq.RequestWin("Lichtorgel V1.0",
                                "© 92 by Christian Stiens",
                                ""," Ok ",win) THEN END;
          | 1: HALT(0);
          ELSE END;

        | 1: (* Kanal *)

          IF itemNum = 0 THEN
            INCL(hw.ciab.pra,1);                   (* Linken Kanal *)
            EXCL(hw.ciab.pra,2);                   (* selektieren  *)
          ELSE
            EXCL(hw.ciab.pra,1);                   (* Rechten Kanal *)
            INCL(hw.ciab.pra,2);                   (* selektieren   *)
          END;

        | 2: (* Pegel *)
          CASE itemNum OF
          | 0: shift := -14
          | 1: shift := -13
          | 2: shift := -12
          ELSE END;

        ELSE
        END;
        menuCode := item.nextSelect;
      END;
    ELSE
    END
  END HandleMessage;

(*---------------------------------------------------------------------*)

  PROCEDURE IoInit (ioa: e.MessagePtr);
    CONST allocMap = "\x01\x02\x04\x08";
  BEGIN
    WITH ioa: au.IOAudioPtr DO
      ioa.data := sys.ADR(allocMap);
      ioa.length := 4;
      ioa.request.message.node.pri := 127;
    END;
  END IoInit;

(*---------------------------------------------------------------------*)

BEGIN
  IF ver[0]=0X THEN END;

  scr := NIL;
  win := NIL;
  menu := NIL;
  ioa := NIL;
  pp := -1;
  pb := -1;

  Misc.base := e.OpenResource(Misc.miscName);
  IF Misc.base=NIL THEN HALT(0) END;

  pp := Misc.AllocMiscResource(Misc.parallelPort,"Lichtorgel");
  pb := Misc.AllocMiscResource(Misc.parallelBits,"Lichtorgel");

  rq.Assert((pp=NIL) & (pb=NIL),"Parallel Port belegt");

  scr := I.OpenScreen(I.NewScreen(0,0,320,200,
                                  4,
                                  0,1,
                                  {},
                                  I.customScreen,
                                  NIL, NIL, NIL, NIL));

  rq.Assert(scr # NIL,"Kein Schirm");

  nw := I.NewWindow(0,0, 320, 200,
                    0,1,
                    LONGSET{I.menuPick},
                    LONGSET{I.activate,I.backDrop,I.borderless},
                    NIL,NIL,
                    NIL,
                    NIL,NIL, 0,0,0,0,
                    I.customScreen);
  nw.screen := scr;

  win := I.OpenWindow(nw);
  rq.Assert(win # NIL,"Kein Fenster");

  rp := win.rPort;
  vp := I.ViewPortAddress(win);

  col[0] := 0;
  col[1] := 0CCCH;
  col[2] := 000CH;
  col[3] := 0C00H;
  col[14]:= 0C00H;
  col[15]:= 00C0H;

  g.LoadRGB4(vp,col,16);

  I.ShowTitle(scr,I.LFALSE);

  MakeMenu(win);

  MakeTmpRas(rp);
  MakeArea(rp,4);

  FOR i := 0 TO 7 DO
    x := i DIV 2 * 77 + 44;
    y := i MOD 2 * 88 + 62;
    g.SetAPen(rp,i+4);
    IF g.AreaCircle(rp,x,y,35) THEN END;
    IF g.AreaEnd(rp) THEN END;
  END;

  ioa := OpenDev(au.audioName,0,LONGSET{},SIZE(au.IOAudio),IoInit);
  rq.Assert(ioa # NIL,"Can't open audio.device");

  CASE sys.VAL(LONGINT,ioa.request.unit) OF
    1: chan := 0 |
    2: chan := 1 |
    4: chan := 2 |
    8: chan := 3     ELSE HALT(0)
  END;

  hw.ciaa.ddrb := SHORTSET{};                   (* Alle Bits Eingang *)
  hw.ciab.ddra := hw.ciab.ddra + SHORTSET{1,2}; (* Bit 1 & 2 Output *)
  INCL(hw.ciab.pra,1); EXCL(hw.ciab.pra,2);     (* Linker Kanal *)

  shift := -13;                                 (* Mittlerer Pegel *)

  LOOP
    GetIMsg(win,mes);
    HandleMessage(mes);
    Record;
    Analyse;
    SetCols;
    IF e.m68020 IN e.exec.attnFlags THEN
                                    g.WaitTOF END; (* 50 mal/sec reicht :-) *)
  END;

CLOSE

  IF (pp=NIL)&(pb=NIL) THEN hw.ciab.ddra := hw.ciab.ddra-SHORTSET{1,2} END;
  IF ioa # NIL THEN CloseDev(ioa) END;
  IF menu# NIL THEN I.ClearMenuStrip(win) END;
  IF win # NIL THEN I.CloseWindow(win) END;
  IF scr # NIL THEN I.OldCloseScreen(scr) END;
  IF pp=NIL THEN Misc.FreeMiscResource(Misc.parallelPort) END;
  IF pb=NIL THEN Misc.FreeMiscResource(Misc.parallelBits) END;

END Lichtorgel.