{******************************************************************************
 *                                                                            *
 *      Unit            :       ProTracker Music Interface Kit                *
 *      Author          :       Marq/Fit                                      *
 *      Version         :       0.42                                          *
 *      Description     :       Functions for 4-channel PT/NST/ST module      *
 *                              playing with DAC, SB & GUS                    *
 *      Implemented cmds:       0  - Arpeggio                                 *
 *                              1  - Porta Up                                 *
 *                              2  - Porta Dn                                 *
 *                              3  - Tone porta                               *
 *                              4  - Vibrato                                  *
 *                              5  - ToneP + VolSlide                         *
 *                              6  - Vibrato + VolSlide                       *
 *                              7  - Tremolo                                  *
 *                              9  - Sample offset                            *
 *                              A  - Volume slide                             *
 *                              B  - Jump                                     *
 *                              C  - Volume set                               *
 *                              D  - Pattern break                            *
 *                              E1 - FineSlideUp                              *
 *                              E2 - FineSlideDn                              *
 *                              E6 - Jumploop                                 *
 *                              E9 - Retrig note                              *
 *                              EA - FineVolUp                                *
 *                              EB - FineVolDn                                *
 *                              EC - Cut note                                 *
 *                              ED - Note delay                               *
 *                              EE - Pattern delay                            *
 *                              F  - Speed/Tempo set                          *
 *      Comments        :       Thanks to Yzi & Pete for their support and    *
 *                              á-testing!                                    *
 *                              Pascal sucks but I'm just too kind NOT to     *
 *                              convert this...                               *
 *                              This is not a very good example of TP code?!  *
 *                                                                            *
 ******************************************************************************}

Unit PTMIK;

Interface

Const
     pt_MASTER_CLK=3546836;
     pt_ERROR=0;
     pt_OK=1;
     pt_DAC=0;
     pt_SB=1;
     pt_GUS=2;
     GUS_STARTA=2;
     GUS_ENDA=4;
     GUS_CURRENT=$A;
     GUS_GF1_RESET=$4C;
     GUS_VOICE_CONTROL=0;
     GUS_ACTIVE_VOICES=$E;
     gus_pan: Array [0..3] of Byte = (4,12,12,4);
     pt_period: Array [0..36*16-1] of Word =

	(856,808,762,720,678,640,604,570,538,508,480,453,
         428,404,381,360,339,320,302,285,269,254,240,226,
         214,202,190,180,170,160,151,143,135,127,120,113,

	850,802,757,715,674,637,601,567,535,505,477,450,
	425,401,379,357,337,318,300,284,268,253,239,225,
        213,201,189,179,169,159,150,142,134,126,119,113,

        844,796,752,709,670,632,597,563,532,502,474,447,
	422,398,376,355,335,316,298,282,266,251,237,224,
        211,199,188,177,167,158,149,141,133,125,118,112,

        838,791,746,704,665,628,592,559,528,498,470,444,
	419,395,373,352,332,314,296,280,264,249,235,222,
        209,198,187,176,166,157,148,140,132,125,118,111,

	832,785,741,699,660,623,588,555,524,495,467,441,
	416,392,370,350,330,312,294,278,262,247,233,220,
        208,196,185,175,165,156,147,139,131,124,117,110,

	826,779,736,694,655,619,584,551,520,491,463,437,
	413,390,368,347,328,309,292,276,260,245,232,219,
        206,195,184,174,164,155,146,138,130,123,116,109,

	820,774,730,689,651,614,580,547,516,487,460,434,
	410,387,365,345,325,307,290,274,258,244,230,217,
        205,193,183,172,163,154,145,137,129,122,115,109,

        814,768,725,684,646,610,575,543,513,484,457,431,
	407,384,363,342,323,305,288,272,256,242,228,216,
        204,192,181,171,161,152,144,136,128,121,114,108,

	907,856,808,762,720,678,640,604,570,538,508,480,
	453,428,404,381,360,339,320,302,285,269,254,240,
        226,214,202,190,180,170,160,151,143,135,127,120,

	900,850,802,757,715,675,636,601,567,535,505,477,
	450,425,401,379,357,337,318,300,284,268,253,238,
        225,212,200,189,179,169,159,150,142,134,126,119,

	894,844,796,752,709,670,632,597,563,532,502,474,
	447,422,398,376,355,335,316,298,282,266,251,237,
        223,211,199,188,177,167,158,149,141,133,125,118,

	887,838,791,746,704,665,628,592,559,528,498,470,
	444,419,395,373,352,332,314,296,280,264,249,235,
        222,209,198,187,176,166,157,148,140,132,125,118,

	881,832,785,741,699,660,623,588,555,524,494,467,
	441,416,392,370,350,330,312,294,278,262,247,233,
        220,208,196,185,175,165,156,147,139,131,123,117,

	875,826,779,736,694,655,619,584,551,520,491,463,
	437,413,390,368,347,328,309,292,276,260,245,232,
        219,206,195,184,174,164,155,146,138,130,123,116,

	868,820,774,730,689,651,614,580,547,516,487,460,
	434,410,387,365,345,325,307,290,274,258,244,230,
        217,205,193,183,172,163,154,145,137,129,122,115,

	862,814,768,725,684,646,610,575,543,513,484,457,
	431,407,384,363,342,323,305,288,272,256,242,228,
        216,203,192,181,171,161,152,144,136,128,121,114);
     pt_vib_table: Array [0..63] of Integer =
        (0,24,49,74,97,120,141,161,180,197,212,224,235,244,250,253,
        255,253,250,244,235,224,212,197,180,161,141,120,97,74,49,24,
        0,-24,-49,-74,-97,-120,-141,-161,-180,-197,-212,-224,-235,-244,
        -250,-253,-255,-253,-250,-244,-235,-224,-212,-197,-180,-161,
        -141,-120,-97,-74,-49,-24);

Var
   pt_curpos,
   pt_index,
   pt_inst,
   pt_itemp,
   pt_mainvol,
   pt_pattdelay:Integer;

   pt_curper,
   pt_vol,
   pt_cvol,
   pt_tonedest,
   pt_tonespd,
   pt_jumpdest,
   pt_jumpcnt:Array [0..3] of Integer;

   pt_freq,
   pt_device,
   pt_port,
   pt_SB_port,
   pt_counter,
   pt_VBmax,
   pt_VBcnt,
   pt_oldmax,
   pt_speed,
   pt_save_speed,
   pt_row,
   pt_off,
   pt_temp,
   gus_baseaddr,
   gus_maxfrequency:Word;

   pt_slen,
   pt_roff,
   pt_rlen,
   pt_sseg:Array [0..30] of Word;

   pt_clen,
   pt_sdec,
   pt_snum,
   pt_next,
   pt_add_off,
   pt_add_dec,
   pt_vib_off,
   pt_vib_size,
   pt_vib_spd,
   pt_tre_off,
   pt_tre_size,
   pt_tre_spd,
   pt_note:Array [0..3] of Word;

   pt_per_off,
   pt_per_dec:Array [0..1023] of Word;

   pt_modlen,
   pt_cmd,
   pt_prm,
   pt_not,
   pt_sam,
   pt_ptns:Byte;

   pt_pos:Array [0..127] of Byte;
   pt_on:Array [0..3] of Byte;

   pt_loop,
   pt_svol,
   pt_finetune:Array [0..30] of Byte;

   pt_songname:String;
   pt_patt:Array [0..99] of Pointer;
   pt_smp:Array [0..31] of Pointer;
   pt_address: Array [0..3] of Longint; { A bit odd thingy...}

   gus_start,
   gus_end,
   gus_repeat:Array [0..31] of Longint;

   gus_meminstalled,
   gus_availstart:Longint;

   pt_oldfunc:Pointer;

