{$apptype console}
Program PSG_Player;

uses windows,mmsystem,myutils;
type
byte_array = ^pload_arr;
pload_arr = array [0..MAXINT div 2] of byte;


var J:byte_array;

const

ch_a_volume = $43;
ch_b_volume = $44;
ch_c_volume = $45;
snare_volume    = $54;

ch_a_freq_lsb   = $A0;
ch_a_freq_msb   = $B0;
ch_b_freq_lsb   = $A1;
ch_b_freq_msb   = $B1;
ch_c_freq_lsb   = $A2;
ch_c_freq_msb   = $B2;
snare_freq_msb  = $B7;
snare_freq_lsb  = $A7;

var
xlat_mode : integer;
mixer_reg, psg_volume_a, psg_volume_b, psg_volume_c,
noise_enabled, noise_vol,adlib_a_vol,
adlib_b_vol,
adlib_c_vol:byte;
ch_a_flsb, ch_a_fmsb, ch_b_flsb, ch_b_fmsb, ch_c_flsb, ch_c_fmsb:byte;
noise_freq, ch_a_freq, ch_b_freq, ch_c_freq : smallint;

var PSG_REGNUM,psg_value:byte;


procedure Wrt_Adlib;assembler;
asm
                push    edx
                push    ecx
                push    eax
                mov dx, 388h
                out dx, al
                mov ecx, 6
@@1:            in  al, dx
                loop    @@1


                pop ax
                inc dx
                push    ax
                xchg    al, ah
                out dx, al
                dec dx
                mov     ecx, 35
@@0:            in  al, dx
                loop    @@0


                pop eax
                pop ecx
                pop edx
                {retf}
end;

procedure Write_Adlib (a, b:byte);
begin
asm

               push    edx
               push    ecx

                mov al, a
                mov edx, 388h
                out dx, al
//..END;
//SLEEP(10);
                mov ecx, 6
@@1:            in  al, dx
                loop    @@1
//ASM
                mov al, b
                mov edx, 389h
                out dx, al

               dec  dx
                mov     ecx, 35
@@0:            in  al, dx
                loop    @@0
//END;
//SLEEP(10);

               pop  ecx
               pop  edx

end;
end;

procedure Init_Adlib;{near;assembler;}
var i:byte;
begin
for  i:= 1 to 255 do Write_Adlib (i,0);
end;

procedure Synt_Init;
const
proper_init:array [0..71] of byte =(

        {   36, 0,      ; total regs to setup}

            $1, $20,    {; enable waveform distortion}


{; --- CHANNEL A SETUP ---}

            $20, $01,   {; Channel A operator 1 (Modulator)}
            $40, $18,   {; modulator volume}
            $60, $F0,
            $80, $14,   {; sustain level / release level (14h)}
            $e0, $02,   {; ch.A distortion, operator 1}
            $c0, $0A,   {; strong feedback / operator 2 make snd}
            $23, $01,   {; Channel A operator 2 (Carrier)}
            $63, $F0,
            $83, $13,
            $e3, $00,   {; Channel A distortion, operator 1}


{; --- CHANNEL B SETUP ---}

            $21, $01,   {; Channel B operator 1 (modulator)}
            $41, $18,
            $61, $F0,
            $81, $14,
            $e1, $02,   {; ch.b distortion, operator 1}
            $C1, $0A,
            $24, $01,   {; Channel B operator 2 (carrier)}
            $64, $F0,
            $84, $13,
            $e4, $00,   {; ch.b distortion, operator 2}


{; --- CHANNEL C SETUP ---}

            $22, $01,   {; Channel C, modulator (OP1)}
            $42, $18,
            $62, $F0,
            $82, $14,
            $e2, $02,   {; ch.C}
            $C2, $0A,
            $25, $01,   {; Channel C, carrier (OP2)}
            $65, $F0,
            $85, $13,
            $e5, $00,   {; 31, ch C}


{; --- NOISE CHANNEL SETUP. Channel 8 used for noise (vol reg=54h)}

            $34, $21,   {; ch.8 AM/VIB/EG, operator 2}
            $74, $99,   {; ch.8 attack/decay rate, operator 2}
            $94, $00,   {; ch.8 sustain/release level,operator 2}
            $F4, $00,   {; ch.8 waveform select, operator 2}
            $bd, $28);  {; SNARE drum ON, 6 melodic/4 percussion}


