home *** CD-ROM | disk | FTP | other *** search
/ World of Sound / World of Sound.iso / utils / misc / fmsynth / src / source.lha / FMsynth.mod < prev    next >
Encoding:
Text File  |  1993-06-27  |  75.3 KB  |  2,388 lines
  1. (*-------------------------------------------------------------------------
  2.  :Program.     FMsynth.mod
  3.  :Contents.    6 Operator FM-Syntheziser
  4.  :Author.      Christian Stiens
  5.  :Address.     Snail-Mail:           E-Mail:
  6.  :Address.     Heustiege 2           UUCP: Christian_Stiens@ouzonix.bo.open.de
  7.  :Address.     D-59348 Lüdinghausen  FIDO: 2:243/4802.25
  8.  :Copyright.   Giftware, © 93 Christian Stiens
  9.  :Language.    Oberon-2
  10.  :Translator.  Amiga Oberon 3.01d
  11.  :History.     V1.0, 26-Feb-93: first release
  12.  :History.     V1.1, 21-Jun-93: keymap now compatible with ProTracker
  13.  :History.           21-Jun-93: sound can be > 99999 Bytes
  14.  :History.           21-Jun-93: uses "setthresh" no more
  15.  :History.           23-Jun-93: AutoCalc
  16.  :History.           26-Jun-93: Chords
  17.  :Imports.     AudioSupport, IntuiSupport, MyFileReq, IntuiPointer
  18. -------------------------------------------------------------------------*)
  19.  
  20. MODULE FMsynth;
  21.  
  22.   (* $JOIN sintab.o *)
  23.  
  24.   IMPORT
  25.     arg  := Arguments,
  26.     as   := AudioSupport,
  27.     c    := Conversions,
  28.     cia  := Cia,
  29.     d    := Dos,
  30.     e    := Exec,
  31.     fr   := MyFileReq,
  32.     g    := Graphics,
  33.     hw   := Hardware,
  34.     I    := Intuition,
  35.     ie   := InputEvent,
  36.     ip   := IntuiPointer,
  37.     is   := IntuiSupport,
  38.     ffp  := MathFFP,
  39.     trans:= MathTrans,
  40.     ol   := OberonLib,
  41.     rq   := Requests,
  42.     str  := Strings,
  43.     u    := Utility,
  44.     SYS  := SYSTEM;
  45.  
  46.  
  47.   CONST
  48.     ver = "\o$VER: fmsynth 1.1 (26.6.93)";
  49.  
  50.     (* $DataChip+ *)
  51.  
  52.     beep = "\x00\x7F\x00\x80";
  53.  
  54.  
  55.   TYPE
  56.  
  57.     Algorithm = STRUCT
  58.       numLines : INTEGER;
  59.       line     : ARRAY 15 OF STRUCT mod,car: SHORTINT END;
  60.     END;
  61.  
  62.     Operator = STRUCT
  63.       scR   : SHORTINT;
  64.       scL   : SHORTINT;
  65.       r,l   : ARRAY 4 OF SHORTINT;
  66.       freq  : REAL;
  67.       outp  : SHORTINT;
  68.       mode  : SHORTINT;
  69.     END;
  70.  
  71.     LFO = STRUCT
  72.       wave    : SHORTINT;  (* LFOWaves *)
  73.       spd,del : SHORTINT;
  74.       amd,pmd : SHORTINT;
  75.     END;
  76.  
  77.  
  78.   CONST
  79.     maxPM = 5.0E5;
  80.     intPerSec = 110;
  81.  
  82.  
  83.   CONST
  84.     numChords = 8;
  85.  
  86.   TYPE
  87.     ChordTable = ARRAY numChords,3 OF REAL;
  88.  
  89.   CONST
  90.     f0  = 1;
  91.     f3  = 1.189207;
  92.     f4  = 1.259921;
  93.     f5  = 1.334840;
  94.     f6  = 1.414214;
  95.     f7  = 1.498307;
  96.     f10 = 1.781797;
  97.     f11 = 1.887749;
  98.  
  99.  
  100.   CONST
  101.     chordTable = ChordTable(f0,f0,f0,
  102.                             f0,f4,f7,
  103.                             f0,f3,f7,
  104.                             f0,f3,f6,
  105.                             f0,f5,f7,
  106.                             f0,f4,f10,
  107.                             f0,f4,f11,
  108.                             f0,f3,f10);
  109.  
  110.   CONST
  111.     sin=0; tri=1; down=2; up=3; sqr=4; (* LFOWaves *)
  112.     end=0; keyDown=1; keyUp=2;         (* State *)
  113.     poly=0; mono=1;                    (* Mode *)
  114.     car=0; mod=1; none=2;
  115.     ratio=0; fixed=1;                  (* Operator.mode *)
  116.  
  117.     pfH  = {I.freeHoriz,I.propBorderless};
  118.     pfV  = {I.freeVert,I.propBorderless};
  119.  
  120.     (*----- Gadget-IDs -----*)
  121.  
  122.     O1=1;O2=2;O3=3;O4=4;O5=5;O6=6;SR=7;SL=8;
  123.     R1=9;R2=10;R3=11;R4=12;L1=13;L2=14;L3=15;L4=16;
  124.     OL=17;FR=18;WA=19;SP=20;DE=21;AM=22;PM=23;
  125.     M1=24;M2=25;M3=26;M4=27;M5=28;M6=29;
  126.     C1=30;C2=31;C3=32;C4=33;C5=34;C6=35;
  127.     LN=36;RR=37;CS=38;TP=39;OS=40;OK=41;CA=42;
  128.     B1=43;B2=44;B3=45;B4=46;B5=47;CL=48;
  129.     OM=49;FB=50;MD=51;FL=52;PR=53;
  130.  
  131.  
  132.   VAR  (*--- Globals ----*)
  133.  
  134.     scr           : I.ScreenPtr;
  135.     scrtitle      : ARRAY 80 OF CHAR;
  136.     win,win2      : I.WindowPtr;
  137.     req           : I.RequesterPtr;
  138.     rp            : g.RastPortPtr;
  139.     vp            : g.ViewPortPtr;
  140.     pal           : BOOLEAN;
  141.     oldfltstate   : BOOLEAN;
  142.     mes           : I.IntuiMessage;
  143.     menu          : I.MenuPtr;
  144.     me            : d.ProcessPtr;
  145.     oldWindowPtr  : I.WindowPtr;
  146.     filePath      : e.STRING;
  147.     file          : d.FileHandlePtr;
  148.     op            : ARRAY 6 OF Operator;
  149.     opNr          : SHORTINT;
  150.     lfo           : LFO;
  151.     lfoTab        : ARRAY 256 OF SHORTINT;
  152.     lfoPic        : UNTRACED POINTER TO SYS.BYTE;
  153.     lfoImg        : I.ImagePtr;
  154.     fmImg         : I.ImagePtr;
  155.     fmPic         : UNTRACED POINTER TO SYS.BYTE;
  156.     mixPic        : UNTRACED POINTER TO SYS.BYTE;
  157.     mixImg        : I.ImagePtr;
  158.     zifPic        : UNTRACED POINTER TO SYS.BYTE;
  159.     zifImg        : I.ImagePtr;
  160.     algo          : Algorithm;
  161.     isCarrier     : ARRAY 6 OF BOOLEAN;
  162.     output        : INTEGER;
  163.     maxoutp       : INTEGER;
  164.     disabled      : BOOLEAN;
  165.     key           : ARRAY 128 OF SHORTINT;
  166.     period        : ARRAY 36 OF REAL;
  167.     channel       : ARRAY 36 OF SHORTINT;
  168.     rRate         : SHORTINT;
  169.     mode          : SHORTINT;
  170.     soundBuf      : SYS.ADDRESS;
  171.     soundLen      : LONGINT;
  172.     lenHi         : LONGINT;
  173.     oneShotHi     : LONGINT;
  174.     repeatHi      : LONGINT;
  175.     shiftOct      : INTEGER;
  176.     chord         : INTEGER;
  177.     filter        : BOOLEAN;
  178.     autoCalc      : BOOLEAN;
  179.     transp        : REAL;
  180.     feedback      : SHORTINT;
  181.     int           : e.Interrupt;
  182.     intOn         : BOOLEAN;
  183.     volTemp       : REAL;
  184.     perTemp       : REAL;
  185.     Per           : INTEGER;
  186.     vol,per       : ARRAY 4 OF REAL;
  187.     deltaVol      : REAL;
  188.     state         : ARRAY 4 OF SHORTINT;
  189.     delay         : ARRAY 4 OF INTEGER;
  190.     lfoArg        : ARRAY 4 OF INTEGER;
  191.     lfoInc        : INTEGER;
  192.     i,id          : INTEGER;
  193.     lastCar       : SHORTINT;
  194.     lastMod       : SHORTINT;
  195.     lastWas       : SHORTINT;
  196.     flag          : BOOLEAN;
  197.     keyCode       : INTEGER;
  198.     selGad        : I.GadgetPtr;
  199.     actPropGad    : I.GadgetPtr;
  200.     code          : INTEGER;
  201.     octave        : INTEGER;
  202.     chan          : SHORTINT;
  203.     lockreq       : I.Requester;
  204.     sinTab ["_SinTab"] : ARRAY 8192 OF SHORTINT;
  205.  
  206.  
  207.     (*----- Gadgets -----*)
  208.  
  209.     gadOp   : ARRAY 7 OF I.GadgetPtr;
  210.     gadEG   : ARRAY 8 OF I.GadgetPtr; knobEG : ARRAY 8 OF I.Image;
  211.     gadAlgM : ARRAY 7 OF I.GadgetPtr;
  212.     gadAlgC : ARRAY 7 OF I.GadgetPtr;
  213.     gadFreq : I.GadgetPtr;
  214.     gadLen  : I.GadgetPtr;
  215.     gadOutp : I.GadgetPtr;  knobOutp : I.Image;
  216.     gadLFOs : I.GadgetPtr;  knobLFOs : I.Image;
  217.     gadLFOd : I.GadgetPtr;  knobLFOd : I.Image;
  218.     gadLFOa : I.GadgetPtr;  knobLFOa : I.Image;
  219.     gadLFOp : I.GadgetPtr;  knobLFOp : I.Image;
  220.     gadLFOw : I.GadgetPtr;
  221.     gadScR  : I.GadgetPtr;  knobScR  : I.Image;
  222.     gadScL  : I.GadgetPtr;  knobScL  : I.Image;
  223.     gadRel  : I.GadgetPtr;  knobRel  : I.Image;
  224.     gadCalc : I.GadgetPtr;
  225.     gadTsp  : I.GadgetPtr;
  226.     gadOffs : I.GadgetPtr;  knobPlot : I.Image;
  227.     gadOk   : I.GadgetPtr;
  228.     gadCncl : I.GadgetPtr;
  229.     gadBuf  : ARRAY 6 OF I.GadgetPtr;
  230.     gadClr  : I.GadgetPtr;
  231.     gadFeed : I.GadgetPtr;
  232.     gadFlt  : I.GadgetPtr;
  233.     gadMode : I.GadgetPtr;
  234.     gadOM   : I.GadgetPtr;
  235.     gadPer  : I.GadgetPtr;
  236.  
  237. (*------------------------------------------------------------------------*)
  238.  
  239.   PROCEDURE LFOPics;  (* $EntryExitCode- *)
  240.   BEGIN SYS.INLINE
  241.    (03C00H,04200H,08100H,08100H,00081H,00081H,00042H,0003CH,
  242.     00800H,01400H,02200H,04101H,08082H,00044H,00028H,00010H,
  243.     08100H,0C180H,0A140H,09120H,08910H,08508H,08304H,08102H,
  244.     00102H,00306H,0050AH,00912H,01122H,02142H,04182H,08102H,
  245.     0FF00H,08100H,08100H,08100H,00102H,00102H,00102H,001FEH)
  246.   END LFOPics;
  247.  
  248. (*------------------------------------------------------------------------*)
  249.  
  250.   PROCEDURE MixPics; (* $EntryExitCode- *)
  251.   BEGIN SYS.INLINE(
  252.     0C5D2H, 0AA95H, 0AA95H, 0CE95H, 0AA95H, 0AA92H,
  253.     0EAB6H, 08AA5H, 0C935H, 08925H, 08AA5H, 08AB6H,
  254.     0A492H, 0EAD5H, 0EAD5H, 0AAB5H, 0AAB5H, 0A492H,
  255.     0C491H, 0AA8AH, 0AA84H, 0CA84H, 08A84H, 084E4H,
  256.     00490H, 00AD0H, 00AD0H, 00AB0H, 00AB0H, 00490H,
  257.     009DCH, 01510H, 01598H, 01510H, 01510H, 00910H)
  258.   END MixPics;
  259.  
  260. (*------------------------------------------------------------------------*)
  261.  
  262.   PROCEDURE Ziffern; (* $EntryExitCode- *)
  263.   BEGIN SYS.INLINE(
  264.     0C000H, 0C000H, 0C000H, 0C000H, 0C000H,  (* 0 *)
  265.     04000H, 0C000H, 04000H, 04000H, 04000H,  (* 1 *)
  266.     0C000H, 04000H, 0C000H, 08000H, 0C000H,  (* 2 *)
  267.     0C000H, 04000H, 0C000H, 04000H, 0C000H,  (* 3 *)
  268.     08000H, 08000H, 0C000H, 04000H, 04000H,  (* 4 *)
  269.     0C000H, 08000H, 0C000H, 04000H, 0C000H,  (* 5 *)
  270.     0C000H, 08000H, 0C000H, 0C000H, 0C000H,  (* 6 *)
  271.     0C000H, 04000H, 04000H, 04000H, 04000H,  (* 7 *)
  272.     0C000H, 0C000H, 08000H, 0C000H, 0C000H,  (* 8 *)
  273.     0C000H, 0C000H, 0C000H, 04000H, 0C000H)  (* 9 *)
  274.   END Ziffern;
  275.  
  276. (*------------------------------------------------------------------------*)
  277.  
  278.   PROCEDURE FMPic; (* $EntryExitCode- *)
  279.   BEGIN SYS.INLINE(
  280.     (* [0] *)
  281.     0FF80H,00007H,0F03FH,0FFFFH,0FFFFH,0FFFEH,01FFFH,0FFFFH,
  282.     0FFBFH,0FEF7H,0F7BFH,0FFFFH,0FFFFH,0F878H,0DFFFH,0FFFFH,
  283.     0FFBFH,0FFF1H,0E78FH,0FFFFH,0FFFFH,0F373H,0C7FFH,0FFFFH,
  284.     0FF9FH,0FF79H,0EF0FH,0FFFFH,0FFFFH,0E717H,0C7FFH,0FFFFH,
  285.     0FFCFH,08738H,0CF0FH,0FFFFH,0FFFFH,0CF17H,0C7FFH,0FFFFH,
  286.     0FFEFH,0833CH,0DF00H,01018H,07843H,09F03H,0C0FFH,0FFFFH,
  287.     0FFEFH,0803CH,01F0FH,0C7C3H,02319H,03FEBH,0C67FH,0FFFFH,
  288.     0FFEFH,0903EH,03F1FH,0EFE7H,08F3CH,07FE3H,0DF3FH,0FFFFH,
  289.     0FFEFH,0983EH,03F3FH,0EFE7H,09FFEH,01F03H,0FF9FH,0FFFFH,
  290.     0FFEFH,0F8BFH,07F3EH,047C3H,0BFFEH,01F03H,0FF8FH,0FFFFH,
  291.     0FFEFH,0F8BFH,0FF3FH,003C7H,01F7EH,01F03H,0EF8FH,0FFFFH,
  292.     0FFEFH,0F8B7H,0EF3FH,083E7H,01E3EH,01F1BH,0C78FH,0FFFFH,
  293.     0FFEFH,098B7H,0EF1FH,0C1EEH,01E3EH,01F1BH,0C78FH,0FFFFH,
  294.     0FFEFH,090B3H,0CF0FH,0E5FEH,01E3EH,01F1BH,0C78FH,0FFFFH,
  295.     0FFEFH,080B3H,0CF07H,0E0FEH,01E3EH,01F0BH,0C78FH,0FFFFH,
  296.     0FFCFH,08031H,08F33H,0E2FCH,01E3EH,01F63H,0C78FH,0FFFFH,
  297.     0FF9FH,0C071H,08F3BH,0E2FCH,01E3EH,01FE7H,0C78FH,0FFFFH,
  298.     0FFBFH,0E6F9H,09F9FH,0C27CH,03F3FH,00FCFH,0EFCFH,0FFFFH,
  299.     0FFBFH,0E2F8H,01F8FH,08078H,01E1EH,0078FH,0EFC7H,0FFFFH,
  300.     0FF80H,00200H,00000H,00378H,04000H,01000H,00007H,0FFFFH,
  301.     0FFE0H,00380H,00000H,00770H,06000H,01800H,00007H,0FFFFH,
  302.     0FFE0H,00380H,0F008H,007F0H,0F030H,03C08H,00007H,0FFFFH,
  303.     0FFFFH,0FFFFH,0FFFFH,0F7E0H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
  304.     0FFFFH,0FFFFH,0FFFFH,0F3C1H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
  305.     0FFFFH,0FFFFH,0FFFFH,0F801H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
  306.     0FFFFH,0FFFFH,0FFFFH,0FC03H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
  307.     0FFFFH,0FFFFH,0FFFFH,0FE07H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
  308.     (* [1] *)
  309.     0007FH,0FFF8H,00FC0H,00000H,00000H,00001H,0E000H,00000H,
  310.     0007FH,0FFF8H,00FC0H,00000H,00000H,00787H,0E000H,00000H,
  311.     0007FH,0FFFCH,01FC0H,00000H,00000H,00F8FH,0E000H,00000H,
  312.     0007FH,0FFFCH,01FC0H,00000H,00000H,01F8FH,0E000H,00000H,
  313.     0003FH,0FFFEH,03F80H,00000H,00000H,03F8FH,0E000H,00000H,
  314.     0001FH,0CFFEH,03F9FH,0EFE7H,087BCH,07FFFH,0EF00H,00000H,
  315.     0001FH,0FFFFH,07FBFH,0FFFFH,0DFFEH,0FFF7H,0FF80H,00000H,
  316.     0001FH,0FC7FH,07FFFH,0FFFFH,0FFFFH,0FFF7H,0FFC0H,00000H,
  317.     0001FH,0FC7FH,0FFFFH,0FFFFH,0FFFFH,0FFF7H,0FFC0H,00000H,
  318.     0001FH,0FC7FH,0FFFFH,0FFFFH,0FFFFH,03F87H,0FFC0H,00000H,
  319.     0001FH,0FC7FH,0FFFFH,0EFFFH,0FFFFH,03F87H,0FFC0H,00000H,
  320.     0001FH,0FC7FH,0FFFFH,0E7FFH,0BFFFH,03F87H,0FFC0H,00000H,
  321.     0001FH,0FC7FH,0FFFFH,0F7FFH,0BF7FH,03F87H,0EFC0H,00000H,
  322.     0001FH,0FC7FH,0FFBFH,0F3FFH,03F7FH,03F87H,0EFC0H,00000H,
  323.     0001FH,0F87FH,0FFFFH,0F3FFH,03F7FH,03FF7H,0EFC0H,00000H,
  324.     0003FH,0E0FFH,0FFFFH,0F1FFH,03F7FH,03FFFH,0EFC0H,00000H,
  325.     0007FH,0F1FFH,0FFFFH,0F1FEH,07FFFH,0BFFFH,0FFE0H,00000H,
  326.     0007FH,0F1FFH,0FFFFH,0F1FEH,07FFFH,0BFFFH,0FFE0H,00000H,
  327.     0007FH,0F1FFH,0FFFFH,0E7FEH,07FFFH,09FFFH,0FFE0H,00000H,
  328.     0007FH,0F1FCH,03FDFH,0CFFCH,03F3FH,00FDFH,0FFE0H,00000H,
  329.     00000H,00000H,00000H,00FFCH,00000H,00000H,00000H,00000H,
  330.     00000H,00000H,00000H,00FF8H,00000H,00000H,00000H,00000H,
  331.     00000H,00000H,00000H,00FF8H,00000H,00000H,00000H,00000H,
  332.     00000H,00000H,00000H,00FF0H,00000H,00000H,00000H,00000H,
  333.     00000H,00000H,00000H,007E0H,00000H,00000H,00000H,00000H,
  334.     00000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H,
  335.     00000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H);
  336.   END FMPic;
  337.  
  338. (*------------------------------------------------------------------------*)
  339.  
  340.   PROCEDURE VKnob; (* $EntryExitCode- *)
  341.   BEGIN
  342.     SYS.INLINE(
  343.     07800H,0FC00H,00000H,0FC00H,07800H,
  344.     0FC00H,0FC00H,0FC00H,0FC00H,0FC00H)
  345.   END VKnob;
  346.  
  347. (*------------------------------------------------------------------------*)
  348.  
  349.   PROCEDURE HKnob; (* $EntryExitCode- *)
  350.   BEGIN
  351.     SYS.INLINE(
  352.     05000H,0D800H,0D800H,0D800H,0D800H,05000H,
  353.     0F800H,0F800H,0F800H,0F800H,0F800H,0F800H)
  354.   END HKnob;
  355.  
  356. (*------------------------------------------------------------------------*)
  357.  
  358.   PROCEDURE ToChipMem(adr:e.ADDRESS; size:LONGINT; check:BOOLEAN): e.ADDRESS;
  359.     VAR newAdr: e.ADDRESS;
  360.         p1,p2: UNTRACED POINTER TO SYS.BYTE;
  361.   BEGIN
  362.     IF check & (e.chip IN e.TypeOfMem(adr)) THEN RETURN adr END;
  363.     INCL(ol.MemReqs,e.chip);
  364.     ol.New(newAdr,size);
  365.     EXCL(ol.MemReqs,e.chip);
  366.     p1 := adr; p2 := newAdr;
  367.     e.CopyMem(p1^,p2^,size);
  368.     RETURN newAdr
  369.   END ToChipMem;
  370.  
  371. (*------------------------------------------------------------------------*)
  372.  
  373.   PROCEDURE LockWindow(win: I.WindowPtr);
  374.   BEGIN
  375.     I.InitRequester(lockreq);
  376.     lockreq.width := 1;
  377.     lockreq.height := 1;
  378.     lockreq.backFill := SHORT(SHORT(g.ReadPixel(win.rPort,0,0)));
  379.     IF ~ I.Request(SYS.ADR(lockreq),win) THEN HALT(20) END;
  380.   END LockWindow;
  381.  
  382. (*------------------------------------------------------------------------*)
  383.  
  384.   PROCEDURE UnLockWindow(win:I.WindowPtr);
  385.   BEGIN
  386.     I.EndRequest(SYS.ADR(lockreq),win);
  387.   END UnLockWindow;
  388.  
  389. (*------------------------------------------------------------------------*)
  390.  
  391.   PROCEDURE Request(hail,pos,neg:ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
  392.  
  393.     VAR
  394.       txt0,t : I.IntuiTextPtr;
  395.       posGad : I.GadgetPtr;
  396.  
  397.   BEGIN
  398.     IF req=NIL THEN
  399.       txt0 := is.CreateIntuiText(2,0,g.jam1,0,10,NIL,"", is.CreateIntuiText(3,0,g.jam1,0,9,NIL,"",NIL));
  400.       is.whitePen := 3; is.blackPen := 2;
  401.       is.gadgetFrontPen := 3; is.gadgetBackPen := 1;
  402.       gadOk   := is.CreateBoolGadget(0,12,31,55,12," ",is.autoBorder,NIL,is.stdGad,is.stdAct+{I.endGadget});
  403.       gadCncl := is.CreateBoolGadget(0,85,31,55,12," ",gadOk.gadgetRender,NIL,is.stdGad,is.stdAct+{I.endGadget});
  404.       req := is.CreateRequester(85,75,150,50,0,0,is.autoBorder,txt0,{},1);
  405.       is.AddReqGadget(req,gadOk);
  406.       is.AddReqGadget(req,gadCncl);
  407.     END;
  408.     t := req.reqText; t.iText := SYS.ADR(hail); t.leftEdge := 76-SHORT(str.Length(hail))*4;
  409.     t := t.nextText;  t.iText := SYS.ADR(hail); t.leftEdge := 75-SHORT(str.Length(hail))*4;
  410.     IF pos[0] # 0X THEN
  411.       t := req.reqGadget.nextGadget.gadgetText;
  412.       t.iText := SYS.ADR(pos); t.leftEdge := 29-SHORT(str.Length(pos))*4;
  413.     END;
  414.     t := req.reqGadget.gadgetText;
  415.     t.iText := SYS.ADR(neg); t.leftEdge := 29-SHORT(str.Length(neg))*4;
  416.     IF pos[0]=0X THEN
  417.       posGad := req.reqGadget.nextGadget;
  418.       req.reqGadget.nextGadget := NIL;
  419.     END;
  420.     IF ~I.Request(req,win) THEN RETURN TRUE END;
  421.     REPEAT is.GetIMsg(win,mes,TRUE) UNTIL I.gadgetUp IN mes.class;
  422.     IF pos[0]=0X THEN
  423.       req.reqGadget.nextGadget := posGad
  424.     END;
  425.     RETURN mes.iAddress = gadOk;
  426.   END Request;
  427.  
  428. (*------------------------------------------------------------------------*)
  429.  
  430.   PROCEDURE InitKnobs;
  431.     VAR i:INTEGER;
  432.   BEGIN
  433.     (*--- VertKnobs ---*)
  434.     knobOutp.leftEdge := 0;
  435.     knobOutp.topEdge := 0;
  436.     knobOutp.width := 6;
  437.     knobOutp.height := 5;
  438.     knobOutp.depth := 2;
  439.     knobOutp.imageData := ToChipMem(SYS.VAL(SYS.ADDRESS,VKnob),20,TRUE);
  440.     knobOutp.planePick := SHORTSET{0,1};
  441.     knobOutp.planeOnOff := SHORTSET{};
  442.     knobOutp.nextImage := NIL;
  443.     FOR i:=0 TO 7 DO
  444.       knobEG[i] := knobOutp
  445.     END;
  446.     knobScL := knobOutp;
  447.     knobScR := knobOutp;
  448.     (*--- HorizKnobs ---*)
  449.     knobLFOs.leftEdge := 0;
  450.     knobLFOs.topEdge := 0;
  451.     knobLFOs.width := 5;
  452.     knobLFOs.height := 6;
  453.     knobLFOs.depth := 2;
  454.     knobLFOs.imageData := ToChipMem(SYS.VAL(SYS.ADDRESS,HKnob),24,TRUE);
  455.     knobLFOs.planePick := SHORTSET{0,1};
  456.     knobLFOs.planeOnOff := SHORTSET{};
  457.     knobLFOs.nextImage := NIL;
  458.     knobLFOd := knobLFOs;
  459.     knobLFOa := knobLFOs;
  460.     knobLFOp := knobLFOs;
  461.     knobPlot := knobLFOs;
  462.     knobRel  := knobLFOs;
  463.   END InitKnobs;
  464.  
  465. (*------------------------------------------------------------------------*)
  466.  
  467.   PROCEDURE StringToReal(s: ARRAY OF CHAR; VAR x: REAL): BOOLEAN; (* $CopyArrays- *)
  468.     VAR v,w,z  : LONGINT;
  469.         i      : INTEGER;
  470.         p      : BOOLEAN;
  471.         minus  : BOOLEAN;
  472.         f      : REAL;
  473.   BEGIN
  474.     i := 0; v := 0; w := 0; p := FALSE; f := 1; minus := FALSE;
  475.     WHILE (i < LEN(s)) & (s[i] # 0X) DO
  476.       IF s[i] = "." THEN
  477.         p := TRUE
  478.       ELSIF s[i] = "-" THEN
  479.         minus := TRUE
  480.       ELSE
  481.         IF (s[i] >= "0") & (s[i] <= "9") THEN
  482.           z := ORD(s[i]) - ORD("0");
  483.           IF p THEN f := f / 10; w := w * 10 + z ELSE v := v * 10 + z END;
  484.         END;
  485.       END; INC(i)
  486.     END;
  487.     x := v + w * f;
  488.     IF minus THEN x := -x END;
  489.     RETURN TRUE;
  490.   END StringToReal;
  491.  
  492. (*------------------------------------------------------------------------*)
  493.  
  494.   PROCEDURE RealToString(x: REAL; VAR s: ARRAY OF CHAR; n: INTEGER): BOOLEAN;
  495.     VAR i    : INTEGER;
  496.         w    : REAL;
  497.         v,f,z: LONGINT;
  498.         flag : BOOLEAN;
  499.         ovfl : BOOLEAN;
  500.         zn   : LONGINT;
  501.         p    : BOOLEAN;
  502.  
  503.     PROCEDURE Char(ch: CHAR);
  504.     BEGIN
  505.       IF i < LEN(s) THEN
  506.         s[i] := ch;
  507.         INC(i)
  508.       ELSE
  509.         IF ~p THEN ovfl := TRUE END;
  510.       END;
  511.     END Char;
  512.  
  513.   BEGIN (* RealToString *)
  514.     i := 0; ovfl := FALSE; flag := FALSE; p := FALSE;
  515.     IF x<0 THEN Char("-"); x:=-x END;
  516.     zn := 1;
  517.     WHILE n>0 DO zn := zn * 10; DEC(n) END;
  518.     x := x + 0.5/zn;   (* Round *)
  519.     v := ENTIER(x);
  520.     w := x - v;        (* Trunc *)
  521.     f := 1000000000;
  522.     REPEAT
  523.       z := v DIV f;
  524.       IF z # 0 THEN flag := TRUE END;
  525.       IF flag  THEN Char(CHR(z+ORD("0"))) END;
  526.       v := v - z * f; f := f DIV 10
  527.     UNTIL f = 0;
  528.     p := TRUE;
  529.     Char(".");
  530.     w := w * zn; v := ENTIER(w); f := zn;
  531.     WHILE f >= 10 DO
  532.       f := f DIV 10;
  533.       z := v DIV f;
  534.       Char(CHR(z+ORD("0")));
  535.       v := v - z * f;
  536.     END;
  537.     IF i < LEN(s) THEN s[i] := 0X END;
  538.     RETURN ~ ovfl
  539.   END RealToString;
  540.  
  541. (*------------------------------------------------------------------------*)
  542.  
  543.   PROCEDURE IntPerSec(ints: INTEGER);
  544.     VAR wert : INTEGER;
  545.         eClock : LONGINT;
  546.   BEGIN
  547.     (* $RangeChk- $OvflChk- *)
  548.     IF e.exec.libNode.version >= 37 THEN
  549.       eClock := e.exec.eClockFrequency
  550.     ELSE
  551.       eClock := 712644;
  552.     END;
  553.     wert := SHORT(ENTIER(eClock/ints+0.5));
  554.     hw.ciaa.talo := SHORT(SYS.VAL(INTEGER,SYS.VAL(SET,wert) * {0..7}));
  555.     hw.ciaa.tahi := SHORT(SYS.LSH(wert,-8));
  556.     INCL(hw.ciaa.cra,hw.craLoad);
  557.     (* $RangeChk= $OvflChk= *)
  558.   END IntPerSec;
  559.  
  560. (*------------------------------------------------------------------------*)
  561.  
  562.   PROCEDURE SetTimer(start: BOOLEAN);
  563.   BEGIN
  564.     IF start THEN
  565.       IntPerSec(intPerSec);
  566.       INCL(hw.ciaa.cra,hw.craStart)
  567.     ELSE
  568.       EXCL(hw.ciaa.cra,hw.craStart)
  569.     END;
  570.   END SetTimer;
  571.  
  572. (*------------------------------------------------------------------------*)
  573.  
  574.   PROCEDURE Print(rp:g.RastPortPtr; x,y:INTEGER; str:ARRAY OF CHAR);
  575.     (* $CopyArrays- *)
  576.     VAR i:INTEGER;
  577.   BEGIN
  578.     i := 0;
  579.     WHILE (i < LEN(str)) & (str[i] # 0X) DO INC(i) END;
  580.     g.SetDrMd(rp,g.jam1);
  581.     g.Move(rp,x+1,y+1);
  582.     g.SetAPen(rp,2);
  583.     g.Text(rp,str,i);
  584.     g.SetAPen(rp,3);
  585.     g.Move(rp,x,y);
  586.     g.Text(rp,str,i);
  587.   END Print;
  588.  
  589. (*------------------------------------------------------------------------*)
  590.  
  591.   PROCEDURE Box(rp:g.RastPortPtr; x,y,a,b:INTEGER;
  592.                          out:BOOLEAN;fill:INTEGER);
  593.   BEGIN
  594.     IF fill >= 0 THEN
  595.       g.SetAPen(rp,fill);
  596.       g.RectFill(rp,x,y,x+a-1,y+b-1)
  597.     END;
  598.     IF out THEN g.SetAPen(rp,3) ELSE g.SetAPen(rp,2) END;
  599.     g.Move(rp,x+a-1,y); g.Draw(rp,x,y); g.Draw(rp,x,y+b-1);
  600.     IF out THEN g.SetAPen(rp,2) ELSE g.SetAPen(rp,3) END;
  601.     g.Draw(rp,x+a-1,y+b-1); g.Draw(rp,x+a-1,y+1);
  602.   END Box;
  603.  
  604. (*------------------------------------------------------------------------*)
  605.  
  606.   PROCEDURE PrintNumber(rp:g.RastPortPtr; x,y: INTEGER; num: INTEGER);
  607.  
  608.     VAR z: ARRAY 3 OF INTEGER;
  609.         adr: UNTRACED POINTER TO SYS.BYTE;
  610.         i,j: INTEGER;
  611.   BEGIN
  612.     z[2] := num DIV 100;
  613.     z[1] := num MOD 100 DIV 10;
  614.     z[0] := num MOD 10;
  615.     IF    num >= 100 THEN j := 3
  616.     ELSIF num >=  10 THEN j := 2
  617.     ELSE                  j := 1
  618.     END;
  619.     g.SetAPen(rp,1);
  620.     CASE j OF
  621.       1: g.RectFill(rp,x-6,y,x-2,y+4) |
  622.       2: g.RectFill(rp,x-6,y,x-5,y+4)
  623.     ELSE END;
  624.     FOR i:=0 TO j-1 DO
  625.       adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,Ziffern) + z[i]*10);
  626.       e.CopyMem(adr^,zifPic^,10);
  627.       I.DrawImage(rp,zifImg^,x-i*3,y);
  628.     END;
  629.   END PrintNumber;
  630.  
  631. (*------------------------------------------------------------------------*)
  632.  
  633.   PROCEDURE Frame(rp:g.RastPortPtr; x,y,a,b:INTEGER);
  634.   BEGIN
  635.     g.Move(rp,x+a-1,y);
  636.     g.Draw(rp,x,y); g.Draw(rp,x,y+b-1);
  637.     g.Draw(rp,x+a-1,y+b-1); g.Draw(rp,x+a-1,y+1);
  638.   END Frame;
  639.  
  640. (*------------------------------------------------------------------------*)
  641.  
  642.   PROCEDURE ResetChord;
  643.     VAR i: INTEGER;
  644.         item: I.MenuItemPtr;
  645.   BEGIN
  646.     chord := 0;
  647.     I.ClearMenuStrip(win);
  648.     FOR i := 0 TO numChords-1 DO
  649.       item := I.ItemAddress(menu^,I.UIntToLong(I.FullMenuNum(2,1,i)));
  650.       IF i=0 THEN INCL(item.flags,I.checked)
  651.              ELSE EXCL(item.flags,I.checked) END;
  652.     END;
  653.     IF I.SetMenuStrip(win,menu^) THEN END;
  654.   END ResetChord;
  655.  
  656. (*------------------------------------------------------------------------*)
  657.  
  658.   PROCEDURE SetUpMenu;
  659.     CONST es = LONGSET{};
  660.   BEGIN
  661.     is.DefMenu("Project",8,0,7*8+2,10,TRUE);
  662.  
  663.     is.DefItem("Load Voice..",0, 0,128,10,0,es,"L",is.stdItem+{I.commSeq});
  664.     is.DefItem("Save Voice..",0,10,128,10,0,es,"S",is.stdItem+{I.commSeq});
  665.     is.DefItem("Save 8SVX..", 0,20,128,10,0,es,"V",is.stdItem+{I.commSeq});
  666.     is.DefItem("New",         0,30,128,10,0,es,"N",is.stdItem+{I.commSeq});
  667.     is.DefItem("About",       0,40,128,10,0,es," ",is.stdItem);
  668.     is.DefSub(  fmImg^,               60,10,170,30,0,es," ",{I.itemEnabled});
  669.     is.DefSub(" Version 1.1, © 1993 ",60,40,170,10,0,es," ",is.stdItem-{I.highComp});
  670.     is.DefSub(" by Christian Stiens ",60,50,170,10,0,es," ",is.stdItem-{I.highComp});
  671.     is.DefSub("      Giftware       ",60,60,170,10,0,es," ",is.stdItem-{I.highComp});
  672.     is.DefSub(" All Rights Reserved ",60,70,170,10,0,es," ",is.stdItem-{I.highComp});
  673.     is.DefItem("Quit",      0,50,128,10,0,es,"Q",is.stdItem+{I.commSeq});
  674.  
  675.     is.DefMenu("Operator",10*8,0,8*8+2,10,TRUE);
  676.  
  677.     is.DefItem("Init",      0, 0,85,10,0,es,"I",is.stdItem+{I.commSeq});
  678.     is.DefItem("Store    »",0,10,85,10,0,es," ",is.stdItem);
  679.     is.DefSub("to 1",60, 0,35,10,0,es," ",is.stdItem);
  680.     is.DefSub("to 2",60,10,35,10,0,es," ",is.stdItem);
  681.     is.DefSub("to 3",60,20,35,10,0,es," ",is.stdItem);
  682.     is.DefSub("to 4",60,30,35,10,0,es," ",is.stdItem);
  683.     is.DefSub("to 5",60,40,35,10,0,es," ",is.stdItem);
  684.     is.DefSub("to 6",60,50,35,10,0,es," ",is.stdItem);
  685.     is.DefItem("Freqency »",0,20,85,10,0,es," ",is.stdItem);
  686.     is.DefSub("Double",50, 0,80,10,0,es,"D",is.stdItem+{I.commSeq});
  687.     is.DefSub("Halve ",50,10,80,10,0,es,"H",is.stdItem+{I.commSeq});
  688.  
  689.     is.DefMenu("Special",20*8,0,7*8+2,10,TRUE);
  690.  
  691.     is.DefItem("Algorithm   »",0, 0,110,10,0,es," ",is.stdItem);
  692.     is.DefSub("#0",63, 0,50,10,0,es,"0",is.stdItem+{I.commSeq});
  693.     is.DefSub("#1",63,10,50,10,0,es,"1",is.stdItem+{I.commSeq});
  694.     is.DefSub("#2",63,20,50,10,0,es,"2",is.stdItem+{I.commSeq});
  695.     is.DefSub("#3",63,30,50,10,0,es,"3",is.stdItem+{I.commSeq});
  696.     is.DefSub("#4",63,40,50,10,0,es,"4",is.stdItem+{I.commSeq});
  697.     is.DefSub("#5",63,50,50,10,0,es,"5",is.stdItem+{I.commSeq});
  698.     is.DefSub("#6",63,60,50,10,0,es,"6",is.stdItem+{I.commSeq});
  699.     is.DefSub("#7",63,70,50,10,0,es,"7",is.stdItem+{I.commSeq});
  700.     is.DefSub("#8",63,80,50,10,0,es,"8",is.stdItem+{I.commSeq});
  701.     is.DefSub("#9",63,90,50,10,0,es,"9",is.stdItem+{I.commSeq});
  702.  
  703.     is.DefItem("Chord       »",0,10,110,10,0,es," ",is.stdItem);
  704.     is.itemLeftEdge := I.lowCheckWidth;
  705.     is.DefSub("None",63, 0,48,10,0,-LONGSET{0}," ",is.stdItem+{I.checkIt,I.checked});
  706.     is.DefSub("maj", 63,10,48,10,0,-LONGSET{1}," ",is.stdItem+{I.checkIt});
  707.     is.DefSub("min", 63,20,48,10,0,-LONGSET{2}," ",is.stdItem+{I.checkIt});
  708.     is.DefSub("dim", 63,30,48,10,0,-LONGSET{3}," ",is.stdItem+{I.checkIt});
  709.     is.DefSub("sus4",63,40,48,10,0,-LONGSET{4}," ",is.stdItem+{I.checkIt});
  710.     is.DefSub("7",   63,50,48,10,0,-LONGSET{5}," ",is.stdItem+{I.checkIt});
  711.     is.DefSub("7maj",63,60,48,10,0,-LONGSET{6}," ",is.stdItem+{I.checkIt});
  712.     is.DefSub("7min",63,70,48,10,0,-LONGSET{7}," ",is.stdItem+{I.checkIt});
  713.  
  714.     is.itemLeftEdge := 2;
  715.     is.DefItem("Set Loop..", 0,20,110,10,0,es,"P",is.stdItem+{I.commSeq});
  716.     is.DefItem("Fourier..",  0,30,110,10,0,es,"F",is.stdItem+{I.commSeq});
  717.  
  718.     is.itemLeftEdge := I.lowCheckWidth;
  719.  
  720.     is.DefItem("AutoCalc", 0,40,110,10,0,es,"A",is.stdItem+{I.commSeq,I.menuToggle,I.checkIt});
  721.     menu := is.InstallMenuStrip(win);
  722.   END SetUpMenu;
  723.  
  724. (*------------------------------------------------------------------------*)
  725.  
  726.   PROCEDURE DoFileRequest(text:ARRAY OF CHAR;VAR filePath:e.STRING):BOOLEAN; (* $CopyArrays- *)
  727.     VAR ok:BOOLEAN;
  728.   BEGIN
  729.     ip.Busy(win);
  730.     LockWindow(win);
  731.     fr.defaultLeft := 10;
  732.     IF CAP(text[0])#"S" THEN
  733.       ok := fr.FileReqWin(text,filePath,win);
  734.     ELSE
  735.       ok := fr.FileReqWinSave(text,filePath,win);
  736.     END;
  737.     UnLockWindow(win);
  738.     ip.Normal(win);
  739.     RETURN ok;
  740.   END DoFileRequest;
  741.  
  742. (*------------------------------------------------------------------------*)
  743.  
  744.   PROCEDURE AddGad(gad: I.GadgetPtr);
  745.   BEGIN
  746.     is.AddGadget(win,gad);
  747.   END AddGad;
  748.  
  749. (*------------------------------------------------------------------------*)
  750.  
  751.   VAR screenTags: u.Tags3;
  752.  
  753.  
  754.   PROCEDURE NSProc (ns: I.ExtNewScreenPtr);
  755.   BEGIN ns.extension := SYS.ADR(screenTags) END NSProc;
  756.  
  757.  
  758.   PROCEDURE ^DrawKeyboard;
  759.  
  760.  
  761.   PROCEDURE SetUpScreen;
  762.  
  763.     TYPE  ColorType = ARRAY 4 OF INTEGER;
  764.  
  765.     VAR   i,pos    : INTEGER;
  766.           strPtr   : UNTRACED POINTER TO ARRAY 6 OF CHAR;
  767.           scrHe    : INTEGER;
  768.           str      : ARRAY 2 OF CHAR;
  769.           dispInfo : g.DisplayInfo;
  770.   BEGIN
  771.     screenTags := u.Tags3(I.saPens,SYS.ADR("\xFF\xFF"),
  772.                           I.saDisplayID,g.defaultMonitorID+g.loresKey,
  773.                           u.done,u.done);
  774.     scrtitle := "FMsynth oct: 1 name:                 ";
  775.  
  776.     IF I.int.libNode.version < 36 THEN
  777.       pal := g.gfx.normalDisplayRows >= 256;
  778.     ELSE
  779.       IF g.GetDisplayInfoData(NIL,dispInfo,SIZE(dispInfo),g.dtagDisp,g.palMonitorID+g.loresKey) <= 0 THEN
  780.         pal := FALSE
  781.       ELSIF dispInfo.notAvailable # 0 THEN
  782.         screenTags[1].data := g.ntscMonitorID+g.loresKey;
  783.         pal := FALSE;
  784.       ELSE
  785.         screenTags[1].data := g.palMonitorID+g.loresKey;
  786.         pal := TRUE;
  787.       END;
  788.     END;
  789.     IF pal THEN scrHe := 256 ELSE scrHe := 200 END;
  790.  
  791.     scr := is.CreateScreen(scrtitle,(g.gfx.normalDisplayColumns-640) DIV 4,0,320,scrHe,2,{},NSProc);
  792.     vp := SYS.ADR(scr.viewPort);
  793.  
  794.     g.LoadRGB4(vp,ColorType(0000H,0AAAH,0555H,0FFFH),4);
  795.  
  796.     win := is.CreateWindow("",0,11,320,scrHe-11,scr,
  797.                            LONGSET{I.borderless,I.backDrop,I.activate,I.noCareRefresh},
  798.                            LONGSET{I.gadgetDown,I.gadgetUp,I.mouseMove,I.rawKey,I.menuPick},
  799.                            NIL);
  800.     ip.Normal(win);
  801.     me.windowPtr := win;
  802.     rp := win.rPort;
  803.     InitKnobs;
  804.     SetUpMenu;
  805.     (*----------- BackGround -------------*)
  806.     Box(rp,0,0,320,189,TRUE,1);
  807.     (*----------- Operator ---------------*)
  808.     Box(rp,8,5,214,85,FALSE,-1);
  809.     Print(rp,13,13,"Operator");
  810.     Print(rp,100,16,"1 2 3 4 5 6");
  811.     FOR i:=1 TO 6 DO
  812.       Box(rp,i*16+82,8,12,12,TRUE,-1);
  813.       gadOp[i] := is.CreateBoolGadget(O1-1+i,i*16+82,8,12,12,"",NIL,NIL,is.stdGad,is.stdAct);
  814.       AddGad(gadOp[i]);
  815.     END;
  816.     gadScR := is.CreatePropGadget(SR,16,29,6,40,0,128,SYS.ADR(knobScR),I.gadgHNone,is.stdAct+{I.followMouse},pfV);
  817.     gadScL := is.CreatePropGadget(SL,28,29,6,40,0,128,SYS.ADR(knobScL),I.gadgHNone,is.stdAct+{I.followMouse},pfV);
  818.     Print(rp,15,76,"R");
  819.     Print(rp,27,76,"L");
  820.     Print(rp,13,86,"KSc");
  821.     AddGad(gadScR);
  822.     AddGad(gadScL);
  823.     FOR i := 0 TO 7 DO
  824.       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);
  825.       str[0] := CHR(ORD("1")+i MOD 4); str[1] := 0X;
  826.       Print(rp,gadEG[i].leftEdge-1,gadEG[i].topEdge+47,str);
  827.       AddGad(gadEG[i]);
  828.     END;
  829.     Print(rp, 50,86,"Rate");
  830.     Print(rp,100,86,"Lvl");
  831.     gadOutp := is.CreatePropGadget(OL,147,29,6,40,0,128,SYS.ADR(knobOutp),I.gadgHNone,is.stdAct+{I.followMouse},pfV);
  832.     AddGad(gadOutp);
  833.     Print(rp,138,76,"Outp");
  834.     Print(rp,138,86,"Lvl");
  835.     gadFreq := is.CreateStrGadget(FR,166,40,48,8,6,"","",NIL,is.stdGad,is.stdAct+{I.stringRight});
  836.     Box(rp,165,39,50,10,FALSE,0);
  837.     AddGad(gadFreq);
  838.     Print(rp,166,35,"Freq");
  839.     gadOM := is.CreateBoolGadget(OM,177,65,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
  840.     Box(rp,177,65,25,12,TRUE,-1);
  841.     AddGad(gadOM);
  842.     Print(rp,178,61,"Mode");
  843.     (*----------- Algorithm ----------*)
  844.     Box(rp,8,94,124,90,FALSE,-1);
  845.     Print(rp,13,102,"Algorithm");
  846.     Print(rp,26,128,"1 2 3 4 5 6"); Print(rp,26,160,"1 2 3 4 5 6");
  847.     FOR i := 1 TO 6 DO
  848.       Box(rp,i*16+8,120,12,12,TRUE,-1);
  849.       gadAlgM[i] := is.CreateBoolGadget(M1-1+i,i*16+8,120,12,12,"",NIL,NIL,is.stdGad,is.stdAct);
  850.       AddGad(gadAlgM[i]);
  851.       Box(rp,i*16+8,152,12,12,TRUE,-1);
  852.       gadAlgC[i] := is.CreateBoolGadget(C1-1+i,i*16+8,152,12,12,"",NIL,NIL,is.stdGad,is.stdAct);
  853.       AddGad(gadAlgC[i]);
  854.     END;
  855.     Print(rp,26,115,"Modulator"); Print(rp,26,175,"Carrier");
  856.     (*------------- LFO -------------*)
  857.     Box(rp,228,5,84,85,FALSE,-1);
  858.     Print(rp,233,13,"LFO");
  859.     gadLFOs := is.CreatePropGadget(SP,265,47,40,6,128,0,SYS.ADR(knobLFOs),I.gadgHNone,is.stdAct,pfH);
  860.     gadLFOd := is.CreatePropGadget(DE,265,57,40,6,128,0,SYS.ADR(knobLFOd),I.gadgHNone,is.stdAct,pfH);
  861.     gadLFOa := is.CreatePropGadget(AM,265,67,40,6,128,0,SYS.ADR(knobLFOa),I.gadgHNone,is.stdAct,pfH);
  862.     gadLFOp := is.CreatePropGadget(PM,265,77,40,6,128,0,SYS.ADR(knobLFOp),I.gadgHNone,is.stdAct,pfH);
  863.     Print(rp,235,52,"Spd"); Print(rp,235,62,"Del");
  864.     Print(rp,235,72,"AMD"); Print(rp,235,82,"PMD");
  865.     gadLFOw := is.CreateBoolGadget(WA,277,24,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
  866.     Box(rp,277,24,25,12,TRUE,-1);
  867.     Print(rp,235,32,"Wave");
  868.     AddGad(gadLFOs); AddGad(gadLFOd);
  869.     AddGad(gadLFOa); AddGad(gadLFOp);
  870.     AddGad(gadLFOw);
  871.     (*------------ Sound ------------*)
  872.     Box(rp,138,94,174,90,FALSE,-1);
  873.     Print(rp,143,102,"Sound");
  874.  
  875.     gadCalc := is.CreateBoolGadget(CS,153,109,38,14,"",NIL,NIL,is.stdGad,is.stdAct);
  876.     Box(rp,153,109,38,14,TRUE,-1);
  877.     Print(rp,153+3,110+8,"Calc");
  878.  
  879.     gadLen := is.CreateStrGadget(LN,148,140,48+8,8,7,"","",NIL,is.stdGad,is.stdAct+{I.longint,I.stringRight});
  880.     Box(rp,148-1,140-1,48+8+2,8+2,FALSE,0);
  881.     Print(rp,148,135,"Size");
  882.  
  883.     gadTsp := is.CreateStrGadget(TP,148,165,48,8,6,"","",NIL,is.stdGad,is.stdAct+{I.stringRight});
  884.     Box(rp,147,165-1,48+2,8+2,FALSE,0);
  885.     Print(rp,148,160,"Transp");
  886.  
  887.     gadFeed := is.CreateStrGadget(FB,280,100,16,8,2,"","",NIL,is.stdGad,is.stdAct+{I.longint,I.stringRight});
  888.     Box(rp,280-1,100-1,16+2,8+2,FALSE,0);
  889.     Print(rp,210,100+6,"Feedback");
  890.  
  891.     gadPer := is.CreateStrGadget(PR,264,115,32,8,4,"","",NIL,is.stdGad,is.stdAct+{I.longint,I.stringRight});
  892.     Box(rp,264-1,115-1,32+2,8+2,FALSE,0);
  893.     Print(rp,210,115+6,"Period");
  894.  
  895.     gadMode := is.CreateBoolGadget(MD,268,130,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
  896.     Box(rp,268,130,25,12,TRUE,-1);
  897.     Print(rp,210,130+8,"Mode");
  898.  
  899.     gadFlt := is.CreateBoolGadget(FL,268,145,25,12,"",NIL,NIL,is.stdGad,is.stdAct);
  900.     Box(rp,268,145,25,12,TRUE,-1);
  901.     Print(rp,210,145+8,"Filter");
  902.  
  903.     gadRel := is.CreatePropGadget(RR,264,165,40,6,128,0,SYS.ADR(knobRel),I.gadgHNone,is.stdAct,pfH);
  904.     AddGad(gadRel);
  905.     Print(rp,210,165+5,"RlRate");
  906.  
  907.     AddGad(gadLen);
  908.     AddGad(gadCalc);
  909.     AddGad(gadTsp);
  910.     AddGad(gadFeed);
  911.     AddGad(gadPer);
  912.     AddGad(gadMode);
  913.     AddGad(gadFlt);
  914.     (*-------------------------------*)
  915.     I.RefreshGadgets(gadOp[1],win,NIL);
  916.     IF pal THEN DrawKeyboard END;
  917.   END SetUpScreen;
  918.  
  919. (*------------------------------------------------------------------------*)
  920.  
  921.   PROCEDURE DrawKeyboard;
  922.     CONST X=20; Y=204; H1=26; H2=15; N=5*7;
  923.     VAR i: INTEGER;
  924.   BEGIN
  925.     Box(rp,0,190,320,55,TRUE,1);
  926.     Box(rp,8,195,304,45,FALSE,-1);
  927.     i := 0; WHILE i <= N DO
  928.       g.SetAPen(rp,2);
  929.       g.Move(rp,X+i*8,Y);
  930.       g.Draw(rp,X+i*8,Y+H1);
  931.       IF i < N THEN
  932.         g.SetAPen(rp,3);
  933.         g.RectFill(rp,X+1+i*8,Y,X+7+i*8,Y+H1);
  934.       END;
  935.       IF (i # 0) & (ABS((i-1) MOD 7-4) # 2) THEN
  936.         g.SetAPen(rp,0);
  937.         g.RectFill(rp,X-2+i*8,Y,X-2+4+i*8,Y+H2);
  938.       END;
  939.     INC(i) END;
  940.     g.SetAPen(rp,2);
  941.     g.Move(rp,X,Y); g.Draw(rp,X+280,Y);
  942.     g.Move(rp,X,Y+H1); g.Draw(rp,X+280,Y+H1);
  943.   END DrawKeyboard;
  944.  
  945. (*------------------------------------------------------------------------*)
  946.  
  947.   PROCEDURE MarkKey(nr: INTEGER; mark: BOOLEAN);
  948.     TYPE
  949.       Tab=ARRAY 12 OF INTEGER;
  950.     CONST
  951.       tab=Tab(0,4,8,12,16,24,28,32,36,40,44,48);
  952.     VAR
  953.       x,y: INTEGER;
  954.       black: BOOLEAN;
  955.       nrDIV12,nrMOD12: INTEGER;
  956.   BEGIN
  957.     (* $OvflChk- $RangeChk- $NilChk- *)
  958.     IF (~pal) OR (nr < 0) OR (nr > 59) THEN RETURN END;
  959.     SYS.SETREG(7,nr DIV 12);
  960.     nrDIV12 := SHORT(SYS.REG(7));
  961.     nrMOD12 := SHORT(SYS.ROT(SYS.REG(7),-16));
  962.     black := nrMOD12 IN {1,3,6,8,10};
  963.     x := 23 + nrDIV12 * 56 + tab[nrMOD12];
  964.     IF black THEN y := 215 ELSE y := 225 END;
  965.     IF black # mark THEN g.SetAPen(rp,0) ELSE g.SetAPen(rp,3) END;
  966.     g.RectFill(rp,x,y,x+2,y+2);
  967.     (* $OvflChk= $RangeChk= $NilChk= *)
  968.   END MarkKey;
  969.  
  970. (*------------------------------------------------------------------------*)
  971.  
  972.   PROCEDURE CheckLine(m,c: SHORTINT);
  973.     VAR
  974.       i: INTEGER;
  975.       found: BOOLEAN;
  976.   BEGIN
  977.     IF m <= c THEN RETURN END;
  978.     found := FALSE;
  979.     i := 1;
  980.     WHILE (i <= algo.numLines) & ~ found DO
  981.       IF (algo.line[i-1].mod=m) & (algo.line[i-1].car=c) THEN
  982.         found := TRUE
  983.       ELSE
  984.         INC(i)
  985.       END
  986.     END;
  987.     IF found THEN
  988.       WHILE i<algo.numLines DO
  989.         algo.line[i-1].mod := algo.line[i].mod;
  990.         algo.line[i-1].car := algo.line[i].car;
  991.         INC(i)
  992.       END;
  993.       DEC(algo.numLines)
  994.     ELSE
  995.       INC(algo.numLines);
  996.       algo.line[i-1].mod := m;
  997.       algo.line[i-1].car := c;
  998.     END
  999.   END CheckLine;
  1000.  
  1001. (*------------------------------------------------------------------------*)
  1002.  
  1003.   PROCEDURE GetCarrier;
  1004.     VAR c,i   : INTEGER;
  1005.         mods  : BOOLEAN;
  1006.   BEGIN
  1007.     output := 0;
  1008.     maxoutp := 0;
  1009.     FOR c := 0 TO 5 DO
  1010.       mods := FALSE;
  1011.       FOR i := 1 TO algo.numLines DO
  1012.         IF algo.line[i-1].mod = c THEN mods := TRUE END;
  1013.       END;
  1014.       isCarrier[c] := ~ mods;
  1015.     END;
  1016.     g.SetAPen(rp,1); g.RectFill(rp,24,164,115,168);
  1017.     g.SetAPen(rp,3);
  1018.     FOR c := 0 TO 5 DO
  1019.       IF isCarrier[c] THEN
  1020.         g.Move(rp,c*16+30,164);
  1021.         g.Draw(rp,c*16+30,167);
  1022.         INC(output,op[c].outp);
  1023.         IF op[c].outp > maxoutp THEN maxoutp := op[c].outp END;
  1024.       END;
  1025.     END;
  1026.   END GetCarrier;
  1027.  
  1028. (*------------------------------------------------------------------------*)
  1029.  
  1030.   PROCEDURE DrawAlgo;
  1031.     VAR i : INTEGER;
  1032.   BEGIN
  1033.     g.SetAPen(rp,1); g.RectFill(rp,24,132,115,151);
  1034.     g.SetAPen(rp,3);
  1035.     FOR i := 1 TO algo.numLines DO
  1036.       g.Move(rp,algo.line[i-1].mod*16+30,132);
  1037.       g.Draw(rp,algo.line[i-1].car*16+30,151);
  1038.     END;
  1039.     GetCarrier;
  1040.     IF feedback # 0 THEN
  1041.       g.Move(rp,5*16+30,132);
  1042.       g.Draw(rp,5*16+30,151);
  1043.     END;
  1044.   END DrawAlgo;
  1045.  
  1046. (*------------------------------------------------------------------------*)
  1047.  
  1048.   PROCEDURE NextLFOWave;
  1049.     VAR i,j : INTEGER;
  1050.         adr : UNTRACED POINTER TO SYS.BYTE;
  1051.   BEGIN
  1052.     IF lfo.wave=sqr THEN lfo.wave:=sin ELSE INC(lfo.wave) END;
  1053.     FOR i:=0 TO 255 DO
  1054.       CASE lfo.wave OF
  1055.       | sin:
  1056.         lfoTab[i] := -sinTab[i*32];
  1057.       | tri:
  1058.         CASE i DIV 64 OF
  1059.         | 0:  lfoTab[i] := SHORT(i*2);
  1060.         |1,2: lfoTab[i] := SHORT(255-i*2);
  1061.         | 3:  lfoTab[i] := SHORT(i*2-512);
  1062.         END;
  1063.       | down:
  1064.         lfoTab[i] := SHORT(i-128);
  1065.       | up:
  1066.         lfoTab[i] := SHORT(127-i);
  1067.       | sqr:
  1068.         lfoTab[i] := SHORT((i DIV 128) * 255 - 128);
  1069.       END;
  1070.     END;
  1071.     adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,LFOPics) + LONG(LONG(lfo.wave)) * 16);
  1072.     e.CopyMem(adr^,lfoPic^,16);
  1073.     I.DrawImage(rp,lfoImg^,gadLFOw.leftEdge+5,gadLFOw.topEdge+2)
  1074.   END NextLFOWave;
  1075.  
  1076. (*------------------------------------------------------------------------*)
  1077.  
  1078.   PROCEDURE BufLen(nr:INTEGER): LONGINT; (* 1 <= nr <= 5 *)
  1079.   BEGIN
  1080.     RETURN SYS.LSH(lenHi,5-nr);
  1081.   END BufLen;
  1082.  
  1083. (*------------------------------------------------------------------------*)
  1084.  
  1085.   PROCEDURE Buffer(nr:INTEGER): SYS.ADDRESS; (* 1 <= nr <= 5 *)
  1086.     TYPE A = ARRAY 5 OF LONGINT;
  1087.     CONST tab = A(0,16,24,28,30);
  1088.   BEGIN
  1089.     RETURN SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,soundBuf) + tab[nr-1]*lenHi);
  1090.   END Buffer;
  1091.  
  1092. (*------------------------------------------------------------------------*)
  1093.  
  1094.   PROCEDURE LoopsOff;
  1095.   BEGIN
  1096.     oneShotHi := lenHi;
  1097.     repeatHi := 0;
  1098.   END LoopsOff;
  1099.  
  1100. (*------------------------------------------------------------------------*)
  1101.  
  1102.   PROCEDURE AllocMem(VAR buf: SYS.ADDRESS; size: LONGINT; chip: BOOLEAN);
  1103.     VAR oldReqs : LONGSET;
  1104.   BEGIN
  1105.     oldReqs := ol.MemReqs;
  1106.     ol.MemReqs := LONGSET{e.memClear};
  1107.     IF chip THEN INCL(ol.MemReqs,e.chip) END;
  1108.     ol.Allocate(buf,size);
  1109.     ol.MemReqs := oldReqs;
  1110.   END AllocMem;
  1111.  
  1112. (*------------------------------------------------------------------------*)
  1113.  
  1114.   PROCEDURE GetMem;
  1115.     VAR i   : INTEGER;
  1116.         str : UNTRACED POINTER TO ARRAY 7 OF CHAR;
  1117.         err : BOOLEAN;
  1118.         n   : SHORTINT;
  1119.   BEGIN
  1120.     IF soundLen > 253952 THEN soundLen := 253952 END;
  1121.     lenHi := soundLen DIV 31;
  1122.     IF ODD(lenHi) THEN DEC(lenHi) END;
  1123.     IF lenHi<4 THEN lenHi := 4 END;
  1124.     soundLen := lenHi * 31;
  1125.     str := is.GadgetText(gadLen);
  1126.     n := 6;
  1127.     IF soundLen<100000 THEN DEC(n) END;
  1128.     IF soundLen< 10000 THEN DEC(n) END;
  1129.     IF soundLen<  1000 THEN DEC(n) END;
  1130.     err := c.IntToStr(soundLen,str^,10,n," ");
  1131.     I.RefreshGList(gadLen,win,NIL,1);
  1132.     IF soundBuf # NIL THEN ol.Dispose(soundBuf) END;
  1133.     AllocMem(soundBuf,soundLen,TRUE);
  1134.     IF soundBuf=NIL THEN
  1135.       soundLen:=0;
  1136.       IF Request("No mem for buffer","","Cancel") THEN END;
  1137.     END;
  1138.   END GetMem;
  1139.  
  1140. (*------------------------------------------------------------------------*)
  1141.  
  1142.   PROCEDURE InitOp(nr: INTEGER);
  1143.   BEGIN
  1144.     op[nr].scR  := 64;
  1145.     op[nr].scL  := 64;
  1146.     op[nr].r[0] := 127;
  1147.     op[nr].r[1] := 0;
  1148.     op[nr].r[2] := 0;
  1149.     op[nr].r[3] := 0;
  1150.     op[nr].l[0] := 127;
  1151.     op[nr].l[1] := 0;
  1152.     op[nr].l[2] := 0;
  1153.     op[nr].l[3] := 0;
  1154.     op[nr].outp := 0;
  1155.     op[nr].freq := 1.0;
  1156.     op[nr].mode := ratio;
  1157.   END InitOp;
  1158.  
  1159. (*------------------------------------------------------------------------*)
  1160.  
  1161.   PROCEDURE SetREALGad(gad:I.GadgetPtr; x:REAL);
  1162.     VAR str : UNTRACED POINTER TO ARRAY 6 OF CHAR;
  1163.         v,n : INTEGER;
  1164.   BEGIN
  1165.     str := is.GadgetText(gad);
  1166.     IF RealToString(x,str^,4) THEN END;
  1167.     str^[5] := 0X;
  1168.     I.RefreshGList(gad,win,NIL,1);
  1169.   END SetREALGad;
  1170.  
  1171. (*------------------------------------------------------------------------*)
  1172.  
  1173.   PROCEDURE GetREALGad(gad:I.GadgetPtr; VAR x:REAL);
  1174.     VAR err: BOOLEAN;
  1175.         str: UNTRACED POINTER TO ARRAY 6 OF CHAR;
  1176.   BEGIN
  1177.     str := is.GadgetText(gad);
  1178.     IF ~ StringToReal(str^,x) THEN x := 1.0 END;
  1179.     x := ABS(x);
  1180.   END GetREALGad;
  1181.  
  1182. (*------------------------------------------------------------------------*)
  1183.  
  1184.   PROCEDURE ShowPot(rp:g.RastPortPtr; gad: I.GadgetPtr);
  1185.     VAR val : INTEGER;
  1186.   BEGIN
  1187.     val := 127-is.VertPot(gad,128);
  1188.     PrintNumber(rp,gad.leftEdge+4,gad.topEdge-6,val);
  1189.   END ShowPot;
  1190.  
  1191. (*------------------------------------------------------------------------*)
  1192.  
  1193.   PROCEDURE SetOp(nr: INTEGER);
  1194.  
  1195.     VAR
  1196.       i: INTEGER;
  1197.       adr: UNTRACED POINTER TO SYS.BYTE;
  1198.       gad: I.GadgetPtr;
  1199.  
  1200.   BEGIN
  1201.     adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,MixPics) + LONG(LONG(op[nr].mode)) * 12);
  1202.     e.CopyMem(adr^,mixPic^,12);
  1203.     I.DrawImage(rp,mixImg^,gadOM.leftEdge+5,gadOM.topEdge+3);
  1204.     FOR i := 1 TO 6 DO
  1205.       IF i=nr+1 THEN g.SetAPen(rp,3) ELSE g.SetAPen(rp,1) END;
  1206.       Frame(rp,i*16+81,7,14,14);
  1207.       Frame(rp,i*16+80,7,16,15);
  1208.     END;
  1209.     FOR i := 0 TO 3 DO
  1210.       gad := gadEG[i];
  1211.       is.SetProp(gad,win,NIL,0,127-op[nr].r[i],0,128);
  1212.       ShowPot(rp,gad);
  1213.       gad :=gadEG[4+i];
  1214.       is.SetProp(gad,win,NIL,0,127-op[nr].l[i],0,128);
  1215.       ShowPot(rp,gad);
  1216.     END;
  1217.     is.SetProp(gadScL, win,NIL,0,127-op[nr].scL ,0,128);
  1218.     is.SetProp(gadScR, win,NIL,0,127-op[nr].scR ,0,128);
  1219.     is.SetProp(gadOutp,win,NIL,0,127-op[nr].outp,0,128);
  1220.     ShowPot(rp,gadScL);
  1221.     ShowPot(rp,gadScR);
  1222.     ShowPot(rp,gadOutp);
  1223.     SetREALGad(gadFreq,op[nr].freq);
  1224.   END SetOp;
  1225.  
  1226. (*------------------------------------------------------------------------*)
  1227.  
  1228.   PROCEDURE SetLFO;
  1229.   BEGIN
  1230.     is.SetProp(gadLFOs,win,NIL,lfo.spd,0,128,0);
  1231.     is.SetProp(gadLFOd,win,NIL,lfo.del,0,128,0);
  1232.     is.SetProp(gadLFOa,win,NIL,lfo.amd,0,128,0);
  1233.     is.SetProp(gadLFOp,win,NIL,lfo.pmd,0,128,0);
  1234.     lfoInc := (LONG(lfo.spd)+1) * 64;
  1235.     IF lfo.wave=sin THEN lfo.wave:=sqr ELSE DEC(lfo.wave) END;
  1236.     NextLFOWave;
  1237.   END SetLFO;
  1238.  
  1239. (*------------------------------------------------------------------------*)
  1240.  
  1241.   PROCEDURE SetRR;
  1242.   BEGIN
  1243.     is.SetProp(gadRel,win,NIL,127-rRate,0,128,0);
  1244.     deltaVol:=(trans.Exp(0.05*rRate)-1.0)*0.112;
  1245.   END SetRR;
  1246.  
  1247. (*------------------------------------------------------------------------*)
  1248.  
  1249.   PROCEDURE SetFeedback;
  1250.     VAR str: UNTRACED POINTER TO ARRAY 2 OF CHAR;
  1251.   BEGIN
  1252.     IF feedback<0 THEN feedback:=0 END;
  1253.     IF feedback>7 THEN feedback:=7 END;
  1254.     str := is.GadgetText(gadFeed);
  1255.     str^[0] := CHR(feedback+ORD("0"));
  1256.     str^[1] := 0X;
  1257.     I.RefreshGList(gadFeed,win,NIL,1);
  1258.     DrawAlgo;
  1259.   END SetFeedback;
  1260.  
  1261. (*------------------------------------------------------------------------*)
  1262.  
  1263.   PROCEDURE SetFilter;
  1264.     VAR adr: UNTRACED POINTER TO SYS.BYTE;
  1265.   BEGIN
  1266.     as.Filter(filter);
  1267.     adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,MixPics) + 4 * 12);
  1268.     IF ~filter THEN adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,adr)+12) END;
  1269.     e.CopyMem(adr^,mixPic^,12);
  1270.     I.DrawImage(rp,mixImg^,gadFlt.leftEdge+5,gadFlt.topEdge+3)
  1271.   END SetFilter;
  1272.  
  1273. (*------------------------------------------------------------------------*)
  1274.  
  1275.   PROCEDURE SetMode;
  1276.     VAR adr: UNTRACED POINTER TO SYS.BYTE;
  1277.   BEGIN
  1278.     adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,MixPics) + 2 * 12);
  1279.     IF mode=poly THEN adr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,adr)+12) END;
  1280.     e.CopyMem(adr^,mixPic^,12);
  1281.     I.DrawImage(rp,mixImg^,gadMode.leftEdge+5,gadMode.topEdge+3)
  1282.   END SetMode;
  1283.  
  1284. (*------------------------------------------------------------------------*)
  1285.  
  1286.   PROCEDURE SetKeys;
  1287.     VAR i:INTEGER;
  1288.   BEGIN
  1289.     FOR i:=0 TO 127 DO key[i]:=-1 END;
  1290.     key[49]:=0; key[33]:=1; key[50]:=2; key[34]:=3; key[51]:=4;
  1291.     key[52]:=5; key[36]:=6; key[53]:=7; key[37]:=8; key[54]:=9; key[38]:=10;
  1292.     key[55]:=11;key[56]:=12;key[40]:=13;key[57]:=14;key[41]:=15;key[58]:=16;
  1293.     key[97]:=17;key[43]:=18;
  1294.     key[66]:=11;key[16]:=12;key[2] :=13;key[17]:=14;key[3]:=15; key[18]:=16;
  1295.     key[19]:=17;key[5] :=18;key[20]:=19;key[6] :=20;key[21]:=21;key[7] :=22;
  1296.     key[22]:=23;key[23]:=24;key[9] :=25;key[24]:=26;key[10]:=27;key[25]:=28;
  1297.     key[26]:=29;key[12]:=30;key[27]:=31;key[13]:=32;key[68]:=33;key[65]:=34;
  1298.     key[0] :=10;
  1299.   END SetKeys;
  1300.  
  1301. (*------------------------------------------------------------------------*)
  1302.  
  1303.   PROCEDURE SetPer;
  1304.     VAR i   : INTEGER;
  1305.         p   : REAL;
  1306.         str : UNTRACED POINTER TO ARRAY 4 OF CHAR;
  1307.         err : BOOLEAN;
  1308.         n   : SHORTINT;
  1309.   BEGIN
  1310.     IF Per < 124 THEN Per := 124 END;
  1311.     IF Per > 999 THEN Per := 999 END;
  1312.     str := is.GadgetText(gadPer);
  1313.     err := c.IntToStr(Per,str^,10,3," ");
  1314.     I.RefreshGList(gadPer,win,NIL,1);
  1315.     FOR i := 35 TO 0 BY -1 DO
  1316.       IF i MOD 12 = 11 THEN p := Per ELSE p := p * 1.059463094 END;
  1317.       period[i] := p;
  1318.     END;
  1319.   END SetPer;
  1320.  
  1321. (*------------------------------------------------------------------------*)
  1322.  
  1323.   PROCEDURE Muls (i{0},j{1}: INTEGER): LONGINT; (* $EntryExitCode- *)
  1324.   BEGIN
  1325.     SYS.INLINE(0C1C1H,04E75H);   (* MULS D1,D0 ; RTS *)
  1326.   END Muls;
  1327.  
  1328. (*---------------------------------------------------------------------*)
  1329.  
  1330.   PROCEDURE Inc(freq,faktor:REAL; okt:INTEGER; mode:SHORTINT): LONGINT;
  1331.   BEGIN
  1332.     (* $OvflChk- $RangeChk- *)
  1333.     IF mode=ratio THEN
  1334.       RETURN SYS.LSH(ENTIER(freq * faktor * transp * (65536.0*64.0) + 0.5),okt)
  1335.     ELSE (* mode=fixed *)
  1336.       RETURN ENTIER(freq*(0.738184*65536.0));
  1337.     END;
  1338.     (* $OvflChk= $RangeChk= *)
  1339.   END Inc;
  1340.  
  1341. (*------------------------------------------------------------------------*)
  1342.  
  1343.   PROCEDURE CalcSound();
  1344.  
  1345.     VAR
  1346.       i,j        : INTEGER;
  1347.       b,k        : INTEGER;
  1348.       arg        : ARRAY 6 OF LONGINT;
  1349.       inc        : ARRAY 6 OF LONGINT;
  1350.       d          : ARRAY 6 OF INTEGER;
  1351.       a          : ARRAY 6 OF LONGINT;
  1352.       l          : LONGINT;
  1353.       y          : SHORTINT;
  1354.       mod        : ARRAY 6,8 OF SHORTINT;
  1355.       num        : ARRAY 6 OF SHORTINT;
  1356.       phi        : INTEGER;
  1357.       m,c        : SHORTINT;
  1358.       ra         : ARRAY 6,4 OF LONGINT;
  1359.       le         : ARRAY 6,4 OF LONGINT;
  1360.       raTemp     : LONGINT;
  1361.       leTemp     : LONGINT;
  1362.       e          : ARRAY 6 OF LONGINT;
  1363.       p          : ARRAY 6 OF SHORTINT;
  1364.       outp       : ARRAY 6 OF INTEGER;
  1365.       buf        : INTEGER;
  1366.       bufs2Calc  : INTEGER;
  1367.       part       : INTEGER;
  1368.       parts2Calc : INTEGER;
  1369.       bufLen     : LONGINT;
  1370.       bufPtr     : UNTRACED POINTER TO SHORTINT;
  1371.       bufPtr2    : UNTRACED POINTER TO SHORTINT;
  1372.       rate       : REAL;
  1373.       raSc       : REAL;
  1374.       leSc       : REAL;
  1375.       mlevel     : INTEGER;
  1376.       fast       : BOOLEAN;
  1377.  
  1378.   BEGIN
  1379.     (* $OvflChk- $RangeChk- $NilChk- *)
  1380.     GetCarrier;
  1381.     IF output = 0 THEN
  1382.       IF ~autoCalc THEN
  1383.         IF Request("No output level","","Cancel") THEN END;
  1384.         RETURN
  1385.       END;
  1386.     END;
  1387.     IF soundBuf = NIL THEN
  1388.       IF ~autoCalc & Request("No buffer","","Cancel") THEN END;
  1389.       RETURN
  1390.     END;
  1391.     SetTimer(FALSE);
  1392.     ip.Busy(win);
  1393.     LockWindow(win);
  1394.  
  1395.     IF output=0 THEN
  1396.       mlevel := 0;
  1397.     ELSE
  1398.       IF chord=0 THEN mlevel := 2080;
  1399.                  ELSE mlevel :=  680; END;
  1400.       mlevel := SHORT(ENTIER((mlevel / output) * maxoutp))
  1401.     END;
  1402.  
  1403.     FOR i := 0 TO 5 DO num[i] := -1 END;
  1404.  
  1405.     FOR i := 0 TO algo.numLines-1 DO
  1406.       m := algo.line[i].mod; c := algo.line[i].car;
  1407.       INC(num[c]); mod[c,num[c]] := m;
  1408.     END;
  1409.  
  1410.     fast := TRUE;
  1411.  
  1412.     FOR i := 0 TO 5 DO
  1413.       IF (op[i].outp#0)&((op[i].scR#64)OR(op[i].scL#64)OR(op[i].mode=fixed))
  1414.         THEN fast := FALSE
  1415.       END;
  1416.     END;
  1417.  
  1418.     IF fast THEN bufs2Calc := 1 ELSE bufs2Calc := 5 END;
  1419.  
  1420.     IF chord=0 THEN parts2Calc := 1 ELSE parts2Calc := 3 END;
  1421.  
  1422.     FOR buf := 1 TO bufs2Calc DO
  1423.  
  1424.       FOR i := 0 TO 5 DO
  1425.         raSc := trans.Pow(buf - 1, op[i].scR / 64 + 1);
  1426.         FOR j := 0 TO 3 DO
  1427.           le[i,j] := LONG(LONG(op[i].l[j])) * (128 * 65536);
  1428.           rate := (trans.Exp(0.08*op[i].r[j])-1) * 41218 * raSc;
  1429.           IF rate < 1.065353E+9 THEN ra[i,j] := ffp.Fix(rate);
  1430.                                 ELSE ra[i,j] := 1065353216; END;
  1431.           IF (j>0) & (op[i].l[j]<op[i].l[j-1]) THEN ra[i,j] := -ra[i,j] END;
  1432.         END;
  1433.         leSc := op[i].scL - 64;
  1434.         IF leSc >= 0 THEN leSc := 1 - leSc * (5-buf) / 256;
  1435.                      ELSE leSc := 1 + leSc * (buf-1) / 256 END;
  1436.         outp[i] := SHORT(ffp.Fix(op[i].outp * leSc * 8 + 0.5));
  1437.       END;
  1438.  
  1439.       FOR part := 0 TO parts2Calc-1 DO
  1440.  
  1441.         FOR i := 0 TO 5 DO
  1442.           arg[i] := 0; p[i] := 0; e[i] := 0;
  1443.           inc[i] := Inc(op[i].freq,chordTable[chord,part],buf,op[i].mode);
  1444.         END;
  1445.   
  1446.         k := 0;
  1447.         bufPtr := Buffer(buf);
  1448.         bufLen := BufLen(buf);
  1449.   
  1450.         FOR l := 0 TO bufLen-1 DO
  1451.           IF k=0 THEN
  1452.             FOR i := 0 TO 5 DO
  1453.               raTemp := ra[i,p[i]];  leTemp := le[i,p[i]];
  1454.               INC(e[i],raTemp);
  1455.               IF raTemp < 0 THEN
  1456.                 IF e[i] <= leTemp THEN
  1457.                   e[i] := leTemp;
  1458.                   IF p[i] < 3 THEN INC(p[i]) END;
  1459.                 END;
  1460.               ELSIF raTemp > 0 THEN
  1461.                 IF e[i] >= leTemp THEN
  1462.                   e[i] := leTemp;
  1463.                   IF p[i] < 3 THEN INC(p[i]) END;
  1464.                 END;
  1465.               END;
  1466.   
  1467.               a[i] := Muls(SHORT(SYS.ROT(e[i],-16)),outp[i]);
  1468.   
  1469.             END;
  1470.           END;
  1471.           k := (k+1) MOD 16;
  1472.           b := 0;
  1473.           d[5] := 0;
  1474.   
  1475.           IF SHORT(SYS.ROT(a[5],-16))=0 THEN
  1476.             d[5] := 0
  1477.           ELSE
  1478.             i := feedback+1; REPEAT
  1479.               phi := SHORT(SYS.ROT(arg[5],-16)) + d[5];
  1480.               d[5] := SHORT(ASH(Muls(SHORT(SYS.ROT(a[5],-16)),LONG(sinTab[phi MOD 8192])),-3));
  1481.             DEC(i) UNTIL i=0;
  1482.             IF isCarrier[5] THEN INC(b,d[5]) END;
  1483.           END;
  1484.   
  1485.           INC(arg[5],inc[5]);
  1486.   
  1487.           i:=4; REPEAT
  1488.             IF SHORT(SYS.ROT(a[i],-16))=0 THEN
  1489.               d[i] := 0
  1490.             ELSE
  1491.               phi := SHORT(SYS.ROT(arg[i],-16));
  1492.               FOR j:=0 TO num[i] DO
  1493.                 INC(phi,d[mod[i,j]])
  1494.               END;
  1495.               d[i] := SHORT(ASH(Muls(SHORT(SYS.ROT(a[i],-16)),LONG(sinTab[phi MOD 8192])),-3));
  1496.               IF isCarrier[i] THEN INC(b,d[i]) END;
  1497.             END;
  1498.             INC(arg[i],inc[i]);
  1499.           DEC(i) UNTIL i<0;
  1500.   
  1501.           y := SHORT(SHORT(SYS.ROT(Muls(b,mlevel),-16)));
  1502.  
  1503.           IF part=0 THEN bufPtr^ := y;
  1504.                     ELSE INC(bufPtr^,y) END;
  1505.  
  1506.           bufPtr := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,bufPtr)+1);
  1507.  
  1508.         END; (* FOR l *)
  1509.       END; (* FOR part *)
  1510.     END; (* FOR buf *)
  1511.  
  1512.     IF fast THEN
  1513.       FOR buf := 2 TO 5 DO
  1514.         bufPtr  := Buffer(buf);
  1515.         bufPtr2 := Buffer(buf-1);
  1516.         bufLen := BufLen(buf);
  1517.         FOR l:=0 TO bufLen-1 DO
  1518.           bufPtr^ := bufPtr2^;
  1519.           bufPtr  := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,bufPtr) +1);
  1520.           bufPtr2 := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,bufPtr2)+2);
  1521.         END;
  1522.       END;
  1523.     END;
  1524.  
  1525.     SetTimer(TRUE);
  1526.     UnLockWindow(win);
  1527.     ip.Normal(win);
  1528.  
  1529.     disabled := TRUE;
  1530.     as.PlaySound(3,SYS.ADR(beep),4,500,40,100);
  1531.     state[3] := end;
  1532.     disabled := FALSE;
  1533.  
  1534.     (* $OvflChk= $RangeChk= $NilChk= *)
  1535.   END CalcSound;
  1536.  
  1537. (*------------------------------------------------------------------------*)
  1538.  
  1539.   PROCEDURE SetLoop;
  1540.  
  1541.     VAR
  1542.       rp    : g.RastPortPtr;
  1543.       mes   : I.IntuiMessage;
  1544.       offs  : LONGINT;
  1545.       last  : LONGINT;
  1546.       pip   : I.PropInfoPtr;
  1547.       mark1 : LONGINT;
  1548.       mark2 : LONGINT;
  1549.       mx    : INTEGER;
  1550.       i,id  : INTEGER;
  1551.       sGad  : I.GadgetPtr;
  1552.       nr    : INTEGER;
  1553.  
  1554.   (*···············································*)
  1555.  
  1556.     PROCEDURE Plot;
  1557.       VAR i,j : INTEGER;
  1558.           buf : UNTRACED POINTER TO SHORTINT;
  1559.           x   : LONGINT;
  1560.           y   : INTEGER;
  1561.           str : ARRAY 6 OF CHAR;
  1562.           err : BOOLEAN;
  1563.           m   : LONGINT;
  1564.     BEGIN
  1565.       g.SetAPen(rp,1); g.RectFill(rp,6,26,313,93);
  1566.       g.RectFill(rp,122,12,208,22);
  1567.       IF (mark1 # 0) OR (mark2 # 0) THEN
  1568.         m := SYS.LSH(mark1,5-nr);
  1569.         x := (m-offs);
  1570.         buf:=Buffer(nr);
  1571.         buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+m);
  1572.         y:=buf^;
  1573.         err:=c.IntToStr(y,str,10,4," ");
  1574.         Print(rp,122,20,str);
  1575.         y := y DIV 4;
  1576.         g.SetAPen(rp,2); g.Move(rp,6,59-y); g.Draw(rp,313,59-y);
  1577.         IF (x>=0)&(x<=307) THEN g.Move(rp,SHORT(6+x),26);g.Draw(rp,SHORT(6+x),93) END;
  1578.         m := SYS.LSH(mark2,5-nr);
  1579.         x := (m-offs);
  1580.         buf:=Buffer(nr);
  1581.         buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+m);
  1582.         y:=buf^;
  1583.         err := c.IntToStr(y,str,10,4," ");
  1584.         Print(rp,176,20,str);
  1585.         y := y DIV 4;
  1586.         g.SetAPen(rp,0); g.Move(rp,6,59-y); g.Draw(rp,313,59-y);
  1587.         IF (x>=0)&(x<=307) THEN g.Move(rp,SHORT(6+x),26);g.Draw(rp,SHORT(6+x),93) END;
  1588.       END;
  1589.       buf := Buffer(nr);
  1590.  
  1591.       buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+offs);
  1592.  
  1593.       g.SetAPen(rp,3);
  1594.       i:=0;WHILE i<=307 DO
  1595.         IF i < BufLen(nr) THEN
  1596.           j := 59 - LONG(buf^) DIV 4;
  1597.           IF i=0 THEN g.Move(rp,i+6,j) ELSE g.Draw(rp,i+6,j) END;
  1598.           buf:=SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,buf)+1);
  1599.         END;
  1600.         INC(i)
  1601.       END;
  1602.     END Plot;
  1603.  
  1604.   (*···············································*)
  1605.  
  1606.     PROCEDURE GetLoop;
  1607.     BEGIN
  1608.       mark1:=oneShotHi;
  1609.       mark2:=mark1+repeatHi;
  1610.       IF mark1=lenHi THEN mark1:=0;mark2:=0 END;
  1611.     END GetLoop;
  1612.  
  1613.   (*···············································*)
  1614.  
  1615.     PROCEDURE SetLoop;
  1616.       VAR i : INTEGER;
  1617.     BEGIN
  1618.       IF mark1 >= lenHi THEN mark1:=lenHi-2 END;
  1619.       IF mark2 >= lenHi THEN mark2:=lenHi-2 END;
  1620.       IF (mark1=0) & (mark2=0) THEN
  1621.         oneShotHi := lenHi; repeatHi := 0;
  1622.         RETURN
  1623.       END;
  1624.       IF mark1<mark2 THEN oneShotHi:=mark1 ELSE oneShotHi:=mark2 END;
  1625.       repeatHi := ABS(mark1-mark2);
  1626.     END SetLoop;
  1627.  
  1628.   (*···············································*)
  1629.  
  1630.     PROCEDURE SetBuf;
  1631.       VAR hBody : LONGINT;
  1632.           i     : INTEGER;
  1633.     BEGIN
  1634.       offs := 0;
  1635.       IF BufLen(nr) < 600 THEN
  1636.         hBody := 65535
  1637.       ELSE
  1638.         hBody := 19000000 DIV (BufLen(nr)-308);
  1639.       END;
  1640.       I.NewModifyProp(gadOffs^,win2,NIL,pfH,0,0,hBody,0,1);
  1641.       i := 1; WHILE i <= 5 DO
  1642.         IF i=nr THEN g.SetAPen(rp,3) ELSE g.SetAPen(rp,1) END;
  1643.         Frame(rp,i*16+49,107,14,14);
  1644.         Frame(rp,i*16+48,107,16,15);
  1645.       INC(i) END
  1646.     END SetBuf;
  1647.  
  1648.   (*···············································*)
  1649.  
  1650.   BEGIN (* SetLoop *)
  1651.     IF soundBuf=NIL THEN
  1652.       IF Request("No buffer","","Cancel") THEN END;
  1653.       RETURN;
  1654.     END;
  1655.     win2 := is.CreateWindow("Set Loop",0,50,320,126,scr,
  1656.       LONGSET{I.activate,I.windowClose,I.windowDrag,I.windowDepth,I.rmbTrap},
  1657.       LONGSET{I.gadgetUp,I.gadgetDown,I.closeWindow,I.mouseButtons},NIL);
  1658.     ip.Normal(win2);
  1659.     LockWindow(win);
  1660.     ip.Busy(win);
  1661.     rp := win2.rPort;
  1662.     Box(rp,0,11,320,115,TRUE,1); Box(rp,5,25,310,70,FALSE,-1);
  1663.     IF gadClr=NIL THEN gadClr:=is.CreateBoolGadget(CL,256,108,46,12,"",NIL,NIL,is.stdGad,is.stdAct) END;
  1664.     Box(rp,256,108,46,12,TRUE,-1);
  1665.     Print(rp,259,116,"Clear");
  1666.     is.AddGadget(win2,gadClr);
  1667.     Print(rp,220,116,"Loop");
  1668.  
  1669.     FOR i:=1 TO 5 DO
  1670.       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;
  1671.       Box(rp,50+i*16,108,12,12,TRUE,-1);
  1672.       is.AddGadget(win2,gadBuf[i]);
  1673.     END;
  1674.     Print(rp,12,116,"Octave");
  1675.     Print(rp,68,116,"1 2 3 4 5");
  1676.  
  1677.     IF gadOffs=NIL THEN gadOffs:=is.CreatePropGadget(OS,10,98,300,6,0,0,SYS.ADR(knobPlot),I.gadgHNone,is.stdAct,pfH) END;
  1678.     is.AddGadget(win2,gadOffs);
  1679.     I.RefreshGadgets(gadClr,win2,NIL);
  1680.     pip := gadOffs^.specialInfo;
  1681.     nr:=1;
  1682.     SetBuf;
  1683.     GetLoop;
  1684.     Plot;
  1685.     LOOP
  1686.       is.GetIMsg(win2,mes,TRUE);
  1687.       IF I.gadgetUp IN mes.class THEN
  1688.         sGad := mes.iAddress; id := sGad^.gadgetID;
  1689.         CASE id OF
  1690.         | B1..B5 : nr:=id-B1+1; GetLoop; SetBuf; Plot;
  1691.         | CL     : mark1:=0; mark2:=0; SetLoop; Plot;
  1692.         ELSE
  1693.         END
  1694.       END;
  1695.       IF I.closeWindow IN mes.class THEN EXIT END;
  1696.       IF I.mouseButtons IN mes.class THEN
  1697.         mx := mes.mouseX-6;
  1698.         IF (mx>=0)&(mx<=307)&(mes.mouseY<95) THEN
  1699.           CASE mes.code OF
  1700.             I.selectDown: mark1:=2*SYS.LSH(offs+mx,nr-6); SetLoop; Plot|
  1701.             I.menuDown  : mark2:=2*SYS.LSH(offs+mx,nr-6); SetLoop; Plot
  1702.           ELSE
  1703.           END;
  1704.         END;
  1705.       END;
  1706.       IF (I.gadgetDown IN mes.class) & (mes.iAddress=gadOffs) THEN
  1707.         LOOP
  1708.           is.GetIMsg(win2,mes,FALSE);
  1709.           last:=offs;
  1710.           offs := ENTIER(I.UIntToLong(pip^.horizPot)/65535.0 * (BufLen(nr)-308));
  1711.           IF offs > BufLen(nr)-308 THEN offs := BufLen(nr)-308 END;
  1712.           IF offs < 0 THEN offs := 0 END;
  1713.           IF offs#last THEN Plot END;
  1714.           IF I.gadgetUp IN mes.class THEN EXIT END;
  1715.           d.Delay(5);
  1716.         END
  1717.       END
  1718.     END;
  1719.     UnLockWindow(win);
  1720.     ip.Normal(win);
  1721.     is.DeleteWindow(win2); win2:=NIL
  1722.   END SetLoop;
  1723.  
  1724. (*------------------------------------------------------------------------*)
  1725.  
  1726.   PROCEDURE FourierAnalysis;
  1727.  
  1728.     VAR
  1729.       rp  : g.RastPortPtr;
  1730.       mes : I.IntuiMessage;
  1731.       buf : UNTRACED POINTER TO ARRAY 50000 OF SHORTINT;
  1732.       f   : ARRAY 64 OF REAL;
  1733.       max : REAL;
  1734.       i,k,inc,argA,argB,wert,h : INTEGER;
  1735.       a,b,bufArg,bufInc        : LONGINT;
  1736.  
  1737.   BEGIN
  1738.     (* $RangeChk- $OvflChk- $NilChk- *)
  1739.     IF soundBuf=NIL THEN
  1740.       IF Request("No buffer","","Cancel") THEN END;
  1741.       RETURN;
  1742.     END;
  1743.     IF repeatHi=0 THEN
  1744.       IF Request("No loop","","Cancel") THEN END;
  1745.       RETURN;
  1746.     END;
  1747.     win2 := is.CreateWindow("Fourier-Analysis",20,50,280,116,scr,
  1748.       LONGSET{I.activate,I.windowClose,I.windowDrag,I.windowDepth},
  1749.       LONGSET{I.closeWindow},NIL);
  1750.     ip.Normal(win2);
  1751.     ip.Busy(win);
  1752.     LockWindow(win);
  1753.     rp := win2.rPort;
  1754.     Box(rp,0,11,280,105,TRUE,1); Box(rp,5,15,270,95,FALSE,-1);
  1755.     g.SetAPen(rp,2);
  1756.     buf := SYS.VAL(SYS.ADDRESS,SYS.VAL(LONGINT,soundBuf) + oneShotHi * 16);
  1757.     bufInc := repeatHi * 16 * 65536 DIV 128;
  1758.     inc := 64;
  1759.     max := 0;
  1760.     k := 1; WHILE k < 64 DO
  1761.       argA := 0;
  1762.       argB := 2048;
  1763.       bufArg := 0;
  1764.       a := 0; b := 0;
  1765.       i := 0; WHILE i < 128 DO
  1766.         wert := buf[SHORT(SYS.ROT(bufArg,-16))];
  1767.         INC(a,wert * sinTab[argA MOD 8192]);
  1768.         INC(b,wert * sinTab[argB MOD 8192]);
  1769.         INC(argA,inc);
  1770.         INC(argB,inc);
  1771.         INC(bufArg,bufInc);
  1772.       INC(i) END;
  1773.       f[k] := trans.Sqrt(a*1.0*a + b*1.0*b);
  1774.       IF f[k] > max THEN max := f[k] END;
  1775.       INC(inc,64);
  1776.     INC(k) END;
  1777.     IF max <= 1.0E-8 THEN max := 1 END;
  1778.     k := 1; WHILE k < 64 DO
  1779.       h := SHORT(ffp.Fix(f[k] / max * 80.0 + 0.5));
  1780.       IF h <= 0 THEN h := 1 END;
  1781.       g.RectFill(rp,10+k*4,102-(h-1),10+2+k*4,102);
  1782.     INC(k) END;
  1783.     is.GetIMsg(win2,mes,TRUE);
  1784.     UnLockWindow(win);
  1785.     ip.Normal(win);
  1786.     is.DeleteWindow(win2); win2:=NIL;
  1787.     (* $RangeChk= $OvflChk= $NilChk= *)
  1788.   END FourierAnalysis;
  1789.  
  1790. (*------------------------------------------------------------------------*)
  1791.  
  1792.   PROCEDURE SetLine(l,m,c: INTEGER);
  1793.   BEGIN
  1794.     algo.line[l-1].mod:=SHORT(m-1);
  1795.     algo.line[l-1].car:=SHORT(c-1);
  1796.   END SetLine;
  1797.  
  1798. (*------------------------------------------------------------------------*)
  1799.  
  1800.   PROCEDURE Refresh;
  1801.   BEGIN
  1802.     SetOp(0);
  1803.     SetREALGad(gadTsp,transp);
  1804.     SetLFO;
  1805.     SetRR;
  1806.     SetFeedback;
  1807.     SetFilter;
  1808.     SetMode;
  1809.     SetPer;
  1810.     GetMem;
  1811.   END Refresh;
  1812.  
  1813. (*------------------------------------------------------------------------*)
  1814.  
  1815.   PROCEDURE SetName(name: ARRAY OF CHAR); (* $CopyArrays- *)
  1816.     VAR voicename: e.STRING;
  1817.         i: LONGINT;
  1818.   BEGIN
  1819.     COPY(name,voicename);
  1820.     FOR i := str.Length(voicename)-1 TO 0 BY -1 DO
  1821.       CASE voicename[i] OF ".": voicename[i] := 0X | ":","/": str.Delete(voicename,0,i+1); i := -1  ELSE END;
  1822.     END;
  1823.     WHILE str.Length(voicename) < 16 DO str.AppendChar(voicename," ") END;
  1824.     e.CopyMem(voicename,scrtitle[21],16);
  1825.     I.SetWindowTitles(win,-1,SYS.ADR(scrtitle));
  1826.   END SetName;
  1827.  
  1828. (*------------------------------------------------------------------------*)
  1829.  
  1830.   PROCEDURE Save8SVX(filePath:ARRAY OF CHAR): BOOLEAN;  (* $CopyArrays- *)
  1831.  
  1832.     TYPE
  1833.       Voice8Header = STRUCT
  1834.         oneShotHiSamples      : LONGINT;
  1835.         repeatHiSamples       : LONGINT;
  1836.         samplesPerHiCycle     : LONGINT;
  1837.         samplesPerSec         : INTEGER;
  1838.         ctOctave,sCompression : SHORTINT;
  1839.         volume                : STRUCT hi,lo: INTEGER END;
  1840.       END;
  1841.  
  1842.     VAR
  1843.       vhdr     : Voice8Header;
  1844.       bodySize : LONGINT;
  1845.       ok       : BOOLEAN;
  1846.       i        : INTEGER;
  1847.       size     : LONGINT;
  1848.       len      : LONGINT;
  1849.       buf      : UNTRACED POINTER TO SYS.BYTE;
  1850.  
  1851.   BEGIN
  1852.     IF soundBuf=NIL THEN RETURN FALSE END;
  1853.  
  1854.     file := d.Open(filePath,d.oldFile);
  1855.     IF file#NIL THEN
  1856.       d.OldClose(file);
  1857.       IF ~Request("Overwrite file?","Ok","Cancel") THEN RETURN TRUE END;
  1858.     END;
  1859.  
  1860.     bodySize := (oneShotHi+repeatHi) * 31;
  1861.     file := d.Open(filePath,d.newFile);
  1862.     IF file=NIL THEN RETURN FALSE END;
  1863.     vhdr.oneShotHiSamples := oneShotHi;
  1864.     vhdr.repeatHiSamples := repeatHi;
  1865.     vhdr.samplesPerHiCycle := 0;
  1866.     vhdr.samplesPerSec := 8363;
  1867.     vhdr.ctOctave := 5;
  1868.     vhdr.sCompression := 0;
  1869.     vhdr.volume.hi := 1; vhdr.volume.lo := 0;
  1870.     ip.Busy(win);
  1871.     LOOP
  1872.       size := 4 + SIZE(vhdr)+8 + 22+8 + bodySize+8;
  1873.       IF (d.Write(file,"FORM",4)<4) OR
  1874.          (d.Write(file,size,4)  <4) OR
  1875.          (d.Write(file,"8SVX",4)<4) THEN EXIT END;
  1876.       size := SIZE(vhdr);
  1877.       IF (d.Write(file,"VHDR",4)<4) OR
  1878.          (d.Write(file,size,4)  <4) OR
  1879.          (d.Write(file,vhdr,SIZE(vhdr))<SIZE(vhdr)) THEN EXIT END;
  1880.       size := 22;
  1881.       IF (d.Write(file,"ANNO",4)<4) OR
  1882.          (d.Write(file,size,4)  <4) OR
  1883.          (d.Write(file,"Generated by FMsynth\o\o",22)<22) THEN EXIT END;
  1884.       IF (d.Write(file,"BODY",4)  <4) OR
  1885.          (d.Write(file,bodySize,4)<4) THEN EXIT END;
  1886.       i := 5; WHILE i >= 1 DO
  1887.         buf := Buffer(i);
  1888.         len := SYS.LSH(repeatHi+oneShotHi,5-i);
  1889.         IF d.Write(file,buf^,len) < len THEN EXIT END;
  1890.       DEC(i) END;
  1891.       ip.Normal(win);
  1892.       d.OldClose(file);
  1893.       RETURN TRUE;
  1894.     END;
  1895.     ip.Normal(win);
  1896.     d.OldClose(file);
  1897.     RETURN FALSE
  1898.   END Save8SVX;
  1899.  
  1900. (*------------------------------------------------------------------------*)
  1901.  
  1902.   PROCEDURE SaveVoice(filePath:ARRAY OF CHAR):BOOLEAN;  (* $CopyArrays- *)
  1903.  
  1904.     VAR i : INTEGER;
  1905.  
  1906.     PROCEDURE Write(dat: ARRAY OF SYS.BYTE): BOOLEAN; (* $CopyArrays- *)
  1907.     BEGIN RETURN d.Write(file,dat,LEN(dat)) < LEN(dat) END Write;
  1908.  
  1909.   BEGIN
  1910.     file := d.Open(filePath,d.oldFile);
  1911.     IF file#NIL THEN
  1912.       d.OldClose(file);
  1913.       IF ~Request("Overwrite file?","Ok","Cancel") THEN RETURN TRUE END;
  1914.     END;
  1915.  
  1916.     file := d.Open(filePath,d.newFile);
  1917.     IF file=NIL THEN RETURN FALSE END;
  1918.     ip.Busy(win);
  1919.     LOOP
  1920.       IF d.Write(file,"FMsy",4) < 4 THEN EXIT END;
  1921.       IF d.Write(file," 1.0",4) < 4 THEN EXIT END;
  1922.       FOR i := 0 TO 5 DO
  1923.         IF Write(op[i]) THEN EXIT END;
  1924.       END;
  1925.       IF Write(oneShotHi) OR
  1926.          Write(repeatHi)  OR
  1927.          Write(algo)      OR
  1928.          Write(lfo)       OR
  1929.          Write(transp)    OR
  1930.          Write(soundLen)  OR
  1931.          Write(feedback)  OR
  1932.          Write(filter)    OR
  1933.          Write(mode)      OR
  1934.          Write(Per)       OR
  1935.          Write(rRate) THEN EXIT
  1936.       END;
  1937.       ip.Normal(win);
  1938.       d.OldClose(file);
  1939.       SetName(filePath);
  1940.       RETURN TRUE;
  1941.     END;
  1942.     d.OldClose(file);
  1943.     ip.Normal(win);
  1944.     RETURN FALSE;
  1945.   END SaveVoice;
  1946.  
  1947. (*------------------------------------------------------------------------*)
  1948.  
  1949.   PROCEDURE LoadVoice(filePath:ARRAY OF CHAR):BOOLEAN; (* $CopyArrays- *)
  1950.     VAR i   : INTEGER;
  1951.         head: LONGINT;
  1952.  
  1953.     PROCEDURE Read(VAR dat: ARRAY OF SYS.BYTE): BOOLEAN;
  1954.     BEGIN RETURN d.Read(file,dat,LEN(dat)) < LEN(dat) END Read;
  1955.  
  1956.   BEGIN
  1957.     file := d.Open(filePath,d.oldFile);
  1958.     IF file=NIL THEN RETURN FALSE END;
  1959.     ip.Busy(win);
  1960.     LOOP
  1961.       IF d.Read(file,head,4) < 4 THEN EXIT END;
  1962.       IF head # SYS.VAL(LONGINT,"FMsy") THEN EXIT END;
  1963.       IF d.Read(file,head,4) < 4 THEN EXIT END;
  1964.       IF head # SYS.VAL(LONGINT," 1.0") THEN EXIT END;
  1965.  
  1966.       FOR i:=0 TO 5 DO
  1967.         IF Read(op[i]) THEN EXIT END;
  1968.       END;
  1969.       IF Read(oneShotHi) OR
  1970.          Read(repeatHi)  OR
  1971.          Read(algo)      OR
  1972.          Read(lfo)       OR
  1973.          Read(transp)    OR
  1974.          Read(soundLen)  OR
  1975.          Read(feedback)  OR
  1976.          Read(filter)    OR
  1977.          Read(mode)      OR
  1978.          Read(Per)       OR
  1979.          Read(rRate) THEN EXIT
  1980.       END;
  1981.       ip.Normal(win);
  1982.       Refresh;
  1983.       d.OldClose(file);
  1984.       SetName(filePath);
  1985.       ResetChord;
  1986.       RETURN TRUE;
  1987.     END;
  1988.     d.OldClose(file);
  1989.     ip.Normal(win);
  1990.     Refresh;
  1991.     RETURN FALSE;
  1992.   END LoadVoice;
  1993.  
  1994. (*------------------------------------------------------------------------*)
  1995.  
  1996.   PROCEDURE New;
  1997.     VAR i: INTEGER;
  1998.   BEGIN
  1999.     FOR i:=0 TO 5 DO InitOp(i) END;
  2000.     algo.numLines := 0;
  2001.     transp := 1.0;
  2002.     shiftOct := 0;
  2003.     lfo.wave:=sin; lfo.spd:=0; lfo.del:=0; lfo.amd:=0; lfo.pmd:=0;
  2004.     lastWas:=none; flag:=FALSE;
  2005.     opNr:=0;
  2006.     soundLen := 15996;
  2007.     Per := 226;
  2008.     rRate:=127;
  2009.     feedback:=0;
  2010.     filter:=FALSE;
  2011.     mode:=poly;
  2012.     Refresh;
  2013.     LoopsOff;
  2014.     scrtitle[13] := CHR(shiftOct+ORD("1"));
  2015.     SetName("Unnamed");
  2016.     ResetChord;
  2017.   END New;
  2018.  
  2019. (*------------------------------------------------------------------------*)
  2020.  
  2021.   PROCEDURE SoundStop;
  2022.     VAR ch: SHORTINT;
  2023.   BEGIN
  2024.     FOR ch := as.left0 TO as.left1 DO
  2025.       as.StopSound(ch);
  2026.       state[ch] := end;
  2027.     END
  2028.   END SoundStop;
  2029.  
  2030. (*------------------------------------------------------------------------*)
  2031.  
  2032.   PROCEDURE CheckMenu;
  2033.     VAR menuCode,menuNr,itemNr,subNr:INTEGER;
  2034.         item:I.MenuItemPtr;
  2035.         changed: BOOLEAN;
  2036.   BEGIN
  2037.     changed := FALSE;
  2038.     menuCode:=mes.code;
  2039.     WHILE menuCode # I.menuNull DO
  2040.       item := I.ItemAddress(menu^,menuCode);
  2041.       menuNr := I.MenuNum(menuCode);
  2042.       itemNr := I.ItemNum(menuCode);
  2043.       subNr  := I.SubNum(menuCode);
  2044.       CASE menuNr OF
  2045.       | 0:
  2046.         IF (itemNr=0) & DoFileRequest("Load Voice",filePath) THEN
  2047.           IF ~LoadVoice(filePath) & Request("Can't load voice","","Cancel") THEN END;
  2048.         END;
  2049.         IF (itemNr=1) & DoFileRequest("Save Voice",filePath) THEN
  2050.           IF ~SaveVoice(filePath) & Request("Can't save voice","","Cancel") THEN END;
  2051.         END;
  2052.         IF (itemNr=2) & DoFileRequest("Save 8SVX",filePath) THEN
  2053.           IF ~Save8SVX(filePath) & Request("Can't save sound","","Cancel") THEN END;
  2054.         END;
  2055.         IF (itemNr=3) & Request("Are you sure?","Yes","No") THEN New END;
  2056.         IF (itemNr=5) & Request("Really quit?","Ok","Cancel") THEN SoundStop; HALT(0) END;
  2057.       | 1:
  2058.         IF itemNr=0 THEN InitOp(opNr); SetOp(opNr) END;
  2059.         IF (itemNr=1) & (subNr>=0) & (subNr<=5) THEN
  2060.           op[subNr] := op[opNr];
  2061.           changed := TRUE;
  2062.         END;
  2063.         IF itemNr=2 THEN
  2064.           CASE subNr OF
  2065.           | 0: IF op[opNr].freq <= 49999.0 THEN
  2066.                  op[opNr].freq:=op[opNr].freq*2;SetREALGad(gadFreq,op[opNr].freq);
  2067.                  changed := TRUE;
  2068.                END;
  2069.           | 1: IF op[opNr].freq >= 0.0002 THEN
  2070.                  op[opNr].freq:=op[opNr].freq/2;SetREALGad(gadFreq,op[opNr].freq);
  2071.                  changed := TRUE;
  2072.                END;
  2073.           ELSE
  2074.           END
  2075.         END;
  2076.       | 2:
  2077.         IF itemNr=0 THEN
  2078.           CASE subNr OF
  2079.           | 0: algo.numLines:=0;
  2080.           | 1: algo.numLines:=3; SetLine(1,2,1); SetLine(2,4,3); SetLine(3,6,5);
  2081.           | 2: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,5,4); SetLine(4,6,5);
  2082.           | 3: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,1); SetLine(3,4,3); SetLine(4,6,5);
  2083.           | 4: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,4,2); SetLine(4,6,5);
  2084.           | 5: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,4,3); SetLine(4,6,5);
  2085.           | 6: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,5,4); SetLine(4,6,4);
  2086.           | 7: algo.numLines:=4; SetLine(1,2,1); SetLine(2,6,3); SetLine(3,6,4); SetLine(4,6,5);
  2087.           | 8: algo.numLines:=4; SetLine(1,2,1); SetLine(2,3,1); SetLine(3,5,4); SetLine(4,6,4);
  2088.           | 9: algo.numLines:=5; SetLine(1,2,1); SetLine(2,3,2); SetLine(3,4,3); SetLine(4,5,4); SetLine(5,6,5);
  2089.           ELSE
  2090.           END;
  2091.           DrawAlgo;
  2092.           changed := TRUE;
  2093.         END;
  2094.         IF itemNr=1 THEN
  2095.           IF (subNr >= 0) & (subNr < numChords) THEN chord := subNr END;
  2096.         END;
  2097.         IF itemNr=2 THEN SetLoop END;
  2098.         IF itemNr=3 THEN FourierAnalysis END;
  2099.         IF itemNr=4 THEN autoCalc := I.checked IN item.flags END;
  2100.       ELSE
  2101.       END;
  2102.       menuCode := item.nextSelect
  2103.     END;
  2104.     IF changed & autoCalc THEN CalcSound() END;
  2105.   END CheckMenu;
  2106.  
  2107. (*------------------------------------------------------------------------*)
  2108.  
  2109.   (* $SaveRegs+ $StackChk- *)
  2110.  
  2111.   PROCEDURE InterruptProc;
  2112.     VAR volMod : INTEGER;
  2113.         perMod : INTEGER;
  2114.         ch : SHORTINT;
  2115.   BEGIN
  2116.     (* $NilChk- $OvflChk- $RangeChk- *)
  2117.     SYS.SETREG(13,SYS.REG(9));
  2118.     IF ~disabled THEN
  2119.       FOR ch:=as.left0 TO as.left1 DO
  2120.         IF delay[ch]>0 THEN DEC(delay[ch]) END;
  2121.         IF state[ch] # end THEN
  2122.           IF state[ch] = keyUp THEN
  2123.             vol[ch] := vol[ch]-deltaVol;
  2124.             IF vol[ch] <= 0.0 THEN
  2125.               vol[ch]   := 0.0;
  2126.               state[ch] := end;
  2127.             END;
  2128.           END;
  2129.           volTemp := vol[ch];
  2130.           perTemp := per[ch];
  2131.           IF delay[ch]=0 THEN
  2132.             INC(lfoArg[ch],lfoInc);
  2133.           END;
  2134.           IF lfo.amd>0 THEN  (* Modulate volume *)
  2135.             volTemp := volTemp * (1.0-lfo.amd*((128+LONG(lfoTab[SYS.LSH(lfoArg[ch],-8)]))/32768.0));
  2136.           END;
  2137.           IF lfo.pmd>0 THEN  (* Modulate period *)
  2138.             perTemp := perTemp * (1.0+lfo.pmd*((128+LONG(lfoTab[SYS.LSH(lfoArg[ch],-8)]))/maxPM));
  2139.           END;
  2140.           volMod := SHORT(ffp.Fix(volTemp+0.5));
  2141.           perMod := SHORT(ffp.Fix(perTemp+0.5));
  2142.   
  2143.           as.ModifySound(ch,perMod,volMod);
  2144.         END;
  2145.       END;
  2146.     END;
  2147.     (* $NilChk= $OvflChk= $RangeChk= *)
  2148.   END InterruptProc;
  2149.  
  2150.   (* $StackChk= *)
  2151.  
  2152. (*------------------------------------------------------------------------*)
  2153.  
  2154.   PROCEDURE HandleVertGad(gad: I.GadgetPtr; new:BOOLEAN): SHORTINT;
  2155.     VAR val: INTEGER;
  2156.   BEGIN
  2157.     val := 127-is.VertPot(gad,128);
  2158.     IF new THEN is.SetProp(gad,win,NIL,0,127-val,0,128) END;
  2159.     ShowPot(rp,gad);
  2160.     RETURN SHORT(val);
  2161.   END HandleVertGad;
  2162.  
  2163. (*------------------------------------------------------------------------*)
  2164.  
  2165.   PROCEDURE HandleHorizGad(gad: I.GadgetPtr): SHORTINT;
  2166.     VAR val: INTEGER;
  2167.   BEGIN
  2168.     val := is.HorizPot(gad,128);
  2169.     is.SetProp(gad,win,NIL,val,0,128,0);
  2170.     RETURN SHORT(val);
  2171.   END HandleHorizGad;
  2172.  
  2173. (*------------------------------------------------------------------------*)
  2174.  
  2175. BEGIN
  2176.  
  2177.   (*
  2178.   win:=NIL; win2:=NIL; scr:=NIL; menu:=NIL; req:=NIL;
  2179.   gadOffs:=NIL; gadClr:=NIL;
  2180.   soundBuf := NIL; soundLen := 0;
  2181.   intOn:=FALSE;
  2182.   FOR i:=1 TO 5 DO gadBuf[i]:=NIL END;
  2183.   *)
  2184.   SYS.SETREG(0,SYS.ADR(ver));
  2185.   me := SYS.VAL(SYS.ADDRESS,ol.Me);
  2186.   oldWindowPtr := me.windowPtr;
  2187.   oldfltstate := as.CheckFilter();
  2188.  
  2189.   IF ol.OldSP.stackSize<4000 THEN HALT(d.error) END;
  2190.  
  2191.   lfoPic := ToChipMem(SYS.VAL(SYS.ADDRESS,LFOPics),16,FALSE);
  2192.   mixPic := ToChipMem(SYS.VAL(SYS.ADDRESS,MixPics),12,FALSE);
  2193.   lfoImg := is.CreateImage(0,0,16,8,1,lfoPic^,SHORTSET{1},SHORTSET{0},NIL);
  2194.   mixImg := is.CreateImage(0,0,16,6,1,mixPic^,SHORTSET{1},SHORTSET{0},NIL);
  2195.   fmPic  := ToChipMem(SYS.VAL(SYS.ADDRESS,FMPic),864,TRUE);
  2196.   fmImg  := is.CreateImage(27,0,117,27,2,fmPic^,SHORTSET{0,1},SHORTSET{},NIL);
  2197.   zifPic := ToChipMem(SYS.VAL(SYS.ADDRESS,Ziffern),10,FALSE);
  2198.   zifImg := is.CreateImage(0,0,2,5,1,zifPic^,SHORTSET{1},SHORTSET{0},NIL);
  2199.  
  2200.   as.SetPriority(20);
  2201.   IF (as.OpenChannel({as.left0 })<0) OR
  2202.      (as.OpenChannel({as.right0})<0) OR
  2203.      (as.OpenChannel({as.right1})<0) OR
  2204.      (as.OpenChannel({as.left1 })<0) THEN rq.Fail("Can't open audio channel") END;
  2205.  
  2206.  
  2207.   SetUpScreen;
  2208.   New;
  2209.   SetKeys;
  2210.  
  2211.   int.node.type := e.interrupt;
  2212.   int.node.pri  := 0;
  2213.   int.node.name := NIL;
  2214.   int.data := SYS.REG(13);
  2215.   int.code := InterruptProc;
  2216.  
  2217.   SoundStop;
  2218.   chan:=as.left0;
  2219.  
  2220.   cia.base := e.OpenResource(cia.ciaaName);
  2221.   rq.Assert(cia.base # NIL,"Can't open ciaa.resource");
  2222.  
  2223.   rq.Assert(cia.AddICRVector(hw.ta,SYS.ADR(int))=NIL,"CIAA Timer A in use");
  2224.   hw.ciaa.cra := SHORTSET{};
  2225.   intOn:=TRUE;
  2226.  
  2227.   SetTimer(TRUE);
  2228.  
  2229.   is.msgFilter := LONGSET{I.mouseMove};
  2230.  
  2231.   LOOP
  2232.     is.GetIMsg(win,mes,TRUE);
  2233.  
  2234.     IF (I.rawKey IN mes.class) & ~(ie.repeat IN mes.qualifier) THEN
  2235.       code := mes.code;
  2236.       CASE code OF
  2237.         64: SoundStop|                               (* Space *)
  2238.         80..84: shiftOct := code-80;                 (* F1 - F5 *)
  2239.                 scrtitle[13] := CHR(shiftOct+ORD("1"));
  2240.                 I.SetWindowTitles(win,-1,SYS.ADR(scrtitle))|
  2241.       ELSE
  2242.         IF code<128 THEN                             (* Key down *)
  2243.           keyCode := key[code];
  2244.           IF keyCode >= 0 THEN
  2245.             octave := keyCode DIV 12 + shiftOct + 1;
  2246.             IF (octave<=5) & (soundBuf # NIL) THEN
  2247.               disabled := TRUE;
  2248.               per[chan]   := period[keyCode];
  2249.               vol[chan]   := 64.0;
  2250.               delay[chan] := LONG(lfo.del) * 2;
  2251.               lfoArg[chan]:= 0;
  2252.               perTemp := per[chan];
  2253.               volTemp := vol[chan];
  2254.               IF lfo.amd>0 THEN
  2255.                 volTemp := volTemp * (1.0-lfo.amd*((128+LONG(lfoTab[0]))/32768.0));
  2256.               END;
  2257.               IF lfo.pmd>0 THEN
  2258.                 perTemp := perTemp * (1.0+lfo.pmd*((128+LONG(lfoTab[0]))/maxPM));
  2259.               END;
  2260.               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)));
  2261.               state[chan] := keyDown;
  2262.               channel[keyCode] := chan;
  2263.               disabled := FALSE;
  2264.  
  2265.               IF mode=poly THEN
  2266.                 CASE chan OF
  2267.                 | as.left0:  chan:=as.right0
  2268.                 | as.right0: chan:=as.left1
  2269.                 | as.right1: chan:=as.left0
  2270.                 | as.left1:  chan:=as.right1
  2271.                 END;
  2272.               END;
  2273.               MarkKey(keyCode+shiftOct*12,TRUE);
  2274.             END
  2275.           END
  2276.         ELSE                                         (* Key up *)
  2277.           keyCode := key[code-128];
  2278.           IF keyCode >= 0 THEN
  2279.             state[channel[keyCode]] := keyUp;
  2280.             MarkKey(keyCode+shiftOct*12,FALSE);
  2281.           END
  2282.         END
  2283.       END
  2284.  
  2285.     ELSIF I.menuPick IN mes.class THEN CheckMenu
  2286.  
  2287.     ELSIF I.mouseMove IN mes.class THEN
  2288.       IF (actPropGad # NIL) & (HandleVertGad(actPropGad,FALSE)=0) THEN END;
  2289.  
  2290.     ELSIF I.gadgetDown IN mes.class THEN
  2291.       actPropGad := mes.iAddress;
  2292.  
  2293.     ELSIF I.gadgetUp IN mes.class THEN
  2294.       selGad:=mes.iAddress; id:=selGad.gadgetID;
  2295.       CASE id OF
  2296.       | O1..O6: opNr := SHORT(id-O1);SetOp(opNr);
  2297.       | R1..R4: op[opNr].r[id-R1] := HandleVertGad(gadEG[id-R1],TRUE);
  2298.                 IF autoCalc THEN CalcSound END;
  2299.       | L1..L4: op[opNr].l[id-L1] := HandleVertGad(gadEG[id-R1],TRUE);
  2300.                 IF autoCalc THEN CalcSound END;
  2301.  
  2302.       | OL: op[opNr].outp := HandleVertGad(gadOutp,TRUE);
  2303.             IF autoCalc THEN CalcSound END;
  2304.  
  2305.       | SL: op[opNr].scL := HandleVertGad(gadScL,TRUE);
  2306.             IF autoCalc THEN CalcSound END;
  2307.  
  2308.       | SR: op[opNr].scR := HandleVertGad(gadScR,TRUE);
  2309.             IF autoCalc THEN CalcSound END;
  2310.  
  2311.       | FR: GetREALGad(gadFreq,op[opNr].freq);
  2312.             SetREALGad(gadFreq,op[opNr].freq);
  2313.             IF autoCalc THEN CalcSound END;
  2314.  
  2315.       | TP: GetREALGad(gadTsp,transp);
  2316.             SetREALGad(gadTsp,transp);
  2317.             IF autoCalc THEN CalcSound END;
  2318.  
  2319.       | M1..M6:
  2320.         lastMod := SHORT(id-M1);
  2321.         IF flag THEN
  2322.           IF lastWas=car THEN
  2323.             CheckLine(lastMod,lastCar);
  2324.             DrawAlgo;
  2325.             flag := FALSE;
  2326.             IF autoCalc THEN CalcSound END;
  2327.           END;
  2328.         ELSE
  2329.           flag := TRUE
  2330.         END;
  2331.         lastWas := mod;
  2332.       | C1..C6:
  2333.         lastCar  := SHORT(id-C1);
  2334.         IF flag THEN
  2335.           IF lastWas=mod THEN
  2336.             CheckLine(lastMod,lastCar);
  2337.             DrawAlgo;
  2338.             flag := FALSE;
  2339.             IF autoCalc THEN CalcSound END;
  2340.           END;
  2341.         ELSE
  2342.           flag := TRUE
  2343.         END;
  2344.         lastWas := car;
  2345.       | WA: NextLFOWave;
  2346.       | SP: lfo.spd := HandleHorizGad(gadLFOs);
  2347.             lfoInc  := (LONG(lfo.spd)+1)*64;
  2348.       | DE: lfo.del := HandleHorizGad(gadLFOd)
  2349.       | AM: lfo.amd := HandleHorizGad(gadLFOa)
  2350.       | PM: lfo.pmd := HandleHorizGad(gadLFOp)
  2351.       | CS: IF autoCalc THEN
  2352.               autoCalc := FALSE; CalcSound(); autoCalc := TRUE;
  2353.             ELSE
  2354.                                  CalcSound();
  2355.             END;
  2356.       | RR: rRate := SHORT(127-is.HorizPot(gadRel,128)); SetRR;
  2357.       | LN: soundLen := is.GadgetVal(gadLen); GetMem; LoopsOff;
  2358.       | FB: feedback := SHORT(SHORT(is.GadgetVal(gadFeed))); SetFeedback;
  2359.             IF autoCalc THEN CalcSound END;
  2360.  
  2361.       | OM: IF op[opNr].mode=ratio THEN
  2362.               op[opNr].mode:=fixed
  2363.             ELSE
  2364.               op[opNr].mode:=ratio
  2365.             END;
  2366.             SetOp(opNr);
  2367.             IF autoCalc THEN CalcSound END;
  2368.  
  2369.       | PR: Per := SHORT(is.GadgetVal(gadPer)); SetPer;
  2370.       | MD: IF mode=poly THEN mode := mono ELSE mode:=poly END; SetMode;
  2371.       | FL: filter := ~ filter; SetFilter;
  2372.       ELSE
  2373.       END
  2374.  
  2375.     END
  2376.   END;
  2377.  
  2378. CLOSE
  2379.  
  2380.   me.windowPtr := oldWindowPtr;
  2381.   IF intOn THEN SetTimer(FALSE); cia.RemICRVector(hw.ta,SYS.ADR(int)) END;
  2382.   is.DeleteWindow(win);
  2383.   IF is.DeleteScreen(scr) THEN END;
  2384.   as.Filter(oldfltstate);
  2385.  
  2386. END FMsynth.
  2387.  
  2388.