Function pt_init(device,port:Integer):Integer;
Function pt_load(path:String):Integer;
Function pt_play(freq:word):Integer;
Procedure pt_stop;
Procedure pt_pause;
Procedure pt_continue;
Procedure pt_SB_handler;
Procedure pt_DAC_handler;
Procedure pt_GUS_handler;Interrupt;
Procedure pt_commands;
Procedure pt_retrig(n:Integer);
Procedure pt_checkloop;
Procedure pt_calc_inc;
Procedure pt_settimer(freq:Word);
Procedure pt_resettimer;
Procedure pt_restoreclock;
Function pt_bcd2d(bcd:Word):Word;
Function pt_resetSB(base:Integer):Integer;
Procedure gus_pokeb(addr_hi,addr_lo:Word;data:Byte);
Function gus_peekb(addr_hi,addr_lo:Word):Byte;
Procedure gus_outb(reg:Integer;data:Byte);
Procedure gus_outw(reg:Integer;data:Word);
Procedure gus_setperiod(per:Word);
Procedure gus_resetGF1;
Procedure gus_delay;
Function gus_reset(portti:Integer):Integer;
Procedure gus_vol(vol:Word);
Procedure gus_setlocation(l_type:Byte;loca:Longint);
Procedure gus_selectvoice(chan:Integer);
Procedure gus_transferblock(seg0,ofs0,adhi,adlo,tsize:Word);
Procedure gus_retrig(n:Integer);
Function pt_LPT(number:Integer):Integer;

Implementation

Uses
    DOS,CRT;

Function pt_init(device,port:Integer):Integer;
Begin
     pt_mainvol:=64;

     If device=pt_SB then
     Begin
          pt_device:=pt_SB;
          If pt_resetSB(port)=1 then
          Begin
               pt_port:=port;
               pt_SB_port:=port+$C;
               pt_init:=pt_OK;
          End
          Else
              pt_init:=pt_ERROR;
          exit;
     End;

     If device=pt_GUS then
     Begin
          pt_device:=pt_GUS;
          if gus_reset(port)=pt_error then
             pt_init:=pt_ERROR
          Else
              pt_init:=pt_OK;
          exit;
     End;

     If device=pt_DAC then
     Begin
          pt_device:=pt_DAC;
          pt_port:=port;
          pt_init:=pt_OK;
          exit;
     End;

     pt_init:=pt_ERROR;
End;

Function pt_load(path:String):Integer;
Var
   n:Integer;
   hand:File;
   l,
   po,
   cnt,
   help,
   helpseg,
   helpoff:Word;
   mk:String;
   temp:Array [0..4] of Byte;
   modhead:Array [0..931] of Byte;
   gusblok:Pointer;

Begin
     Assign(hand,path);
     {$I-};
     Reset(hand,1);
     If IOresult<>0 then
     Begin
          pt_load:=pt_ERROR;
          exit;
     End;
     {$I+};

     Seek(hand,1080);
     mk:='0000';
     Blockread(hand,mk[1],4);

     If (mk='M.K.') or (mk='FLT4') then
        pt_inst:=31
     Else
     Begin
          If (mk='6CHN') or (mk='8CHN') or (mk='FLT8') then
          Begin
               pt_load:=pt_ERROR;
               exit;
          End
          Else
              pt_inst:=15;
     End;

     Seek(hand,0);
     pt_songname:='                    ';
     Blockread(hand,pt_songname[1],20);
     Blockread(hand,modhead,pt_inst*30);

     help:=0;
     For n:=0 to pt_inst-1 do
     Begin
          pt_slen[n]:=modhead[help+22];
          pt_slen[n]:=pt_slen[n] SHL 8;
          pt_slen[n]:=pt_slen[n]+modhead[help+23];
          pt_slen[n]:=pt_slen[n] SHL 1;

          pt_finetune[n]:=modhead[help+24];
          pt_svol[n]:=modhead[help+25];
          If pt_svol[n]>64 then
             pt_svol[n]:=64;

          pt_roff[n]:=modhead[help+26];
          pt_roff[n]:=pt_roff[n] SHL 8;
          pt_roff[n]:=pt_roff[n]+modhead[help+27];

          pt_rlen[n]:=modhead[help+28];
          pt_rlen[n]:=pt_rlen[n] SHL 8;
          pt_rlen[n]:=pt_rlen[n]+modhead[help+29];

          If pt_inst=31 then
          Begin
               pt_roff[n]:=pt_roff[n] SHL 1;
               pt_rlen[n]:=pt_rlen[n] SHL 1;
          End;

          Inc(help,30);
     End;

     Blockread(hand,pt_modlen,1);
     If pt_modlen=0 then
     Begin
          pt_load:=pt_ERROR;
          exit;
     End;
     Blockread(hand,temp,1);
     Blockread(hand,pt_pos,128);

     If pt_inst=31 then
        Blockread(hand,temp,4);

     pt_ptns:=pt_pos[0];
     For n:=1 to 127 do
         If pt_pos[n]>pt_ptns then
            pt_ptns:=pt_pos[n];

     For n:=0 to pt_ptns do
     Begin
          If MaxAvail<1024 then
          Begin
               pt_load:=pt_ERROR;
               exit;
          End;
          Getmem(pt_patt[n],1024);
          Blockread(hand,pt_patt[n]^,1024);
     End;

     If pt_device=pt_GUS then
     Begin
          For n:=0 to 15 do     { NOT NECESSARY??? }
              gus_pokeb(0,n,0);

          gus_availstart:=16;
          If Maxavail<65528 then
          Begin
               pt_load:=pt_ERROR;
               exit;
          End;

          Getmem(gusblok,65528);
          help:=Seg(gusblok^);

          For n:=0 to pt_inst-1 do
          Begin
               If pt_slen[n]<>0 then
               Begin
                    Blockread(hand,gusblok^,pt_slen[n]);
                    gus_transferblock(help,0,gus_availstart SHR 16,gus_availstart AND $ffff,pt_slen[n]);
                    gus_start[n]:=gus_availstart;
                    gus_availstart:=gus_availstart+longint(pt_slen[n]);
               End
               Else
                   gus_start[n]:=0;

               If pt_rlen[n]<3 then
               Begin
                    pt_loop[n]:=0;
                    gus_repeat[n]:=gus_start[n];
                    gus_end[n]:=gus_start[n]+longint(pt_slen[n]-1);
               End
               Else
               Begin
                    pt_loop[n]:=1;
                    gus_repeat[n]:=gus_start[n]+longint(pt_roff[n]);
                    gus_end[n]:=gus_repeat[n]+longint(pt_rlen[n])-1;
               End;
        End;

        Freemem(gusblok,65528);
     End
     Else
     Begin
          For n:=0 to pt_inst-1 do
          Begin
               If MaxAvail<longint(pt_slen[n]) then
               Begin
                    pt_load:=0;
                    exit;
               End;
               Getmem(pt_smp[n],pt_slen[n]);
               If pt_slen[n]<>0 then
               Begin
                    Blockread(hand,pt_smp[n]^,pt_slen[n]);
                    pt_sseg[n]:=Seg(pt_smp[n]^);
               End
               Else
                   pt_slen[n]:=1;    { It has to be something }

               If pt_rlen[n]<3 then
                  pt_loop[n]:=0
               Else
               Begin
                    pt_loop[n]:=1;
                    pt_slen[n]:=pt_roff[n]+pt_rlen[n];
               End;
        End;
     End;

     Close(hand);

     For n:=0 to pt_ptns do
     Begin
          helpseg:=Seg(pt_patt[n]^);
          helpoff:=Ofs(pt_patt[n]^);

          Asm
          push    es
          push    di
          push    dx

          mov     ax,helpseg
          mov     es,ax
          mov     di,helpoff
          mov     cx,1024/4

          @smultron:
          mov     bh,es:[di]
          mov     bl,es:[di+1]
          mov     dh,es:[di+2]

          mov     al,dh
          and     al,0fh
          mov     es:[di+2],al

          mov     ah,dh
          shr     ah,1
          shr     ah,1
          shr     ah,1
          shr     ah,1
          mov     al,bh
          and     al,10h
          add     al,ah
          mov     es:[di],al

          mov     ah,bh
          and     ah,0fh
          mov     al,bl
          test    ax,0ffffh
          jz      @movo

          xor     bx,bx

          @gertrud:
          cmp     ax,word ptr ds:pt_period[bx]
          jae     @entti
          add     bx,2
          cmp     bx,36*2
          jne     @gertrud

          @movo:
          xor     bx,bx
          mov     es:[di+1],bl
          jmp     @anataas

          @entti:
          shr     bx,1
          inc     bx
          mov     es:[di+1],bl

          @anataas:
          add     di,4
          loop    @smultron

          pop     dx
          pop     di
          pop     es
          End;
     End;
        {       Bytes after the (fast!) conversion:
                1 - Sample number
                2 - Note number
                3 - Special command
                4 - Command parameter   }

     pt_load:=pt_OK;