var a,b: byte;
i:integer;
begin

for i:= 0 to 35 do begin
a:= proper_init [i+i];
b:= proper_init [i+i+1];
Write_Adlib (A,b);
end;

end;

procedure psg_init;
begin
                noise_enabled := 0;
                noise_freq    := 0;
                mixer_reg     := $3f;
        adlib_a_vol   := $3f;
        adlib_b_vol   := $3f;
        adlib_c_vol   := $3f;
        noise_vol     := $3f;
        ch_a_freq     := $c8;
        ch_b_freq     := $c8;
        ch_c_freq     := $c8;
        ch_a_flsb     := $98;
        ch_a_fmsb     := $11;
        ch_b_flsb     := $98;
        ch_b_fmsb     := $11;
        ch_c_flsb     := $98;
        ch_c_fmsb     := $11;
end;


procedure marat_xlat2;near;assembler;
asm
        mov bx, ax
        or  bx, bx
        je  @@1

        cmp bx, 17
        jbe @@6

        cmp bx, 35
        jbe @@5

        mov ax, 0CACEh
        mov dx, 00023h
        div bx
        jmp @@3

@@6:        mov ax, 3ffh
        mov bl, 7
        jmp @@2

@@1:        mov ax, 1

@@3:        xor bl, bl
@@4:        cmp ax, 400h
        jbe @@2
        shr ax, 1
        inc bl
        jmp @@4

@@2:        and ah, 3o
        and bl, 7o
        shl bl, 1
        shl bl, 1
        or  ah, bl
        retn

@@5:        jmp @@2
end;

procedure do_all_writes;assembler;
var tmp:byte;
begin

        Write_Adlib(ch_a_freq_lsb, ch_a_flsb);
        Write_Adlib(ch_a_freq_msb, ch_a_fmsb);
                Write_Adlib(ch_b_freq_lsb, ch_b_flsb);
        Write_Adlib(ch_b_freq_msb, ch_b_fmsb);
                Write_Adlib(ch_c_freq_lsb, ch_c_flsb);
                Write_Adlib(ch_c_freq_msb, ch_c_fmsb);

                tmp := noise_vol;
                if tmp < $1f then tmp := $1f;
                if noise_enabled = 0 then tmp := $3f;

                Write_Adlib (snare_volume, tmp);
                noise_enabled := 0;
end;

procedure write_psg;//assembler;
label _flow_cha, _fhigh_cha, _flow_chb, _fhigh_chb, _flow_chc,
_fhigh_chc, _done, _mixer, _vol_ch_a, _vol_ch_b, _vol_ch_c;

begin

asm
                push eax
        push ebx
        push ecx
        push edx
                not cl
        mov byte ptr  [psg_value], cl
end;

//    psg_value := not psg_value;

case PSG_RegNum of
0:  goto _flow_cha;
1:  goto _fhigh_cha;
2:  goto _flow_chb;
3:  goto _fhigh_chb;
4:  goto _flow_chc;
5:  goto _fhigh_chc;
6:  goto _done;
7:  goto _mixer;
8:  goto _vol_ch_a;
9:  goto _vol_ch_b;
10: goto _vol_ch_c;
11: goto _done;
12: goto _done;
13: goto _done;
14: goto _done;
15: goto _done;

end;

_flow_cha:
asm
        mov byte ptr ch_a_freq, cl
                mov     ax, ch_a_freq
        call    marat_xlat2
                mov     ch_a_flsb, al
                mov     al, ch_a_fmsb
                and     al, 40o
                or      ah, al
                mov     ch_a_fmsb, ah
                mov     al, ch_a_freq_lsb
        mov ah, ch_a_flsb
        call    Wrt_Adlib
        mov al, ch_a_freq_msb
        mov ah, ch_a_fmsb
        call    Wrt_Adlib
        end; goto _done;

_fhigh_cha:
asm
        and cl, 0Fh
        mov byte ptr [ch_a_freq+1], cl
                mov     ax, word ptr [ch_a_freq]
        call    marat_xlat2
                mov     byte ptr  [ch_a_flsb], al
                mov     al, byte ptr [ch_a_fmsb]
                and     al, 40o
                or      ah, al
                mov     byte ptr [ch_a_fmsb], ah
                mov     al, ch_a_freq_lsb
        mov ah, byte ptr  [ch_a_flsb]
        call    Wrt_Adlib
        mov al, ch_a_freq_msb
        mov ah, byte ptr [ch_a_fmsb]
        call    Wrt_Adlib
        end; goto _done;
