Power-Programmierung/CD1.mdf/pascal/library/dos/database/gsdb28/gs_scrn.pas

Pascal/Delphi Source File | 1992-02-24 | 6.8 KB | 283 lines

unit GS_Scrn;
{-----------------------------------------------------------------------------
                           Screen Handler Routines

       GS_Scrn Copyright (c)  Richard F. Griffin

       20 February 1992

       102 Molded Stone Pl
       Warner Robins, GA  31088

       -------------------------------------------------------------
       This unit handles the objects for all screen display operations.

   Changes:

------------------------------------------------------------------------------}

interface
{$D-}

uses
    Crt,
    Dos;

Type
   GS_Scrn_Str80  =  string[80];

var
   GS_Scrn_ScB : Boolean;
   GS_Scrn_Segmt : word;
   GS_Scrn_Mode  : integer;


procedure GS_Scrn_Await_Key;

procedure GS_Scrn_Get_Win(x1,y1,x2,y2 : integer;var HS);

procedure GS_Scrn_Put_Win(x1,y1,x2,y2 : integer; var HS);

procedure GS_Scrn_Put_Atr(cx,cy,bx,by,f,b : integer);

procedure GS_Scrn_Put_Char(cx,cy : integer; ch : char);

{procedure GS_Scrn_Swap_Char(cx,cy : integer; ch : char);}

Procedure GS_Scrn_SetCursor(c : boolean);
                                      {Sets big cursor if argument is true;}
                                      {Sets small cursor if false}
Procedure GS_Scrn_HideCursor;
Procedure GS_Scrn_ShowCursor;

implementation

type
   stype = array [1..25,1..80] of word;

var
   Scrn_p : ^stype;
   reg    : Registers;
{.pa}
{
         ┌──────────────────────────────────────────────────────────┐
         │  ********     Screen Cursor Size Routines      *******   │
         │                                                          │
         │  The next three routines are used to change the size of  │
         │  the screen cursor to indicate whether insert is on or   │
         │  off.  BIOS calls are used.                              │
         └──────────────────────────────────────────────────────────┘
}

PROCEDURE LineCursor;                 {Set cursor to two lines}
BEGIN
   reg.ah := $03;                     {Service 3 }
   INTR($10,reg);                     {Intr 10. Get scan lines}
   reg.ah := $01;                     {Service 1 }
   reg.ch := reg.cl-1;                {Set two line difference }
   INTR($10,reg);                     {Interrupt 10.  Set scan lines}
END;

PROCEDURE BigCursor;                  {Set cursor to four lines}
BEGIN
   reg.ah := $03;                     {Service 3 }
   INTR($10,reg);                     {Intr 10. Get scan lines}
   reg.ah := $01;                     {Service 1 }
   reg.ch := reg.cl - 3;              {Set four scan lines for cursor}
   INTR($10,reg);                     {Interrupt 10.  Set scan lines }
END;

procedure GS_Scrn_SetCursor(c : boolean);
                                      {Sets big cursor if argument is true;}
                                      {sets small cursor otherwise.}
begin
   if c then BigCursor else LineCursor;
end;

PROCEDURE GS_Scrn_HideCursor;
BEGIN
   reg.ah := $03;                 { Service 3 }
   INTR($10,reg);                 { Intr 10. Get scan lines}
   reg.cx := reg.cx OR $2000;     { Set bit 5 to 1}
   reg.ah := $01;                 { Service 1 }
   INTR($10,reg);                 { Intr 10 resets cursor}
END;

PROCEDURE GS_Scrn_ShowCursor;
BEGIN
   reg.ah := $03;               { Service 3 }
   INTR($10,reg);               { Intr 10. Get scan lines}
   reg.cx := reg.cx AND $DFFF;  { Set bit 5 to 0}
   reg.ah := $01;               { Service 1 }
   INTR($10,reg);               { Intr 10 resets cursor}
END;


procedure GS_Scrn_Put_Char(cx,cy : integer; ch : char);
var
   valu : word;
BEGIN
   valu := (TextAttr shl 8) + byte(ch);
   scrn_p^[cy,cx] := valu;
END;

