{DEMO PROGRAM TO SHOW THE COLOR GRAPHICS CAPABILITIES OF THESE PROCEDURES.
THIS PROGRAM ASSUMES STARTING IN 80 X 25 ALPHANUMERIC MODE ON THE COLOR
DISPLAY. I SUGGEST YOU DOWNLOAD THE ENTIRE PROGRAM AS ONE PIECE AND GET IT
WORKING AND THEN CHANGE ONE PART AT A TIME TO UNDERSTAND HOW IT WORKS}

{ Pset -- set point at x-y to a color
  Linedraw -- draw a line from x-y to x-y
  Boxdraw -- draw a box by giving opposite corner coordinates
  screen -- select screen type much like basic screen command
  color -- select background color and pallete                  }

PROGRAM COLOR_DEMO;
var
    i,k        :  integer;
    x,y        :  integer;
    row        :  integer;
    col        :  integer;

{=======================================================================}
procedure screen(sel : integer);
{=======================================================================}
{PROC TO SET SCREEN TO 320 X 200 COLOR OR 80 X 25 ALPHANUMERIC COLOR.   }
{SCREEN(0) = GRAPHICS 320 X 200                                         }
{SCREEN(1) = ALPHANUMERIC 80 X 25                                       }
{                                                                       }
{=======================================================================}

type Regpack = record
                 AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS: Integer;
               end;

var Registers  :  Regpack;
    AL, AH     :  byte;

begin
  if sel = 0 then
  begin
    Registers.AX := $0003;  {use standard bios calls to set the graphics}
    Intr($10, Registers);   {adapter }
  end;
  if sel = 1 then
  begin
    Registers.AX := $0004;
    Intr($10, Registers);
  end;
end;

{=======================================================================}
procedure color(backg , palette : integer);
{=======================================================================}
{PROC TO SET COLOR OF BACKGROUND AND PALETTE                            }
{WORKS LIKE BASIC GRAPHICS COLOR STATEMENT                              }
{                                                                       }
{=======================================================================}

var t1, t2     :  integer;

begin
  t1 := palette shl 5;       {shift 0 or 1 into proper bit}
  t1 := t1 and $0020;        {mask out any other bits}
  t2 := backg and $000F;     {mask out all but background color select bits}
  port[$03D9] := t1 or t2;   {put the 2 together and send to the color select}
end;                         {register on the color board}
{=======================================================================}
procedure rowoff(r : integer; var mo,ro :integer);
{=======================================================================}
{PROC TO FIND MAJOR MEMORY OFFSET AND ROW OFFSET -- A SUBROUTINE        }
{USED BY PSET                                                           }
{                                                                       }
{=======================================================================}

var

t1,t2          : integer;

begin
  t1 := r and $01;        {find major offset from row input}
  if t1 = 1 then mo := $2000 else mo := $0000;
  t2 := r shr 1;          {find row offset}
  ro := t2 * 80;
end;

{=======================================================================}
procedure coloff(c : integer; var co,dn :integer);
{=======================================================================}
{PROC TO FIND BYTE OFFSET WITHIN ROW AND DOT WITHIN BYTE -- A SUBROUTINE}
{USED BY PSET                                                           }
{                                                                       }
{=======================================================================}

begin
  co := c shr 2;    {find byte within column}
  dn := c and $03;  {find dot number within byte}
end;

{=======================================================================}
procedure dot_color(var dt0,dt1,dt2,dt3 : integer ;cn : integer);
{=======================================================================}
{PROC TO SET DOT WITHIN BYTE TO THE CORRECT COLOR -- A SUBROUTINE       }
{USED BY PSET                                                           }
{                                                                       }
{=======================================================================}

