Foro de programacion

micropais · #1 (**permalink**) 30 de agosto,2005, 10:50

8) 8) 8)

Código:

{
Micropais 2005 -  Algoritmo de Bresenham para Pascal.

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.