_flow_chb:
asm
        mov     byte ptr  [ch_b_freq], cl
                mov     ax, word ptr [ch_b_freq]
        call    marat_xlat2
                mov     byte ptr  [ch_b_flsb], al
                mov     al, byte ptr [ch_b_fmsb]
                and     al, 40o
                or      ah, al
                mov     byte ptr  [ch_b_fmsb], ah
                mov     al, ch_b_freq_lsb
                mov     ah, byte ptr [ch_b_flsb]
        call    Wrt_Adlib
                mov     al, ch_b_freq_msb
                mov     ah, byte ptr [ch_b_fmsb]
        call    Wrt_Adlib
        end; goto _done;

_fhigh_chb:
asm
        and cl, 0Fh
                mov     byte ptr  [ch_b_freq+1], cl
                mov     ax, word ptr [ch_b_freq]
        call    marat_xlat2
                mov     byte ptr  [ch_b_flsb], al
                mov     al, byte ptr  [ch_b_fmsb]
                and     al, 40o
                or      ah, al
                mov     byte ptr [ch_b_fmsb], ah
                mov     al, ch_b_freq_lsb
                mov     ah, byte ptr [ch_b_flsb]
        call    Wrt_Adlib
                mov     al, ch_b_freq_msb
                mov     ah, byte ptr [ch_b_fmsb]
        call    Wrt_Adlib
        end; goto _done;
_flow_chc:
asm
        mov     byte ptr  [ch_c_freq], cl
                mov     ax, word ptr  [ch_c_freq]
        call    marat_xlat2
                mov     byte ptr  [ch_c_flsb], al
                mov     al, byte ptr  [ch_c_fmsb]
                and     al, 40o
                or      ah, al
                mov     byte ptr  [ch_c_fmsb], ah
                mov     al, ch_c_freq_lsb
                mov     ah, byte ptr  [ch_c_flsb]
        call    Wrt_Adlib
                mov     al, ch_c_freq_msb
                mov     ah, byte ptr  [ch_c_fmsb]
        call    Wrt_Adlib
        end; goto _done;
_fhigh_chc:
asm
        and cl, 0Fh
                mov     byte ptr  [ch_c_freq+1], cl
                mov     ax, word ptr  [ch_c_freq]
        call    marat_xlat2
                mov     byte ptr  [ch_c_flsb], al
                mov     al, byte ptr  [ch_c_fmsb]
                and     al, 40o
                or      ah, al
                mov     byte ptr  [ch_c_fmsb], ah
                mov     al, ch_c_freq_lsb
                mov     ah, byte ptr  [ch_c_flsb]
        call    Wrt_Adlib
                mov     al, ch_c_freq_msb
                mov     ah, byte ptr  [ch_c_fmsb]
        call    Wrt_Adlib
        end; goto _done;

_vol_ch_a:
asm
        mov al, ch_a_volume
        mov ah, cl

        and ah, 1Fh
        cmp ah, 16
        jne @@no_env_a
        mov ah, 0Bh

@@no_env_a: mov byte ptr  [psg_volume_a], ah
        not ah
        shl ah, 1
        shl ah, 1
        and ah, 00111100b
        mov byte ptr  [adlib_a_vol], ah
        call    Wrt_Adlib

        test    byte ptr  [mixer_reg], 8
        jne @@no_noise_A

        mov ah, byte ptr  [adlib_a_vol]
        mov byte ptr  [noise_vol], ah

        cmp byte ptr  [noise_enabled], 0
        je  @@no_noise_A

        mov al, snare_volume
        call    wrt_adlib

@@no_noise_A:
        end; goto _done;
_vol_ch_b:
asm
        mov al, ch_b_volume
        mov ah, cl
        and ah, 1Fh
        cmp ah, 16
        jne @@no_env_b
        mov ah, 0Bh

@@no_env_b: mov byte ptr  [psg_volume_b], ah
        not ah
        shl ah, 1
        shl ah, 1
        and ah, 00111100b
        mov byte ptr  [adlib_b_vol], ah
        call    Wrt_Adlib

        test    byte ptr  [mixer_reg], 16
        jne @@no_noise_B

        mov ah, byte ptr  [adlib_b_vol]
        mov byte ptr  [noise_vol], ah

        cmp byte ptr  [noise_enabled], 0
        je  @@no_noise_B

        mov al, snare_volume
        call    wrt_adlib