End;

Function pt_play(freq:Word):Integer;
Var
   n:Integer;
Begin
     pt_freq:=freq;

     If (pt_device=pt_SB) and (freq>44000) then
        pt_play:=pt_ERROR;

     If pt_device<>pt_GUS then
     Begin
          pt_VBmax:=freq div 50;
          pt_oldmax:=freq div 50;
          pt_calc_inc;
     End;

     If pt_device=pt_SB then
     Begin
          Repeat until (Port[pt_SB_port] AND $80)=0;
          Port[pt_SB_port]:=$D1;
     End;

     pt_speed:=6;
     pt_counter:=5;
     pt_row:=63;
     pt_curpos:=0;
     pt_index:=-1;
     pt_VBcnt:=1;
     pt_pattdelay:=0;

     For n:=0 to 3 do
     Begin
          pt_add_dec[n]:=0;
          pt_add_off[n]:=0;
          pt_on[n]:=0;
          pt_vol[n]:=0;
          pt_cvol[n]:=0;
          pt_address[n]:=0;
          pt_clen[n]:=65535;
          pt_jumpcnt[n]:=-1;
          pt_snum[n]:=0;
     End;

     getintvec($8,pt_oldfunc);

     case pt_device of
          pt_SB  : Begin
                        pt_settimer(pt_freq);
                        pt_SB_handler;
                   End;
          pt_DAC : Begin
                        pt_settimer(pt_freq);
                        pt_DAC_handler;
                   End;
          pt_GUS : Begin
                        gus_maxfrequency:=44100;
                        gus_outb(GUS_ACTIVE_VOICES,13);
                        gus_outb(GUS_GF1_RESET,1+2);
                        pt_settimer(50);
                        setintvec($8,Addr(pt_GUS_handler));
                   End;
     End;

     pt_play:=pt_OK;
End;

Procedure pt_stop;
Begin
     pt_resettimer;
     setintvec($8,pt_oldfunc);

     If pt_device=pt_SB then
        pt_resetSB(pt_port);

     If pt_device=pt_GUS then
     Begin
          gus_resetGF1;
          pt_resettimer;
     End;

     pt_restoreclock;
End;

Procedure pt_pause;

Var
   value:Byte;

Begin
     value:=Port[$21];
     Port[$21]:=value OR 1;

     If pt_device=pt_GUS then
        For value:=0 to 3 do
        Begin
             gus_selectvoice(value);
             gus_vol(0);
        End;
End;

Procedure pt_continue;
Var
   value:Byte;

Begin
        value:=Port[$21];
        Port[$21]:=value AND $FE;

        If pt_device=pt_GUS then
           For value:=0 to 3 do
           Begin
                gus_selectvoice(value);
                gus_vol(pt_cvol[value]);
           End;
End;

Procedure pt_DAC_handler;
Begin
     Asm
     push       ds
     push       dx
     push       ax

     mov     dx,seg @pt_handst
     mov     ds,dx
     mov     dx,offset @pt_handst
     mov     al,8
     mov     ah,025h
     int     021h

     pop     ax
     pop     dx
     pop     ds
     jmp     @getaway

     @check1:
     mov     bx,0
     call    pt_checkloop
     jmp     @chan2

     @check2:
     mov     bx,1
     call    pt_checkloop
     jmp     @chan3

     @check3:
     mov     bx,2
     call    pt_checkloop
     jmp     @chan4

     @check4:
     mov     bx,3
     call    pt_checkloop
     jmp     @output_byte

     @misc:
     jmp     @newamigablank

     @temp1:
     jmp     @check1
     @temp2:
     jmp     @check2

     @pt_handst:
     push    ax
     push    bx
     push    dx
     push    es
     push    ds

     mov     dx,seg pt_curpos
     mov     ds,dx

     dec     word ptr pt_VBcnt
     jz      @misc

     @startmixing:
     les     bx,dword ptr pt_address
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol
     mov     dx,ax

     mov     ax,word ptr pt_add_dec
     add     word ptr pt_sdec,ax
     adc     bx,word ptr pt_add_off
     mov     word ptr pt_address,bx

     cmp     bx,word ptr pt_clen
     jae     @temp1

     @chan2:
     les     bx,dword ptr pt_address+4
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol+2
     add     dx,ax

     mov     ax,word ptr pt_add_dec+2
     add     word ptr pt_sdec+2,ax
     adc     bx,word ptr pt_add_off+2
     mov     word ptr pt_address+4,bx

     cmp     bx,word ptr pt_clen+2
     jae     @temp2

     @chan3:
     les     bx,dword ptr pt_address+8
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol+4
     add     dx,ax

     mov     ax,word ptr pt_add_dec+4
     add     word ptr pt_sdec+4,ax
     adc     bx,word ptr pt_add_off+4
     mov     word ptr pt_address+8,bx

     cmp     bx,word ptr pt_clen+4
     jae     @temp3

     @chan4:
     les     bx,dword ptr pt_address+12
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol+6
     add     dx,ax

     mov     ax,word ptr pt_add_dec+6
     add     word ptr pt_sdec+6,ax
     adc     bx,word ptr pt_add_off+6
     mov     word ptr pt_address+12,bx

     cmp     bx,word ptr pt_clen+6
     jae     @temp4

     @output_byte:
     xor     dh,128
     mov     al,dh
     mov     dx,pt_port
     out     dx,al

     mov     al,020h
     out     020h,al

     pop     ds
     pop     es
     pop     dx
     pop     bx
     pop     ax
     iret

     @temp3:
     jmp     @check3
     @temp4:
     jmp     @check4

     @newamigablank:
     push    cx
     push    si
     push    di
     push    bp
     mov     bp,sp

     call    pt_commands

     mov     sp,bp
     pop     bp
     pop     di
     pop     si
     pop     cx

     jmp     @startmixing

     @getaway:
     End;