begin
    case cn of
    0  :  begin           {set correct bit pattern for correct dot and color}
            dt0 := $0000;
            dt1 := $0000;
            dt2 := $0000;
            dt3 := $0000;
          end;
    1  :  begin
            dt0 := $0040;
            dt1 := $0010;
            dt2 := $0004;
            dt3 := $0001;
          end;
    2  :  begin
            dt0 := $0080;
            dt1 := $0020;
            dt2 := $0008;
            dt3 := $0002;
          end;
    3  :  begin
            dt0 := $00C0;
            dt1 := $0030;
            dt2 := $000C;
            dt3 := $0003;
          end;
  end;
end;

{=======================================================================}
procedure pset(set_col,set_row,color_no : integer);
{=======================================================================}
{PROC TO SET A POINT AT COL AND ROW (OR X AND Y IF YOU PREFER) COORD-   }
{INATES.                                                                }
{WORKS LIKE BASIC PSET STATEMENT                                        }
{                                                                       }
{=======================================================================}

const
  VideoSeg: Integer   = $0B800;

var
    major_offset  :  integer;
    row_offset    :  integer;
    col_offset    :  integer;
    dot_no        :  integer;
    membyte       :  integer;
    temp          :  integer;
    d0            :  integer;
    d1            :  integer;
    d2            :  integer;
    d3            :  integer;
    cn            :  integer;

begin { main code of pset proc }
  rowoff(set_row,major_offset,row_offset);
  coloff(set_col,col_offset,dot_no);
  dot_color(d0,d1,d2,d3,color_no);
  membyte := Mem[videoseg : major_offset + col_offset + row_offset];
  {get byte to be changed}
  {pull information from byte that was there, masking bits that}
  {will be changed to zero, then set bits to be changed to proper color}
    case dot_no of
    0  :  begin
            temp := membyte and (not $C0);
            membyte := temp or d0;
          end;
    1  :  begin
            temp := membyte and (not $30);
            membyte := temp or d1;
          end;
    2  :  begin
            temp := membyte and (not $0C);
            membyte := temp or d2;
          end;
    3  :  begin
            temp := membyte and (not $03);
            membyte := temp or d3;
          end;
  end;
  Mem[videoseg : major_offset + col_offset + row_offset] := membyte;
  {put changed byte back}
end;

{=======================================================================}
Procedure Drawline(FromX,FromY,ToX,ToY,color_no:Integer);
{=======================================================================}
{PROC TO DRAW A LINE FROM X-Y COORDINATE TO A 2ND X-Y COORDINATE        }
{THIS PROC WAS WRITTEN BY ALEX MARTINELLI FROM ROME                     }
{                                                                       }
{=======================================================================}
{ note all coords assumed to be in proper ranges - no checks done !}

var temp,Dx, Dy, XIncBefore, XIncAfter, YIncBefore, YIncAfter : Integer;
    Curpoint, Accumul : Integer;

begin {drawline}
  { set 'standard values' for increments assuming line inclination
     is between 0 and 45 degrees }
  XIncBefore := 1 ; XIncAfter := 0 ;
  YincBefore := 0 ; YIncAfter := 1 ;
  { correct for negative slopes, if any }
  Dx := ToX - FromX;
  if Dx<0 then begin
    Dx := abs(Dx);
    XIncBefore := -1 ;
  end {if};
  Dy := ToY - FromY;
  if Dy<0 then begin
    Dy := abs(Dy);
    YIncAfter := -1 ;
  end {if};
  { correct for line closer to vertical than to horizontal, if needed }
  if Dx<Dy then begin
    { swap Dx and Dy }
    Temp := Dx ;
    Dx := Dy ;
    Dy := Temp ;
    { swap 'before' and 'after' status for increments }
    XIncAfter := XIncBefore ; XIncBefore := 0;
    YIncBefore := YIncAfter ; YIncAfter := 0;
  end{if};
  { now: Dx is total number of points to plot;
          Dy is increment of the shorter axis per each Dx of increment
             along the longer axis. }
  Accumul := Dx div 2 ;
  for Curpoint := 1 to Dx do begin
    pset(FromX,FromY,color_no);
    FromX := FromX + XIncBefore ;
    FromY := FromY + YIncBefore ;
    Accumul := Accumul + Dy ;
    if Accumul > Dx then begin
      Accumul := Accumul - Dx ;
      FromX := FromX + XIncAfter ;
      FromY := FromY + YIncAfter ;
    end{if};
  end{for};
