(*-------------------------------------------------------------------------
 :Program.     FMsynth.mod
 :Contents.    6 Operator FM-Syntheziser
 :Author.      Christian Stiens
 :Address.     Snail-Mail:           E-Mail:
 :Address.     Heustiege 2           UUCP: Christian_Stiens@ouzonix.bo.open.de
 :Address.     W-4710 Lüdinghausen   FIDO: 2:245/5802.25
 :Copyright.   Giftware, © 93 Christian Stiens
 :Language.    Oberon-2
 :Translator.  Amiga Oberon 3.01d
 :History.     V1.0, 26-Feb-93: first release
 :Imports.     AudioSupport, IntuiSupport, DeviceSupport,
 :Imports.     MyFileReq, IntuiPointer
-------------------------------------------------------------------------*)

MODULE FMsynth;

  (* $JOIN sintab.o *)

  IMPORT
    arg  := Arguments,
    as   := AudioSupport,
    c    := Conversions,
    cia  := Cia,
    d    := Dos,
    ds   := DeviceSupport,
    e    := Exec,
    fr   := MyFileReq,
    g    := Graphics,
    hw   := Hardware,
    I    := Intuition,
    in   := Input,
    ip   := IntuiPointer,
    is   := IntuiSupport,
    ffp  := MathFFP,
    trans:= MathTrans,
    ol   := OberonLib,
    rq   := Requests,
    SYS  := SYSTEM,
    str  := Strings,
    t    := Timer,
    wb   := Workbench;


  CONST
    ver = "\o$VER: fmsynth 1.0 (26.2.93)";

    (* $DataChip+ *)

    beep = "\x00\x7F\x00\x80";


  TYPE

    Algorithm = STRUCT
      numLines : INTEGER;
      line     : ARRAY 15 OF STRUCT mod,car: SHORTINT END;
    END;

    Operator = STRUCT
      scR   : SHORTINT;
      scL   : SHORTINT;
      r,l   : ARRAY 4 OF SHORTINT;
      freq  : REAL;
      outp  : SHORTINT;
      mode  : SHORTINT;
    END;

    LFO = STRUCT
      wave    : SHORTINT;  (* LFOWaves *)
      spd,del : SHORTINT;
      amd,pmd : SHORTINT;
    END;


  CONST
    maxPM = 5.0E5;


  CONST
    sin=0; tri=1; down=2; up=3; sqr=4; (* LFOWaves *)
    end=0; keyDown=1; keyUp=2;         (* State *)
    poly=0; mono=1;                    (* Mode *)
    car=0; mod=1; none=2;
    ratio=0; fixed=1;                  (* Operator.mode *)

    pfH  = {I.freeHoriz,I.propBorderless};
    pfV  = {I.freeVert,I.propBorderless};

    (*----- Gadget-IDs -----*)

    O1=1;O2=2;O3=3;O4=4;O5=5;O6=6;SR=7;SL=8;
    R1=9;R2=10;R3=11;R4=12;L1=13;L2=14;L3=15;L4=16;
    OL=17;FR=18;WA=19;SP=20;DE=21;AM=22;PM=23;
    M1=24;M2=25;M3=26;M4=27;M5=28;M6=29;
    C1=30;C2=31;C3=32;C4=33;C5=34;C6=35;
    LN=36;RR=37;CS=38;TP=39;OS=40;OK=41;CA=42;
    B1=43;B2=44;B3=45;B4=46;B5=47;CL=48;
    OM=49;FB=50;MD=51;FL=52;PR=53;


  VAR  (*--- Globals ----*)

    scr         : I.ScreenPtr;
    scrtitle    : ARRAY 80 OF CHAR;
    win,win2    : I.WindowPtr;
    req         : I.RequesterPtr;
    rp          : g.RastPortPtr;
    vp          : g.ViewPortPtr;
    pal         : BOOLEAN;
    oldfltstate : BOOLEAN;
    mes         : I.IntuiMessage;
    menu        : I.MenuPtr;
    pref        : I.Preferences;
    oldThresh   : t.TimeVal;
    me          : d.ProcessPtr;
    oldWindowPtr: I.WindowPtr;
    filePath    : e.STRING;
    file        : d.FileHandlePtr;
    op          : ARRAY 6 OF Operator;
    opNr        : SHORTINT;
    lfo         : LFO;
    lfoTab      : ARRAY 256 OF SHORTINT;
    lfoPic      : UNTRACED POINTER TO SYS.BYTE;
    lfoImg      : I.ImagePtr;
    fmImg       : I.ImagePtr;
    fmPic       : UNTRACED POINTER TO SYS.BYTE;
    mixPic      : UNTRACED POINTER TO SYS.BYTE;
    mixImg      : I.ImagePtr;
    zifPic      : UNTRACED POINTER TO SYS.BYTE;
    zifImg      : I.ImagePtr;
    algo        : Algorithm;
    isCarrier   : ARRAY 6 OF BOOLEAN;
    output      : INTEGER;
    maxoutp     : INTEGER;
    disabled    : BOOLEAN;
    key         : ARRAY 128 OF SHORTINT;
    period      : ARRAY 36 OF REAL;
    channel     : ARRAY 36 OF SHORTINT;
    mode        : SHORTINT;
    soundBuf    : SYS.ADDRESS;
    soundLen    : LONGINT;
    lenHi       : LONGINT;
    oneShotHi   : LONGINT;
    repeatHi    : LONGINT;
    shiftOct    : INTEGER;
    rRate       : SHORTINT;
    filter      : BOOLEAN;
    transp      : REAL;
    feedback    : SHORTINT;
    int         : e.Interrupt;
    intOn       : BOOLEAN;
    volTemp     : REAL;
    perTemp     : REAL;
    Per         : INTEGER;
    vol,per     : ARRAY 4 OF REAL;
    deltaVol    : REAL;
    state       : ARRAY 4 OF SHORTINT;
    delay       : ARRAY 4 OF INTEGER;
    lfoArg      : ARRAY 4 OF INTEGER;
    lfoInc      : INTEGER;
    i,id        : INTEGER;
    lastCar     : SHORTINT;
    lastMod     : SHORTINT;
    lastWas     : SHORTINT;
    flag        : BOOLEAN;
    keyCode     : INTEGER;
    selGad      : I.GadgetPtr;
    actPropGad  : I.GadgetPtr;
    code        : INTEGER;
    octave      : INTEGER;
    chan        : SHORTINT;
    lockreq     : I.Requester;
    tr          : t.TimeRequestPtr;
    sinTab ["_SinTab"] : ARRAY 8192 OF SHORTINT;


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

    gadOp   : ARRAY 7 OF I.GadgetPtr;
    gadEG   : ARRAY 8 OF I.GadgetPtr; knobEG : ARRAY 8 OF I.Image;
    gadAlgM : ARRAY 7 OF I.GadgetPtr;
    gadAlgC : ARRAY 7 OF I.GadgetPtr;
    gadFreq : I.GadgetPtr;
    gadLen  : I.GadgetPtr;
    gadOutp : I.GadgetPtr;  knobOutp : I.Image;
    gadLFOs : I.GadgetPtr;  knobLFOs : I.Image;
    gadLFOd : I.GadgetPtr;  knobLFOd : I.Image;
    gadLFOa : I.GadgetPtr;  knobLFOa : I.Image;
    gadLFOp : I.GadgetPtr;  knobLFOp : I.Image;
    gadLFOw : I.GadgetPtr;
    gadScR  : I.GadgetPtr;  knobScR  : I.Image;
    gadScL  : I.GadgetPtr;  knobScL  : I.Image;
    gadRel  : I.GadgetPtr;  knobRel  : I.Image;
    gadCalc : I.GadgetPtr;
    gadTsp  : I.GadgetPtr;
    gadOffs : I.GadgetPtr;  knobPlot : I.Image;
    gadOk   : I.GadgetPtr;
    gadCncl : I.GadgetPtr;
    gadBuf  : ARRAY 6 OF I.GadgetPtr;
    gadClr  : I.GadgetPtr;
    gadFeed : I.GadgetPtr;
    gadFlt  : I.GadgetPtr;
    gadMode : I.GadgetPtr;
    gadOM   : I.GadgetPtr;
    gadPer  : I.GadgetPtr;

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

  PROCEDURE LFOPics;  (* $EntryExitCode- *)
  BEGIN SYS.INLINE
   (03C00H,04200H,08100H,08100H,00081H,00081H,00042H,0003CH,
    00800H,01400H,02200H,04101H,08082H,00044H,00028H,00010H,
    08100H,0C180H,0A140H,09120H,08910H,08508H,08304H,08102H,
    00102H,00306H,0050AH,00912H,01122H,02142H,04182H,08102H,
    0FF00H,08100H,08100H,08100H,00102H,00102H,00102H,001FEH)
  END LFOPics;

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

  PROCEDURE MixPics; (* $EntryExitCode- *)
  BEGIN SYS.INLINE(
    0C5D2H, 0AA95H, 0AA95H, 0CE95H, 0AA95H, 0AA92H,
    0EAB6H, 08AA5H, 0C935H, 08925H, 08AA5H, 08AB6H,
    0A492H, 0EAD5H, 0EAD5H, 0AAB5H, 0AAB5H, 0A492H,
    0C491H, 0AA8AH, 0AA84H, 0CA84H, 08A84H, 084E4H,
    00490H, 00AD0H, 00AD0H, 00AB0H, 00AB0H, 00490H,
    009DCH, 01510H, 01598H, 01510H, 01510H, 00910H)
  END MixPics;

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

  PROCEDURE Ziffern; (* $EntryExitCode- *)
  BEGIN SYS.INLINE(
    0C000H, 0C000H, 0C000H, 0C000H, 0C000H,  (* 0 *)
    04000H, 0C000H, 04000H, 04000H, 04000H,  (* 1 *)
    0C000H, 04000H, 0C000H, 08000H, 0C000H,  (* 2 *)
    0C000H, 04000H, 0C000H, 04000H, 0C000H,  (* 3 *)
    08000H, 08000H, 0C000H, 04000H, 04000H,  (* 4 *)
    0C000H, 08000H, 0C000H, 04000H, 0C000H,  (* 5 *)
    0C000H, 08000H, 0C000H, 0C000H, 0C000H,  (* 6 *)
    0C000H, 04000H, 04000H, 04000H, 04000H,  (* 7 *)
    0C000H, 0C000H, 08000H, 0C000H, 0C000H,  (* 8 *)
    0C000H, 0C000H, 0C000H, 04000H, 0C000H)  (* 9 *)
  END Ziffern;

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

  PROCEDURE FMPic; (* $EntryExitCode- *)
  BEGIN SYS.INLINE(
    (* [0] *)
    0FF80H,00007H,0F03FH,0FFFFH,0FFFFH,0FFFEH,01FFFH,0FFFFH,
    0FFBFH,0FEF7H,0F7BFH,0FFFFH,0FFFFH,0F878H,0DFFFH,0FFFFH,
    0FFBFH,0FFF1H,0E78FH,0FFFFH,0FFFFH,0F373H,0C7FFH,0FFFFH,
    0FF9FH,0FF79H,0EF0FH,0FFFFH,0FFFFH,0E717H,0C7FFH,0FFFFH,
    0FFCFH,08738H,0CF0FH,0FFFFH,0FFFFH,0CF17H,0C7FFH,0FFFFH,
    0FFEFH,0833CH,0DF00H,01018H,07843H,09F03H,0C0FFH,0FFFFH,
    0FFEFH,0803CH,01F0FH,0C7C3H,02319H,03FEBH,0C67FH,0FFFFH,
    0FFEFH,0903EH,03F1FH,0EFE7H,08F3CH,07FE3H,0DF3FH,0FFFFH,
    0FFEFH,0983EH,03F3FH,0EFE7H,09FFEH,01F03H,0FF9FH,0FFFFH,
    0FFEFH,0F8BFH,07F3EH,047C3H,0BFFEH,01F03H,0FF8FH,0FFFFH,
    0FFEFH,0F8BFH,0FF3FH,003C7H,01F7EH,01F03H,0EF8FH,0FFFFH,
    0FFEFH,0F8B7H,0EF3FH,083E7H,01E3EH,01F1BH,0C78FH,0FFFFH,
    0FFEFH,098B7H,0EF1FH,0C1EEH,01E3EH,01F1BH,0C78FH,0FFFFH,
    0FFEFH,090B3H,0CF0FH,0E5FEH,01E3EH,01F1BH,0C78FH,0FFFFH,
    0FFEFH,080B3H,0CF07H,0E0FEH,01E3EH,01F0BH,0C78FH,0FFFFH,
    0FFCFH,08031H,08F33H,0E2FCH,01E3EH,01F63H,0C78FH,0FFFFH,
    0FF9FH,0C071H,08F3BH,0E2FCH,01E3EH,01FE7H,0C78FH,0FFFFH,
    0FFBFH,0E6F9H,09F9FH,0C27CH,03F3FH,00FCFH,0EFCFH,0FFFFH,
    0FFBFH,0E2F8H,01F8FH,08078H,01E1EH,0078FH,0EFC7H,0FFFFH,
    0FF80H,00200H,00000H,00378H,04000H,01000H,00007H,0FFFFH,
    0FFE0H,00380H,00000H,00770H,06000H,01800H,00007H,0FFFFH,
    0FFE0H,00380H,0F008H,007F0H,0F030H,03C08H,00007H,0FFFFH,
    0FFFFH,0FFFFH,0FFFFH,0F7E0H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
    0FFFFH,0FFFFH,0FFFFH,0F3C1H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
    0FFFFH,0FFFFH,0FFFFH,0F801H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
    0FFFFH,0FFFFH,0FFFFH,0FC03H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
    0FFFFH,0FFFFH,0FFFFH,0FE07H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
    (* [1] *)
    0007FH,0FFF8H,00FC0H,00000H,00000H,00001H,0E000H,00000H,
    0007FH,0FFF8H,00FC0H,00000H,00000H,00787H,0E000H,00000H,
    0007FH,0FFFCH,01FC0H,00000H,00000H,00F8FH,0E000H,00000H,
    0007FH,0FFFCH,01FC0H,00000H,00000H,01F8FH,0E000H,00000H,
    0003FH,0FFFEH,03F80H,00000H,00000H,03F8FH,0E000H,00000H,
    0001FH,0CFFEH,03F9FH,0EFE7H,087BCH,07FFFH,0EF00H,00000H,
    0001FH,0FFFFH,07FBFH,0FFFFH,0DFFEH,0FFF7H,0FF80H,00000H,
    0001FH,0FC7FH,07FFFH,0FFFFH,0FFFFH,0FFF7H,0FFC0H,00000H,
    0001FH,0FC7FH,0FFFFH,0FFFFH,0FFFFH,0FFF7H,0FFC0H,00000H,
    0001FH,0FC7FH,0FFFFH,0FFFFH,0FFFFH,03F87H,0FFC0H,00000H,
    0001FH,0FC7FH,0FFFFH,0EFFFH,0FFFFH,03F87H,0FFC0H,00000H,
    0001FH,0FC7FH,0FFFFH,0E7FFH,0BFFFH,03F87H,0FFC0H,00000H,
    0001FH,0FC7FH,0FFFFH,0F7FFH,0BF7FH,03F87H,0EFC0H,00000H,
    0001FH,0FC7FH,0FFBFH,0F3FFH,03F7FH,03F87H,0EFC0H,00000H,
    0001FH,0F87FH,0FFFFH,0F3FFH,03F7FH,03FF7H,0EFC0H,00000H,
    0003FH,0E0FFH,0FFFFH,0F1FFH,03F7FH,03FFFH,0EFC0H,00000H,
    0007FH,0F1FFH,0FFFFH,0F1FEH,07FFFH,0BFFFH,0FFE0H,00000H,
    0007FH,0F1FFH,0FFFFH,0F1FEH,07FFFH,0BFFFH,0FFE0H,00000H,
    0007FH,0F1FFH,0FFFFH,0E7FEH,07FFFH,09FFFH,0FFE0H,00000H,
    0007FH,0F1FCH,03FDFH,0CFFCH,03F3FH,00FDFH,0FFE0H,00000H,
    00000H,00000H,00000H,00FFCH,00000H,00000H,00000H,00000H,
    00000H,00000H,00000H,00FF8H,00000H,00000H,00000H,00000H,
    00000H,00000H,00000H,00FF8H,00000H,00000H,00000H,00000H,
    00000H,00000H,00000H,00FF0H,00000H,00000H,00000H,00000H,
    00000H,00000H,00000H,007E0H,00000H,00000H,00000H,00000H,
    00000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H,
    00000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H);
  END FMPic;

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

  PROCEDURE VKnob; (* $EntryExitCode- *)
  BEGIN
    SYS.INLINE(
    07800H,0FC00H,00000H,0FC00H,07800H,
    0FC00H,0FC00H,0FC00H,0FC00H,0FC00H)
  END VKnob;

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

  PROCEDURE HKnob; (* $EntryExitCode- *)
  BEGIN
    SYS.INLINE(
    05000H,0D800H,0D800H,0D800H,0D800H,05000H,
    0F800H,0F800H,0F800H,0F800H,0F800H,0F800H)
  END HKnob;

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

  PROCEDURE ToChipMem(adr:e.ADDRESS; size:LONGINT; check:BOOLEAN): e.ADDRESS;
    VAR newAdr: e.ADDRESS;
        p1,p2: UNTRACED POINTER TO SYS.BYTE;
  BEGIN
    IF check & (e.chip IN e.TypeOfMem(adr)) THEN RETURN adr END;
    INCL(ol.MemReqs,e.chip);
    ol.New(newAdr,size);
    EXCL(ol.MemReqs,e.chip);
    p1 := adr; p2 := newAdr;
    e.CopyMem(p1^,p2^,size);
    RETURN newAdr
  END ToChipMem;

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

  PROCEDURE LockWindow(win: I.WindowPtr);
  BEGIN
    I.InitRequester(lockreq);
    lockreq.width := 1;
    lockreq.height := 1;
    lockreq.backFill := SHORT(SHORT(g.ReadPixel(win.rPort,0,0)));
    IF ~ I.Request(SYS.ADR(lockreq),win) THEN HALT(20) END;
  END LockWindow;

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

  PROCEDURE UnLockWindow(win:I.WindowPtr);
  BEGIN
    I.EndRequest(SYS.ADR(lockreq),win);
  END UnLockWindow;

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

  PROCEDURE Request(hail,pos,neg:ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)

    VAR
      txt0,t : I.IntuiTextPtr;
      posGad : I.GadgetPtr;

  BEGIN
    IF req=NIL THEN
      txt0 := is.CreateIntuiText(2,0,g.jam1,0,10,NIL,"", is.CreateIntuiText(3,0,g.jam1,0,9,NIL,"",NIL));
      is.whitePen := 3; is.blackPen := 2;
      is.gadgetFrontPen := 3; is.gadgetBackPen := 1;
      gadOk   := is.CreateBoolGadget(0,12,31,55,12," ",is.autoBorder,NIL,is.stdGad,is.stdAct+{I.endGadget});
      gadCncl := is.CreateBoolGadget(0,85,31,55,12," ",gadOk.gadgetRender,NIL,is.stdGad,is.stdAct+{I.endGadget});
      req := is.CreateRequester(85,75,150,50,0,0,is.autoBorder,txt0,{},1);
      is.AddReqGadget(req,gadOk);
      is.AddReqGadget(req,gadCncl);
    END;
    t := req.reqText; t.iText := SYS.ADR(hail); t.leftEdge := 76-SHORT(str.Length(hail))*4;
    t := t.nextText;  t.iText := SYS.ADR(hail); t.leftEdge := 75-SHORT(str.Length(hail))*4;
    IF pos[0] # 0X THEN
      t := req.reqGadget.nextGadget.gadgetText;
      t.iText := SYS.ADR(pos); t.leftEdge := 29-SHORT(str.Length(pos))*4;
    END;
    t := req.reqGadget.gadgetText;
    t.iText := SYS.ADR(neg); t.leftEdge := 29-SHORT(str.Length(neg))*4;
    IF pos[0]=0X THEN
      posGad := req.reqGadget.nextGadget;
      req.reqGadget.nextGadget := NIL;
    END;
    IF ~I.Request(req,win) THEN RETURN TRUE END;
    REPEAT is.GetIMsg(win,mes,TRUE) UNTIL I.gadgetUp IN mes.class;
    IF pos[0]=0X THEN
      req.reqGadget.nextGadget := posGad
    END;
    RETURN mes.iAddress = gadOk;
  END Request;

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

  PROCEDURE InitKnobs;
    VAR i:INTEGER;
  BEGIN
    (*--- VertKnobs ---*)
    knobOutp.leftEdge := 0;
    knobOutp.topEdge := 0;
    knobOutp.width := 6;
    knobOutp.height := 5;
    knobOutp.depth := 2;
    knobOutp.imageData := ToChipMem(SYS.VAL(SYS.ADDRESS,VKnob),20,TRUE);
    knobOutp.planePick := SHORTSET{0,1};
    knobOutp.planeOnOff := SHORTSET{};
    knobOutp.nextImage := NIL;
    FOR i:=0 TO 7 DO
      knobEG[i] := knobOutp
    END;
    knobScL := knobOutp;
    knobScR := knobOutp;
    (*--- HorizKnobs ---*)
    knobLFOs.leftEdge := 0;
    knobLFOs.topEdge := 0;
    knobLFOs.width := 5;
    knobLFOs.height := 6;
    knobLFOs.depth := 2;
    knobLFOs.imageData := ToChipMem(SYS.VAL(SYS.ADDRESS,HKnob),24,TRUE);
    knobLFOs.planePick := SHORTSET{0,1};
    knobLFOs.planeOnOff := SHORTSET{};
    knobLFOs.nextImage := NIL;
    knobLFOd := knobLFOs;
    knobLFOa := knobLFOs;
    knobLFOp := knobLFOs;
    knobPlot := knobLFOs;
    knobRel  := knobLFOs;
  END InitKnobs;

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

  PROCEDURE StringToReal(s: ARRAY OF CHAR; VAR x: REAL): BOOLEAN; (* $CopyArrays- *)
    VAR v,w,z  : LONGINT;
        i      : INTEGER;
        p      : BOOLEAN;
        minus  : BOOLEAN;
        f      : REAL;
  BEGIN
    i := 0; v := 0; w := 0; p := FALSE; f := 1; minus := FALSE;
    WHILE (i < LEN(s)) & (s[i] # 0X) DO
      IF s[i] = "." THEN
        p := TRUE
      ELSIF s[i] = "-" THEN
        minus := TRUE
      ELSE
        IF (s[i] >= "0") & (s[i] <= "9") THEN
          z := ORD(s[i]) - ORD("0");
          IF p THEN f := f / 10; w := w * 10 + z ELSE v := v * 10 + z END;
        END;
      END; INC(i)
    END;
    x := v + w * f;
    IF minus THEN x := -x END;
    RETURN TRUE;
  END StringToReal;

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

  PROCEDURE RealToString(x: REAL; VAR s: ARRAY OF CHAR; n: INTEGER): BOOLEAN;
    VAR i    : INTEGER;
        w    : REAL;
        v,f,z: LONGINT;
        flag : BOOLEAN;
        ovfl : BOOLEAN;
        zn   : LONGINT;
        p    : BOOLEAN;

    PROCEDURE Char(ch: CHAR);
    BEGIN
      IF i < LEN(s) THEN
        s[i] := ch;
        INC(i)
      ELSE
        IF ~p THEN ovfl := TRUE END;
      END;
    END Char;

  BEGIN (* RealToString *)
    i := 0; ovfl := FALSE; flag := FALSE; p := FALSE;
    IF x<0 THEN Char("-"); x:=-x END;
    zn := 1;
    WHILE n>0 DO zn := zn * 10; DEC(n) END;
    x := x + 0.5/zn;   (* Round *)
    v := ENTIER(x);
    w := x - v;        (* Trunc *)
    f := 1000000000;
    REPEAT
      z := v DIV f;
      IF z # 0 THEN flag := TRUE END;
      IF flag  THEN Char(CHR(z+ORD("0"))) END;
      v := v - z * f; f := f DIV 10
    UNTIL f = 0;
    p := TRUE;
    Char(".");
    w := w * zn; v := ENTIER(w); f := zn;
    WHILE f >= 10 DO
      f := f DIV 10;
      z := v DIV f;
      Char(CHR(z+ORD("0")));
      v := v - z * f;
    END;
    IF i < LEN(s) THEN s[i] := 0X END;
    RETURN ~ ovfl
  END RealToString;

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

  PROCEDURE SetThresh(secs,micro: LONGINT);
  BEGIN
    IF tr#NIL THEN
      tr.time.secs  := secs;
      tr.time.micro := micro;
      ds.DoCommand(tr,in.setThresh);
    END;
  END SetThresh;

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

  PROCEDURE IntPerSec(ints: INTEGER);
    VAR wert : INTEGER;
        eClock : LONGINT;
  BEGIN
    (* $RangeChk- $OvflChk- *)
    IF e.exec.libNode.version >= 37 THEN
      eClock := e.exec.eClockFrequency
    ELSE
      eClock := 712644;
    END;
    wert := SHORT(ENTIER(eClock/ints+0.5));
    hw.ciaa.talo := SHORT(SYS.VAL(INTEGER,SYS.VAL(SET,wert) * {0..7}));
    hw.ciaa.tahi := SHORT(SYS.LSH(wert,-8));
    INCL(hw.ciaa.cra,hw.craLoad);
    (* $RangeChk= $OvflChk= *)
  END IntPerSec;

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

  PROCEDURE SetTimer(start: BOOLEAN);
  BEGIN
    IF start THEN
      IntPerSec(110);
      INCL(hw.ciaa.cra,hw.craStart)
    ELSE
      EXCL(hw.ciaa.cra,hw.craStart)
    END;
  END SetTimer;

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

  PROCEDURE Print(rp:g.RastPortPtr; x,y:INTEGER; str:ARRAY OF CHAR);
    (* $CopyArrays- *)
    VAR i:INTEGER;
  BEGIN
    i := 0;
    WHILE (i < LEN(str)) & (str[i] # 0X) DO INC(i) END;
    g.SetDrMd(rp,g.jam1);
    g.Move(rp,x+1,y+1);
    g.SetAPen(rp,2);
    g.Text(rp,str,i);
    g.SetAPen(rp,3);
    g.Move(rp,x,y);
    g.Text(rp,str,i);
  END Print;

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

  PROCEDURE Box(rp:g.RastPortPtr; x,y,a,b:INTEGER;
                         out:BOOLEAN;fill:INTEGER);
  BEGIN
    IF fill >= 0 THEN
      g.SetAPen(rp,fill);
      g.RectFill(rp,x,y,x+a-1,y+b-1)
    END;
    IF out THEN g.SetAPen(rp,3) ELSE g.SetAPen(rp,2) END;
    g.Move(rp,x+a-1,y); g.Draw(rp,x,y); g.Draw(rp,x,y+b-1);
    IF out THEN g.SetAPen(rp,2) ELSE g.SetAPen(rp,3) END;
    g.Draw(rp,x+a-1,y+b-1); g.Draw(rp,x+a-1,y+1);
  END Box;

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

  PROCEDURE PrintNumber(rp:g.RastPortPtr; x,y: INTEGER; num: INTEGER);

    VAR z: ARRAY 3 OF INTEGER;
        adr: UNTRACED POINTER TO SYS.BYTE;
        i,j: INTEGER;
  BEGIN
    z[2] := num DIV 100;
    z[1] := num MOD 100 DIV 10;
    z[0] := num MOD 10;
    IF    num >= 100 THEN j := 3
    ELSIF num >=  10 THEN j := 2
    ELSE                  j := 1
    END;
    g.SetAPen(rp,1);
    CASE j OF
      1: g.RectFill(rp,x-6,y,x-2,y+4) |
      2: g.RectFill(rp,x-6,y,x-5,y+4)
    ELSE END;
    FOR i:=0 TO j-1 DO
      adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,Ziffern) + z[i]*10);
      e.CopyMem(adr^,zifPic^,10);
      I.DrawImage(rp,zifImg^,x-i*3,y);
    END;
  END PrintNumber;

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

  PROCEDURE Frame(rp:g.RastPortPtr; x,y,a,b:INTEGER);
  BEGIN
    g.Move(rp,x+a-1,y);
    g.Draw(rp,x,y); g.Draw(rp,x,y+b-1); g.Draw(rp,x+a-1,y+b-1); g.Draw(rp,x+a-1,y+1);
  END Frame;

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

  PROCEDURE SetUpMenu;
    CONST es = LONGSET{};
  BEGIN
    is.DefMenu("Project",8,0,7*8+2,10,TRUE);
    is.DefItem("Load Voice..",0, 0,128,10,0,es,"L",is.stdItem+{I.commSeq});
    is.DefItem("Save Voice..",0,10,128,10,0,es,"S",is.stdItem+{I.commSeq});
    is.DefItem("Save 8SVX..", 0,20,128,10,0,es,"V",is.stdItem+{I.commSeq});
    is.DefItem("New",         0,30,128,10,0,es,"N",is.stdItem+{I.commSeq});
    is.DefItem("About",       0,40,128,10,0,es," ",is.stdItem);
    is.DefSub(  fmImg^,               60,10,170,30,0,es," ",{I.itemEnabled});
    is.DefSub(" Version 1.0, © 1993 ",60,40,170,10,0,es," ",is.stdItem-{I.highComp});
    is.DefSub(" by Christian Stiens ",60,50,170,10,0,es," ",is.stdItem-{I.highComp});
    is.DefSub("      Giftware       ",60,60,170,10,0,es," ",is.stdItem-{I.highComp});
    is.DefSub(" All Rights Reserved ",60,70,170,10,0,es," ",is.stdItem-{I.highComp});
    is.DefItem("Quit",      0,50,128,10,0,es,"Q",is.stdItem+{I.commSeq});

    is.DefMenu("Operator",10*8,0,8*8+2,10,TRUE);
    is.DefItem("Init",      0, 0,85,10,0,es,"I",is.stdItem+{I.commSeq});
    is.DefItem("Store    »",0,10,85,10,0,es," ",is.stdItem);
    is.DefSub("to 1",60, 0,35,10,0,es," ",is.stdItem);
    is.DefSub("to 2",60,10,35,10,0,es," ",is.stdItem);
    is.DefSub("to 3",60,20,35,10,0,es," ",is.stdItem);
    is.DefSub("to 4",60,30,35,10,0,es," ",is.stdItem);
    is.DefSub("to 5",60,40,35,10,0,es," ",is.stdItem);
    is.DefSub("to 6",60,50,35,10,0,es," ",is.stdItem);
    is.DefItem("Freqency »",0,20,85,10,0,es," ",is.stdItem);
    is.DefSub("Double",50, 0,80,10,0,es,"D",is.stdItem+{I.commSeq});
    is.DefSub("Halve ",50,10,80,10,0,es,"H",is.stdItem+{I.commSeq});

    is.DefMenu("Special",20*8,0,7*8+2,10,TRUE);
    is.DefItem("Algorithm   »",0,00,110,10,0,es," ",is.stdItem);
    is.DefSub("#0",70, 0,50,10,0,es,"0",is.stdItem+{I.commSeq});
    is.DefSub("#1",70,10,50,10,0,es,"1",is.stdItem+{I.commSeq});
    is.DefSub("#2",70,20,50,10,0,es,"2",is.stdItem+{I.commSeq});
    is.DefSub("#3",70,30,50,10,0,es,"3",is.stdItem+{I.commSeq});
    is.DefSub("#4",70,40,50,10,0,es,"4",is.stdItem+{I.commSeq});
    is.DefSub("#5",70,50,50,10,0,es,"5",is.stdItem+{I.commSeq});
    is.DefSub("#6",70,60,50,10,0,es,"6",is.stdItem+{I.commSeq});
    is.DefSub("#7",70,70,50,10,0,es,"7",is.stdItem+{I.commSeq});
    is.DefSub("#8",70,80,50,10,0,es,"8",is.stdItem+{I.commSeq});
    is.DefSub("#9",70,90,50,10,0,es,"9",is.stdItem+{I.commSeq});
    is.DefItem("Set Loop..", 0,10,110,10,0,es,"P",is.stdItem+{I.commSeq});
    is.DefItem("Fourier..",  0,20,110,10,0,es,"F",is.stdItem+{I.commSeq});
    menu := is.InstallMenuStrip(win);
  END SetUpMenu;

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

  PROCEDURE DoFileRequest(text:ARRAY OF CHAR;VAR filePath:e.STRING):BOOLEAN; (* $CopyArrays- *)
    VAR ok:BOOLEAN;
  BEGIN
    ip.Busy(win);
    LockWindow(win);
    SetThresh(oldThresh.secs,oldThresh.micro);
    fr.defaultLeft := 10;
    IF CAP(text[0])#"S" THEN
      ok := fr.FileReqWin(text,filePath,win);
    ELSE
      ok := fr.FileReqWinSave(text,filePath,win);
    END;
    UnLockWindow(win);
    ip.Normal(win);
    RETURN ok;
  END DoFileRequest;

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

  PROCEDURE AddGad(gad: I.GadgetPtr);
  BEGIN
    is.AddGadget(win,gad);
  END AddGad;

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

  PROCEDURE ^DrawKeyboard;

  PROCEDURE SetUpScreen;

    TYPE  ColorType = ARRAY 4 OF INTEGER;

    VAR   i,pos  : INTEGER;
          strPtr : UNTRACED POINTER TO ARRAY 6 OF CHAR;
          scrHe  : INTEGER;
          str    : ARRAY 2 OF CHAR;
  BEGIN
    pal := g.gfx.normalDisplayRows >= 256;
    IF pal THEN scrHe := 256 ELSE scrHe := 200 END;

    scrtitle := "FMsynth oct: 1 name:                 ";

    scr := is.CreateScreen(scrtitle,(g.gfx.normalDisplayColumns-640) DIV 4,0,320,scrHe,2,{},NIL);
    vp := SYS.ADR(scr.viewPort);

    g.LoadRGB4(vp,ColorType(0000H,0AAAH,0555H,0FFFH),4);

    win := is.CreateWindow("",0,11,320,scrHe-11,scr,
     LONGSET{I.borderless,I.backDrop,I.activate},
     LONGSET{I.gadgetDown,I.gadgetUp,I.mouseMove,I.rawKey,I.menuPick,I.activeWindow,I.inactiveWindow},NIL);
    ip.Normal(win);
    me.windowPtr := win;
    rp := win.rPort;
    InitKnobs;
    SetUpMenu;
    (*----------- BackGround -------------*)
    Box(rp,0,0,320,189,TRUE,1);
    (*----------- Operator ---------------*)
    Box(rp,8,5,214,85,FALSE,-1);
    Print(rp,13,13,"Operator");
    Print(rp,100,16,"1 2 3 4 5 6");
    FOR i:=1 TO 6 DO
      Box(rp,i*16+82,8,12,12,TRUE,-1);
      gadOp[i] := is.CreateBoolGadget(O1-1+i,i*16+82,8,12,12,"",NIL,NIL,is.stdGad,is.stdAct);
      AddGad(gadOp[i]);
    END;
    gadScR := is.CreatePropGadget(SR,16,29,6,40,0,128,SYS.ADR(knobScR),I.gadgHNone,is.stdAct+{I.followMouse},pfV);
    gadScL := is.CreatePropGadget(SL,28,29,6,40,0,128,SYS.ADR(knobScL),I.gadgHNone,is.stdAct+{I.followMouse},pfV);
    Print(rp,15,76,"R");
    Print(rp,27,76,"L");
    Print(rp,13,86,"KSc");
    AddGad(gadScR);
    AddGad(gadScL);
    FOR i := 0 TO 7 DO
      gadEG[i] := is.CreatePropGadget(R1+i,47+10*i+i DIV 4*6,29,6,40,0,128,SYS.ADR(knobEG[i]),I.gadgHNone,is.stdAct+{I.followMouse},pfV);
      str[0] := CHR(ORD("1")+i MOD 4); str[1] := 0X;
      Print(rp,gadEG[i].leftEdge-1,gadEG[i].topEdge+47,str);
      AddGad(gadEG[i]);
    END;
    Print(rp, 50,86,"Rate");
    Print(rp,100,86,"Lvl");
    gadOutp := is.CreatePropGadget(OL,147,29,6,40,0,128,SYS.ADR(knobOutp),I.gadgHNone,is.stdAct+{I.followMouse},pfV);
    AddGad(gadOutp);
    Print(rp,138,76,"Outp");
    Print(rp,138,86,"Lvl");
    gadFreq := is.CreateStrGadget(FR,166,40,48,8,6,"","",NIL,is.stdGad,is.stdAct+{I.stringRight});
    Box(rp,165,39,50,10,FALSE,0);
    AddGad(gadFreq);
    Print(rp,166,35,"Freq");
    gadOM := is.CreateBoolGadget(OM,177,65,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
    Box(rp,177,65,25,12,TRUE,-1);
    AddGad(gadOM);
    Print(rp,178,61,"Mode");
    (*----------- Algorithm ----------*)
    Box(rp,8,94,124,90,FALSE,-1);
    Print(rp,13,102,"Algorithm");
    Print(rp,26,128,"1 2 3 4 5 6"); Print(rp,26,160,"1 2 3 4 5 6");
    FOR i := 1 TO 6 DO
      Box(rp,i*16+8,120,12,12,TRUE,-1);
      gadAlgM[i] := is.CreateBoolGadget(M1-1+i,i*16+8,120,12,12,"",NIL,NIL,is.stdGad,is.stdAct);
      AddGad(gadAlgM[i]);
      Box(rp,i*16+8,152,12,12,TRUE,-1);
      gadAlgC[i] := is.CreateBoolGadget(C1-1+i,i*16+8,152,12,12,"",NIL,NIL,is.stdGad,is.stdAct);
      AddGad(gadAlgC[i]);
    END;
    Print(rp,26,115,"Modulator"); Print(rp,26,175,"Carrier");
    (*------------- LFO -------------*)
    Box(rp,228,5,84,85,FALSE,-1);
    Print(rp,233,13,"LFO");
    gadLFOs := is.CreatePropGadget(SP,265,47,40,6,128,0,SYS.ADR(knobLFOs),I.gadgHNone,is.stdAct,pfH);
    gadLFOd := is.CreatePropGadget(DE,265,57,40,6,128,0,SYS.ADR(knobLFOd),I.gadgHNone,is.stdAct,pfH);
    gadLFOa := is.CreatePropGadget(AM,265,67,40,6,128,0,SYS.ADR(knobLFOa),I.gadgHNone,is.stdAct,pfH);
    gadLFOp := is.CreatePropGadget(PM,265,77,40,6,128,0,SYS.ADR(knobLFOp),I.gadgHNone,is.stdAct,pfH);
    Print(rp,235,52,"Spd"); Print(rp,235,62,"Del");
    Print(rp,235,72,"AMD"); Print(rp,235,82,"PMD");
    gadLFOw := is.CreateBoolGadget(WA,277,24,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
    Box(rp,277,24,25,12,TRUE,-1);
    Print(rp,235,32,"Wave");
    AddGad(gadLFOs); AddGad(gadLFOd);
    AddGad(gadLFOa); AddGad(gadLFOp);
    AddGad(gadLFOw);
    (*------------ Sound ------------*)
    Box(rp,138,94,174,90,FALSE,-1);
    Print(rp,143,102,"Sound");

    gadCalc := is.CreateBoolGadget(CS,153,109,38,14,"",NIL,NIL,is.stdGad,is.stdAct);
    Box(rp,153,109,38,14,TRUE,-1);
    Print(rp,153+3,110+8,"Calc");

    gadLen := is.CreateStrGadget(LN,148,140,48,8,6,"","",NIL,is.stdGad,is.stdAct+{I.longint,I.stringRight});
    Box(rp,148-1,140-1,48+2,8+2,FALSE,0);
    Print(rp,148,135,"Length");

    gadTsp := is.CreateStrGadget(TP,148,165,48,8,6,"","",NIL,is.stdGad,is.stdAct+{I.stringRight});
    Box(rp,147,165-1,48+2,8+2,FALSE,0);
    Print(rp,148,160,"Transp");

    gadFeed := is.CreateStrGadget(FB,280,100,16,8,2,"","",NIL,is.stdGad,is.stdAct+{I.longint,I.stringRight});
    Box(rp,280-1,100-1,16+2,8+2,FALSE,0);
    Print(rp,210,100+6,"Feedback");

    gadPer := is.CreateStrGadget(PR,264,115,32,8,4,"","",NIL,is.stdGad,is.stdAct+{I.longint,I.stringRight});
    Box(rp,264-1,115-1,32+2,8+2,FALSE,0);
    Print(rp,210,115+6,"Period");

    gadMode := is.CreateBoolGadget(MD,268,130,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
    Box(rp,268,130,25,12,TRUE,-1);
    Print(rp,210,130+8,"Mode");

    gadFlt := is.CreateBoolGadget(FL,268,145,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
    Box(rp,268,145,25,12,TRUE,-1);
    Print(rp,210,145+8,"Filter");

    gadRel := is.CreatePropGadget(RR,264,165,40,6,128,0,SYS.ADR(knobRel),I.gadgHNone,is.stdAct,pfH);
    AddGad(gadRel);
    Print(rp,210,165+5,"RlRate");

    AddGad(gadLen);
    AddGad(gadCalc);
    AddGad(gadTsp);
    AddGad(gadFeed);
    AddGad(gadPer);
    AddGad(gadMode);
    AddGad(gadFlt);
    (*-------------------------------*)
    I.RefreshGadgets(gadOp[1],win,NIL);
    IF pal THEN DrawKeyboard END;
  END SetUpScreen;

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

  PROCEDURE DrawKeyboard;
    CONST X=20; Y=204; H1=26; H2=15; N=5*7;
    VAR i: INTEGER;
  BEGIN
    Box(rp,0,190,320,55,TRUE,1);
    Box(rp,8,195,304,45,FALSE,-1);
    i := 0; WHILE i <= N DO
      g.SetAPen(rp,2);
      g.Move(rp,X+i*8,Y);
      g.Draw(rp,X+i*8,Y+H1);
      IF i < N THEN
        g.SetAPen(rp,3);
        g.RectFill(rp,X+1+i*8,Y,X+7+i*8,Y+H1);
      END;
      IF (i # 0) & (ABS((i-1) MOD 7-4) # 2) THEN
        g.SetAPen(rp,0);
        g.RectFill(rp,X-2+i*8,Y,X-2+4+i*8,Y+H2);
      END;
    INC(i) END;
    g.SetAPen(rp,2);
    g.Move(rp,X,Y); g.Draw(rp,X+280,Y);
    g.Move(rp,X,Y+H1); g.Draw(rp,X+280,Y+H1);
  END DrawKeyboard;

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

  PROCEDURE MarkKey(nr: INTEGER; mark: BOOLEAN);
    TYPE
      Tab=ARRAY 12 OF INTEGER;
    CONST
      tab=Tab(0,4,8,12,16,24,28,32,36,40,44,48);
    VAR
      x,y: INTEGER;
      black: BOOLEAN;
      nrDIV12,nrMOD12: INTEGER;
  BEGIN
    (* $OvflChk- $RangeChk- $NilChk- *)
    IF (~pal) OR (nr < 0) OR (nr > 59) THEN RETURN END;
    SYS.SETREG(7,nr DIV 12);
    nrDIV12 := SHORT(SYS.REG(7));
    nrMOD12 := SHORT(SYS.ROT(SYS.REG(7),-16));
    black := nrMOD12 IN {1,3,6,8,10};
    x := 23 + nrDIV12 * 56 + tab[nrMOD12];
    IF black THEN y := 215 ELSE y := 225 END;
    IF black # mark THEN g.SetAPen(rp,0) ELSE g.SetAPen(rp,3) END;
    g.RectFill(rp,x,y,x+2,y+2);
    (* $OvflChk= $RangeChk= $NilChk= *)
  END MarkKey;

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

  PROCEDURE CheckLine(m,c: SHORTINT);
    VAR
      i: INTEGER;
      found: BOOLEAN;
  BEGIN
    IF m <= c THEN RETURN END;
    found := FALSE;
    i := 1;
    WHILE (i <= algo.numLines) & ~ found DO
      IF (algo.line[i-1].mod=m) & (algo.line[i-1].car=c) THEN
        found := TRUE
      ELSE
        INC(i)
      END
    END;
    IF found THEN
      WHILE i<algo.numLines DO
        algo.line[i-1].mod := algo.line[i].mod;
        algo.line[i-1].car := algo.line[i].car;
        INC(i)
      END;
      DEC(algo.numLines)
    ELSE
      INC(algo.numLines);
      algo.line[i-1].mod := m;
      algo.line[i-1].car := c;
    END
  END CheckLine;

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

  PROCEDURE GetCarrier;
    VAR c,i   : INTEGER;
        mods  : BOOLEAN;
  BEGIN
    output := 0;
    maxoutp := 0;
    FOR c := 0 TO 5 DO
      mods := FALSE;
      FOR i := 1 TO algo.numLines DO
        IF algo.line[i-1].mod = c THEN mods := TRUE END;
      END;
      isCarrier[c] := ~ mods;
    END;
    g.SetAPen(rp,1); g.RectFill(rp,24,164,115,168);
    g.SetAPen(rp,3);
    FOR c := 0 TO 5 DO
      IF isCarrier[c] THEN
        g.Move(rp,c*16+30,164);
        g.Draw(rp,c*16+30,167);
        INC(output,op[c].outp);
        IF op[c].outp > maxoutp THEN maxoutp := op[c].outp END;
      END;
    END;
  END GetCarrier;

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

  PROCEDURE DrawAlgo;
    VAR i : INTEGER;
  BEGIN
    g.SetAPen(rp,1); g.RectFill(rp,24,132,115,151);
    g.SetAPen(rp,3);
    FOR i := 1 TO algo.numLines DO
      g.Move(rp,algo.line[i-1].mod*16+30,132);
      g.Draw(rp,algo.line[i-1].car*16+30,151);
    END;
    GetCarrier;
    IF feedback # 0 THEN
      g.Move(rp,5*16+30,132);
      g.Draw(rp,5*16+30,151);
    END;
  END DrawAlgo;

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

  PROCEDURE NextLFOWave;
    VAR i,j : INTEGER;
        adr : UNTRACED POINTER TO SYS.BYTE;
  BEGIN
    IF lfo.wave=sqr THEN lfo.wave:=sin ELSE INC(lfo.wave) END;
    FOR i:=0 TO 255 DO
      CASE lfo.wave OF
      | sin:
        lfoTab[i] := -sinTab[i*32];
      | tri:
        CASE i DIV 64 OF
        | 0:  lfoTab[i] := SHORT(i*2);
        |1,2: lfoTab[i] := SHORT(255-i*2);
        | 3:  lfoTab[i] := SHORT(i*2-512);
        END;
      | down:
        lfoTab[i] := SHORT(i-128);
      | up:
        lfoTab[i] := SHORT(127-i);
      | sqr:
        lfoTab[i] := SHORT((i DIV 128) * 255 - 128);
      END;
    END;
    adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,LFOPics) + LONG(LONG(lfo.wave)) * 16);
    e.CopyMem(adr^,lfoPic^,16);
    I.DrawImage(rp,lfoImg^,gadLFOw.leftEdge+5,gadLFOw.topEdge+2)
  END NextLFOWave;

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

  PROCEDURE BufLen(nr:INTEGER): LONGINT; (* 1 <= nr <= 5 *)
  BEGIN
    RETURN SYS.LSH(lenHi,5-nr);
  END BufLen;

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

  PROCEDURE Buffer(nr:INTEGER): SYS.ADDRESS; (* 1 <= nr <= 5 *)
    TYPE A = ARRAY 5 OF LONGINT;
    CONST tab = A(0,16,24,28,30);
  BEGIN
    RETURN SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,soundBuf) + tab[nr-1]*lenHi);
  END Buffer;

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

  PROCEDURE LoopsOff;
  BEGIN
    oneShotHi := lenHi;
    repeatHi := 0;
  END LoopsOff;

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

  PROCEDURE AllocMem(VAR buf: SYS.ADDRESS; size: LONGINT; chip: BOOLEAN);
    VAR oldReqs : LONGSET;
  BEGIN
    oldReqs := ol.MemReqs;
    ol.MemReqs := LONGSET{e.memClear};
    IF chip THEN INCL(ol.MemReqs,e.chip) END;
    ol.Allocate(buf,size);
    ol.MemReqs := oldReqs;
  END AllocMem;

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

  PROCEDURE GetMem;
    VAR i   : INTEGER;
        str : UNTRACED POINTER TO ARRAY 6 OF CHAR;
        err : BOOLEAN;
        n   : SHORTINT;
  BEGIN
    lenHi := soundLen DIV 31;
    IF ODD(lenHi) THEN DEC(lenHi) END;
    IF lenHi<4 THEN lenHi := 4 END;
    soundLen := lenHi * 31;
    str := is.GadgetText(gadLen);
    n:=5;
    IF soundLen<10000 THEN DEC(n) END;
    IF soundLen< 1000 THEN DEC(n) END;
    err := c.IntToStr(soundLen,str^,10,n," ");
    I.RefreshGList(gadLen,win,NIL,1);
    IF soundBuf # NIL THEN ol.Dispose(soundBuf) END;
    AllocMem(soundBuf,soundLen,TRUE);
    IF soundBuf=NIL THEN
      soundLen:=0;
      IF Request("No memory for buffer","","Cancel") THEN END;
    END;
  END GetMem;

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

  PROCEDURE InitOp(nr: INTEGER);
  BEGIN
    op[nr].scR  := 64;
    op[nr].scL  := 64;
    op[nr].r[0] := 127;
    op[nr].r[1] := 0;
    op[nr].r[2] := 0;
    op[nr].r[3] := 0;
    op[nr].l[0] := 127;
    op[nr].l[1] := 0;
    op[nr].l[2] := 0;
    op[nr].l[3] := 0;
    op[nr].outp := 0;
    op[nr].freq := 1.0;
    op[nr].mode := ratio;
  END InitOp;

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

  PROCEDURE SetREALGad(gad:I.GadgetPtr; x:REAL);
    VAR str : UNTRACED POINTER TO ARRAY 6 OF CHAR;
        v,n : INTEGER;
  BEGIN
    str := is.GadgetText(gad);
    IF RealToString(x,str^,4) THEN END;
    str^[5] := 0X;
    I.RefreshGList(gad,win,NIL,1);
  END SetREALGad;

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

  PROCEDURE GetREALGad(gad:I.GadgetPtr; VAR x:REAL);
    VAR err: BOOLEAN;
        str: UNTRACED POINTER TO ARRAY 6 OF CHAR;
  BEGIN
    str := is.GadgetText(gad);
    IF ~ StringToReal(str^,x) THEN x := 1.0 END;
    x := ABS(x);
  END GetREALGad;

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

  PROCEDURE ShowPot(rp:g.RastPortPtr; gad: I.GadgetPtr);
    VAR val : INTEGER;
  BEGIN
    val := 127-is.VertPot(gad,128);
    PrintNumber(rp,gad.leftEdge+4,gad.topEdge-6,val);
  END ShowPot;

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

  PROCEDURE SetOp(nr: INTEGER);

    VAR
      i: INTEGER;
      adr: UNTRACED POINTER TO SYS.BYTE;
      gad: I.GadgetPtr;

  BEGIN
    adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,MixPics) + LONG(LONG(op[nr].mode)) * 12);
    e.CopyMem(adr^,mixPic^,12);
    I.DrawImage(rp,mixImg^,gadOM.leftEdge+5,gadOM.topEdge+3);
    FOR i := 1 TO 6 DO
      IF i=nr+1 THEN g.SetAPen(rp,3) ELSE g.SetAPen(rp,1) END;
      Frame(rp,i*16+81,7,14,14);
      Frame(rp,i*16+80,7,16,15);
    END;
    FOR i := 0 TO 3 DO
      gad := gadEG[i];
      is.SetProp(gad,win,NIL,0,127-op[nr].r[i],0,128);
      ShowPot(rp,gad);
      gad :=gadEG[4+i];
      is.SetProp(gad,win,NIL,0,127-op[nr].l[i],0,128);
      ShowPot(rp,gad);
    END;
    is.SetProp(gadScL, win,NIL,0,127-op[nr].scL ,0,128);
    is.SetProp(gadScR, win,NIL,0,127-op[nr].scR ,0,128);
    is.SetProp(gadOutp,win,NIL,0,127-op[nr].outp,0,128);
    ShowPot(rp,gadScL);
    ShowPot(rp,gadScR);
    ShowPot(rp,gadOutp);
    SetREALGad(gadFreq,op[nr].freq);
  END SetOp;

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

  PROCEDURE SetLFO;
  BEGIN
    is.SetProp(gadLFOs,win,NIL,lfo.spd,0,128,0);
    is.SetProp(gadLFOd,win,NIL,lfo.del,0,128,0);
    is.SetProp(gadLFOa,win,NIL,lfo.amd,0,128,0);
    is.SetProp(gadLFOp,win,NIL,lfo.pmd,0,128,0);
    lfoInc := (LONG(lfo.spd)+1) * 64;
    IF lfo.wave=sin THEN lfo.wave:=sqr ELSE DEC(lfo.wave) END;
    NextLFOWave;
  END SetLFO;

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

  PROCEDURE SetRR;
  BEGIN
    is.SetProp(gadRel,win,NIL,127-rRate,0,128,0);
    deltaVol:=(trans.Exp(0.05*rRate)-1.0)*0.112;
  END SetRR;

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

  PROCEDURE SetFeedback;
    VAR str: UNTRACED POINTER TO ARRAY 2 OF CHAR;
  BEGIN
    IF feedback<0 THEN feedback:=0 END;
    IF feedback>7 THEN feedback:=7 END;
    str := is.GadgetText(gadFeed);
    str^[0] := CHR(feedback+ORD("0"));
    str^[1] := 0X;
    I.RefreshGList(gadFeed,win,NIL,1);
    DrawAlgo;
  END SetFeedback;

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

  PROCEDURE SetFilter;
    VAR adr: UNTRACED POINTER TO SYS.BYTE;
  BEGIN
    as.Filter(filter);
    adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,MixPics) + 4 * 12);
    IF ~filter THEN adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,adr)+12) END;
    e.CopyMem(adr^,mixPic^,12);
    I.DrawImage(rp,mixImg^,gadFlt.leftEdge+5,gadFlt.topEdge+3)
  END SetFilter;

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

  PROCEDURE SetMode;
    VAR adr: UNTRACED POINTER TO SYS.BYTE;
  BEGIN
    adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,MixPics) + 2 * 12);
    IF mode=poly THEN adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,adr)+12) END;
    e.CopyMem(adr^,mixPic^,12);
    I.DrawImage(rp,mixImg^,gadMode.leftEdge+5,gadMode.topEdge+3)
  END SetMode;

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

  PROCEDURE SetKeys;
    VAR i:INTEGER;
  BEGIN
    FOR i:=0 TO 127 DO key[i]:=-1 END;
    key[96]:=0; key[48]:=0; key[32]:=1; key[49]:=2; key[33]:=3; key[50]:=4;
    key[51]:=5; key[35]:=6; key[52]:=7; key[36]:=8; key[53]:=9; key[37]:=10;
    key[54]:=11;key[55]:=12;key[39]:=13;key[56]:=14;key[40]:=15;key[57]:=16;
    key[58]:=17;key[42]:=18;key[97]:=19;
    key[66]:=11;key[16]:=12;key[2] :=13;key[17]:=14;key[3]:=15; key[18]:=16;
    key[19]:=17;key[5] :=18;key[20]:=19;key[6] :=20;key[21]:=21;key[7] :=22;
    key[22]:=23;key[23]:=24;key[9] :=25;key[24]:=26;key[10]:=27;key[25]:=28;
    key[26]:=29;key[12]:=30;key[27]:=31;key[13]:=32;key[68]:=33;
    key[0] :=10;key[43]:=20;key[65]:=34;
  END SetKeys;

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

  PROCEDURE SetPer;
    VAR i   : INTEGER;
        p   : REAL;
        str : UNTRACED POINTER TO ARRAY 4 OF CHAR;
        err : BOOLEAN;
        n   : SHORTINT;
  BEGIN
    IF Per < 124 THEN Per := 124 END;
    IF Per > 999 THEN Per := 999 END;
    str := is.GadgetText(gadPer);
    err := c.IntToStr(Per,str^,10,3," ");
    I.RefreshGList(gadPer,win,NIL,1);
    FOR i := 35 TO 0 BY -1 DO
      IF i MOD 12 = 11 THEN p := Per ELSE p := p * 1.059463094 END;
      period[i] := p;
    END;
  END SetPer;

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

  PROCEDURE Muls (i{0},j{1}: INTEGER): LONGINT; (* $EntryExitCode- *)
  BEGIN
    SYS.INLINE(0C1C1H,04E75H);   (* MULS D1,D0 ; RTS *)
  END Muls;

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

  PROCEDURE Inc(freq:REAL; okt:INTEGER; mode:SHORTINT): LONGINT;
  BEGIN
    (* $OvflChk- $RangeChk- *)
    IF mode=ratio THEN
      RETURN SYS.LSH(ENTIER(freq * transp * (65536.0*64.0) + 0.5),okt)
    ELSE (* mode=fixed *)
      RETURN ENTIER(freq*(0.738184*65536.0));
    END;
    (* $OvflChk= $RangeChk= *)
  END Inc;

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

  PROCEDURE CalcSound();

    VAR
      i,j     : INTEGER;
      arg     : ARRAY 6 OF LONGINT;
      inc     : ARRAY 6 OF LONGINT;
      d       : ARRAY 6 OF INTEGER;
      a       : ARRAY 6 OF LONGINT;
      k       : INTEGER;
      l       : LONGINT;
      mod     : ARRAY 6,8 OF SHORTINT;
      num     : ARRAY 6 OF SHORTINT;
      phi     : INTEGER;
      b       : INTEGER;
      m,c     : SHORTINT;
      ra      : ARRAY 6,4 OF LONGINT;
      le      : ARRAY 6,4 OF LONGINT;
      raTemp  : LONGINT;
      leTemp  : LONGINT;
      e       : ARRAY 6 OF LONGINT;
      p       : ARRAY 6 OF SHORTINT;
      outp    : ARRAY 6 OF INTEGER;
      buf     : INTEGER;
      bufLen  : LONGINT;
      bufPtr  : UNTRACED POINTER TO SHORTINT;
      bufPtr2 : UNTRACED POINTER TO SHORTINT;
      rate    : REAL;
      raSc    : REAL;
      leSc    : REAL;
      buf2Calc: INTEGER;
      x       : INTEGER;
      fast    : BOOLEAN;

  BEGIN
    (* $OvflChk- $RangeChk- $NilChk- *)
    GetCarrier;
    IF output = 0 THEN
      IF Request("No output level","","Cancel") THEN END;
      RETURN
    END;
    IF soundBuf = NIL THEN
      IF Request("No buffer","","Cancel") THEN END;
      RETURN
    END;
    SetTimer(FALSE);
    ip.Busy(win);
    SetThresh(oldThresh.secs,oldThresh.micro);
    LockWindow(win);

    x := SHORT(ENTIER((2080 / output) * maxoutp));

    FOR i := 0 TO 5 DO num[i] := -1 END;

    FOR i := 0 TO algo.numLines-1 DO
      m := algo.line[i].mod; c := algo.line[i].car;
      INC(num[c]); mod[c,num[c]] := m;
    END;

    fast := TRUE;

    FOR i := 0 TO 5 DO
      IF (op[i].outp#0)&((op[i].scR#64)OR(op[i].scL#64)OR(op[i].mode=fixed))
        THEN fast := FALSE
      END;
    END;

    IF fast THEN buf2Calc := 1 ELSE buf2Calc := 5 END;

    FOR buf:=1 TO buf2Calc DO

      FOR i := 0 TO 5 DO
        arg[i]:=0; inc[i] := Inc(op[i].freq,buf,op[i].mode);
        p[i] := 0; e[i] := 0;
        raSc := trans.Pow(buf - 1, op[i].scR / 64.0 + 1.0);
        FOR j := 0 TO 3 DO
          le[i,j] := LONG(LONG(op[i].l[j])) * (128 * 65536);
          rate := (trans.Exp(0.08*op[i].r[j])-1.0) * 41218.0 * raSc;
          IF rate < 1.065353E+9 THEN
            ra[i,j] := ffp.Fix(rate);
          ELSE
            ra[i,j] :=1065353216;
          END;
          IF (j>0) & (op[i].l[j]<op[i].l[j-1]) THEN ra[i,j]:=-ra[i,j] END;
        END;
        leSc := op[i].scL - 64;
        IF leSc >= 0.0 THEN leSc := 1.0 - leSc * (5-buf) / 256.0;
                       ELSE leSc := 1.0 + leSc * (buf-1) / 256.0 END;

        outp[i] := SHORT(ffp.Fix(op[i].outp * 8.0 * leSc + 0.5));

      END;

      k := 0;
      bufPtr := Buffer(buf);
      bufLen := BufLen(buf);
      FOR l:=0 TO bufLen-1 DO
        IF k=0 THEN
          FOR i:=0 TO 5 DO
            raTemp := ra[i,p[i]];  leTemp := le[i,p[i]];
            INC(e[i],raTemp);
            IF raTemp < 0 THEN
              IF e[i] <= leTemp THEN
                e[i] := leTemp;
                IF p[i]<3 THEN INC(p[i]) END;
              END;
            ELSIF raTemp > 0 THEN
              IF e[i] >= leTemp THEN
                e[i] := leTemp;
                IF p[i]<3 THEN INC(p[i]) END;
              END;
            END;

            a[i] := Muls( SHORT(SYS.ROT(e[i],-16)) , outp[i]);

          END;
        END;
        k := (k+1) MOD 16;
        b:=0;
        d[5] := 0;

        IF SHORT(SYS.ROT(a[5],-16))=0 THEN
          d[5] := 0
        ELSE
          i := feedback+1; REPEAT
            phi := SHORT(SYS.ROT(arg[5],-16)) + d[5];

            d[5] := SHORT(ASH(Muls(SHORT(SYS.ROT(a[5],-16)),LONG(sinTab[phi MOD 8192])),-3));

          DEC(i) UNTIL i=0;
          IF isCarrier[5] THEN INC(b,d[5]) END;
        END;

        INC(arg[5],inc[5]);

        i:=4; REPEAT
          IF SHORT(SYS.ROT(a[i],-16))=0 THEN
            d[i] := 0
          ELSE
            phi := SHORT(SYS.ROT(arg[i],-16));
            j:=0; WHILE j <= num[i] DO
              INC(phi,d[mod[i,j]]);
              INC(j);
            END;
            d[i] := SHORT(ASH( Muls(SHORT(SYS.ROT(a[i],-16)) , LONG(sinTab[phi MOD 8192]) )  ,-3));
            IF isCarrier[i] THEN INC(b,d[i]) END;
          END;
          INC(arg[i],inc[i]);
        DEC(i) UNTIL i<0;

        bufPtr^ := SHORT(SHORT(SYS.ROT(Muls(b,x),-16)));
        bufPtr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,bufPtr)+1);

      END;
    END;

    IF fast THEN
      FOR buf := 2 TO 5 DO
        bufPtr  := Buffer(buf);
        bufPtr2 := Buffer(buf-1);
        bufLen := BufLen(buf);
        FOR l:=0 TO bufLen-1 DO
          bufPtr^ := bufPtr2^;
          bufPtr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,bufPtr)+1); bufPtr2 := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,bufPtr2)+2);
        END;
      END;
    END;
    SetTimer(TRUE);
    UnLockWindow(win);
    IF I.windowActive IN win.flags THEN SetThresh(60,0) END;
    ip.Normal(win);
    (* $OvflChk= $RangeChk= $NilChk= *)
  END CalcSound;

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

  PROCEDURE SetLoop;

    VAR
      rp    : g.RastPortPtr;
      mes   : I.IntuiMessage;
      offs  : LONGINT;
      last  : LONGINT;
      pip   : I.PropInfoPtr;
      mark1 : LONGINT;
      mark2 : LONGINT;
      mx    : INTEGER;
      i,id  : INTEGER;
      sGad  : I.GadgetPtr;
      nr    : INTEGER;

  (*···············································*)

    PROCEDURE Plot;
      VAR i,j : INTEGER;
          buf : UNTRACED POINTER TO SHORTINT;
          x   : LONGINT;
          y   : INTEGER;
          str : ARRAY 6 OF CHAR;
          err : BOOLEAN;
          m   : LONGINT;
    BEGIN
      g.SetAPen(rp,1); g.RectFill(rp,6,26,313,93);
      g.RectFill(rp,122,12,208,22);
      IF (mark1 # 0) OR (mark2 # 0) THEN
        m := SYS.LSH(mark1,5-nr);
        x := (m-offs);
        buf:=Buffer(nr);
        buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+m);
        y:=buf^;
        err:=c.IntToStr(y,str,10,4," ");
        Print(rp,122,20,str);
        y := y DIV 4;
        g.SetAPen(rp,2); g.Move(rp,6,59-y); g.Draw(rp,313,59-y);
        IF (x>=0)&(x<=307) THEN g.Move(rp,SHORT(6+x),26);g.Draw(rp,SHORT(6+x),93) END;
        m := SYS.LSH(mark2,5-nr);
        x := (m-offs);
        buf:=Buffer(nr);
        buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+m);
        y:=buf^;
        err := c.IntToStr(y,str,10,4," ");
        Print(rp,176,20,str);
        y := y DIV 4;
        g.SetAPen(rp,0); g.Move(rp,6,59-y); g.Draw(rp,313,59-y);
        IF (x>=0)&(x<=307) THEN g.Move(rp,SHORT(6+x),26);g.Draw(rp,SHORT(6+x),93) END;
      END;
      buf := Buffer(nr);

      buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+offs);

      g.SetAPen(rp,3);
      i:=0;WHILE i<=307 DO
        IF i < BufLen(nr) THEN
          j := 59 - LONG(buf^) DIV 4;
          IF i=0 THEN g.Move(rp,i+6,j) ELSE g.Draw(rp,i+6,j) END;
          buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+1);
        END;
        INC(i)
      END;
    END Plot;

  (*···············································*)

    PROCEDURE GetLoop;
    BEGIN
      mark1:=oneShotHi;
      mark2:=mark1+repeatHi;
      IF mark1=lenHi THEN mark1:=0;mark2:=0 END;
    END GetLoop;

  (*···············································*)

    PROCEDURE SetLoop;
      VAR i : INTEGER;
    BEGIN
      IF mark1 >= lenHi THEN mark1:=lenHi-2 END;
      IF mark2 >= lenHi THEN mark2:=lenHi-2 END;
      IF (mark1=0) & (mark2=0) THEN
        oneShotHi := lenHi; repeatHi := 0;
        RETURN
      END;
      IF mark1<mark2 THEN oneShotHi:=mark1 ELSE oneShotHi:=mark2 END;
      repeatHi := ABS(mark1-mark2);
    END SetLoop;

  (*···············································*)

    PROCEDURE SetBuf;
      VAR hBody : LONGINT;
          i     : INTEGER;
    BEGIN
      offs := 0;
      IF BufLen(nr) < 600 THEN
        hBody := 65535
      ELSE
        hBody := 19000000 DIV (BufLen(nr)-308);
      END;
      I.NewModifyProp(gadOffs^,win2,NIL,pfH,0,0,hBody,0,1);
      i := 1; WHILE i <= 5 DO
        IF i=nr THEN g.SetAPen(rp,3) ELSE g.SetAPen(rp,1) END;
        Frame(rp,i*16+49,107,14,14);
        Frame(rp,i*16+48,107,16,15);
      INC(i) END
    END SetBuf;

  (*···············································*)

  BEGIN (* SetLoop *)
    IF soundBuf=NIL THEN
      IF Request("No buffer","","Cancel") THEN END;
      RETURN;
    END;
    win2 := is.CreateWindow("Set Loop",0,50,320,126,scr,
      LONGSET{I.activate,I.windowClose,I.windowDrag,I.windowDepth,I.rmbTrap},
      LONGSET{I.gadgetUp,I.gadgetDown,I.closeWindow,I.mouseButtons},NIL);
    ip.Normal(win2);
    LockWindow(win);
    ip.Busy(win);
    SetThresh(oldThresh.secs,oldThresh.micro);
    rp := win2.rPort;
    Box(rp,0,11,320,115,TRUE,1); Box(rp,5,25,310,70,FALSE,-1);
    IF gadClr=NIL THEN gadClr:=is.CreateBoolGadget(CL,256,108,46,12,"",NIL,NIL,is.stdGad,is.stdAct) END;
    Box(rp,256,108,46,12,TRUE,-1);
    Print(rp,259,116,"Clear");
    is.AddGadget(win2,gadClr);
    Print(rp,220,116,"Loop");

    FOR i:=1 TO 5 DO
      IF gadBuf[i]=NIL THEN gadBuf[i]:=is.CreateBoolGadget(B1+i-1,50+i*16,108,12,12,"",NIL,NIL,is.stdGad,is.stdAct) END;
      Box(rp,50+i*16,108,12,12,TRUE,-1);
      is.AddGadget(win2,gadBuf[i]);
    END;
    Print(rp,12,116,"Octave");
    Print(rp,68,116,"1 2 3 4 5");

    IF gadOffs=NIL THEN gadOffs:=is.CreatePropGadget(OS,10,98,300,6,0,0,SYS.ADR(knobPlot),I.gadgHNone,is.stdAct,pfH) END;
    is.AddGadget(win2,gadOffs);
    I.RefreshGadgets(gadClr,win2,NIL);
    pip := gadOffs^.specialInfo;
    nr:=1;
    SetBuf;
    GetLoop;
    Plot;
    LOOP
      is.GetIMsg(win2,mes,TRUE);
      IF I.gadgetUp IN mes.class THEN
        sGad := mes.iAddress; id := sGad^.gadgetID;
        CASE id OF
        | B1..B5 : nr:=id-B1+1; GetLoop; SetBuf; Plot;
        | CL     : mark1:=0; mark2:=0; SetLoop; Plot;
        ELSE
        END
      END;
      IF I.closeWindow IN mes.class THEN EXIT END;
      IF I.mouseButtons IN mes.class THEN
        mx := mes.mouseX-6;
        IF (mx>=0)&(mx<=307)&(mes.mouseY<95) THEN
          CASE mes.code OF
            I.selectDown: mark1:=2*SYS.LSH(offs+mx,nr-6); SetLoop; Plot|
            I.menuDown  : mark2:=2*SYS.LSH(offs+mx,nr-6); SetLoop; Plot
          ELSE
          END;
        END;
      END;
      IF (I.gadgetDown IN mes.class) & (mes.iAddress=gadOffs) THEN
        LOOP
          is.GetIMsg(win2,mes,FALSE);
          last:=offs;
          offs := ENTIER(I.UIntToLong(pip^.horizPot)/65535.0 * (BufLen(nr)-308));
          IF offs > BufLen(nr)-308 THEN offs := BufLen(nr)-308 END;
          IF offs < 0 THEN offs := 0 END;
          IF offs#last THEN Plot END;
          IF I.gadgetUp IN mes.class THEN EXIT END;
          d.Delay(5);
        END
      END
    END;
    UnLockWindow(win);
    ip.Normal(win);
    is.DeleteWindow(win2); win2:=NIL
  END SetLoop;

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

  PROCEDURE FourierAnalysis;

    VAR
      rp  : g.RastPortPtr;
      mes : I.IntuiMessage;
      buf : UNTRACED POINTER TO ARRAY 50000 OF SHORTINT;
      f   : ARRAY 64 OF REAL;
      max : REAL;
      i,k,inc,argA,argB,wert,h : INTEGER;
      a,b,bufArg,bufInc        : LONGINT;

  BEGIN
    (* $RangeChk- $OvflChk- $NilChk- *)
    IF soundBuf=NIL THEN
      IF Request("No buffer","","Cancel") THEN END;
      RETURN;
    END;
    IF repeatHi=0 THEN
      IF Request("No loop","","Cancel") THEN END;
      RETURN;
    END;
    win2 := is.CreateWindow("Fourier-Analysis",20,50,280,116,scr,
      LONGSET{I.activate,I.windowClose,I.windowDrag,I.windowDepth},
      LONGSET{I.closeWindow},NIL);
    ip.Normal(win2);
    ip.Busy(win);
    LockWindow(win);
    SetThresh(oldThresh.secs,oldThresh.micro);
    rp := win2.rPort;
    Box(rp,0,11,280,105,TRUE,1); Box(rp,5,15,270,95,FALSE,-1);
    g.SetAPen(rp,2);
    buf := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,soundBuf) + oneShotHi * 16);
    bufInc := repeatHi * 16 * 65536 DIV 128;
    inc := 64;
    max := 0;
    k := 1; WHILE k < 64 DO
      argA := 0;
      argB := 2048;
      bufArg := 0;
      a := 0; b := 0;
      i := 0; WHILE i < 128 DO
        wert := buf[SHORT(SYS.ROT(bufArg,-16))];
        INC(a,wert * sinTab[argA MOD 8192]);
        INC(b,wert * sinTab[argB MOD 8192]);
        INC(argA,inc);
        INC(argB,inc);
        INC(bufArg,bufInc);
      INC(i) END;
      f[k] := trans.Sqrt(a*1.0*a + b*1.0*b);
      IF f[k] > max THEN max := f[k] END;
      INC(inc,64);
    INC(k) END;
    IF max <= 1.0E-8 THEN max := 1 END;
    k := 1; WHILE k < 64 DO
      h := SHORT(ffp.Fix(f[k] / max * 80.0 + 0.5));
      IF h <= 0 THEN h := 1 END;
      g.RectFill(rp,10+k*4,102-(h-1),10+2+k*4,102);
    INC(k) END;
    is.GetIMsg(win2,mes,TRUE);
    UnLockWindow(win);
    ip.Normal(win);
    is.DeleteWindow(win2); win2:=NIL;
    (* $RangeChk= $OvflChk= $NilChk= *)
  END FourierAnalysis;

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

  PROCEDURE SetLine(l,m,c: INTEGER);
  BEGIN
    algo.line[l-1].mod:=SHORT(m-1);
    algo.line[l-1].car:=SHORT(c-1);
  END SetLine;

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

  PROCEDURE Refresh;
  BEGIN
    SetOp(0);
    SetREALGad(gadTsp,transp);
    SetLFO;
    SetRR;
    SetFeedback;
    SetFilter;
    SetMode;
    SetPer;
    GetMem;
  END Refresh;

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

  PROCEDURE SetName(name: ARRAY OF CHAR); (* $CopyArrays- *)
    VAR voicename: e.STRING;
        i: LONGINT;
  BEGIN
    COPY(name,voicename);
    FOR i := str.Length(voicename)-1 TO 0 BY -1 DO
      CASE voicename[i] OF ".": voicename[i] := 0X | ":","/": str.Delete(voicename,0,i+1); i := -1  ELSE END;
    END;
    WHILE str.Length(voicename) < 16 DO str.AppendChar(voicename," ") END;
    e.CopyMem(voicename,scrtitle[21],16);
    I.SetWindowTitles(win,-1,SYS.ADR(scrtitle));
  END SetName;

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

  PROCEDURE Save8SVX(filePath:ARRAY OF CHAR): BOOLEAN;  (* $CopyArrays- *)

    TYPE
      Voice8Header = STRUCT
        oneShotHiSamples      : LONGINT;
        repeatHiSamples       : LONGINT;
        samplesPerHiCycle     : LONGINT;
        samplesPerSec         : INTEGER;
        ctOctave,sCompression : SHORTINT;
        volume                : STRUCT hi,lo: INTEGER END;
      END;

    VAR
      vhdr     : Voice8Header;
      bodySize : LONGINT;
      ok       : BOOLEAN;
      i        : INTEGER;
      size     : LONGINT;
      len      : LONGINT;
      buf      : UNTRACED POINTER TO SYS.BYTE;

  BEGIN
    IF soundBuf=NIL THEN RETURN FALSE END;
    bodySize := (oneShotHi+repeatHi) * 31;
    file := d.Open(filePath,d.newFile);
    IF file=NIL THEN RETURN FALSE END;
    vhdr.oneShotHiSamples := oneShotHi;
    vhdr.repeatHiSamples := repeatHi;
    vhdr.samplesPerHiCycle := 0;
    vhdr.samplesPerSec := 8363;
    vhdr.ctOctave := 5;
    vhdr.sCompression := 0;
    vhdr.volume.hi := 1; vhdr.volume.lo := 0;
    ip.Busy(win);
    LOOP
      size := 4 + SIZE(vhdr)+8 + 22+8 + bodySize+8;
      IF (d.Write(file,"FORM",4)<4) OR
         (d.Write(file,size,4)  <4) OR
         (d.Write(file,"8SVX",4)<4) THEN EXIT END;
      size := SIZE(vhdr);
      IF (d.Write(file,"VHDR",4)<4) OR
         (d.Write(file,size,4)  <4) OR
         (d.Write(file,vhdr,SIZE(vhdr))<SIZE(vhdr)) THEN EXIT END;
      size := 22;
      IF (d.Write(file,"ANNO",4)<4) OR
         (d.Write(file,size,4)  <4) OR
         (d.Write(file,"Generated by FMsynth\o\o",22)<22) THEN EXIT END;
      IF (d.Write(file,"BODY",4)  <4) OR
         (d.Write(file,bodySize,4)<4) THEN EXIT END;
      i := 5; WHILE i >= 1 DO
        buf := Buffer(i);
        len := SYS.LSH(repeatHi+oneShotHi,5-i);
        IF d.Write(file,buf^,len) < len THEN EXIT END;
      DEC(i) END;
      ip.Normal(win);
      d.OldClose(file);
      RETURN TRUE;
    END;
    ip.Normal(win);
    d.OldClose(file);
    RETURN FALSE
  END Save8SVX;

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

  PROCEDURE SaveVoice(filePath:ARRAY OF CHAR):BOOLEAN;  (* $CopyArrays- *)

    VAR i : INTEGER;

    PROCEDURE Write(dat: ARRAY OF SYS.BYTE): BOOLEAN; (* $CopyArrays- *)
    BEGIN RETURN d.Write(file,dat,LEN(dat)) < LEN(dat) END Write;

  BEGIN
    file := d.Open(filePath,d.newFile);
    IF file=NIL THEN RETURN FALSE END;
    ip.Busy(win);
    LOOP
      IF d.Write(file,"FMsy",4) < 4 THEN EXIT END;
      IF d.Write(file," 1.0",4) < 4 THEN EXIT END;
      FOR i := 0 TO 5 DO
        IF Write(op[i]) THEN EXIT END;
      END;
      IF Write(oneShotHi) OR
         Write(repeatHi)  OR
         Write(algo)      OR
         Write(lfo)       OR
         Write(transp)    OR
         Write(soundLen)  OR
         Write(feedback)  OR
         Write(filter)    OR
         Write(mode)      OR
         Write(Per)       OR
         Write(rRate) THEN EXIT
      END;
      ip.Normal(win);
      d.OldClose(file);
      SetName(filePath);
      RETURN TRUE;
    END;
    d.OldClose(file);
    ip.Normal(win);
    RETURN FALSE;
  END SaveVoice;

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

  PROCEDURE LoadVoice(filePath:ARRAY OF CHAR):BOOLEAN; (* $CopyArrays- *)
    VAR i   : INTEGER;
        head: LONGINT;

    PROCEDURE Read(VAR dat: ARRAY OF SYS.BYTE): BOOLEAN;
    BEGIN RETURN d.Read(file,dat,LEN(dat)) < LEN(dat) END Read;

  BEGIN
    file := d.Open(filePath,d.oldFile);
    IF file=NIL THEN RETURN FALSE END;
    ip.Busy(win);
    LOOP
      IF d.Read(file,head,4) < 4 THEN EXIT END;
      IF head # SYS.VAL(LONGINT,"FMsy") THEN EXIT END;
      IF d.Read(file,head,4) < 4 THEN EXIT END;
      IF head # SYS.VAL(LONGINT," 1.0") THEN EXIT END;

      FOR i:=0 TO 5 DO
        IF Read(op[i]) THEN EXIT END;
      END;
      IF Read(oneShotHi) OR
         Read(repeatHi)  OR
         Read(algo)      OR
         Read(lfo)       OR
         Read(transp)    OR
         Read(soundLen)  OR
         Read(feedback)  OR
         Read(filter)    OR
         Read(mode)      OR
         Read(Per)       OR
         Read(rRate) THEN EXIT
      END;
      ip.Normal(win);
      Refresh;
      d.OldClose(file);
      SetName(filePath);
      RETURN TRUE;
    END;
    d.OldClose(file);
    ip.Normal(win);
    Refresh;
    RETURN FALSE;
  END LoadVoice;

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

  PROCEDURE New;
    VAR i : INTEGER;
  BEGIN
    FOR i:=0 TO 5 DO InitOp(i) END;
    algo.numLines := 0;
    transp := 1.0;
    shiftOct := 0;
    lfo.wave:=sin; lfo.spd:=0; lfo.del:=0; lfo.amd:=0; lfo.pmd:=0;
    lastWas:=none; flag:=FALSE;
    opNr:=0;
    soundLen := 15996;
    Per := 226;
    rRate:=127;
    feedback:=0;
    filter:=FALSE;
    mode:=poly;
    Refresh;
    LoopsOff;
    SetName("Unnamed");
  END New;

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

  PROCEDURE SoundStop;
    VAR ch: SHORTINT;
  BEGIN
    FOR ch := as.left0 TO as.left1 DO
      as.StopSound(ch);
      state[ch] := end;
    END
  END SoundStop;

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

  PROCEDURE CheckMenu;
    VAR menuCode,menuNr,itemNr,subNr:INTEGER; item:I.MenuItemPtr;
  BEGIN
    menuCode:=mes.code;
    WHILE menuCode # I.menuNull DO
      item := I.ItemAddress(menu^,menuCode);
      menuNr := I.MenuNum(menuCode);
      itemNr := I.ItemNum(menuCode);
      subNr  := I.SubNum(menuCode);
      CASE menuNr OF
      | 0:
        IF (itemNr=0) & DoFileRequest("Load Voice",filePath) THEN
          IF ~LoadVoice(filePath) & Request("Can't load voice","","Cancel") THEN END;
        END;
        IF (itemNr=1) & DoFileRequest("Save Voice",filePath) THEN
          IF ~SaveVoice(filePath) & Request("Can't save voice","","Cancel") THEN END;
        END;
        IF (itemNr=2) & DoFileRequest("Save 8SVX",filePath) THEN
          IF ~Save8SVX(filePath) & Request("Can't save sound","","Cancel") THEN END;
        END;
        IF (itemNr=3) & Request("Are you sure?","Yes","No") THEN New END;
        IF (itemNr=5) & Request("Really quit?","Ok","Cancel") THEN SoundStop; HALT(0) END;
      | 1:
        IF itemNr=0 THEN InitOp(opNr); SetOp(opNr) END;
        IF (itemNr=1)&(subNr>=0)&(subNr<=5) THEN op[subNr]:=op[opNr] END;
        IF itemNr=2 THEN
          CASE subNr OF
          | 0: IF op[opNr].freq <= 49999.0 THEN
                 op[opNr].freq:=op[opNr].freq*2;SetREALGad(gadFreq,op[opNr].freq);
               END;
          | 1: IF op[opNr].freq >= 0.0002 THEN
                op[opNr].freq:=op[opNr].freq/2;SetREALGad(gadFreq,op[opNr].freq);
               END;
          ELSE
          END
        END;
      | 2:
        IF itemNr=1 THEN SetLoop END;
        IF itemNr=2 THEN FourierAnalysis END;

        IF itemNr=0 THEN
          CASE subNr OF
          | 0: algo.numLines:=0;
          | 1: algo.numLines:=3; SetLine(1,2,1); SetLine(2,4,3); SetLine(3,6,5);
          | 2: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,5,4); SetLine(4,6,5);
          | 3: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,1); SetLine(3,4,3); SetLine(4,6,5);
          | 4: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,4,2); SetLine(4,6,5);
          | 5: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,4,3); SetLine(4,6,5);
          | 6: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,5,4); SetLine(4,6,4);
          | 7: algo.numLines:=4; SetLine(1,2,1); SetLine(2,6,3); SetLine(3,6,4); SetLine(4,6,5);
          | 8: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,1); SetLine(3,5,4); SetLine(4,6,4);
          | 9: algo.numLines:=5; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,4,3); SetLine(4,5,4); SetLine(5,6,5);
          ELSE
          END;
          DrawAlgo;
        END;
      ELSE
      END;
      menuCode := item^.nextSelect
    END
  END CheckMenu;

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

  (* $SaveRegs+ $StackChk- *)

  PROCEDURE InterruptProc;
    VAR volMod : INTEGER;
        perMod : INTEGER;
        ch : SHORTINT;
  BEGIN
    (* $NilChk- $OvflChk- $RangeChk- *)
    SYS.SETREG(13,SYS.REG(9));
    IF ~disabled THEN
      FOR ch:=as.left0 TO as.left1 DO
        IF delay[ch]>0 THEN DEC(delay[ch]) END;
        IF state[ch] # end THEN
          IF state[ch] = keyUp THEN
            vol[ch] := vol[ch]-deltaVol;
            IF vol[ch] <= 0.0 THEN
              vol[ch]   := 0.0;
              state[ch] := end;
            END;
          END;
          volTemp := vol[ch];
          perTemp := per[ch];
          IF delay[ch]=0 THEN
            INC(lfoArg[ch],lfoInc);
          END;
          IF lfo.amd>0 THEN  (* Modulate volume *)
            volTemp := volTemp * (1.0-lfo.amd*((128+LONG(lfoTab[SYS.LSH(lfoArg[ch],-8)]))/32768.0));
          END;
          IF lfo.pmd>0 THEN  (* Modulate period *)
            perTemp := perTemp * (1.0+lfo.pmd*((128+LONG(lfoTab[SYS.LSH(lfoArg[ch],-8)]))/maxPM));
          END;
          volMod := SHORT(ffp.Fix(volTemp+0.5));
          perMod := SHORT(ffp.Fix(perTemp+0.5));
  
          as.ModifySound(ch,perMod,volMod);
        END;
      END;
    END;
    (* $NilChk= $OvflChk= $RangeChk= *)
  END InterruptProc;

  (* $StackChk= *)

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

  PROCEDURE HandleVertGad(gad: I.GadgetPtr; new:BOOLEAN): SHORTINT;
    VAR val: INTEGER;
  BEGIN
    val := 127-is.VertPot(gad,128);
    IF new THEN is.SetProp(gad,win,NIL,0,127-val,0,128) END;
    ShowPot(rp,gad);
    RETURN SHORT(val);
  END HandleVertGad;

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

  PROCEDURE HandleHorizGad(gad: I.GadgetPtr): SHORTINT;
    VAR val: INTEGER;
  BEGIN
    val := is.HorizPot(gad,128);
    is.SetProp(gad,win,NIL,val,0,128,0);
    RETURN SHORT(val);
  END HandleHorizGad;

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