End;

Procedure pt_SB_handler;
Begin
     Asm
     push       ds
     push       dx
     push       ax

     mov     dx,seg @pt_handst
     mov     ds,dx
     mov     dx,offset @pt_handst
     mov     al,8
     mov     ah,025h
     int     021h

     pop     ax
     pop     dx
     pop     ds
     jmp     @getaway

     @check1:
     mov     bx,0
     call    pt_checkloop
     jmp     @chan2

     @check2:
     mov     bx,1
     call    pt_checkloop
     jmp     @chan3

     @check3:
     mov     bx,2
     call    pt_checkloop
     jmp     @chan4

     @check4:
     mov     bx,3
     call    pt_checkloop
     jmp     @output_byte

     @misc:
     jmp     @newamigablank

     @temp1:
     jmp     @check1
     @temp2:
     jmp     @check2

     @pt_handst:
     push    ax
     push    bx
     push    dx
     push    es
     push    ds

     mov     dx,seg pt_curpos
     mov     ds,dx

     mov     dx,word ptr pt_SB_port
     @wait1:
     in      al,dx
     rcl     al,1
     jc      @wait1
     mov     al,010h
     out     dx,al

     dec     word ptr pt_VBcnt
     jz      @misc

     @startmixing:
     les     bx,dword ptr pt_address
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol
     mov     dx,ax

     mov     ax,word ptr pt_add_dec
     add     word ptr pt_sdec,ax
     adc     bx,word ptr pt_add_off
     mov     word ptr pt_address,bx

     cmp     bx,word ptr pt_clen
     jae     @temp1

     @chan2:
     les     bx,dword ptr pt_address+4
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol+2
     add     dx,ax

     mov     ax,word ptr pt_add_dec+2
     add     word ptr pt_sdec+2,ax
     adc     bx,word ptr pt_add_off+2
     mov     word ptr pt_address+4,bx

     cmp     bx,word ptr pt_clen+2
     jae     @temp2

     @chan3:
     les     bx,dword ptr pt_address+8
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol+4
     add     dx,ax

     mov     ax,word ptr pt_add_dec+4
     add     word ptr pt_sdec+4,ax
     adc     bx,word ptr pt_add_off+4
     mov     word ptr pt_address+8,bx

     cmp     bx,word ptr pt_clen+4
     jae     @temp3

     @chan4:
     les     bx,dword ptr pt_address+12
     mov     al,byte ptr es:[bx]

     imul    byte ptr pt_cvol+6
     add     dx,ax

     mov     ax,word ptr pt_add_dec+6
     add     word ptr pt_sdec+6,ax
     adc     bx,word ptr pt_add_off+6
     mov     word ptr pt_address+12,bx

     cmp     bx,word ptr pt_clen+6
     jae     @temp4

     @output_byte:
     xor     dh,128
     mov     ah,dh
     mov     dx,word ptr pt_SB_port

     @wait2:
     in      al,dx
     rcl     al,1
     jc      @wait2
     mov     al,ah
     out     dx,al

     mov     al,020h
     out     020h,al

     pop     ds
     pop     es
     pop     dx
     pop     bx
     pop     ax
     iret

     @temp3:
     jmp     @check3
     @temp4:
     jmp     @check4

     @newamigablank:
     push    cx
     push    si
     push    di
     push    bp
     mov     bp,sp

     call    pt_commands

     mov     sp,bp
     pop     bp
     pop     di
     pop     si
     pop     cx

     jmp     @startmixing

     @getaway:
     End;
End;

Procedure pt_commands;
Var
   n:integer;
   helps,
   helpo:Word;

Label
     1;