end {Procedure Drawline};

{=======================================================================}
Procedure Drawbox(fx,fy,tx,ty,colr_no:Integer);
{=======================================================================}
{PROC TO DRAW BOX -- FX AND FY ARE FROM X FROM Y UPPER LEFT CORNER AND  }
{TX AND TY ARE TO X AND TO Y LOWER RIGHT CORNER -- THIS WORKS SIMILAR   }
{TO THE LINE COMMAND IN BASIC WITH THE BOX OPTION                       }
{                                                                       }
{=======================================================================}

begin
Drawline(fx,fy,tx,fy,colr_no);   {top horizontal}
Drawline(tx,fy,tx,ty,colr_no);   {right vertical}
Drawline(tx,ty,fx,ty,colr_no);   {bottom horizontal}
Drawline(fx,ty,fx,fy,colr_no);   {left vertical}
end;
{=======================================================================}
{START OF DEMO PROGRAM MAIN CODE                                        }
{ 1) DRAW COLORBARS USING PSET PROCEDURE                                }
{ 2) DRAW VARIOUS LENGTH LINES USING LINE PROCEDURE                     }
{ 3) DRAW VARIOUS SIZE BOXES USING BOX DRAW PROCEDURE -- ALSO USE       }
{    WRITELN TO SHOW X - Y COORDINATES AS THE BOXES ARE DRAWN           }
{                                                                       }
{=======================================================================}

begin
  row := 0;
  col := 1;
  x := 0;
  y := 199;
{ start of colorbar demo }
  screen(1);                  {set graphics mode}
  color(0,0);                 {set background color 0, pallette 0 }
  gotoxy(10,23);
  writeln('COLOR BAR DEMO');
  for row := 0 to 100 do      {draw colorbars using pset}
  begin
    for col := 0 to 20 do
    pset(col,row,0);
    for col := 21 to 40 do
    pset(col,row,1);
    for col := 41 to 60 do
    pset(col,row,2);
    for col := 61 to 80 do
    pset(col,row,3);
  end;
  gotoxy(10,24);
  writeln('HIT RETURN TO CONTINUE');
  read;
  { start of line draw demo }
  screen(1);                  {set graphics mode again to erase the screen}
  color(7,1);                 {change background color and pallete selection}
  gotoxy(10,23);
  writeln('LINE DRAW DEMO');
  i := 0;
  repeat
  Drawline(0,0,319,I,2);      {draw lines with drawline proc}
  i := i + 10;
  until i >= 199;
  gotoxy(10,24);
  writeln('HIT RETURN TO CONTINUE');
  read;
  { start of box draw demo }
  screen(1);                  {set graphics mode again to erase the screen}
  color(0,0);                 {change background color and pallete selection}
  gotoxy(28,21);
  writeln('BOX DRAW DEMO');
  gotoxy(28,7);
  writeln('X - Y');           {this is to continually show x-y coordinates}
  gotoxy(28,8);               {as program draws boxes}
  writeln('COORDINATES');
  for k := 1 to 26 do
  begin
    gotoxy(28,10);
    writeln('X is ',x:3);
    gotoxy(28,11);
    writeln('Y is ',y:3);
    Drawbox(x,x,y,y,2);
    x := x + 4;
    y := y - 4;
  end;
  x := x - 2;
  y := y + 2;
  for k := 1 to 26 do
  begin
    gotoxy(28,10);
    writeln('X is ',x:3);
    gotoxy(28,11);
    writeln('Y is ',y:3);
    Drawbox(x,x,y,y,1);
    x := x - 4;
    y := y + 4;
  end;
  gotoxy(28,23);
  writeln('HIT RETURN');
  gotoxy(28,24);
  writeln('TO CONTINUE');
  read;
  screen(0);        {go back to alphanumeric mode to use turbo editor}
end.