Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB16.ZIP/PIBLORES.PAS

Pascal/Delphi Source File | 1986-02-06 | 23.3 KB | 594 lines

(*R-,V-,C-,U-*)
PROGRAM PibLoRes;

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*     Program:  PibLoRes                                                   *)
(*                                                                          *)
(*     Purpose:  Demonstrates low resolution (160x100x16 colors) graphics   *)
(*               mode on IBM and compatible color cards.                    *)
(*                                                                          *)
(*     Author:   Philip R. Burns                                            *)
(*     Version:  1.0                                                        *)
(*     Date:     May, 1985                                                  *)
(*                                                                          *)
(*     Requires: IBM PC or close compatible, color graphics card            *)
(*                                                                          *)
(*     Use:      This program demonstrates these three lo-res graphics      *)
(*               procedures:                                                *)
(*                                                                          *)
(*                  Lores_GraphMode                                         *)
(*                  Lores_Move                                              *)
(*                  Lores_Draw                                              *)
(*                                                                          *)
(*               The low resolution graphics mode provides resolution       *)
(*               of 160 horizontal by 100 vertical pixels in 16 colors.     *)
(*               This mode is not directly supported by the BIOS, so        *)
(*               special programming of the CRT registers is required.      *)
(*                                                                          *)
(*               The three procedures listed above are sufficient to        *)
(*               use the lo-res graphics mode.  You should call another     *)
(*               Turbo graphics mode procedure -- say, GraphMode --         *)
(*               at the end of a program which uses these lo-res routines,  *)
(*               otherwise you will find your display in a very peculiar    *)
(*               state indeed.                                              *)
(*                                                                          *)
(*               This low-resolution mode is not really adequate for        *)
(*               serious graphics work, but it is useful for games and      *)
(*               wherever multiple colors are more important than the       *)
(*               degree of resolution.                                      *)
(*                                                                          *)
(*     Credits:  The setup routine is based upon a Basic program called     *)
(*               LOWRES.BAS published in PC WORLD, April, 1985.  The        *)
(*               author was Bernie Lawrence.                                *)
(*                                                                          *)
(*               The line-drawing routine is a straightforward              *)
(*               implementation of an incremental plotter algorithm         *)
(*               adapted for the CRT screen.                                *)
(*                                                                          *)
(*     Problems: Send bug reports, enhancements, etc. to PHILIP BURNS       *)
(*               on either of the following two Chicago BBSs:               *)
(*                                                                          *)
(*                  Gene Plantz's IBBS   [phone]                     *)
(*                  Ron Fox's RBBS       [phone]                     *)
(*                                                                          *)
(*               If you make interesting changes, please upload them        *)
(*               so that everyone else can enjoy them too!                  *)
(*                                                                          *)
(*     P.S.      It would be nice if someone would come up with an          *)
(*               alphanumeric display routine so text could be easily       *)
(*               displayed in lo-res mode.                                  *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

CONST
                                   (* Control registers *)
   Mode_Reg     = $3D8;
   Color_Reg    = $3D9;
                                   (* BIOS saves registers here *)
   Mode_Save    = $465;
   Color_Save   = $466;
                                   (* 6845 CRT controller registers *)
   Crt_Reg      = $3D4;
   Crt_Data     = $3D5;
                                   (* Lo-res is form of 80x25 text  *)
   HiRes_Mode   = 1;
   Video_Mode   = 8;

(* Structured *) CONST
                                   (* 6845 register data        *)

   Reg_Data: ARRAY[ 0 .. 11 ] OF INTEGER

             = ( 113,              (* Horizontal total          *)
                 80,               (* Horizontal displayed      *)
                 90,               (* Horizontal sync position  *)
                 10,               (* Horizontal sync width     *)
                 127,              (* Vertical total            *)
                 6,                (* Vertical adjust           *)
                 100,              (* Vertical displayed        *)
                 112,              (* Vertical sync position    *)
                 2,                (* Non-interlace mode        *)
                 1,                (* Maximum scan line address *)
                 32,               (* Disable cursor display    *)
                 0                 (* Cursor end                *)
                    );

VAR
   Register:     INTEGER;
   Mode:         INTEGER;
                                   (* Color card memory mapped address *)
   Color_Screen: ARRAY[ 0 .. 16000 ] OF BYTE ABSOLUTE $B800:0000;
   I:            INTEGER;
   PixCol:       INTEGER;
   Y:            INTEGER;
   T:            INTEGER;
   X:            INTEGER;
   C:            CHAR;

(*--------------------------------------------------------------------------*)
(*           Lores_GraphMode -- Set Low Resolution Graphics Mode            *)
(*--------------------------------------------------------------------------*)

PROCEDURE Lores_GraphMode;

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*    Procedure:  Lores_GraphMode                                           *)
(*                                                                          *)
(*    Purpose:    Initiates low resolution graphics mode                    *)
(*                                                                          *)
(*    Calling Sequence:                                                     *)
(*                                                                          *)
(*       Lores_GraphMode;                                                   *)
(*                                                                          *)
(*    Calls:  None                                                          *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

BEGIN (* Lores_GraphMode *)

                                   (* Clear out current 6845 settings *)
   MemW[Cseg:Mode_Save]  := 0;
   MemW[Cseg:Color_Save] := 0;
   PORT[Mode_Reg]        := 0;
   PORT[Color_Reg]       := 0;

                                   (* Reprogram 6845 for lo-res       *)
   FOR Register := 0 TO 11 DO
      BEGIN
         PORT[Crt_Reg]  := Register;
         PORT[Crt_Data] := Reg_Data[Register];
      END;
                                   (* Lo-res is actually form of 80x25 *)
                                   (* text mode                        *)

   Mode := HiRes_Mode + Video_Mode;

   MemW[Cseg:Mode_Save] := Mode;
   PORT[Mode_Reg]       := Mode;

                                   (* Clear the screen                *)

   FillChar( Color_Screen, 16000, 0 );

                                   (* Fill graphics memory with 222s.  *)
                                   (* This is character which fills    *)
                                   (* left half of character cell with *)
                                   (* background color and right half  *)
                                   (* with foreground color.           *)
   FOR I := 0 TO 7999 DO
      Color_Screen[2 * I]     := 222;

END   (* Lores_GraphMode *);

(*--------------------------------------------------------------------------*)
(*           Lores_Plot -- Plot Point in Low Resolution Graphics Mode       *)
(*--------------------------------------------------------------------------*)

PROCEDURE Lores_Plot( X , Y , PixCol: INTEGER );

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*    Procedure:  Lores_Plot                                                *)
(*                                                                          *)
(*    Purpose:    Plots point in low-resolution graphics mode               *)
(*                                                                          *)
(*    Calling Sequence:                                                     *)
(*                                                                          *)
(*       Lores_Plot( X , Y , PixCol : INTEGER );                            *)
(*                                                                          *)
(*           X      -- Horizontal postion (0 through 159)                   *)
(*           Y      -- Vertical position (0 through 119)                    *)
(*           PixCol -- Color (0 through 15) of point                        *)
(*                     See the Turbo manual for color assignments.          *)
(*                                                                          *)
(*    Calls:  None                                                          *)
(*                                                                          *)
(*    Remarks:  Requests for point positions outside the correct range,     *)
(*              or for colors outside the correct range, are ignored.       *)
(*              For extra speed, remove the check.                          *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)


VAR
   Pixel:      INTEGER;
   Pixel_Addr: INTEGER;
   Nibble:     INTEGER;
   Legal:      BOOLEAN;

BEGIN (* Lores_Plot *)

   Legal := ( X >= 0 ) AND ( X <= 159 ) AND ( Y >= 0 ) AND ( Y <= 119 ) AND
            ( PixCol >= 0 ) AND ( PixCol <= 15 );

   IF Legal THEN
      BEGIN

         Pixel      := X + ( Y * 160 );
         Pixel_Addr := ( Pixel AND $FFFE ) + 1;
         Nibble     := Pixel MOD 2;

         IF Nibble = 0 THEN
            Color_Screen[Pixel_Addr] := ( Color_Screen[Pixel_Addr] AND $0F )
                                        + PixCol * 16
         ELSE
            Color_Screen[Pixel_Addr] := ( Color_Screen[Pixel_Addr] AND $F0 )
                                        + PixCol;
      END;

END   (* Lores_Plot *);

(*--------------------------------------------------------------------------*)
(*           Lores_Draw -- Draw line between two points, low res. mode      *)
(*--------------------------------------------------------------------------*)

PROCEDURE Lores_Draw( X1, Y1, X2, Y2, LineCol: INTEGER );

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*    Procedure:  Lores_Draw                                                *)
(*                                                                          *)
(*    Purpose:    Draws line between two points in low-res. graphics mode   *)
(*                                                                          *)
(*    Calling Sequence:                                                     *)
(*                                                                          *)
(*       Lores_Draw( X1 , Y1 , X2, Y2, LineCol : INTEGER );                 *)
(*                                                                          *)
(*           X1      -- Horizontal postion (0 through 159), 1st point       *)
(*           Y1      -- Vertical position (0 through 119), 1st point        *)
(*           X2      -- Horizontal postion (0 through 159), 2nd point       *)
(*           Y2      -- Vertical position (0 through 119), 2nd point        *)
(*           LineCol -- Color (0 through 15) of line                        *)
(*                                                                          *)
(*    Calls:  Lores_Plot                                                    *)
(*                                                                          *)
(*    Remarks: An incremental plotter algorithm is used.                    *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

VAR
   Xinc:       INTEGER;
   Yinc:       INTEGER;
   Dx:         INTEGER;
   Cdx:        INTEGER;
   Dy:         INTEGER;
   Cdy:        INTEGER;
   X:          INTEGER;
   Y:          INTEGER;
   Correc_Inc: INTEGER;
   Plotit:     BOOLEAN;

BEGIN (* Lores_Draw *)
                                   (* Starting point *)
   X  := X1;
   Y  := Y1;
                                   (* Changes in (x,y) direction *)
   Dx := X2 - X1;
   Dy := Y2 - Y1;
                                   (* Set increments *)
   IF Dx > 0 THEN
      Xinc := 1
   ELSE
      BEGIN
         Xinc := -1;
         Dx   := -Dx;
      END;

   IF Dy > 0 THEN
      Yinc := 1
   ELSE
      BEGIN
         Yinc := -1;
         Dy   := -Dy;
      END;
                                   (* Reset_Inc is correction value *)
   IF Dy > Dx THEN
      Correc_Inc := Dy
   ELSE
      Correc_Inc := Dx;

   Cdx := Correc_Inc;
   Cdy := Correc_Inc;

                                   (* Plot first point *)
   Lores_Plot( X, Y, LineCol );

                                   (* Plot remaining points *)

   WHILE( ( X <> X2 ) AND ( Y <> Y2 ) ) DO
      BEGIN

         PlotIt := FALSE;

         Cdx    := Cdx - Dx;

         IF Cdx < 0 THEN
            BEGIN
               PlotIt := TRUE;
               X      := X + Xinc;
               Cdx    := Cdx + Correc_Inc;
            END;

         Cdy := Cdy - Dy;

         IF Cdy < 0 THEN
            BEGIN
               PlotIt := TRUE;
               Y      := Y + Yinc;
               Cdy    := Cdy + Correc_Inc;
            END;

         IF PlotIt THEN Lores_Plot( X, Y, LineCol );

      END;

END   (* Lores_Draw *);

(*--------------------------------------------------------------------------*)
(*               D E M O N S T R A T I O N   R O U T I N E S                *)
(*--------------------------------------------------------------------------*)

(*--------------------------------------------------------------------------*)
(*         Lores_Demo1 -- Draw embedded frames using Lo-Res graphics        *)
(*--------------------------------------------------------------------------*)

PROCEDURE Lores_Demo1;

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*    Procedure:  Lores_Demo1                                               *)
(*                                                                          *)
(*    Purpose:    Draws series of embedded frames                           *)
(*                                                                          *)
(*    Calling Sequence:                                                     *)
(*                                                                          *)
(*       Lores_Demo1;                                                       *)
(*                                                                          *)
(*    Calls:  Lores_Plot                                                    *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

BEGIN (* Lores_Demo1 *)

   PixCol := 0;
   Y      := 0;

   FOR T := 1 TO 99 DO
      BEGIN
         Y := Y + 1;
         IF ( T MOD 5 ) = 0 THEN
            PixCol := ( PixCol + 1 ) MOD 15;
         FOR X := 1 TO T DO
            Lores_Plot( X , Y , PixCol );
      END;

   X      := 1;
   PixCol := 8;

   FOR T := 1 TO 99 DO
      BEGIN
         X := X + 1;
         IF ( T MOD 5 ) = 0 THEN PixCol := ( PixCol + 1 ) MOD 15;
         FOR Y := 1 TO T DO
            Lores_Plot( X , Y , PixCol );
      END;

END   (* Lores_Demo1 *);


(*--------------------------------------------------------------------------*)
(*         Lores_Demo2 -- Borland's ART.PAS for lores graphics              *)
(*--------------------------------------------------------------------------*)

PROCEDURE Lores_Demo2;

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*    Procedure:  Lores_Demo2                                               *)
(*                                                                          *)
(*    Purpose:    Draws series of lines at various angles and colors.       *)
(*                From Borland's ART.PAS demonstration program for          *)
(*                medium-resolution graphics.                               *)
(*                                                                          *)
(*    Calling Sequence:                                                     *)
(*                                                                          *)
(*       Lores_Demo2;                                                       *)
(*                                                                          *)
(*    Calls:  Lores_Plot                                                    *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

Const
  Memory = 150;

var
  Line:  array [1..Memory] of record
                                LX1,LY1: integer;
                                LX2,LY2: integer;
                                LColor:  integer;
                              end;
  X1,X2,Y1,Y2,
  CurrentLine,
  ColorCount,
  IncrementCount,
  DeltaX1,DeltaY1,DeltaX2,DeltaY2,
  I,Color:            integer;
  Ch: char;

procedure Init;
begin
  for I:=1 to Memory do
  with Line[I] do
  begin
    LX1:=0; LX2:=0;
    LY1:=0; LY2:=0;
  end;
  X1:=0; Y1:=0; X2:=0; Y2:=0;
  CurrentLine:=1;
  ColorCount:=0;
  IncrementCount:=0;
  Ch:=' ';
end;

procedure AdjustX(var X,DeltaX: integer);
var
  TestX: integer;
begin
  TestX:=X+DeltaX;
  if (TestX<1) or (TestX>160) then
  begin
    TestX:=X;
    DeltaX:=-DeltaX;
  end;
  X:=TestX;
end;

procedure AdjustY(var Y,DeltaY: integer);
var
  TestY: integer;
begin
  TestY:=Y+DeltaY;
  if (TestY<1) or (TestY>90) then
  begin
    TestY:=Y;
    DeltaY:=-DeltaY;
  end;
  Y:=TestY;
end;

procedure SelectNewColor;
begin
  Repeat
     Color:=Random(16)+1;
  Until not ( Color in [0,8] ) ;
  ColorCount:=5*(1+Random(10));
end;

procedure SelectNewDeltaValues;
begin
  DeltaX1:=Random(7)-3;
  DeltaX2:=Random(7)-3;
  DeltaY1:=Random(7)-3;
  DeltaY2:=Random(7)-3;
  IncrementCount:=4*(1+Random(9));
end;


procedure SaveCurrentLine;
begin
  with Line[CurrentLine] do
  begin
    LX1:=X1;
    LY1:=Y1;
    LX2:=X2;
    LY2:=Y2;
    LColor:=Color;
  end;
end;


procedure Regenerate;
var
  I: integer;
begin

  NoSound;

  Lores_GraphMode;
  for I:=1 to Memory do with Line[I] do Lores_Draw(LX1,LY1,LX2,LY2,LColor);
  read(Kbd,Ch);
end;

begin (* Lores_Demo2 *)

  Init;
                                   (* Set up lo-res color graphics mode *)
  Lores_GraphMode;

  Color:=2;
  gotoxy(1,11);
  repeat
    with Line[CurrentLine] do Lores_Draw(LX1,LY1,LX2,LY2,0);

    if ColorCount=0 then SelectNewColor;
    if IncrementCount=0 then SelectNewDeltaValues;

    AdjustX(X1,DeltaX1); AdjustX(X2,DeltaX2);
    AdjustY(Y1,DeltaY1); AdjustY(Y2,DeltaY2);

    Lores_Draw(X1,Y1,X2,Y2,Color);

    SaveCurrentLine;

    CurrentLine:=Succ(CurrentLine);
    if CurrentLine>Memory then CurrentLine:=1;
    ColorCount:=Pred(ColorCount); IncrementCount:=Pred(IncrementCount);

    if KeyPressed then
    begin
      read(Kbd,Ch);
      if Ch<>#27 then
      begin
        Regenerate;
      end;
    end;
  until Ch=#27;
  TextMode;

END   (* Lores_Demo2 *);


(*--------------------------------------------------------------------------*)
(*                       PibLoRes --- Main Program                          *)
(*--------------------------------------------------------------------------*)

BEGIN (* PibLoRes *)

   ClrScr;
                                   (* Announce demonstration *)

   WRITELN('This program demonstrates a low-resolution graphics mode');
   WRITELN('of 160 horizontal by 100 vertical positions, with 16 colors');
   WRITELN('available for each plotting position.');
   WRITELN(' ');
   WRITELN('The first demonstration produces a series of embedded frames.');
   WRITELN('After the frames appear, hit the carriage return key to ');
   WRITELN('go on to the next demonstration.' );
   WRITELN(' ');
   WRITELN('Hit the carriage return (enter) key to start the demo.');

   WHILE( NOT KeyPressed ) DO;
   WHILE KeyPressed DO READ( KBD , C );

                                   (* Do frame demo *)
   Lores_GraphMode;
   Lores_Demo1;
                                   (* Wait for input to clear screen *)
   WHILE( NOT KeyPressed ) DO;
   WHILE KeyPressed DO READ( KBD , C );

                                   (* Announce second demo *)
   GraphMode;
   TextMode( C80 );

   WRITELN('The second demonstration is a modified version of the');
   WRITELN('sample ART.PAS program from the Turbo Pascal release disk.');
   WRITELN('To exit this demonstration, hit the ESCAPE key.  To restart');
   WRITELN('this demonstration, hit the return key.');
   WRITELN(' ');
   WRITELN('Hit the carriage return (enter) key to start the demo.');

   WHILE( NOT KeyPressed ) DO;
   WHILE KeyPressed DO READ( KBD , C );

                                   (* Do ART demo *)
   Lores_GraphMode;
   Lores_Demo2;

                                   (* Ensure screen left in text mode *)
   GraphMode;
   TextMode( C80 );

END   (* PibLoRes *).