@@no_noise_B:   end; goto _done;

_vol_ch_c:
asm
        mov al, ch_c_volume
        mov ah, cl
        and ah, 1Fh
        cmp ah, 16
        jne @@no_env_c
        mov ah, 0Bh

@@no_env_c: mov byte ptr  [psg_volume_c], ah
        not ah
        shl ah, 1
        shl ah, 1
        and ah, 00111100b
        mov byte ptr  [adlib_c_vol], ah
        call    Wrt_Adlib

        test    byte ptr  [mixer_reg], 32
        jne @@no_noise_C

        mov ah, byte ptr  [adlib_c_vol]
        mov byte ptr  [noise_vol], ah

        cmp byte ptr  [noise_enabled], 0
        je  @@no_noise_C

        mov al, snare_volume
        call    wrt_adlib

@@no_noise_C:   end; goto _done;


_mixer:
asm
        mov al, cl
        mov byte ptr  [mixer_reg], al
        not al

        shr al, 1
        shr al, 1
        shr al, 1
        and al, 7o
        or  al, al
        je  @@no_noise

        test    al, 4
        jne @@noise_c
        test    al, 2
        jne @@noise_b

@@noise_a:  mov al, byte ptr  [adlib_a_vol]
        jmp @@noise_done

@@noise_c:  mov al, byte ptr  [adlib_c_vol]
        jmp @@noise_done

@@noise_b:  mov al, byte ptr  [adlib_b_vol]

@@noise_done:   mov byte ptr  [noise_vol], al
        mov al, 1
        jmp @@noise

@@no_noise: xor al, al
@@noise:    mov byte ptr  [noise_enabled], al

        test    cl, 1
        je  @@ch_a_on
@@ch_a_off:     and     byte ptr  [ch_a_fmsb], 11011111b
                jmp     @@ch_b_next
@@ch_a_on:      or      byte ptr  [ch_a_fmsb], 00100000b

@@ch_b_next:    test    cl, 2
                je      @@ch_b_on
@@ch_b_off:     and     byte ptr  [ch_b_fmsb], 11011111b
                jmp     @@ch_c_next
@@ch_b_on:      or      byte ptr  [ch_b_fmsb], 00100000b

@@ch_c_next:    test    cl, 4
                je      @@ch_c_on
@@ch_c_off:     and     byte ptr  [ch_c_fmsb], 11011111b
                jmp     @@ch_write
@@ch_c_on:      or      byte ptr  [ch_c_fmsb], 00100000b

@@ch_write:     call    do_all_writes
        end; //goto _done;

_done:
asm
                pop edx
        pop ecx
        pop ebx
        pop eax
end; exit;


end;

var a:integer = 0;

procedure TimeCallBack(uTimerID, uMessage, dwUser, dw1, dw2:longint);stdcall;
var b1,b2:byte;
begin
//write_hex (J[a+54]);
b1 := J [a+54];
inc (a);
b2 := J [a+54];
inc (a);


if (b1 = $ff) and (b2 = $ff) then begin
a := 0; exit;end;


asm


MOV     AH, b1// [ESI]
                //inc esi
MOV     AL, b2// [ESI]
        //inc esi

                MOV     PSG_REGNUM, AH
//inc psg_regnum;
                MOV     CL, AL
CALL    WRITE_PSG

//                inc si
//      inc si

end;
//a := a + 4;
inc (a);
inc (a);
//kick;
end;


type str = array [0..256] of char;
var P:pchar;
sstring : ^str;



{ ============================ MAIN MODULE ================================= }
label loop;

var f:char;key,i:integer;
FTimerHandle:dword;

//var hDevice:thandle;
//prtdata : pointer;

begin

asm
     mov dx, $E22
     mov ax,$1F
   out dx,al
end;


J := GetFile ('blade1.psg');

synt_init;

PSG_INIT;

FTimerHandle := timeSetEvent(2,0,@TimeCallBack,0,1);

loop:  Key := NeedKeyboard;

if Key <> 27 then goto loop;

timeKillevent(FTimerHandle);

Init_Adlib;

end.