home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / tptools.zip / FIRSTED.ZIP / EDSCRN1.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-21  |  10KB  |  265 lines
  1. {                          EDSCRN1.PAS
  2.                              ED 4.0
  3.              Copyright (c) 1985, 87 by Borland International, Inc.            }
  4.  
  5. {$I eddirect.inc}
  6.  
  7. unit EdScrn1;
  8.   {-Fast screen writing routines for FirstEd}
  9.  
  10. interface
  11.  
  12. uses
  13.   Dos,                       {DOS calls - standard unit}
  14.   Errors;                    {Runtime error handler}
  15.  
  16. const
  17.   DefNoRows = 25;            {Default number of rows/physical screen}
  18.   DefNoCols = 80;            {Default number of cols/physical screen}
  19.  
  20. type
  21.   CharArray = array[0..80] of Char; {Holds a line about to be written to screen}
  22.  
  23.   ColorType = (              {Screen colors}
  24.                TxtColor,     {Text color}
  25.                BlockColor,   {Block color}
  26.                BordColor,    {Window status lines}
  27.                CmdColor,     {Command line color}
  28.                CursorColor,  {Color for solid block cursor, if activated}
  29.                MnColor,      {Normal menu color}
  30.                MfColor,      {Menu frame color}
  31.                MsColor,      {Selected menu item color}
  32.                MhColor,      {Highlighted selection character in menu}
  33.                BoldColor,    {Color for bold attribute}
  34.                DblColor,     {Color for doublestrike attribute}
  35.                UndColor,     {Color for underscore attribute}
  36.                SupColor,     {Color for superscript attribute}
  37.                SubColor,     {Color for subscript attribute}
  38.                Alt1Color,    {Color for alternate 1 attribute - Compressed}
  39.                Alt2Color     {Color for alternate 2 attribute - Italic}
  40.                );
  41.  
  42.   {Stores screen attributes}
  43.   AttributeArray = array[ColorType] of Byte;
  44.  
  45. var
  46.   PhyScrCols : Integer;      {Columns per screen row}
  47.   CtrlAttr : Byte;           {Attribute used to display control characters}
  48.   Tline : CharArray;         {Line of text to write to screen}
  49.   Aline : CharArray;         {Line of attributes to write to screen}
  50.   CursorType : Word;         {Scan lines for normal blinking cursor}
  51.   BigCursor : Word;          {Scan lines for "fat" cursor used in insert mode}
  52.   LogScrRows : Integer;      {No. lines/logical screen}
  53.   LogTopScr : Integer;       {Physical line no. for logical line #1}
  54.   PromptRow : Integer;       {Physical line for signals, etc.}
  55.   ScreenAttr : AttributeArray; {Currently selected attributes}
  56.  
  57. procedure EdFastWrite(St : string; Row, Col, Attr : Integer);
  58.   {-Writes St at Row,Col in Attr (video attribute) without snow}
  59.  
  60. procedure EdChangeAttribute(Number, Row, Col, Attr : Integer);
  61.   {-Changes Number video attributes to Attr starting at Row,Col}
  62.  
  63. procedure EdMoveToScreen(var Source, Dest; Length : Integer);
  64.   {-Moves Length words from Source to Dest (video memory) without snow}
  65.  
  66. procedure EdMoveFromScreen(var Source, Dest; Length : Integer);
  67.   {-Moves Length words from Source (video memory) to Dest without snow}
  68.  
  69. procedure EdWrline(Row : Integer);
  70.   {-General purpose text write - no character translation}
  71.  
  72. procedure EdWrlineCtrl(Row : Integer);
  73.   {-General purpose text write - ctrl chars translated}
  74.  
  75. procedure EdSetCursor(ScanLines : Word);
  76.   {-Change the scan lines of the hardware cursor}
  77.  
  78. procedure EdRestoreScreenMode;
  79.   {-Clean up screen upon exit}
  80.  
  81.   {==========================================================================}
  82.  
  83. implementation
  84.  
  85. type
  86.   TAarray = array[0..160] of Char; {Combined line of char and attr for screen}
  87.  
  88. const
  89.  
  90.   {Marks start of SCREEN INSTALLATION AREA}
  91.   ScreenIDstring : string[24] = 'SCREEN INSTALLATION AREA';
  92.  
  93.   {Colors changeable within FirstEd}
  94.   MonoAttr : AttributeArray = (
  95.                                $07, {TxtColor}
  96.                                $0F, {BlockColor}
  97.                                $70, {BordColor}
  98.                                $07, {CmdColor}
  99.                                $70, {CursorColor}
  100.                                $07, {MnColor}
  101.                                $0F, {MfColor}
  102.                                $70, {MsColor}
  103.                                $0F, {MhColor}
  104.                                $0F, {BoldColor}
  105.                                $0F, {DblColor}
  106.                                $01, {UndColor}
  107.                                $0F, {SupColor}
  108.                                $0F, {SubColor}
  109.                                $0F, {Alt1Color}
  110.                                $0F {Alt2Color}
  111.                                );
  112.  
  113.   ColorAttr : AttributeArray = (
  114.                                 $1E, {TxtColor}
  115.                                 $17, {BlockColor}
  116.                                 $38, {BordColor}
  117.                                 $0F, {CmdColor}
  118.                                 $4A, {CursorColor}
  119.                                 $70, {MnColor}
  120.                                 $78, {MfColor}
  121.                                 $1F, {MsColor}
  122.                                 $71, {MhColor}
  123.                                 $1F, {BoldColor}
  124.                                 $14, {DblColor}
  125.                                 $7F, {UndColor}
  126.                                 $15, {SupColor}
  127.                                 $16, {SubColor}
  128.                                 $1D, {Alt1Color}
  129.                                 $1A {Alt2Color}
  130.                                 );
  131.  
  132.   {Default modes - shared by all windows}
  133.   GoodColorCard : Boolean = False; {False to remove snow on color card}
  134.  
  135. var
  136.   ScreenAdr : Word;          {Base address of video memory}
  137.   InitScreenMode : Byte;     {The video mode on entry to program}
  138.   InitRetraceMode : Boolean; {Set if wait for retrace is needed}
  139.   EgaPresent : Boolean;      {True if EGA card selected}
  140.   RetraceMode : Boolean;     {Check for snow on color cards?}
  141.   PhyScrRows : Integer;      {No. lines/physical screen}
  142.  
  143.   {$L EDSCRN1}
  144.  
  145.   procedure EdFastWrite(St : string; Row, Col, Attr : Integer); external;
  146.   procedure EdChangeAttribute(Number, Row, Col, Attr : Integer); external;
  147.   procedure EdMoveToScreen(var Source, Dest; Length : Integer); external;
  148.   procedure EdMoveFromScreen(var Source, Dest; Length : Integer); external;
  149.   procedure EdSetCursor(ScanLines : Word); external;
  150.   procedure EdMergeTA(var Sbuf); external;
  151.   procedure EdMergeTActrl(var Sbuf); external;
  152.  
  153.   procedure EdWrline(Row : Integer);
  154.     {-General purpose text write - no character translation}
  155.   var
  156.     Sbuf : TAarray;
  157.  
  158.   begin                      {EdWrline}
  159.     {Merge text and attribute lines}
  160.     EdMergeTA(Sbuf);
  161.     EdMoveToScreen(Sbuf, Mem[ScreenAdr: (PhyScrCols shl 1)*Pred(Row)], PhyScrCols);
  162.   end;                       {EdWrline}
  163.  
  164.   procedure EdWrlineCtrl(Row : Integer);
  165.     {-General purpose text write - ctrl chars translated}
  166.   var
  167.     Sbuf : TAarray;
  168.  
  169.   begin                      {EdWrline}
  170.     {Merge text and attribute lines, filtering control characters}
  171.     EdMergeTActrl(Sbuf);
  172.     EdMoveToScreen(Sbuf, Mem[ScreenAdr: (PhyScrCols shl 1)*Pred(Row)], PhyScrCols);
  173.   end;                       {EdWrline}
  174.  
  175.   procedure EdRestoreScreenMode;
  176.     {-Clean up screen upon exit}
  177.   var
  178.     regs : registers;
  179.  
  180.   begin                      {EdRestoreScreenMode}
  181.     {Restore the cursor to original scan lines}
  182.     EdSetCursor(CursorType);
  183.     {Restore the screen mode - also clears the screen}
  184.     with regs do begin
  185.       Ah := 0;
  186.       Al := InitScreenMode;
  187.       intr($10, regs);
  188.     end;
  189.   end;                       {EdRestoreScreenMode}
  190.  
  191.   {***}
  192.   procedure EdGetScreenMode;
  193.     {-determine screen address and colors}
  194.   var
  195.     regs : registers;
  196.  
  197.     function EdEgaPresent : Boolean;
  198.       {-Return True if an EGA card is installed and selected}
  199.     var
  200.       regs : registers;
  201.  
  202.     begin                    {EdEgaPresent}
  203.       with regs do begin
  204.         Ah := $12;
  205.         Bl := $10;
  206.         Cx := $FFFF;
  207.         intr($10, regs);
  208.         EdEgaPresent := (Cx <> $FFFF);
  209.       end;
  210.     end;                     {EdEgaPresent}
  211.  
  212.   begin                      {EdGetScreenMode}
  213.  
  214.     PhyScrCols := DefNoCols; {Number of columns on the screen}
  215.     PromptRow := 1;          {Command Line is line 1 of screen}
  216.     LogTopScr := 2;          {Text windows don't use line 1 of screen}
  217.     PhyScrRows := DefNoRows;
  218.     LogScrRows := Succ(PhyScrRows-LogTopScr);
  219.  
  220.     with regs do begin
  221.       {Get current screen mode}
  222.       ax := $0F00;
  223.       intr($10, regs);
  224.       InitScreenMode := Al;
  225.  
  226.       {Set screen mode to appropriate 80 column mode}
  227.       Ah := 0;
  228.       case InitScreenMode of
  229.         0 : Al := 2;         {Switch from BW40 to BW80}
  230.         1 : Al := 3;         {Switch from CO40 to CO80}
  231.       else
  232.         Al := InitScreenMode; {Assure color burst correct}
  233.       end;
  234.       intr($10, regs);
  235.     end;
  236.  
  237.     InitRetraceMode := (InitScreenMode <> 7);
  238.     EgaPresent := EdEgaPresent;
  239.  
  240.     if InitRetraceMode then begin
  241.       {Color card}
  242.       ScreenAdr := $B800;
  243.       ScreenAttr := ColorAttr;
  244.       CursorType := $0607;
  245.       BigCursor := $0507;
  246.       if EgaPresent then
  247.         GoodColorCard := True;
  248.     end else begin
  249.       ScreenAdr := $B000;
  250.       ScreenAttr := MonoAttr;
  251.       CursorType := $0B0C;
  252.       BigCursor := $090C;
  253.     end;
  254.  
  255.     {Attribute used to mark control characters}
  256.     CtrlAttr := ScreenAttr[BlockColor];
  257.  
  258.     {Don't slow down for good color cards}
  259.     RetraceMode := InitRetraceMode and not(GoodColorCard);
  260.   end;                       {EdGetScreenMode}
  261.  
  262. begin
  263.   EdGetScreenMode;
  264. end.
  265.