(*********************************************************************
* *
* 2M-INTRO 1.0 - Pequeño programa de información sobre 2M. *
* *
*********************************************************************)
(*$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-*)
uses
Dos, Crt;
const
ID_ESPACIO = 1886; (* límite en las gráficas *)
ID_VELOCIDAD = 4850;
CM_CIRIT = 14; (* colores para la pantalla inicial/final *)
CM_CIRIP = 4;
CM_ESTRELLAS = 15;
CM_2M = 10;
CM_2MS = 10;
CM_VERT = 13;
CM_VERF = 6;
CM_VERS = 5;
CM_INFO = 9;
CM_PAUSA = 11;
CE_BARRADOST = 11; (* colores para la grafica de capacidad *)
CE_BARRADOSP = 1;
CE_BARRA2MT = 14;
CE_BARRA2MP = 4;
CE_INDICE = 13;
CE_TITULOT = 11;
CE_TITULOP = 1;
CE_NOTA = 14;
CE_BASECOL = 15;
CE_LEYENDAS = 10;
CV_BARRADOST = 3; (* colores para la grafica de velocidad *)
CV_BARRADOSP = 1;
CV_BARRA2MT = 12;
CV_BARRA2MP = 6;
CV_INDICE = 13;
CV_TITULOT = 11;
CV_TITULOP = 5;
CV_NOTA = 14;
CV_BASECOL = 15;
CV_LEYENDAS = 10;
type
Vram=array [1..4096] of Byte; (* tamaño de la memoria de vídeo *)
Matriz=array [0..3] of array [0..2] of Integer;
var
xPrev,yPrev, (* coordenadas del cursor previas al programa *)
modo:Byte; (* modo de pantalla previo a este programa *)
ScrColor:Vram absolute $b800:0; (* dirección memoria pantalla color *)
ScrMono: Vram absolute $b000:0; (* " " " monocroma *)
pantalla:Vram; (* para preservar memoria de vídeo *)
function ModoPantalla:Byte;
var
r:Registers;
begin
r.ah:=15; intr(16,r); (* función BIOS para averiguar modo de pantalla *)
ModoPantalla:=r.al;
end;
procedure GuardarPantalla;
begin
modo:=ModoPantalla; (* inicializar aquí esta variable global *)
if modo=7 then pantalla:=ScrMono else pantalla:=ScrColor;
xPrev:=whereX; yPrev:=whereY;
if (modo<>2) and (modo<>3) then TextMode(CO80);
end;
procedure ReponerPantalla;
begin
textMode(modo);
window(1,1,80,25); gotoXY(xPrev,yPrev);
if (modo<=3) or (modo=7) then
if ModoPantalla=7 then ScrMono:=pantalla else ScrColor:=pantalla;
end;
procedure CursorOff;
begin
gotoxy(79,25); TextColor(0); write(' '); gotoxy (79,25);
end;
procedure Pausa;
var
t:Char;
begin
CursorOff;
t:=readkey; if t=chr(0) then t:=readkey;
end;
procedure PantallaGalactica;
var
x: Integer;
procedure escribir (cad: String);
var
i:Integer;
begin
gotoxy (8, WhereY);
for i:=1 to length(cad) do
case cad[i] of
' ': write (' ');
'.', '·': begin TextColor(CM_ESTRELLAS); write (cad[i]); end;
'▒': if i<35 then
begin TextColor(CM_2M); write ('▒'); end
else
begin TextColor(CM_VERT); TextBackGround(CM_VERF);
write ('▒'); TextBackGround(0); end;
'█', '▄', '▀': if i<35 then
begin TextColor(CM_2MS); write (cad[i]); end
else
begin TextColor(CM_VERS); write (cad[i]); end;
end;
writeLn;
end; (* escribir *)
begin
TextBackGround(0); TextColor(CM_ESTRELLAS); clrScr;
Randomize;
for x:=1 to 79 do begin
gotoXY (x,random(25)); write('.');
gotoXY (x,random(25)); write('·');
gotoXY (x,random(25)); write('.');
gotoXY (x,random(25)); write('·');
end;
gotoxy (1,6);
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▄ ▒▒▒▒▄ ▒▒▒▒▄');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ ▒▒▒▒▒▄ ▒▒▒▒▒█');
escribir(' ▀▀▀▀▀▀▀▀▀▀▒▒▒▒█. ▒▒▒▒▒▒▄ ▒▒▒▒▒▒█');
escribir(' · . ▒▒▒▒█ ▒▒▒▒▒▒▒▄▒▒▒▒▒▒▒█');
escribir(' · . ▒▒▒▒█ ▒▒▒▒█▒▒▒▒▒█▒▒▒▒█');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ ·▒▒▒▒█ ▒▒▒█▀▒▒▒▒█ . ▒▒▒▒▒▒▒▒▒▒▄ . ·▒▒▒▒▒▒▒▒▒▒▄ ');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ ▒▒▒▒█ ▒█▀ ▒▒▒▒█ ▀▀▀▀▀▀▀▒▒█ ▒▒█▀▀▀▀▀▒▒█');
escribir('▒▒▒▒█▀▀▀▀▀▀▀▀▀▀▀ ▒▒▒▒█ . ▀ ▒▒▒▒█ . · ▒▒█ · ▒▒█ · ▒▒█');
escribir('▒▒▒▒█ · . · ▒▒▒▒█ · . ▒▒▒▒█ ▒▒▒▒▒▒▒▒▒▒█ . ▒▒█ ▒▒▄ ▒▒█');
escribir('▒▒▒▒█ . · ▒▒▒▒█ · ▒▒▒▒█ · ▒▒█▀▀▀▀▀▀▀▀ . ▒▒█ ▀▀ ▒▒█');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▄ ▒▒▒▒█ .· ▒▒▒▒█ ▒▒█ · . · ▒▒█ . ▒▒█');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ .▒▒▒▒█ · ▒▒▒▒█ . ▒▒▒▒▒▒▒▒▒▒▄ ▒▒▄ ▒▒▒▒▒▒▒▒▒▒█');
escribir(' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ ▀▀▀▀ · . ▀▀▀▀ · ▀▀▀▀▀▀▀▀▀▀ ▀▀ ▀▀▀▀▀▀▀▀▀▀');
CursorOff;
end;
procedure Presentacion;
begin
gotoxy(10,3); TextColor (CM_CIRIT); TextBackGround (CM_CIRIP);
write(' C I R I A C O G A R C I A D E C E L I S presents ');
gotoxy(6,21); TextColor (CM_INFO); TextBackGround(0);
write('The highest capacity formatter of faster diskettes ... over the world');
gotoxy(34,24); TextColor (CM_PAUSA);
write('(Press any key)');
CursorOff;
end;
procedure Grafica (id, ctI, cpI, ctD, cpD, cI, cB: Integer; datos:Matriz);
var
disco, columna, altura, x, maxx: Integer;
begin
TextBackGround (0); clrscr;
for disco:=0 to 3 do
for columna:=0 to 1 do begin
if columna=0 then begin
TextColor (ctI); textBackGround (cpI); end
else begin
TextColor (ctD); textBackGround (cpD); end;
for altura:=0 to round(datos[disco,columna]/(id/20.0)) do begin
maxx:=7+disco*18+columna*6;
for x:=maxx to maxx+4 do begin
gotoxy (x, 22-altura);
if columna=0 then write('░') else write('▒');
end;
end;
TextBackGround(0); TextColor (cI);
if (columna=0) or (id=ID_VELOCIDAD) then begin
gotoxy (maxx, 21-altura);
if (id=ID_ESPACIO) then
write(datos[disco, columna]:5)
else
write(datos[disco, columna]/100:2:2);
end
else begin
gotoxy (maxx-2, 21-altura);
write(datos[disco, columna+1]:4,'/',datos[disco, columna]); end
end;
TextColor (ctI); textBackGround (cpI);
gotoxy(7,25); write('░░');
TextColor (ctD); textBackGround (cpD);
gotoxy(26,25); write('▒▒');
TextBackGround(0); gotoxy (10,23); TextColor (cB);
write('5¼-DD 5¼-HD 3½-DD 3½-HD');
end;
procedure GraficaEspacio;
var
datos : Matriz;
begin
datos[0,0]:= 360; datos[0,1]:= 902; datos[0,2]:= 820;
datos[1,0]:=1200; datos[1,1]:=1558; datos[1,2]:=1476;
datos[2,0]:= 720; datos[2,1]:=1066; datos[2,2]:= 984;
datos[3,0]:=1440; datos[3,1]:=1886; datos[3,2]:=1804;
Grafica (ID_ESPACIO, CE_BARRADOST, CE_BARRADOSP, CE_BARRA2MT,
CE_BARRA2MP, CE_INDICE, CE_BASECOL, datos);
TextBackGround(CE_TITULOP); TextColor(CE_TITULOT);
gotoxy (3,1); write('┌──────────┐');
gotoxy (3,2); write('│ DISK │');
gotoxy (3,3); write('│ CAPACITY │');
gotoxy (3,4); write('└──────────┘');
TextBackGround(0); TextColor (CE_NOTA);
gotoxy (4,6); write('In Kbytes');
TextColor(CE_LEYENDAS);
gotoxy (10,25); write('DOS standard');
gotoxy (29,25); write('2M Normal/Maximum');
gotoxy (57,25); write('(Press any Key)');
end;
procedure GraficaVelocidad;
var
datos:Matriz;
begin
datos[0,0]:=1816; datos[0,1]:=2502;
datos[1,0]:=3013; datos[1,1]:=4633;
datos[2,0]:=1505; datos[2,1]:=2574;
datos[3,0]:=3014; datos[3,1]:=4850;
Grafica (ID_VELOCIDAD, CV_BARRADOST, CV_BARRADOSP, CV_BARRA2MT,
CV_BARRA2MP, CV_INDICE, CV_BASECOL, datos);
TextBackGround(CV_TITULOP); TextColor(CV_TITULOT);
gotoxy (4,1); write('┌─────────────┐');
gotoxy (4,2); write('│ BIOS LEVEL │');
gotoxy (4,3); write('│ PERFORMANCE │');
gotoxy (4,4); write('└─────────────┘');
TextBackGround(0); TextColor (CV_NOTA);
gotoxy (3,6); write('Data transfer rate');
gotoxy (3,7); write(' in Kbytes/second');
TextColor(CV_LEYENDAS);
gotoxy (10,25); write('DOS standard');
gotoxy (29,25); write('2M Normal Diskette');
gotoxy (57,25); write('(Press any Key)');
end;
procedure SonidoEstelar;
var
i,j,z:Integer;
procedure eco_sube;
begin
i:=25;
repeat
sound(i+1000); delay(1); sound (i); delay(1); i:=i+5;
until (i>5000) or KeyPressed;
nosound;
end;
procedure eco_baja;
begin
i:=2500;
repeat
sound(i+1000); delay(1); sound (i); delay(1); i:=i-2;
until (i<500) or KeyPressed;
end;
procedure eco_desploma;
begin
repeat
sound(i+1000); delay(1); sound (i); delay(1); i:=i-1;
until (i<25) or KeyPressed;
nosound;
end;
begin (* SonidoEstelar *)
eco_sube; eco_baja; eco_desploma;
i:=25;
repeat
sound(i); delay(1); sound (i+2000); delay(1); i:=i+2;
until (i>2000) or KeyPressed;
nosound;
i:=500;
for z:=1 to 2 do begin
repeat
sound(i); delay(1); sound (i+3000); delay(1);
sound (i+1500); delay(1); i:=i+1;
until (i>2000) or KeyPressed;
nosound;
end;
eco_baja; eco_desploma; eco_sube; eco_baja; eco_desploma;
i:=700; eco_desploma; i:=1000; eco_desploma; i:=2000; eco_desploma;
end;
begin
GuardarPantalla;
PantallaGalactica;
Presentacion;
while not KeyPressed do SonidoEstelar;
Pausa;
GraficaEspacio;
Pausa;
GraficaVelocidad;
Pausa;
PantallaGalactica;
SonidoEstelar;
if KeyPressed then Pausa;
ReponerPantalla;
end.
