Pascal: Línea por algoritmo de Bresenham

Dibujar una línea mediante el algoritmo de Bresenham, accediendo a memoria de pantalla (DOS), en Pascal

Lenguaje: Pascal (compilador: Turbo Pascal 7)

Categoría: Gráficos

(* Fuente procedente de ErrorDeSintaxis.es *)

(* Dibujar una línea mediante el algoritmo *)

(*  de Bresenham, accediendo a memoria de pantalla *)

(*  (DOS), en Pascal *)

(* Lenguaje: Pascal *)

(* Compilador: Turbo Pascal 7 *)

(* Nivel: Básico *)

(* Disponible desde 17/07/2011 *)

(* Aportado por Nacho *)

(* Autor original: Nacho Cabanes *)

(* Web original: http://www.freepascal.es/tutorials/cupasamp02c.php *)

program GrB3;
 
 uses dos, crt;                 { Usaremos interrupciones,
                                  keypressed y delay }
 
 const NumPuntos = 10000;       { Número de puntos que dibujaremos }
 
 var
   regs: registers;            { Para acceder a los registros, claro }
   bucle: real;                { Para bucles, claro }
   tecla: char;                { La tecla que se pulse }
 
 procedure ModoPantalla( modo: byte );
                               { Cambia a un modo dado }
 begin
   regs.ah := 0;               { Función 0 }
   regs.al := modo;            { El modo indicado }
   intr($10,regs);             { Interrupción de video }
 end;
 
 procedure PonPixel(x,y: word; color: byte);      { Dibuja Pixel }
 begin
   Mem[$A000 : y * 320 + x] := color;
 end;
 
 procedure Linea(x, y, x2, y2 : word; color: byte);
 var
   d,
   dx, dy,             { Salto total según x e y }
   ai, bi,
   xi, yi              { Incrementos: +1 ó -1, según se recorra }
           : integer;
 begin
   if (x < x2) then    { Si las componentes X están ordenadas }
   begin
     xi := 1;          { Incremento +1 }
     dx := x2 - x;     { Espacio total en x }
   end
   else                { Si no están ordenadas }
   begin
     xi := - 1;        { Increm. -1 (hacia atrás) }
     dx := x - x2;     { y salto al revés (negativo) }
   end;
   if (y < y2) then    { Análogo para las componentes Y }
   begin
     yi := 1;
     dy := y2 - y;
   end
   else
   begin
     yi := - 1;
     dy := y - y2;
   end;
   PonPixel(x, y,color);   { Dibujamos el primer punto }
   if dx > dy then     { Si hay más salto según x que según y }
   begin               { (recta más cerca de la horizontal) }
     ai := (dy - dx) * 2;   { Variables auxiliares del algoritmo }
     bi := dy * 2;          { ai y bi no varían; d comprueba cuando }
     d  := bi - dx;         { debe cambiar la coordenada y }
     repeat
       if (d >= 0) then     { Comprueba si hay que avanzar según y }
       begin
         y := y + yi;       { Incrementamos Y (+1 ó -1) }
         d := d + ai;       { y la variable de control }
       end
       else
         d := d + bi;       { Si no varía y, d sí lo hace según bi }
       x := x + xi;         { Incrementamos X como corresponda }
       PonPixel(x, y, color);          { Dibujamos el punto }
     until (x = x2);   { Se repite hasta alcanzar el final }
   end
   else                { Si hay más salto según y que según x }
   begin               { (más vertical), todo similar }
     ai := (dx - dy) * 2;
     bi := dx * 2;
     d  := bi - dy;
     repeat
       if (d >= 0) then
       begin
         x := x + xi;
         d := d + ai;
       end
       else
         d := d + bi;
       y := y + yi;
       PonPixel(x, y, color);
     until (y = y2);
   end;
 end;
 
 begin
   ModoPantalla($13);    { Modo 320x200x256 }
   bucle := 0;           { Empezamos en 0 __RADIANES__ }
   repeat
     linea(160,100,      { Línea desde el centro de la pantalla }
       160 + round(60*cos(bucle)),  { Extremo en un círculo }
       100 + round(40*sin(bucle)),
       0);                          { Color negro (borrar) }
     bucle := bucle + 0.1;          { Siguiente posición }
 
     linea(160,100,       { Otra línea, pero ahora blanca }
       160 + round(60*cos(bucle)), 100 + round(40*sin(bucle)),
       15);
     delay(25);           { Esperamos 25 milisegundos }
   until keyPressed;      { Seguimos hasta que se pulse una tecla }
   tecla := ReadKey;      { Quitamos esa tecla del buffer del teclado }
   ModoPantalla(3);       { Y volvemos a modo texto }
 end.