Begin
     pt_VBcnt:=pt_VBmax;

     Inc(pt_counter);
     If pt_counter>=pt_speed then
     Begin
          pt_counter:=0;

          Inc(pt_row);
          If pt_row>63 then
          Begin
               Dec(pt_row,64);
               Inc(pt_index);
               If pt_index=pt_modlen then
                    pt_index:=0;
               pt_curpos:=pt_pos[pt_index];
          End;
          pt_off:=pt_row SHL 4;
     End;

     If (pt_pattdelay<>0) and (pt_counter=0) then
     Begin
          pt_speed:=pt_save_speed;
          pt_pattdelay:=0;
     End;

     helps:=Seg(pt_patt[pt_curpos]^);
     helpo:=Ofs(pt_patt[pt_curpos]^);
     helpo:=helpo+pt_off;

     For n:=0 to 3 do
     Begin
          pt_sam:=mem[helps:helpo];
          pt_not:=mem[helps:helpo+1];
          pt_cmd:=mem[helps:helpo+2];
          pt_prm:=mem[helps:helpo+3];

          If pt_counter=0 then
          Begin
               If (pt_cmd=$E) and (pt_prm SHR 4=$D) then
               Begin
                  If pt_sam<>0 then
                     pt_vol[n]:=pt_svol[pt_sam-1];
               End
               Else
                   pt_retrig(n);

               If (pt_cmd OR pt_prm)<>0 then
               Begin
                    Case pt_cmd of
                         3 : If pt_prm<>0 then
                                pt_tonespd[n]:=pt_prm;
                         4 : Begin
                                  If (pt_prm SHR 4)<>0 then
                                     pt_vib_spd[n]:=pt_prm SHR 4;
                                  If (pt_prm AND $F)<>0 then
                                     pt_vib_size[n]:=pt_prm AND $F;
                             End;
                         7 : Begin
                                  If (pt_prm SHR 4)<>0 then
                                     pt_tre_spd[n]:=pt_prm SHR 4;
                                  If (pt_prm AND $F)<>0 then
                                     pt_tre_size[n]:=pt_prm AND $F;
                             End;
                         9 : Begin
                                  pt_address[n]:=pt_address[n] AND $FFFF0000;
                                  pt_address[n]:=pt_address[n]+(longint(pt_prm) SHL 8);
                             End;
                         $B: Begin
                                  pt_row:=63;
                                  pt_index:=pt_prm-1;
                             End;
                         $C: pt_vol[n]:=pt_prm;
                         $D: pt_row:=63+(pt_prm AND $F)+(pt_prm SHR 4)*10;
                         $E: Case (pt_prm SHR 4) of
                             1 : Begin
                                      pt_curper[n]:=pt_curper[n]-(pt_prm AND $F);
                                      pt_add_off[n]:=pt_per_off[pt_curper[n]];
                                      pt_add_dec[n]:=pt_per_dec[pt_curper[n]];
                                 End;
                             2 : Begin
                                      pt_curper[n]:=pt_curper[n]+(pt_prm AND $F);
                                      pt_add_off[n]:=pt_per_off[pt_curper[n]];
                                      pt_add_dec[n]:=pt_per_dec[pt_curper[n]];
                                 End;
                             6 : Begin
                                      If (pt_prm AND $F)<>0 then
                                      Begin
                                           If pt_jumpcnt[n]=-1 then
                                           Begin
                                                pt_jumpcnt[n]:=(pt_prm AND $F)-1;
                                                pt_row:=pt_jumpdest[n]-1;
                                           End
                                           Else
                                               If pt_jumpcnt[n]<>0 then
                                               Begin
                                                    Dec(pt_jumpcnt[n]);
                                                    pt_row:=pt_jumpdest[n]-1;
                                               End
                                               Else
                                                   pt_jumpcnt[n]:=-1;
                                      End
                                      Else
                                          pt_jumpdest[n]:=pt_row;
                                 End;
                             $B: Begin
                                      pt_vol[n]:=pt_vol[n]-(pt_prm AND $F);
                                      If pt_vol[n]<0 then
                                         pt_vol[n]:=0;
                                 End;
                             $A: Begin
                                      pt_vol[n]:=pt_vol[n]-(pt_prm AND $F);
                                      If pt_vol[n]>64 then
                                         pt_vol[n]:=0;
                                 End;
                             $E: Begin
                                      pt_save_speed:=pt_speed;
                                      pt_speed:=pt_speed*integer((pt_prm AND $F)+1);
                                      pt_pattdelay:=1;
                                 End;
                             End;
                         $F: Begin
                                  If pt_prm<$20 then
                                     pt_speed:=pt_prm
                                  Else
                                  Begin
                                       pt_VBmax:=(longint(pt_oldmax)*125) div longint(pt_prm);
                                       pt_VBcnt:=pt_VBmax;
                                  End;
                             End;
                    End;
               End;
          End;

          If ((pt_cmd OR pt_prm)<>0) and (pt_counter<>0) then
          Begin
               1:
               Case pt_cmd of
                    0 : Begin
                             Case pt_counter MOD 3 of
                             0 : pt_temp:=pt_curper[n];
                             1 : Begin
                                      pt_temp:=pt_note[n]+36*pt_finetune[pt_snum[n]]+(pt_prm SHR 4);
                                      pt_temp:=pt_period[pt_temp];
                                 End;
                             2 : Begin
                                      pt_temp:=pt_note[n]+36*pt_finetune[pt_snum[n]]+(pt_prm AND $F);
                                      pt_temp:=pt_period[pt_temp];
                                 End;
                             End;
                             pt_add_off[n]:=pt_per_off[pt_temp];
                             pt_add_dec[n]:=pt_per_dec[pt_temp];
                        End;
                    1 : Begin
                             pt_curper[n]:=pt_curper[n]-pt_prm;
                             If pt_curper[n]<113 then
                                pt_curper[n]:=113;

                             pt_add_off[n]:=pt_per_off[pt_curper[n]];
                             pt_add_dec[n]:=pt_per_dec[pt_curper[n]];
                        End;
                    2 : Begin
                             pt_curper[n]:=pt_curper[n]+pt_prm;
                             If pt_curper[n]>856 then
                                pt_curper[n]:=856;

                             pt_add_off[n]:=pt_per_off[pt_curper[n]];
                             pt_add_dec[n]:=pt_per_dec[pt_curper[n]];
                        End;
                    3 : Begin
                             If pt_curper[n]<pt_tonedest[n] then
                             Begin
                                  pt_curper[n]:=pt_curper[n]+pt_tonespd[n];
                                  If pt_curper[n]>=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End
                             Else
                             Begin
                                  pt_curper[n]:=pt_curper[n]-pt_tonespd[n];
                                  If pt_curper[n]<=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End;

                             pt_add_off[n]:=pt_per_off[pt_curper[n]];
                             pt_add_dec[n]:=pt_per_dec[pt_curper[n]];
                        End;
                    4 : Begin
                             pt_itemp:=pt_vib_table[pt_vib_off[n]]*pt_vib_size[n];
                             pt_itemp:=pt_itemp div 128;

                             pt_temp:=pt_curper[n]+pt_itemp;
                             pt_add_off[n]:=pt_per_off[pt_temp];
                             pt_add_dec[n]:=pt_per_dec[pt_temp];

                             pt_vib_off[n]:=pt_vib_off[n]+pt_vib_spd[n];
                             pt_vib_off[n]:=pt_vib_off[n] AND 63;
                        End;
                    5 : Begin
                             If pt_curper[n]<pt_tonedest[n] then
                             Begin
                                  pt_curper[n]:=pt_curper[n]+pt_tonespd[n];
                                  If pt_curper[n]>=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End
                             Else
                             Begin
                                  pt_curper[n]:=pt_curper[n]-pt_tonespd[n];
                                  If pt_curper[n]<=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End;

                             pt_add_off[n]:=pt_per_off[pt_curper[n]];
                             pt_add_dec[n]:=pt_per_dec[pt_curper[n]];

                             pt_cmd:=$A;
                             goto 1;
                        End;
                    6 : Begin
                             pt_itemp:=pt_vib_table[pt_vib_off[n]]*pt_vib_size[n];
                             pt_itemp:=pt_itemp div 128;

                             pt_temp:=pt_curper[n]+pt_itemp;
                             pt_add_off[n]:=pt_per_off[pt_temp];
                             pt_add_dec[n]:=pt_per_dec[pt_temp];

                             pt_vib_off[n]:=pt_vib_off[n]+pt_vib_spd[n];
                             pt_vib_off[n]:=pt_vib_off[n] AND 63;

                             pt_cmd:=$A;
                             goto 1;
                        End;
                    7 : Begin
                             pt_itemp:=pt_vib_table[pt_tre_off[n]]*pt_tre_size[n];
                             pt_itemp:=pt_itemp div 64;

                             pt_vol[n]:=pt_svol[pt_snum[n]]+pt_itemp;
                             If pt_vol[n]<0 then
                                pt_vol[n]:=0;
                             If pt_vol[n]>64 then
                                pt_vol[n]:=64;

                             pt_tre_off[n]:=pt_tre_off[n]+pt_tre_spd[n];
                             pt_tre_off[n]:=pt_tre_off[n] AND 63;
                        End;
                    $A: Begin
                             If (pt_prm AND $F<>0) and (pt_prm SHR 4=0) then
                             Begin
                                  pt_vol[n]:=pt_vol[n]-(pt_prm AND $F);
                                  If pt_vol[n]<0 then
                                     pt_vol[n]:=0;
                             End
                             Else
                             Begin
                                  pt_vol[n]:=pt_vol[n]+(pt_prm SHR 4);
                                  If pt_vol[n]>64 then
                                     pt_vol[n]:=64;
                             End;
                        End;
                    $E: Case pt_prm SHR 4 of
                             9 : If pt_counter MOD (pt_prm AND $F)=0 then
                                 pt_retrig(n);
                             $C: If pt_counter>=pt_prm AND $F then
                                 pt_vol[n]:=0;
                             $D: If pt_counter=pt_prm AND $F then
                                 pt_retrig(n);
                        End;
               End;
          End;
          Inc(helpo,4);
     End;

     For n:=0 to 3 do
         If pt_on[n]<>0 then
            pt_cvol[n]:=(pt_mainvol*pt_vol[n]) div 64
         Else
             pt_cvol[n]:=0;
End;

