Power-Programmierung/CD1.mdf/pascal/library/dos/bix/colors.sys

Text File | 1986-08-04 | 6.3 KB | 194 lines

(****************************************************************************)
(*                                                                          *)
(*                            COLORS.SYS                                    *)
(*                                                                          *)
(*      Sets various screen attributes.  Includes:                          *)
(*                                                                          *)
(*      SetCursorOn      -P-   Turns cursor on.                             *)
(*      SetCursorOff     -P-   Turns cursor off.                            *)
(*      IntensityOn      -P-   Sets Default Char. Intensity Bit on.         *)
(*      IntensityOff     -P-   Sets Default Char. Intensity Bit off.        *)
(*      UnderLineOn      -P-   Sets UnderLine Bit on.                       *)
(*      UnderLineOff     -P-   Sets UnderLine Bit off.                      *)
(*      BlinkOn          -P-   Sets Blink Bit On.                           *)
(*      BlinkOff         -P-   Sets Blink Bit Off.                          *)
(*      InverseOn        -P-   Mono: Turns on Inverse. Color: Wierd.        *)
(*      InverseOff       -P-   Mono: Turns off Inverse.  Color: Wierd.      *)
(*      TextForeColor    -P-   Sets Text Foreground Color Bits.             *)
(*      TextBackColor    -P-   Sets Text Backround Color Bits.              *)
(*      TextBorderColor  -P-   Sets Border Attribute (Color).               *)
(*      MakeAttribute    -F-   Converts an Attribute_Rec to Char.           *)
(*      SetColorType     -P-   Sets all Screen Attributes at once.          *)
(*      ColorField       -P-   Sets Attributes of a screen field.           *)
(*                                                                          *)
(*                                                                          *)
(*      REQUIRES:   DISPDEF.SYS                                             *)
(*                  BIOS.SYS                                                *)
(*                  PBIOS.SYS                                               *)
(*                  DISPLAY.SYS                                             *)
(*                                                                          *)
(*      written by:      John Leonard    4/6/1986                           *)
(*                                                                          *)
(*       NOT FOR SALE WITHOUT WRITTEN PERMISSION                            *)
(*                                                                          *)
(****************************************************************************)

procedure SetCursorOn;
   begin
     with CurrentScreenData do begin
        s1 :=  not ((not s1) or 32);
        SetCursorSize( s1,s2);
     end;
   end;


procedure SetCursorOff;
   begin
      with currentscreendata do begin
         if ( (s1 and 32)=32) then exit;
         s1 := s1 or 32;
         setcursorsize(s1,s2);
      end;
   end;


procedure IntensityOff;
   begin
      with CurrentScreenData do begin
        attribute := not( (not attribute) or 8);
      end;
   end;


procedure IntensityOn;
   begin
      with CurrentScreenData do begin
         if ((attribute and $70)=$70) then exit;
         if ((attribute and 8)= 8) then exit;
         Attribute := attribute or 8;
      end;
   end;


procedure UnderLineOn;
   begin
      with CurrentScreenData do begin
        if ((attribute and $70)=$70) then exit;
        if ( hardb = $B000) then begin
           if ((attribute and 8)=8) then attribute := 9 else
               attribute := 1 or (attribute and 128);
           end
        else
           attribute := 1 or  attribute ;
      end;
   end;


procedure UnderLineOff;
   begin
      with CurrentScreenData do begin
         if ((attribute and $70)=$70) then exit;
         if (hardb = $B000) then begin
            if ((attribute and 8)=8) then attribute := 10 else
               attribute :=  7 or (attribute and 128);
            end
         else
            attribute := not ( not(attribute) or 1 );
      end;
   end;



procedure BlinkOn;
   begin
      with CurrentScreenData do begin
         if  ((attribute and 128) = 128) then exit;
         attribute := attribute or 128;
      end;
   end;


procedure BlinkOff;
   begin
      with CurrentScreenData do
          attribute := not((not attribute) or 128);
   end;


procedure InverseOn;
   begin
      with CurrentScreenData do
         if (hardb=$b000) then
            attribute := $70 or (attribute and 128)
         else begin
            if (attribute and 128)=128 then
               attribute :=  not(attribute) or 128
            else
               attribute := not ( attribute or 128 );
         end;
   end;

procedure InverseOff;
   begin
      with CurrentScreenData do
         if ( hardb=$b000) then
            attribute := 10 or (attribute and 128)
         else begin
            if (attribute and 128)=128 then
               attribute :=  not(attribute) or 128
            else
               attribute := not ( attribute or 128 );
         end;
   end;


procedure TextForeColor( i : integer );
   var j:integer;
   begin
      if not (i in [0..15]) then exit;
      j := hi(defaultattribute);
      DefaultAttribute := i or j;
      CurrentScreenData.attribute := DefaultAttribute;
   end;


procedure TextBackColor ( i: integer);
   var j:integer;
   begin
      if not (i in [0..7] ) then exit;
      j := lo(defaultattribute);
      Defaultattribute := (i shl 4) or j;
      CurrentScreenData.attribute := DefaultAttribute;
   end;


procedure TextBorderColor ( i:integer);
   begin
      SetColorPalette(i);
   end;


function MakeAttribute (  scr_rec : Attribute_Rec): char ;
   begin
      MakeAttribute := char( (scr_rec[2] shl 4) + scr_rec[1]) ;
   end;


procedure SetColorType ( scr_rec : Attribute_Rec );
   begin
      TextForeColor( scr_rec[1] );
      TextBackColor( scr_rec[2] );
      TextBorderColor( scr_rec[3] );
   end;



procedure colorfield( x,y,length:integer;attr:char);
   var  i:integer;
   begin
      for i := 0 to length-1 do begin
         while not ( (port[$3DA] and 8)=8 ) do;
         mem[seg(displaystack[0]^):(woffset(y-1,x+i-1)+1) ] := byte(attr);
      end;
   end;