Pascal/Turbo Pascal - Algoritmo de Bresenham para Pascal.

{
Micropais 2005 - Algoritmo de Bresenham para Pascal.

Por falta de espacio ( en algunos foros ) he ahorrado muchos comentarios
he usado el BIOS para los graficos (bastante lento) no obstante se pueden
implementar rutinas muchisimo mas rapidas para la pantalla.
es posible que no funcione algun modo grafico BIOS de echo hay unos cuantos
modos para el mismo tipo de pantalla , he usado los estandard.

Tener el algoritmo de una RECTA a mano presenta algunas ventajas como poder
poner los puntos de una recta en una matriz y recorrer luego su trayectoria.
Rellenar solo los puntos que programemos etc.
ahi van algunos ejemplos.
}

uses crt;

var a,b:integer;
color_letra:byte;
type punto=record
xx:integer;
yy:integer;
end;
var
matriz:array[0..300] of punto;
total_puntos:integer;

{
produce un retardo controlado por tiempo (igual para todos los ordenadores)
hire word alto del valor total en microsegundos
lore word bajo del valor total en microsegundos
}
procedure micro_retardo_bios(hire,lore:word);assembler;
asm
mov ah,86h
mov cx,hire
mov dx,lore
int 15h
end;

procedure BIOS_pon_punto(ejex,ejey:integer;color:byte);assembler;
asm
mov ah,0Ch { subfuncion }
mov al,color { valor del pixel grafico }
mov bh,00 { pagina }
mov cx,ejex { columna }
mov dx,ejey { fila }
int 10h
end;

function BIOS_lee_punto(ejex,ejey:integer):byte;assembler;
asm
mov ah,0Dh { subfuncion }
mov bh,00 { pagina }
mov cx,ejex { columna }
mov dx,ejey { fila }
int 10h
end;