Procedure pt_retrig(n:integer);
Begin
        If pt_sam<>0 then
        Begin
             pt_next[n]:=pt_sam-1;
             pt_vol[n]:=pt_svol[pt_next[n]];
        End;

        If pt_not<>0 then    { New note }
        Begin
                pt_on[n]:=1;

                if (pt_cmd<>3) and (pt_cmd<>5) then    { No ToneP }
                Begin
                        pt_tre_off[n]:=0;
                        pt_vib_off[n]:=0;

                        pt_note[n]:=pt_not-1;
                        pt_sdec[n]:=0;

                        Asm
                           mov     bx,n
                           shl     bx,1
                           shl     bx,1
                           mov word ptr pt_address[bx],0
                        End;

                        pt_snum[n]:=pt_next[n];
                        pt_temp:=pt_note[n]+36*Word(pt_finetune[pt_snum[n]]);
                        pt_curper[n]:=pt_period[pt_temp];
                        pt_clen[n]:=pt_slen[pt_snum[n]];

                        Asm
                           mov     bx,n
                           shl     bx,1
                           mov     ax,word ptr pt_snum[bx]
                           mov     bx,ax
                           shl     bx,1
                           mov     ax,word ptr pt_sseg[bx]
                           mov     bx,n
                           shl     bx,1
                           shl     bx,1
                           mov word ptr pt_address[bx+2],ax
                        End;

                        pt_add_off[n]:=pt_per_off[pt_curper[n]];
                        pt_add_dec[n]:=pt_per_dec[pt_curper[n]];
                End
                Else
                Begin
                        If pt_sam<>0 then
                                pt_snum[n]:=pt_next[n];
                End;

                pt_temp:=pt_not-1;      { New Dest }
                pt_tonedest[n]:=pt_period[pt_temp];
        End;
End;

Procedure pt_checkloop;
Begin
     Asm
        push    bx
        shl     bx,1
        mov     ax,word ptr pt_snum[bx]
        mov     bx,ax
        cmp byte ptr pt_loop[bx],0
        jne     @yes_loop

        pop     bx
        mov byte ptr pt_on[bx],0
        shl     bx,1
        mov word ptr pt_cvol[bx],0
        mov word ptr pt_add_dec[bx],0
        mov word ptr pt_add_off[bx],0
        shl     bx,1
        mov word ptr pt_address[bx],0
        jmp     @get_out

        @yes_loop:
        shl     bx,1
        mov     ax,word ptr pt_roff[bx]
        pop     bx
        shl     bx,1
        shl     bx,1
        mov word ptr pt_address[bx],ax

        @get_out:
     End;
End;

Procedure pt_GUS_handler;
Var
   n:integer;
   helps,
   helpo:Word;

Label
     1;

