home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / mono.zip / MONO.PAS
Pascal/Delphi Source File  |  1986-06-22  |  4KB  |  90 lines
  1. (******************************************************************************
  2.  
  3.                                    MONO.PAS
  4.                                   Version 1.1
  5.                                  May 21, 1985
  6.                                by Randy Forgaard
  7.                              CompuServe 70307,521
  8.  
  9. Requires PC-DOS Turbo Pascal 2.0 or higher (tested under 2.0 and 3.0), and an
  10. IBM-PC or 100% compatible machine.  These are routines for achieving all 11 of
  11. the text highlighting effects supported by the IBM Monochrome Display Adapter:
  12. high-intensity, reverse-video, underlining, blinking, non-display, and their
  13. permissible combinations.  Note: These routines supercede Turbo's built-in
  14. LowVideo and NormVideo routines.
  15.  
  16. The MonochromeVideo routine accepts both an Appearance and a HighlightSet as
  17. arguments.  The IBM Monochrome Display Adapter recognizes all
  18. Appearance/HighlightSet combinations, except that HighIntensity has no effect
  19. when used with BlackOnWhite, and WhiteOnWhite is not supported.  Other
  20. monochrome adapters may accept these combinations, though.  The IBM Monochrome
  21. Display itself uses the HighIntensity attribute, but some other monitors do not
  22. have this capability.
  23.  
  24. ******************************************************************************)
  25.  
  26. {Video highlighting types}
  27. type
  28.   Appearance = (WhiteOnBlack, BlackOnWhite, UnderlinedWhiteOnBlack,
  29.                 BlackOnBlack, WhiteOnWhite);
  30.   Highlight = (HighIntensity, Blink);
  31.   HighlightSet = set of Highlight;
  32.  
  33.  
  34. {Causes "a" and "hs" to be the appearance and highlighting of all characters
  35.  subsequently displayed to the screen using "write" or "writeln," until this
  36.  routine is called again.}
  37.  
  38. procedure MonochromeVideo (a: Appearance; hs: HighlightSet);
  39. const
  40.   BackgroundAttr: array[Appearance] of Byte = (0, 7, 0, 0, 7);
  41.   ForegroundAttr: array[Appearance] of Byte = (7, 0, 1, 0, 7);
  42. var
  43.   highlightBits: Byte absolute hs;
  44. begin
  45.   TextBackground(BackgroundAttr[a]);
  46.   TextColor(ForegroundAttr[a] + (highlightBits shl 3))
  47. end {MonochromeVideo};
  48.  
  49.  
  50. { Example program -- remove next line to enable (a Bela Lubkin trick) }
  51. (*
  52. begin
  53.   ClrScr;
  54.   writeln;
  55.   writeln('All the video combinations supported by the IBM Monochrome ' +
  56.           'Adapter and Display:');
  57.   writeln;
  58.   MonochromeVideo(WhiteOnBlack, []);
  59.   writeln('Normal text');
  60.   MonochromeVideo(WhiteOnBlack, [Blink]);
  61.   writeln('Blinking text');
  62.   MonochromeVideo(WhiteOnBlack, [HighIntensity]);
  63.   writeln('High-intensity text');
  64.   MonochromeVideo(WhiteOnBlack, [Blink, HighIntensity]);
  65.   writeln('Blinking high-intensity text');
  66.   MonochromeVideo(BlackOnWhite, []);
  67.   writeln('Reverse-video text');
  68.   MonochromeVideo(BlackOnWhite, [Blink]);
  69.   writeln('Blinking reverse-video text');
  70.   MonochromeVideo(UnderlinedWhiteOnBlack, []);
  71.   writeln('Underlined text');
  72.   MonochromeVideo(UnderlinedWhiteOnBlack, [Blink]);
  73.   writeln('Blinking underlined text');
  74.   MonochromeVideo(UnderlinedWhiteOnBlack, [HighIntensity]);
  75.   writeln('High-intensity underlined text');
  76.   MonochromeVideo(UnderlinedWhiteOnBlack, [Blink, HighIntensity]);
  77.   writeln('Blinking high-intensity underlined text');
  78.   writeln;
  79.   MonochromeVideo(WhiteOnBlack, []);
  80.   writeln('The following line is black-on-black (invisible):');
  81.   MonochromeVideo(BlackOnBlack, []);
  82.   writeln('Black invisible text');
  83.   MonochromeVideo(WhiteOnBlack, []);
  84.   writeln('Tests complete.')
  85. end.
  86. (**)
  87. ack, []);
  88.   writeln('Black invisible text');
  89.   MonochromeVideo(WhiteOnBlack, []);
  90.   writeln('Tests c