procedure GS_Scrn_Swap_Char(cx,cy : integer; ch : char);
var
   valu,
   hold : word;
BEGIN
   valu := (TextAttr shl 8) + byte(ch);
   hold := scrn_p^[cy,cx];
   scrn_p^[cy,cx] := valu;
   scrn_p^[cy,cx+1] := hold;
END;





procedure GS_Scrn_Await_Key;
var
   wsmin,
   wsmax     : word;
   wscx,
   wscy,
   wsattr    : byte;
   ch        : char;
   Scrn      : Array [1..4000] of byte;
   lopx,
   lopy      : integer;
   hour,
   minute,
   second,
   sec100,
   minhold   : word;

begin
   GetTime(hour,minute,second,sec100);
   minhold := minute + 5;
   if minhold > 59 then minhold := minhold - 59;
   while minute <> minhold do
   begin
      if KeyPressed then exit;
      GetTime(hour,minute,second,sec100);
   end;
   Randomize;
   move(mem[GS_Scrn_Segmt:0], scrn, 4000);
   wsmin := WindMin;
   wsmax := WindMax;
   wsattr := TextAttr;
   wscx := wherex;
   wscy := wherey;
   window (1,1,80,25);
   TextColor(LightGray);
   TextBackground(Black);
   lopx := 37;
   lopy := 17;
   ClrScr;
   gotoxy(lopx, lopy);
   write('Press Any Key to Start');
   while not KeyPressed do
   begin
      GetTime(hour,minute,second,sec100);
      if minute <> minhold then
      begin
         minhold := minute;
         lopx := random(56) + 1;
         lopy := random(23) + 1;
         ClrScr;
         gotoxy(lopx, lopy);
         write('Press Any Key to Start');
      end;
   end;
   ch := ReadKey;
   if ch = #0 then ch := ReadKey;
   move(scrn, mem[GS_Scrn_Segmt:0], 4000);
   WindMin := wsmin;
   WindMax := wsmax;
   TextAttr := wsattr;
   gotoxy(wscx,wscy);
end;


procedure GS_Scrn_Get_Win(x1,y1,x2,y2 : integer; var HS);
var
   i,j,x,y  : integer;
   HoldStr : array [1..2000] of word absolute HS;
begin
   i := 0;
   for y := y1 to y2 do
   begin
      for x := x1 to x2 do
      begin
         inc(i);
         HoldStr[i] := scrn_p^[y,x];
      end;
   end;
end;

procedure GS_Scrn_Put_Win(x1,y1,x2,y2 : integer; var HS);
var
   i,j,x,y  : integer;
   HoldStr : array [1..2000] of word absolute HS;
begin
   i := 0;
   for y := y1 to y2 do
   begin
      for x := x1 to x2 do
      begin
         inc(i);
         scrn_p^[y,x] := HoldStr[i];
      end;
   end;
end;

procedure GS_Scrn_Put_Atr(cx,cy,bx,by,f,b : integer);
var
   i,j,x,y : integer;
   x1, y1, x2, y2  : word;
   c,v,t,g : word;
begin
   if f > 15 then v := 128 else v := 0;
   t := f mod 16;
   g := b mod 8;
   c := (g shl 4) + t + v;
   c := c shl 8;
   x1 := cx + lo(WindMin);
   y1 := cy + hi(WindMin);
   x2 := bx + lo(WindMin);
   y2 := by + hi(WindMin);
   for y := y1 to y2 do
   begin
      for x := x1 to x2 do
      begin
         scrn_p^[y,x] := c + lo(scrn_p^[y,x]);
      end;
   end;
end;

function Dos_Mode : integer;
begin
   GS_Scrn_Mode := LastMode;
   if GS_Scrn_Mode = Mono then
   begin
      TextMode(Mono);
      GS_Scrn_Segmt := $B000;
   end
   else
   begin
      TextMode(CO80);
      GS_Scrn_Segmt := $B800;
   end;
   Dos_Mode := GS_Scrn_Mode;
end;



begin
   GS_Scrn_ScB := false;
   GS_Scrn_Mode:= Dos_Mode;
   TextColor(LightGray);
   TextBackGround(Black);
   scrn_p := ptr(GS_Scrn_Segmt,0);
end.