Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {$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, 220h
- 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
- outb(a, $220);
- outb(b, $221);
- end;
- procedure Init_Adlib;{near;assembler;}
- var i:byte;
- begin
- for i:= 1 to 255 do
- begin
- Write_Adlib(i, 0);
- end;
- 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
- printint ('%d',random(255));
- 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
- hDevice := CreateFile('\\.\\giveio', $80000000, 0, nil, 3, $80, 0);
- CloseHandle (Hdevice);
- outb($3F, $622);
- J := GetFile ('blade1.psg');
- //Init_Adlib;
- //synt_init;
- //PSG_INIT;
- FTimerHandle := timeSetEvent(20,0,@TimeCallBack,0,1);
- loop: Key := NeedKeyboard;
- if Key <> 27 then goto loop;
- timeKillevent(FTimerHandle);
- ExitProcess(0);
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement