home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC Interdit
/
pc-interdit.iso
/
sound
/
gusmod
/
tcp.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-10-21
|
13KB
|
541 lines
{$A+,B-,D+,E+,F+,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,250000}
program gusdemo;
uses crt,dos,design,fselect,gus_mod;
type
Pphun = ^TPhun;
TPhun = array[0..799] of string[80];
const mod_chem = '';
const Programm_quitter : boolean = false;
var phun : Pphun;
phuncount : integer;
modify_voice : integer;
i : integer;
Les_files : Pfileselect_struct;
curr_modnr : integer;
{
Intégration des écrans ANSI
}
{$L c:\edition\prog\fr\asm\tcpans}
procedure tcpans; external;
{$L c:\edition\prog\fr\asm\we_are}
procedure we_are; external;
{$L c:\edition\prog\fr\asm\buy_it}
procedure buy_it; external;
{$L c:\edition\prog\fr\asm\call}
procedure call; external;
{$L c:\edition\prog\fr\asm\helptxt}
procedure helptxt; external;
function fichier_exists(dname : string) : boolean;
{
Vérifie si le fichier transmis existe
}
var dumf : file;
begin;
{$I-}
assign(dumf,dname);
reset(dumf,1);
{$I+}
if IOResult <> 0 then
fichier_exists := false
else begin;
fichier_exists := true;
close(dumf);
end;
end;
procedure color_writeln(s : string);
{
Pour sortir une chaîne dans la combinaison de couleurs TC
}
var colpos,li : integer;
begin;
colpos := 1;
for li := 1 to length(s) do begin;
if s[li] = ' ' then colpos := 0;
inc(colpos);
case colpos of
1..2 : begin;
textcolor(8);
end;
3..4 : begin;
textcolor(2);
end;
5..$ff : begin;
textcolor(10);
end;
end;
write(s[li]);
end;
end;
procedure write_nomfichier(s : string);
{
Affiche le nom de fichier de la chanson, centré
}
var li,slen : integer;
begin;
gotoxy(33,13);
while pos('\',s) <> 0 do begin;
delete(s,1,pos('\',s));
end;
slen := length(s);
slen := (15 - slen) div 2;
for li := 1 to slen do s := ' '+s;
write(s);
end;
procedure write_phunliners;
{
Lit trois lignes dans le fichier "Phun.txt" et les affiche
à l'écran. Le fichier "Phun.txt" est un fichier texte
que l'on peut éditer librement !
}
var tf : text;
begin;
randomize;
if not fichier_exists('phun.txt') then exit;
assign(tf,'phun.txt');
reset(tf);
phuncount := 0;
{$I+}
if ioresult = 0 then begin;
while not eof(tf) do begin;
readln(tf,phun^[phuncount]);
inc(phuncount);
end;
close(tf);
gotoxy(3,43);
color_writeln(phun^[random(phuncount)]);
gotoxy(3,44);
color_writeln(phun^[random(phuncount)]);
gotoxy(3,45);
color_writeln(phun^[random(phuncount)]);
end;
{$I-}
end;
procedure display_modinfos;
{
Affiche le nom des instruments dans le module actuel
}
var li : integer;
begin;
textcolor(14);
textbackground(black);
for li := 1 to 16 do begin;
gotoxy(6,17+li);
color_writeln(Instruments[li]^.nom);
gotoxy(50,17+li);
color_writeln(Instruments[li+16]^.nom);
end;
end;
procedure exit_program;
{
Avant de quitter le programme, vite une dernière indication sur le TC WHQ,
la "Farpoint Station" (04202 76145)...
}
begin;
display_ansi(@call,co80+font8x8);
cursor_off;
repeat until keypressed;
while keypressed do readkey;
cursor_on;
asm mov ax,03; int 10h; end;
halt;
end;
procedure prochain_mod;
{
Lance la sortie du MOD sélectionné suivant
}
begin;
_gus_mod_quitter;
inc(curr_modnr);
if curr_modnr > Les_Files^.nofiles then
curr_modnr := 1;
if not _gus_modload(Les_Files^.fn[curr_modnr]) then begin;
clrscr;
gotoxy(10,10);
write('Sorry dude, Cant''t handle this MOD-File');
delay(1200);
exit_program;
end;
display_ansi(@tcpans,co80+font8x8);
cursor_off;
write_phunliners;
write_nomfichier(Les_Files^.fn[curr_modnr]);
display_modinfos;
fillchar(Play_Chanel,14,1);
_gus_modstart;
end;
procedure display_we_are;
{
Sortir un ANSI avec Infos par le groupe THE COEXISTENCE
}
begin;
display_ansi(@we_are,co80+font8x8);
cursor_off;
repeat until keypressed;
while keypressed do readkey;
display_ansi(@tcpans,co80+font8x8);
cursor_off;
write_phunliners;
write_nomfichier(Les_Files^.fn[curr_modnr]);
display_modinfos;
end;
procedure display_buy_it;
{
Affiche une réclame pour le livre PC Underground
}
begin;
display_ansi(@buy_it,co80+font8x8);
cursor_off;
repeat until keypressed;
while keypressed do readkey;
display_ansi(@tcpans,co80+font8x8);
cursor_off;
write_phunliners;
write_nomfichier(Les_Files^.fn[curr_modnr]);
display_modinfos;
end;
procedure handle_keys(key1,key2 : char);
{
Réagit aux saisies de l'utilisateur
}
var pchan : byte;
begin;
case key1 of
#00 : begin;
case key2 of
#45 : begin;
Programm_quitter := true;
end;
#72 : begin;
if modify_voice > 1 then
dec(modify_voice);
end;
#80 : begin;
if modify_voice < Modinf.Voix then
inc(modify_voice);
end;
#75 : begin; { cursor left }
runinf.Ligne := 64;
dec(runinf.Pattnr,2);
if runinf.Pattnr < -1 then runinf.Pattnr := -1;
end;
#77 : begin; { cursor right }
runinf.Ligne := 64;
inc(runinf.Pattnr);
end;
end;
end;
#27 : begin;
Programm_quitter := true;
end;
#32,
'W',
'w',
'I',
'i' : begin;
display_we_are;
end;
'D',
'd',
'b',
'B' : begin;
display_buy_it;
end;
'L',
'l' : begin;
chpos[modify_voice] := 1;
_gus_set_chanelpos;
end;
'R',
'r' : begin;
chpos[modify_voice] := 15;
_gus_set_chanelpos;
end;
'M',
'm' : begin;
chpos[modify_voice] := 7;
_gus_set_chanelpos;
end;
'U',
'u' : begin;
if Modinf.Voix = 4 then
begin
chpos[1] := 2;
chpos[2] := 5;
chpos[3] := 9;
chpos[4] := 12;
end;
if Modinf.Voix = 8 then
begin
chpos[1] := 1;
chpos[2] := 3;
chpos[3] := 5;
chpos[4] := 7;
chpos[5] := 7;
chpos[6] := 9;
chpos[7] := 11;
chpos[8] := 13;
end;
_gus_set_chanelpos;
end;
',' : begin; { vers la gauche }
if chpos[modify_voice] > 1 then
dec(chpos[modify_voice]);
_gus_set_chanelpos;
end;
'.' : begin; { vers la droite !!! }
if chpos[modify_voice] < 15 then
inc(chpos[modify_voice]);
_gus_set_chanelpos;
end;
'1'..
'8' : begin;
pchan := ord(key1)-48;
if Play_Chanel[pchan] = 1 then begin;
Play_Chanel[pchan] := 0;
textcolor(10); gotoxy(77,2+pchan);
write('M'); textcolor(2);
write('UTE');
end else begin;
Play_Chanel[pchan] := 1;
textcolor(10); gotoxy(77,2+pchan);
write('C'); textcolor(2);
write('H ');
end;
end;
'n',
'N' : begin;
prochain_mod;
end;
end;
end;
procedure screen_update;
const colvals : array[1..35] of byte =
(08,08,08,08,08,02,02,02,02,10,10,10,10,10,10,10,10,
10,10,10,10,10,10,10,10,10,10,10,10,10,05,05,05,05,05);
var volstr : string[66];
li : integer;
auss : integer;
begin;
{ Remettre à jour les barres indiquant le volume }
for li := 1 to Modinf.Voix do begin;
for auss := 1 to round(Runinf.Volumes[li] / 1.78) do begin;
screen[li+2,37+auss].a := colvals[auss];
end;
for auss := round(Runinf.Volumes[li] / 1.78) to 36 do begin;
screen[li+2,38+auss].a := 7;
end;
end;
{ Définir l'arrière-plan en couleurs pour la flèche }
for li := 1 to 8 do begin;
if li = modify_voice then begin;
screen[2+li,34].a := 05;
screen[2+li,35].a := 05;
screen[2+li,36].a := 05;
screen[2+li,37].a := 05;
end else begin;
screen[2+li,34].a := 07;
screen[2+li,35].a := 07;
screen[2+li,36].a := 07;
screen[2+li,37].a := 07;
end;
end;
{ Afficher des informations en temps réel sur le MOD }
gotoxy(18,14);
color_writeln(Modinf.Titre);
textcolor(7);
gotoxy(18,16);
write(runinf.pattnr:3);
gotoxy(64,16);
write(runinf.ligne:3);
gotoxy(64,15);
write(64:3);
gotoxy(18,15);
write(modinf.Nb_Patt:3);
gotoxy(60,14);
write(runinf.speed,' / ',runinf.bpm);
end;
procedure user;
{
Vérifie les saisies aux claviers et remet à jour l'écran
}
var ch1,ch2 : char;
begin;
repeat
ch1 := #255;
ch2 := #255;
if keypressed then begin;
ch1 := readkey;
if keypressed then ch2 := readkey;
handle_keys(ch1,ch2);
end;
screen_update;
until Programm_quitter;
end;
procedure display_help;
{
Affiche l'aide Ansi, même quand aucune carte GUS n'a été trouvée
}
begin;
display_ansi(@helptxt,co80+font8x8);
cursor_off;
repeat until keypressed;
while keypressed do readkey;
exit_program;
end;
function check_commandline : boolean;
{
retourne true, lorsqu'un nom de module a été donné
}
var pst : string;
ist_mod : boolean;
li : integer;
retval : boolean;
begin;
retval := false;
for li := 1 to 9 do begin;
pst := paramstr(li);
ist_mod := true;
if (pos('-h',pst) <> 0) or (pos('-H',pst) <> 0) or
(pos('-?',pst) <> 0) then
begin;
ist_mod := false;
display_help;
end;
if (pst <> '') and ist_mod then begin;
if pos('.',pst) = 0 then pst := pst + '.mod';
if fichier_exists(pst) then { mode valide }
begin
inc(Les_Files^.nofiles);
Les_Files^.fn[Les_Files^.nofiles] := pst;
retval := true;
end;
end;
end;
check_commandline := retval;
end;
begin;
cursor_off;
clrscr;
if not _gus_init_env then display_help;
new(Les_Files);
new(phun);
Les_Files^.path := mod_chem;
Les_Files^.Mask := '*.mod';
Les_Files^.sx := 24;
Les_Files^.sy := 10;
Les_Files^.nofiles := 0;
Les_Files^.Titre := 'Choisir un fichier MOD!!!';
modify_voice := 1;
for i := 1 to 30 do
Les_Files^.fn[i] := '---';
save_screen;
if not check_commandline then begin;
select_packfichiers(Les_Files);
repeat
restore_screen;
if Les_Files^.fn[1] = '---' then exit_program;
_gus_initialiser;
display_ansi(@tcpans,co80+font8x8);
cursor_off;
write_phunliners;
curr_modnr := 1;
if not _gus_modload(Les_Files^.fn[1]) then begin;
clrscr;
gotoxy(10,10);
write('Sorry dude, Cant''t handle this MOD-File');
delay(1200);
exit_program;
end;
write_nomfichier(Les_Files^.fn[1]);
display_modinfos;
fillchar(Play_Chanel,14,1);
_gus_modstart;
user;
_gus_mod_quitter;
dispose(Les_Files);
new(Les_Files);
Les_Files^.path := Mod_chem;
Les_Files^.Mask := '*.mod';
Les_Files^.sx := 24;
Les_Files^.sy := 10;
Les_Files^.nofiles := 0;
for i := 1 to 30 do
Les_Files^.fn[i] := '---';
Programm_quitter := false;
select_packfichiers(Les_Files);
until Les_Files^.fn[1] = '---';
dispose(Les_Files);
dispose(phun);
exit_program;
end else begin;
restore_screen;
if Les_Files^.fn[1] = '---' then exit_program;
_gus_initialiser;
display_ansi(@tcpans,co80+font8x8);
cursor_off;
write_phunliners;
curr_modnr := 1;
_gus_modload(Les_Files^.fn[1]);
write_nomfichier(Les_Files^.fn[1]);
display_modinfos;
fillchar(Play_Chanel,14,1);
_gus_modstart;
user;
_gus_mod_quitter;
dispose(Les_Files);
dispose(phun);
exit_program;
end;
end.