procedure BIOS_GRAFICOS_16_640_POR_200;assembler;
asm
mov ah,00
mov al,0Eh
int 10h
end;
procedure BIOS_GRAFICOS_16_640_POR_350;assembler;
asm
mov ah,00
mov al,10h
int 10h
end;
procedure BIOS_GRAFICOS_16_640_POR_480;assembler;
asm
mov ah,00
mov al,12h
int 10h
end;
procedure BIOS_GRAFICOS_16_800_POR_600;assembler;
asm
mov ah,00
mov al,5Bh
int 10h
end;
procedure BIOS_GRAFICOS_16_1024_POR_768;assembler;
asm
mov ah,00
mov al,5Fh
int 10h
end;
procedure BIOS_GRAFICOS_16_768_POR_1024;assembler;
asm
mov ah,00
mov al,61h
int 10h
end;
procedure BIOS_GRAFICOS_320_POR_200_color;assembler;
asm
mov ah,00
mov al,13h
int 10h
end;
procedure BIOS_GRAFICOS_640_POR_400_COLOR;assembler;
asm
mov ah,00
mov al,5ch
int 10h
end;
procedure BIOS_GRAFICOS_640_POR_480_COLOR;assembler;
asm
mov ax,5dh
int 10h
end;
procedure BIOS_GRAFICOS_800_POR_600_COLOR;assembler;
asm
mov ah,00
mov al,5eh
int 10h
end;
procedure GRAFICOS_1024_POR_768_COLOR;assembler;
asm
mov ah,00
mov al,62h
int 10h
end;
{////////////////////////////////////////////////////////////////////////////}
procedure recta(x1,y1,x2,y2:integer;color:byte);
var
TH,TV, { Tramo Horizontal ,Tramo Vertical }
THR,TVR, { Tramo Horizontal Recto ,Tramo Vertival Recto }
THD,TVD, { Tramo Horizontal Diagonal,Tramo Vertical Diagonal }
x,y, { coordenada X , Coordenada Y }
IH,IV, { Incremento Horizontal ,Incremento Vertical }
E,Er,Ed, { Evaluacion Recto Diagonal }
CNT { contador }
:integer;
{... subprocedimiento .................}
procedure intercambiar(var j,k:integer);
var t:integer;
begin
t:=j;
j:=k;
k:=t;
end;
begin
{ recta (procedimiento principal) }
{ calculo de los incrementos caso tramo diagonal THD TVD }
TH:=1;
TV:=1;
IV:=Y2-Y1;

if IV< 0 then
begin
TV:=-TV;
IV:=-IV;
end;

TVD:=TV;
IH:=X2-X1;

if IH< 0 then
begin
TH:=-TH;
IH:=-IH;
end;

THD:=TH;
{ calculo de los incrementos caso tramo recto THR TVR }
if IH>=IV then
begin
TV:=0;
end else
begin
TH:=0;
intercambiar (IH,IV);
end;

TVR:=TV;
THR:=TH;

{ Valores iniciales }
x:=X1; y:=Y1;
Er:=IV shl 1;
Ed:=Er-IH shl 1;
E :=Er-IH;

{ dibujo de la recta }
CNT:=0;
while cnt<=IH do begin
{ * AQUI tu rutina grafica }
BIOS_pon_punto(x,y,color);
{ * }
if E>=0 then begin
x:=x+THD;
y:=y+TVD;
E:=E+Ed;
end
else
begin
x:=x+THR;
y:=y+TVR;
E:=E+Er;
end;
cnt:=cnt+1;
end;

end;
{****************************************************************************}
procedure Xrecta(x1,y1,x2,y2:integer;color:byte);
var
TH,TV,
THR,TVR,
THD,TVD,
x,y,
IH,IV,
E,Er,Ed,
CNT:integer;

procedure intercambiar(var j,k:integer);
var t:integer;
begin
t:=j;
j:=k;
k:=t;
end;
{///////}
begin
TH:=1;
TV:=1;
IV:=Y2-Y1;

if IV< 0 then
begin
TV:=-TV;
IV:=-IV;
end;

TVD:=TV;
IH:=X2-X1;

if IH< 0 then
begin
TH:=-TH;
IH:=-IH;
end;

THD:=TH;
if IH>=IV then
begin
TV:=0;
end else
begin
TH:=0;
intercambiar (IH,IV);
end;

TVR:=TV;
THR:=TH;

x:=X1; y:=Y1;
Er:=IV shl 1;
Ed:=Er-IH shl 1;
E :=Er-IH;

CNT:=0;
while cnt<=IH do begin
if ( BIOS_lee_punto(x,y)<>color_letra) then BIOS_pon_punto(x,y,color);
matriz[cnt].xx:=x;
matriz[cnt].yy:=y;
if E>=0 then begin
x:=x+THD;
y:=y+TVD;
E:=E+Ed;
end
else
begin
x:=x+THR;
y:=y+TVR;
E:=E+Er;
end;
cnt:=cnt+1;
end;
total_puntos:=cnt;
end;

{////////////////////}
procedure test_recta;
var
cnt:integer;
ix,fx,iy,fy:integer;
{****** sub procedimiento intercambiar ******}
procedure intercambiar(var j,k:integer);
var t:integer;
begin
t:=j;
j:=k;
k:=t;
end;
begin

writeln('presiona Intro para continuar');
randomize;
repeat
cnt:=cnt+1;
ix:=random(320);
iy:=random(100);
fx:=(random(320));
fy:=(random(100));

if ix>fx then intercambiar(ix,fx);
if iy>fy then intercambiar(iy,fy);

recta(ix+160,iy+100,fx+160,fy+100, cnt and 255 );{}

until keypressed;

readln;

end;
{////////////////////}
procedure test_mascara;
begin
BIOS_GRAFICOS_320_POR_200_color;
writeln('Gaficos 320x200 256 colores');
textcolor(2);
color_letra:=14;
textcolor(color_letra);
gotoxy(10,15);write('TEXTO impreso antes de ');
gotoxy(10,16);write('aplicar XRECTA ');
gotoxy(10,17);write('Pulsa INTRO ');
readln;

a:=100;
while a<180 do begin
Xrecta(25,a,250,a, a );
a:=a+1;
end;
gotoxy(10,19);
write('texto NORMAL ');

end;
{////////////////////}
procedure test_trayectoria;
begin
for a:=0 to total_puntos-1 do begin
for b:=1 to 5 do begin
BIOS_pon_punto( (matriz[a].xx)+b,(matriz[a].yy)-2,15);
end;
micro_retardo_bios(0,10000);
for b:=1 to 5 do begin
BIOS_pon_punto( (matriz[a].xx)+b,(matriz[a].yy)-2,0);
end;
end;
end;

{////////////////////////////////////////////////////////////////////////////}
begin
clrscr;

directvideo:=false; { para mostrar TEXTO en pantallas No-TURBO Pascal }

BIOS_GRAFICOS_16_640_POR_200;
writeln('Gaficos 640x200 16 colores');
test_recta;

BIOS_GRAFICOS_16_800_POR_600;
writeln('Gaficos 800x600 16 colores');
test_recta;

BIOS_GRAFICOS_640_POR_400_COLOR;
writeln('Gaficos 640x400 256 colores');
test_recta;

BIOS_GRAFICOS_640_POR_480_COLOR;
writeln('Gaficos 640x480 256 colores');
test_recta;

test_mascara;{}
readln;

BIOS_GRAFICOS_320_POR_200_color;
{ dibujamos unas lineas }
recta(15,15,15,50,1);
recta(15,50,30,50,2);
recta(30,50,75,75,3);
recta(75,75,100,100,4);
recta(100,100,150,150,5);
recta(150,150,150,15,6);
recta(150,15,50,50,8);
recta(50,50,15,15,9);

gotoxy(1,24);
write('DEMO Trayectoria ');
gotoxy(1,25);
write('- Pulsa INTRO - para terminar. ');
repeat
{ seguimos los puntos de la linea }
Xrecta(15,15,15,50,1); test_trayectoria;
Xrecta(15,50,30,50,2); test_trayectoria;
Xrecta(30,50,75,75,3); test_trayectoria;
Xrecta(75,75,100,100,4); test_trayectoria;
Xrecta(100,100,150,150,5); test_trayectoria;
Xrecta(150,150,150,15,6); test_trayectoria;
Xrecta(150,15,50,50,8); test_trayectoria;
Xrecta(50,50,15,15,9); test_trayectoria;
until keypressed;

readln;
end.