Begin
     pt_VBcnt:=pt_VBmax;

     Inc(pt_counter);
     If pt_counter>=pt_speed then
     Begin
          pt_counter:=0;

          Inc(pt_row);
          If pt_row>63 then
          Begin
               Dec(pt_row,64);
               Inc(pt_index);
               If pt_index=pt_modlen then
                    pt_index:=0;
               pt_curpos:=pt_pos[pt_index];
          End;
          pt_off:=pt_row SHL 4;
     End;

     If (pt_pattdelay<>0) and (pt_counter=0) then
     Begin
          pt_speed:=pt_save_speed;
          pt_pattdelay:=0;
     End;

     helps:=Seg(pt_patt[pt_curpos]^);
     helpo:=Ofs(pt_patt[pt_curpos]^);
     helpo:=helpo+pt_off;

     For n:=0 to 3 do
     Begin
          gus_selectvoice(n);

          pt_sam:=mem[helps:helpo];
          pt_not:=mem[helps:helpo+1];
          pt_cmd:=mem[helps:helpo+2];
          pt_prm:=mem[helps:helpo+3];

          If pt_counter=0 then
          Begin
               If (pt_cmd=$E) and (pt_prm SHR 4=$D) then
               Begin
                  If pt_sam<>0 then
                     pt_vol[n]:=pt_svol[pt_sam-1];
               End
               Else
                   gus_retrig(n);

               If (pt_cmd OR pt_prm)<>0 then
               Begin
                    Case pt_cmd of
                         3 : If pt_prm<>0 then
                                pt_tonespd[n]:=pt_prm;
                         4 : Begin
                                  If (pt_prm SHR 4)<>0 then
                                     pt_vib_spd[n]:=pt_prm SHR 4;
                                  If (pt_prm AND $F)<>0 then
                                     pt_vib_size[n]:=pt_prm AND $F;
                             End;
                         7 : Begin
                                  If (pt_prm SHR 4)<>0 then
                                     pt_tre_spd[n]:=pt_prm SHR 4;
                                  If (pt_prm AND $F)<>0 then
                                     pt_tre_size[n]:=pt_prm AND $F;
                             End;
                         9 : Begin
                                  If pt_loop[pt_snum[n]]<>0 then
                                  Begin
                                       gus_setlocation(GUS_CURRENT,gus_start[pt_snum[n]]+(longint(pt_prm) SHL 8));
                                       gus_outb(0,8);
                                  End
                                  Else
                                  Begin
                                       gus_setlocation(GUS_CURRENT,gus_start[pt_snum[n]]+(longint(pt_prm) SHL 8));
                                       gus_outb(0,0);
                                  End
                             End;
                         $B: Begin
                                  pt_row:=63;
                                  pt_index:=pt_prm-1;
                             End;
                         $C: pt_vol[n]:=pt_prm;
                         $D: pt_row:=63+(pt_prm AND $F)+(pt_prm SHR 4)*10;
                         $E: Case (pt_prm SHR 4) of
                             1 : Begin
                                      pt_curper[n]:=pt_curper[n]-(pt_prm AND $F);
                                      gus_setperiod(pt_curper[n]);
                                 End;
                             2 : Begin
                                      pt_curper[n]:=pt_curper[n]+(pt_prm AND $F);
                                      gus_setperiod(pt_curper[n]);
                                 End;
                             6 : Begin
                                      If (pt_prm AND $F)<>0 then
                                      Begin
                                           If pt_jumpcnt[n]=-1 then
                                           Begin
                                                pt_jumpcnt[n]:=(pt_prm AND $F)-1;
                                                pt_row:=pt_jumpdest[n]-1;
                                           End
                                           Else
                                               If pt_jumpcnt[n]<>0 then
                                               Begin
                                                    Dec(pt_jumpcnt[n]);
                                                    pt_row:=pt_jumpdest[n]-1;
                                               End
                                               Else
                                                   pt_jumpcnt[n]:=-1;
                                      End
                                      Else
                                          pt_jumpdest[n]:=pt_row;
                                 End;
                             $B: Begin
                                      pt_vol[n]:=pt_vol[n]-(pt_prm AND $F);
                                      If pt_vol[n]<0 then
                                         pt_vol[n]:=0;
                                 End;
                             $A: Begin
                                      pt_vol[n]:=pt_vol[n]-(pt_prm AND $F);
                                      If pt_vol[n]>64 then
                                         pt_vol[n]:=0;
                                 End;
                             $E: Begin
                                      pt_save_speed:=pt_speed;
                                      pt_speed:=pt_speed*integer((pt_prm AND $F)+1);
                                      pt_pattdelay:=1;
                                 End;
                             End;
                         $F: Begin
                                  If pt_prm<$20 then
                                     pt_speed:=pt_prm
                                  Else
                                       pt_settimer((50*Word(pt_prm)) div 125);
                             End;
                    End;
               End;
          End;

          If ((pt_cmd OR pt_prm)<>0) and (pt_counter<>0) then
          Begin
               1:
               Case pt_cmd of
                    0 : Begin
                             Case pt_counter MOD 3 of
                             0 : pt_temp:=pt_curper[n];
                             1 : Begin
                                      pt_temp:=pt_note[n]+36*pt_finetune[pt_snum[n]]+(pt_prm SHR 4);
                                      pt_temp:=pt_period[pt_temp];
                                 End;
                             2 : Begin
                                      pt_temp:=pt_note[n]+36*pt_finetune[pt_snum[n]]+(pt_prm AND $F);
                                      pt_temp:=pt_period[pt_temp];
                                 End;
                             End;
                             gus_setperiod(pt_temp);
                        End;
                    1 : Begin
                             pt_curper[n]:=pt_curper[n]-pt_prm;
                             If pt_curper[n]<113 then
                                pt_curper[n]:=113;

                             gus_setperiod(pt_curper[n]);
                        End;
                    2 : Begin
                             pt_curper[n]:=pt_curper[n]+pt_prm;
                             If pt_curper[n]>856 then
                                pt_curper[n]:=856;

                             gus_setperiod(pt_curper[n]);
                        End;
                    3 : Begin
                             If pt_curper[n]<pt_tonedest[n] then
                             Begin
                                  pt_curper[n]:=pt_curper[n]+pt_tonespd[n];
                                  If pt_curper[n]>=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End
                             Else
                             Begin
                                  pt_curper[n]:=pt_curper[n]-pt_tonespd[n];
                                  If pt_curper[n]<=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End;

                             gus_setperiod(pt_curper[n]);
                        End;
                    4 : Begin
                             pt_itemp:=pt_vib_table[pt_vib_off[n]]*pt_vib_size[n];
                             pt_itemp:=pt_itemp div 128;

                             pt_temp:=pt_curper[n]+pt_itemp;
                             gus_setperiod(pt_temp);

                             pt_vib_off[n]:=pt_vib_off[n]+pt_vib_spd[n];
                             pt_vib_off[n]:=pt_vib_off[n] AND 63;
                        End;
                    5 : Begin
                             If pt_curper[n]<pt_tonedest[n] then
                             Begin
                                  pt_curper[n]:=pt_curper[n]+pt_tonespd[n];
                                  If pt_curper[n]>=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End
                             Else
                             Begin
                                  pt_curper[n]:=pt_curper[n]-pt_tonespd[n];
                                  If pt_curper[n]<=pt_tonedest[n] then
                                     pt_curper[n]:=pt_tonedest[n];
                             End;

                             gus_setperiod(pt_curper[n]);

                             pt_cmd:=$A;
                             goto 1;
                        End;
                    6 : Begin
                             pt_itemp:=pt_vib_table[pt_vib_off[n]]*pt_vib_size[n];
                             pt_itemp:=pt_itemp div 128;

                             pt_temp:=pt_curper[n]+pt_itemp;
                             gus_setperiod(pt_temp);

                             pt_vib_off[n]:=pt_vib_off[n]+pt_vib_spd[n];
                             pt_vib_off[n]:=pt_vib_off[n] AND 63;

                             pt_cmd:=$A;
                             goto 1;
                        End;
                    7 : Begin
                             pt_itemp:=pt_vib_table[pt_tre_off[n]]*pt_tre_size[n];
                             pt_itemp:=pt_itemp div 64;

                             pt_vol[n]:=pt_svol[pt_snum[n]]+pt_itemp;
                             If pt_vol[n]<0 then
                                pt_vol[n]:=0;
                             If pt_vol[n]>64 then
                                pt_vol[n]:=64;

                             pt_tre_off[n]:=pt_tre_off[n]+pt_tre_spd[n];
                             pt_tre_off[n]:=pt_tre_off[n] AND 63;
                        End;
                    $A: Begin
                             If (pt_prm AND $F<>0) and (pt_prm SHR 4=0) then
                             Begin
                                  pt_vol[n]:=pt_vol[n]-(pt_prm AND $F);
                                  If pt_vol[n]<0 then
                                     pt_vol[n]:=0;
                             End
                             Else
                             Begin
                                  pt_vol[n]:=pt_vol[n]+(pt_prm SHR 4);
                                  If pt_vol[n]>64 then
                                     pt_vol[n]:=64;
                             End;
                        End;
                    $E: Case (pt_prm SHR 4) of
                             9 : If pt_counter MOD (pt_prm AND $F)=0 then
                                    gus_retrig(n);
                             $C: If pt_counter>=(pt_prm AND $F) then
                                    pt_vol[n]:=0;
                             $D: If pt_counter=(pt_prm AND $F) then
                                    gus_retrig(n);
                       End;
               End;
          End;
          Inc(helpo,4);
     End;

     For n:=0 to 3 do
     Begin
         If pt_on[n]<>0 then
            pt_cvol[n]:=(pt_mainvol*pt_vol[n]) div 64
         Else
             pt_cvol[n]:=0;

         gus_selectvoice(n);
         gus_vol(pt_cvol[n]);
     End;

     Port[$20]:=$20;
End;

Procedure gus_retrig(n:Integer);
Begin
     If pt_sam<>0 then
        Begin
             pt_next[n]:=pt_sam-1;
             pt_vol[n]:=pt_svol[pt_next[n]];
        End;

        If pt_not<>0 then    { New note }
        Begin
                pt_on[n]:=1;

                if (pt_cmd<>3) and (pt_cmd<>5) then    { No ToneP }
                Begin
                        pt_tre_off[n]:=0;
                        pt_vib_off[n]:=0;

                        pt_note[n]:=pt_not-1;
                        pt_snum[n]:=pt_next[n];
                        pt_temp:=pt_note[n]+36*pt_finetune[pt_snum[n]];
                        pt_curper[n]:=pt_period[pt_temp];

                        gus_outb(0,2);
                        gus_setperiod(pt_curper[n]);
                        gus_outb($C,gus_pan[n]);

                        If pt_loop[pt_snum[n]]<>0 then
                        Begin
                             gus_setlocation(GUS_STARTA,gus_repeat[pt_snum[n]]);
                             gus_setlocation(GUS_ENDA,gus_end[pt_snum[n]]);
                             gus_setlocation(GUS_CURRENT,gus_start[pt_snum[n]]);
                             gus_outb(0,8);
                        End
                        else
                        Begin
                             gus_setlocation(GUS_STARTA,gus_start[pt_snum[n]]);
                             gus_setlocation(GUS_ENDA,gus_end[pt_snum[n]]);
                             gus_setlocation(GUS_CURRENT,gus_start[pt_snum[n]]);
                             gus_outb(0,0);
                        End;
                End
                Else
                Begin
                        If pt_sam<>0 then
                                pt_snum[n]:=pt_next[n];
                End;

                pt_temp:=pt_not-1;      { New Dest }
                pt_tonedest[n]:=pt_period[pt_temp];
        End;
End;

Procedure pt_calc_inc;

Var
   prd:Word;
   trap:Longint;