BEGIN

  (*
  win:=NIL; win2:=NIL; scr:=NIL; menu:=NIL; req:=NIL;
  gadOffs:=NIL; gadClr:=NIL;
  soundBuf := NIL; soundLen := 0;
  intOn:=FALSE;
  tr := NIL;
  FOR i:=1 TO 5 DO gadBuf[i]:=NIL END;
  *)
  SYS.SETREG(0,SYS.ADR(ver));
  me := SYS.VAL(SYS.ADDRESS,ol.Me);
  oldWindowPtr := me.windowPtr;
  oldfltstate := as.CheckFilter();

  IF ol.OldSP.stackSize<4000 THEN HALT(d.error) END;

  lfoPic := ToChipMem(SYS.VAL(SYS.ADDRESS,LFOPics),16,FALSE);
  mixPic := ToChipMem(SYS.VAL(SYS.ADDRESS,MixPics),12,FALSE);
  lfoImg := is.CreateImage(0,0,16,8,1,lfoPic^,SHORTSET{1},SHORTSET{0},NIL);
  mixImg := is.CreateImage(0,0,16,6,1,mixPic^,SHORTSET{1},SHORTSET{0},NIL);
  fmPic  := ToChipMem(SYS.VAL(SYS.ADDRESS,FMPic),864,TRUE);
  fmImg  := is.CreateImage(27,0,117,27,2,fmPic^,SHORTSET{0,1},SHORTSET{},NIL);
  zifPic := ToChipMem(SYS.VAL(SYS.ADDRESS,Ziffern),10,FALSE);
  zifImg := is.CreateImage(0,0,2,5,1,zifPic^,SHORTSET{1},SHORTSET{0},NIL);

  as.SetPriority(20);
  IF (as.OpenChannel({as.left0 })<0) OR
     (as.OpenChannel({as.right0})<0) OR
     (as.OpenChannel({as.right1})<0) OR
     (as.OpenChannel({as.left1 })<0) THEN rq.Fail("Can't open audio channel") END;

  I.GetPrefs(pref,SIZE(I.Preferences));
  oldThresh := pref.keyRptDelay;

  tr := ds.OpenDev("input.device",0,LONGSET{},SIZE(tr^),NIL);
  rq.Assert(tr#NIL,"Can't open input.device");

  SetUpScreen;
  New;
  SetKeys;

  int.node.type := e.interrupt;
  int.node.pri  := 0;
  int.node.name := NIL;
  int.data := SYS.REG(13);
  int.code := InterruptProc;

  SoundStop;
  chan:=as.left0;

  cia.base := e.OpenResource(cia.ciaaName);
  rq.Assert(cia.base # NIL,"Can't open ciaa.resource");

  rq.Assert(cia.AddICRVector(hw.ta,SYS.ADR(int))=NIL,"CIAA Timer A in use");
  hw.ciaa.cra := SHORTSET{};
  intOn:=TRUE;
  IntPerSec(110);
  SetTimer(TRUE);

  is.msgFilter := LONGSET{I.mouseMove};

  LOOP
    is.GetIMsg(win,mes,TRUE);

    IF I.rawKey IN mes.class THEN
      code := mes.code;
      CASE code OF
        64: SoundStop|                (* Space *)
        80..84: shiftOct := code-80;
                scrtitle[13] := CHR(shiftOct+ORD("1"));
                I.SetWindowTitles(win,-1,SYS.ADR(scrtitle));
                                                |  (* F1 - F5 *)

      ELSE
        IF code<128 THEN                (* Key down *)
          keyCode := key[code];
          IF keyCode >= 0 THEN
            octave := keyCode DIV 12 + shiftOct + 1;
            IF (octave<=5) & (soundBuf # NIL) THEN
              disabled := TRUE;
              per[chan]   := period[keyCode];
              vol[chan]   := 64.0;
              delay[chan] := LONG(lfo.del) * 2;
              lfoArg[chan]:= 0;
              perTemp := per[chan];
              volTemp := vol[chan];
              IF lfo.amd>0 THEN
                volTemp := volTemp * (1.0-lfo.amd*((128+LONG(lfoTab[0]))/32768.0));
              END;
              IF lfo.pmd>0 THEN
                perTemp := perTemp * (1.0+lfo.pmd*((128+LONG(lfoTab[0]))/maxPM));
              END;
              as.PlayLoopSound(chan,Buffer(octave),SYS.LSH(oneShotHi,5-octave),SYS.LSH(repeatHi,5-octave),SHORT(ffp.Fix(perTemp+0.5)),SHORT(ffp.Fix(volTemp+0.5)));
              state[chan] := keyDown;
              channel[keyCode] := chan;
              disabled := FALSE;

              IF mode=poly THEN
                CASE chan OF
                | as.left0:  chan:=as.right0
                | as.right0: chan:=as.left1
                | as.right1: chan:=as.left0
                | as.left1:  chan:=as.right1
                END;
              END;
              MarkKey(keyCode+shiftOct*12,TRUE);
            END
          END
        ELSE                            (* Key up *)
          keyCode := key[code-128];
          IF keyCode >= 0 THEN
            state[channel[keyCode]] := keyUp;
            MarkKey(keyCode+shiftOct*12,FALSE);
          END
        END
      END

    ELSIF I.menuPick IN mes.class THEN CheckMenu

    ELSIF I.mouseMove IN mes.class THEN
      SYS.SETREG(0,HandleVertGad(actPropGad,FALSE));

    ELSIF I.gadgetDown IN mes.class THEN
      actPropGad := mes.iAddress;

    ELSIF I.gadgetUp IN mes.class THEN
      selGad:=mes.iAddress; id:=selGad.gadgetID;
      CASE id OF
      | O1..O6: opNr := SHORT(id-O1);SetOp(opNr)
      | R1..R4: op[opNr].r[id-R1] := HandleVertGad(gadEG[id-R1],TRUE)
      | L1..L4: op[opNr].l[id-L1] := HandleVertGad(gadEG[id-R1],TRUE)
      | OL: op[opNr].outp := HandleVertGad(gadOutp,TRUE)
      | SL: op[opNr].scL := HandleVertGad(gadScL,TRUE)
      | SR: op[opNr].scR := HandleVertGad(gadScR,TRUE)
      | FR: GetREALGad(gadFreq,op[opNr].freq);
            SetREALGad(gadFreq,op[opNr].freq)
      | TP: GetREALGad(gadTsp,transp);
            SetREALGad(gadTsp,transp)
      | M1..M6:
        lastMod := SHORT(id-M1);
        IF flag THEN
          IF lastWas=car THEN
            CheckLine(lastMod,lastCar);
            DrawAlgo;
            flag := FALSE;
          END;
        ELSE
          flag := TRUE
        END;
        lastWas := mod;
      | C1..C6:
        lastCar  := SHORT(id-C1);
        IF flag THEN
          IF lastWas=mod THEN
            CheckLine(lastMod,lastCar);
            DrawAlgo;
            flag := FALSE;
          END;
        ELSE
          flag := TRUE
        END;
        lastWas := car;
      | WA: NextLFOWave;
      | SP: lfo.spd := HandleHorizGad(gadLFOs);
            lfoInc  := (LONG(lfo.spd)+1)*64;
      | DE: lfo.del := HandleHorizGad(gadLFOd)
      | AM: lfo.amd := HandleHorizGad(gadLFOa)
      | PM: lfo.pmd := HandleHorizGad(gadLFOp)
      | CS: CalcSound();
            disabled := TRUE;
            as.PlaySound(0,SYS.ADR(beep),4,500,40,100);
            disabled := FALSE;
      | RR: rRate := SHORT(127-is.HorizPot(gadRel,128)); SetRR;
      | LN: soundLen := is.GadgetVal(gadLen); GetMem; LoopsOff;
      | FB: feedback := SHORT(SHORT(is.GadgetVal(gadFeed))); SetFeedback;
      | OM: IF op[opNr].mode=ratio THEN
              op[opNr].mode:=fixed
            ELSE
              op[opNr].mode:=ratio
            END;
            SetOp(opNr);
      | PR: Per := SHORT(is.GadgetVal(gadPer)); SetPer;
      | MD: IF mode=poly THEN mode := mono ELSE mode:=poly END; SetMode;
      | FL: filter := ~ filter; SetFilter;
      ELSE
      END

    ELSIF I.activeWindow   IN mes.class THEN SetThresh(60,0)
    ELSIF I.inactiveWindow IN mes.class THEN SetThresh(oldThresh.secs,oldThresh.micro)

    END
  END;

CLOSE

  me.windowPtr := oldWindowPtr;
  IF intOn THEN SetTimer(FALSE); cia.RemICRVector(hw.ta,SYS.ADR(int)) END;
  is.DeleteWindow(win);
  IF is.DeleteScreen(scr) THEN END;
  SetThresh(oldThresh.secs,oldThresh.micro);
  ds.CloseDev(tr);
  as.Filter(oldfltstate);

END FMsynth.