Begin
     For prd:=1 to 1023 do
     Begin
          trap:=pt_MASTER_CLK div longint(prd);
          trap:=trap SHL 16;
          trap:=trap div longint(pt_freq);

          pt_per_off[prd]:=trap SHR 16;
          pt_per_dec[prd]:=trap AND $FFFF;
     End;
End;

Procedure pt_settimer(freq:Word);
Var
   help:Word;

Begin
        help:=1193182 div longint(freq);

        Port[$40]:=help AND $FF;
        Port[$40]:=help SHR 8;
        Port[$43]:=0;
End;

Procedure pt_resettimer;
Begin
     Port[$40]:=0;
     Port[$40]:=0;
     Port[$43]:=0;
End;

Procedure pt_restoreclock;

Var
   reg1,
   reg2:Registers;

Begin
	reg1.ax:=$0200;
	intr($1a,reg1);

        reg1.cx:=(pt_bcd2d(reg1.cx SHR 8) SHL 8)+pt_bcd2d(reg1.cx AND $ff);
        reg1.dx:=pt_bcd2d(reg1.dx SHR 8) SHL 8;
	reg2.ax:=$0400;
	intr($1a,reg2);

        reg2.cx:=pt_bcd2d(reg2.cx SHR 8)*100+pt_bcd2d(reg2.cx AND $ff);
        reg2.dx:=(pt_bcd2d(reg2.dx SHR 8) SHL 8)+pt_bcd2d(reg2.dx AND $ff);
	reg2.ax:=$2b00;
	intr($21,reg2);

	reg1.ax:=$2d00;
	intr($21,reg1);
End;

Function pt_bcd2d(bcd:Word):Word;

Var
   help:Word;

Begin
     help:=bcd div 16;
     help:=bcd-16*help+help*10;
     pt_bcd2d:=help;
End;

Function pt_resetSB(base:Integer):Integer;

Var
   tries:Word;

Begin
        tries:=100;     { Try 100 times before exit }

        Port[base+6]:=1;
        delay(1);
        Port[base+6]:=0;
        delay(1);

        { SB will return AAh if it is reset }
        While (port[base+$A]<>$AA) AND (tries<>0) do
	Begin
             Port[base+6]:=1;
             delay(1);
             Port[base+6]:=0;
             delay(1);
             Dec(tries);
	End;

        If tries=0 then
           pt_resetSB:=0        { Not found }
        Else
            pt_resetSB:=1;      { Found }
End;

Function gus_reset(portti:Integer):Integer;

Var
   n:Integer;

Begin
     gus_baseaddr:=portti;
     gus_resetGF1;
     gus_pokeb(0,0,66);
     If gus_peekb(0,0)<>66 then
        gus_reset:=pt_ERROR;

     gus_meminstalled:=65536*4;
     gus_pokeb(4,0,$AA);
     If gus_peekb(4,0)=$AA then
        gus_meminstalled:=65536*8;

     gus_pokeb(8,0,$AA);
     If gus_peekb(8,0)=$AA then
        gus_meminstalled:=65536*16;

     For n:=0 to 31 do
     Begin
          gus_selectvoice(n);
          gus_outb(0,3);
     End;

     gus_reset:=pt_OK;
End;

Procedure gus_delay;
Begin
     Asm
        mov     al, $34
        out     $43, al
        sub     al, 128
        out     $40, al
        out     $40, al

        sub     al, al
        out     $43, al
        in      al, $40
        mov     bl, al
        in      al, $40
        mov     bh, al
        sub     bx, 6
@again: sub     al, al
        out     $43, al
        in      al, $40
        mov     cl, al
        in      al, $40
        mov     ch, al
        cmp     cx, bx
        ja      @again
     End;
End;

Procedure gus_resetGF1;

Var
   n:Integer;

Begin
        gus_outb(GUS_GF1_RESET,0);
        Port[gus_baseaddr]:=9;

        For n:=0 to 3000 do
            gus_delay;

        gus_outb(GUS_GF1_RESET,7);

        For n:=0 to 31 do
        Begin
             gus_selectvoice(n);
             gus_outb(0,3);
             gus_outb($D,3);
             gus_delay;
             gus_outb(0,3);
             gus_outb($D,3);
        End;
End;

Procedure gus_pokeb(addr_hi,addr_lo:Word;data:Byte);
Begin
        Port[gus_baseaddr+$103]:=$43;
        PortW[gus_baseaddr+$104]:=addr_lo;
        Port[gus_baseaddr+$103]:=$44;
        Port[gus_baseaddr+$105]:=addr_hi;
	Port[gus_baseaddr+$107]:=data;
End;

Function gus_peekb(addr_hi,addr_lo:Word):Byte;
Begin
     Port[gus_baseaddr+$103]:=$43;
     PortW[gus_baseaddr+$104]:=addr_lo;
     Port[gus_baseaddr+$103]:=$44;
     Port[gus_baseaddr+$105]:=addr_hi;
     gus_peekb:=Port[gus_baseaddr+$107];
End;

Procedure gus_outb(reg:Integer;data:Byte);
Begin
     Port[gus_baseaddr+$103]:=reg;
     Port[gus_baseaddr+$105]:=data;
End;

Procedure gus_outw(reg:Integer;data:Word);
Begin
     Port[gus_baseaddr+$103]:=reg;
     PortW[gus_baseaddr+$104]:=data;
End;

Procedure gus_transferblock(seg0,ofs0,adhi,adlo,tsize:Word);
Begin
     Asm
        push    ds
        pushf
        cli
        mov     dx, gus_baseaddr
        mov     ds, seg0
        mov     si, ofs0
        mov     bx, adhi
        mov     di, adlo
        cld
        mov     cx, tsize
        add     dx, $103
@tdlp:  mov     al, $43
        out     dx, al
        inc     dx
        mov     ax, di
        out     dx, ax
        dec     dx
        mov     al, $44
        out     dx, al
        add     dx, 2
        mov     al, bl
        out     dx, al
        add     dx, 2
        lodsb
        out     dx, al
        add     di, 1
        adc     bl, 0
        sub     dx, 4
        loop    @tdlp
        popf
        pop     ds
    End;
End;

Procedure gus_selectvoice(chan:Integer);
Begin
     Port[gus_baseaddr+$102]:=chan;
End;

Procedure gus_setlocation(l_type:Byte;loca:Longint);
Begin
     gus_outw(l_type,Word(loca SHR 7));
     gus_outw(l_type+1,Word(loca SHL 9));
End;

Procedure gus_setperiod(per:Word);
Begin
     If per<>0 then
     gus_outw(1,(((pt_MASTER_CLK div gus_maxfrequency) SHL 9) div longint(per)) SHL 1);
End;

Procedure gus_vol(vol:Word);
Var
   erk:Word;

Begin
     erk:=$AA00;

     Case vol of
          0      : erk:=0;
          1..15  : erk:=(erk + vol*$230);
          16..31 : erk:=(erk + $2300 + (vol - $10) * $110);
          32..47 : erk:=(erk + $3400 + (vol - $20) * $80);
          48..58 : erk:=(erk + $3c00 + (vol - $30) * $60);
          59..64 : erk:=(erk + $3fc0 + (vol - 58) * $48);
    End;

    gus_outw(9,erk);
End;

Function pt_LPT(number:Integer):Integer;
Begin
     pt_LPT:=memW[$40:6+number*2]; { From 1 to 4 !! NOT 0..3 !! }
End;

End.
{*** End of File ***}
