home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / FST_SCR2.ZIP / FST_SCR2.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  23.0 KB  |  473 lines
  1. (****************************************************************************)
  2. (*                                                                          *)
  3. (*   SCREEN.PAS - Copyright 1985 Ridgely C. Evers - No Rights Reserved      *)
  4. (*                Attendant file: SCREEN.SCR                                *)
  5. (*                                                                          *)
  6. (*   This program is designed to produce and maintain screen image files    *)
  7. (*   for use with TURBO Pascal and other languages that can directly access *)
  8. (*   the Video buffer for either the monochrome or color display cards.     *)
  9. (*   The program works directly with the video cards (Page 0 only on color  *)
  10. (*   systems, although it would be simple to adapt it to use the other      *)
  11. (*   pages as well).                                                        *)
  12. (*                                                                          *)
  13. (*   It works with two types of images, either "2K"  or "4K" in size.       *)
  14. (*   Both are full screen images, but the 4K images consist of both the     *)
  15. (*   character and attribute values, while the 2K images are made up of     *)
  16. (*   character values only.                                                 *)
  17. (*   Where possible, I recommend that you work with 4K images, since the    *)
  18. (*   programming requirements are so much simpler, and you have complete    *)
  19. (*   control over individual screen attributes such as color, intensity,    *)
  20. (*   underlining, reverse video, and blink.  The only reason to use 2K      *)
  21. (*   images is if disk space is at a real premium.                          *)
  22. (*   Programming techniques within TURBO for loading the screen images      *)
  23. (*   may be found within the program below.  Generally, however, the        *)
  24. (*   recommended method is as follows:                                      *)
  25. (*                                                                          *)
  26. (*        1. You will need a TYPE statement to declare a screen array:      *)
  27. (*            =>  TYPE  ScrnData = Array [0..4095] of Byte;                 *)
  28. (*                                                                          *)
  29. (*        2. Set up a variable for each display your program will use:      *)
  30. (*            =>  VAR   MonoBuf : ScrnData ABSOLUTE $B000:000 {monochrome}  *)
  31. (*                      ColrBuf : ScrnData ABSOLUTE $B800:000 {color}       *)
  32. (*                                                                          *)
  33. (*        3. Set up a variable for the screen image file itself, and        *)
  34. (*           a variable to hold the screen images from the file:            *)
  35. (*            =>  VAR   FileVar : File of ScrnData                          *)
  36. (*                      Screen  : ScrnData                                  *)
  37. (*                                                                          *)
  38. (*        4. Determine which display you are using, if you will be using    *)
  39. (*           more than one, using the Intr procedure and an integer         *)
  40. (*           variable.  This program uses the variable "Card" for this      *)
  41. (*           purpose, and uses the procedure "Get_Display" to set Card      *)
  42. (*           to the appropriate value ($B000 for the monochrome display,    *)
  43. (*           $B800 for color).  If you will be using only one display,      *)
  44. (*           the process is simpler, since you can eliminate the need       *)
  45. (*           for this step, but doing so will mean that your program will   *)
  46. (*           not run on systems with the other type of display.  Since      *)
  47. (*           very little overhead is involved in adding the flexibility     *)
  48. (*           to use both display types.                                     *)
  49. (*                                                                          *)
  50. (*        5. Records within the file are numbered starting with 0.  To      *)
  51. (*           call up a specific screen, use the following procedure:        *)
  52. (*             =>  Seek (FileVar,{screen number you want});                 *)
  53. (*                 Read (FileVar,Screen);                                   *)
  54. (*                 If Card = $B000                                          *)
  55. (*                    Then MonoBuf := Screen                                *)
  56. (*                    Else ColrBuf := Screen;                               *)
  57. (*                                                                          *)
  58. (*   That's all there is to it!  Once you have tried this, you will find    *)
  59. (*   that you won't ever be happy with any other kind of screen interface,  *)
  60. (*   and your users will not only be stunned, they'll be grateful.          *)
  61. (*                                                                          *)
  62. (*   Use of the program is quite straightforward.  When you call up the     *)
  63. (*   program, it will first display its help screen (which is in fact a     *)
  64. (*   screen image created with this program).  Press F7 to begin.           *)
  65. (*   You will be presented with a blank screen.  You may then "paint"       *)
  66. (*   your screen using the full IBM character set (use the Alt key with     *)
  67. (*   the number pad to enter characters 128..255).  The Function keys,      *)
  68. (*   as well as several of the Alt+Alpha keys, control attributes, file     *)
  69. (*   saving and loading, and insert/delete functions.  The cursor keys      *)
  70. (*   move you around on the screen.  At any time, you can call up the       *)
  71. (*   Help screen by pressing F7.                                            *)
  72. (*                                                                          *)
  73. (*   Note: when you call up Help, the bottom of the screen will show        *)
  74. (*         you several things.  On the left side, it will show you          *)
  75. (*         where you are (Col/Row), and what character/attribute            *)
  76. (*         is at the cursor position.  On the right side, it will           *)
  77. (*         show you the "F1" value.  This is the character/attribute        *)
  78. (*         that you will get when you press the F1 key, which is the        *)
  79. (*         repeat function.  You can repeat in any direction (up/down/      *)
  80. (*         left/right) by using F1 in conjunction with the Ctrl, Shift,     *)
  81. (*         and Alt keys.  This is particularly valuable for drawing         *)
  82. (*         boxes and borders using the Extended Character set (128..255).   *)
  83. (*                                                                          *)
  84. (*   Note for super-zoombo use:  you can speed things up even more, at      *)
  85. (*   the expense of memory, by loading all of your screen images into       *)
  86. (*   an array of ScrnData.  For example, if your program has 7 screens,     *)
  87. (*   create a variable array as follows:                                    *)
  88. (*       =>  VAR  ScreenArray : Array [0..6] of ScrnData;                   *)
  89. (*                                                                          *)
  90. (*   At the beginning of your program, read the entire screen image         *)
  91. (*   file into this array.  Then, when you want to fire an image to the     *)
  92. (*   screen, use the following code:                                        *)
  93. (*       =>  If Card = $B000                                                *)
  94. (*              Then MonoBuf := ScreenArray[{# of screen image}]            *)
  95. (*              Else ColrBuf := ScreenArray[{# of screen image}];           *)
  96. (*                                                                          *)
  97. (*   For those of you who want to use 2K images, see the code below for     *)
  98. (*   saving and loading 2K images.                                          *)
  99. (*                                                                          *)
  100. (*   Play with the program.  The best way to learn it is to use it.  I      *)
  101. (*   welcome your comments and suggestions as to how to improve this        *)
  102. (*   program in any way.  Please leave them on the TechMail BBS, to my      *)
  103. (*   attention.                                                             *)
  104. (*                                                                          *)
  105. (****************************************************************************)
  106.  
  107. TYPE
  108.        ScrnData         = Array [0..4095] of Byte;
  109.        SmallScrnData    = Array [0..2047] of Byte;
  110.        RegPack          = Record
  111.                           AX,BX,CX,DX,BP,SI,DI,Flags : Integer;
  112.                           End;
  113.  
  114. VAR
  115.        MonoBuf          : ScrnData Absolute $B000:0000;
  116.        ColrBuf          : ScrnData Absolute $B800:0000;
  117.        SmallScreen      : SmallScrnData;
  118.        SmallFileVar     : File of SmallScrnData;
  119.        Screen, HelpScrn : ScrnData;
  120.        FileVar, HelpFile: File of ScrnData;
  121.        FileName         : String[30];
  122.        RecPack          : RegPack;
  123.        Card,
  124.        i, RecNum,
  125.        CharCode,
  126.        ScanCode,
  127.        CharValue,
  128.        Attribute        : Integer;
  129.        Ch               : Char;
  130.        Row, Col,
  131.        ScrnSub          : Integer;
  132.        Altered, OK,
  133.        LastCol,
  134.        Finished, First  : Boolean;
  135.  
  136.  
  137.  
  138. Procedure Get_Character;
  139. Begin
  140.      RecPack.AX := 0;
  141.      Intr ($16,RecPack);
  142.      With RecPack do begin
  143.           CharCode := AX mod 256;
  144.           ScanCode := AX shr 8;
  145.       End {of With};
  146. End {of Procedure Get_Character};
  147.  
  148. Procedure Check (VAR OK_To_Quit : Boolean);
  149. Begin
  150.      OK_To_Quit := True;
  151.      If Altered Then Begin
  152.         GoToXY (1,25); ClrEol; Write ('Screen NOT Saved!  Proceed? (Y/N) ');
  153.         Repeat
  154.            Get_Character; If CharCode > 90 Then CharCode := CharCode - 32;
  155.         Until Chr(CharCode) in ['N','Y'];
  156.         If Chr(CharCode) = 'N' Then OK_To_Quit := False;
  157.       End;
  158. End;
  159.  
  160. Procedure Give_Help;
  161. Begin
  162.      If Card = $B000
  163.         Then MonoBuf := HelpScrn
  164.         Else ColrBuf := HelpScrn;
  165.      LowVideo;
  166.      If First Then Begin
  167.         TextColor (9); GoToXY (1,24); ClrEol; GoToXY (1,25); ClrEol;
  168.         GoToXY (32,25);
  169.         Write ('Press F7 to Start'); TextColor (7);
  170.         For i := 0 to 3999 do Screen[i] := 0;
  171.       End
  172.      Else Begin
  173.         GoToXY (14,25); Write (Col:2);
  174.         GoToXY (22,25); Write (Row:2);
  175.         GoToXY (31,25); Write (Screen[ScrnSub]:3);
  176.         GoToXY (35,25); Write (Chr(Screen[ScrnSub]));
  177.         GoToXY (43,25); Write (Screen[ScrnSub+1]:3);
  178.         GoToXY (65,25); Write (CharValue:3);
  179.         GoToXY (69,25); Write (Chr(CharValue));
  180.         GoToXY (77,25); Write (Attribute:3);
  181.         GoToXY (1,24);
  182.         If Card = $B000
  183.            Then Begin
  184.               MonoBuf[3931] := Screen[ScrnSub+1];
  185.               MonoBuf[3999] := Attribute;
  186.             End
  187.            Else Begin
  188.               ColrBuf[3931] := Screen[ScrnSub+1];
  189.               ColrBuf[3999] := Attribute;
  190.             End;
  191.       End;
  192.      Repeat Get_Character Until ScanCode = 65;
  193.      If Card = $B000
  194.         Then MonoBuf := Screen
  195.         Else ColrBuf := Screen;
  196. End {of Give_Help};
  197.  
  198. Procedure Get_Display;
  199. Begin
  200.      Intr ($11,RecPack);
  201.      If RecPack.AX AND 48 = 48
  202.         Then Card := $B000
  203.         Else Card := $B800;
  204. End {of Procedure Get_Display};
  205.  
  206.  
  207. Begin
  208.      LowVideo; ClrScr; Finished := False; Row := 1; Col := 1;
  209.      Attribute := 7; CharValue := 32;
  210.      Assign (HelpFile,'SCREEN.SCR'); ReSet (HelpFile);
  211.      Seek (HelpFile,0); Read (HelpFile,HelpScrn);
  212.      Close (HelpFile);
  213.  
  214.      Get_Display;
  215.      First := True; Give_Help; First := False; Altered := False;
  216.  
  217.      While NOT Finished do Begin
  218.         If Col = 81 Then Begin
  219.            LastCol := True; Col := 80;
  220.          End
  221.         Else LastCol := False;
  222.         GoToXY (Col,Row); Get_Character;
  223.         If Card = $B000
  224.            Then Screen := MonoBuf
  225.            Else Screen := ColrBuf;
  226.         ScrnSub := ((Row-1)*160) + ((Col-1)*2);
  227.  
  228.         If CharCode = 0 Then Begin  {to process Extended Code};
  229.  
  230.            Case ScanCode of
  231.                 15:  Begin {to Tab back}
  232.                      Col := ((Col-8) div 8) * 8;
  233.                      If Col < 1 Then Col := 1;
  234.                      End {of Shift Tab};
  235.                 18:  Begin                             {Attribute to EOL}
  236.                      i := ScrnSub;
  237.                      While i < Row*160 do begin
  238.                         If Card = $B000
  239.                            Then MonoBuf[i+1] := Attribute
  240.                            Else ColrBuf[i+1] := Attribute;
  241.                         i := i + 2;
  242.                       End;
  243.                      End;
  244.                 23:  InsLine;                          {Insert}
  245.                 32:  DelLine;                          {Delete}
  246.                 38:  Begin                             {Attribute Whole Line}
  247.                      i := (Row-1)*160;
  248.                      While i < Row*160 do begin
  249.                         If Card = $B000
  250.                            Then MonoBuf[i+1] := Attribute
  251.                            Else ColrBuf[i+1] := Attribute;
  252.                         i := i + 2;
  253.                       End;
  254.                      End;
  255.                 46:  ClrScr;                           {Clear Screen}
  256.  
  257.       59,84,94,104:  Begin {to repeat last character}
  258.                      If ScanCode = 84 Then Col := Col - 2
  259.                      Else If ScanCode = 94 Then Begin
  260.                         Row := Row - 1; If NOT LastCol Then Col := Col - 1;
  261.                       End
  262.                      Else If ScanCode = 104 Then Begin
  263.                         Row := Row + 1; If NOT LastCol Then Col := Col - 1;
  264.                       End;
  265.                      If Col < 1 Then Col := 1 Else
  266.                      If Col > 80 Then Col := 80 Else
  267.                      If Row < 1 Then Row := 1 Else
  268.                      If Row > 25 Then Row := 25;
  269.                      ScrnSub := ((Row-1)*160) + ((Col-1)*2);
  270.                      If Card = $B000 Then Begin
  271.                         MonoBuf[ScrnSub]   := CharValue;
  272.                         MonoBuf[ScrnSub+1] := Attribute;
  273.                       End
  274.                      Else Begin
  275.                         ColrBuf[ScrnSub]   := CharValue;
  276.                         ColrBuf[ScrnSub+1] := Attribute;
  277.                       End;
  278.                      Col := Col + 1; If Col > 81 Then Col := 81;
  279.                      End {of Repeat last character};
  280.  
  281.                 60:  Attribute := Attribute xor 8;   {toggle intensity}
  282.                 61:  Attribute := Attribute xor 119; {toggle reverse}
  283.                 62:  Attribute := Attribute xor 128; {toggle blink}
  284.                 63:  Attribute := Attribute xor 6;   {toggle underline}
  285.                 65:  Give_Help;
  286.  
  287.                 66:  Begin {to load a 4K file}
  288.                      Check (OK);
  289.                      If OK Then Begin
  290.                         GoToXY (1,25); ClrEol; Write ('4K FileName to Load from: ');
  291.                         Read (FileName); Assign (FileVar,FileName);
  292.                         {$I-}
  293.                         ReSet (FileVar);
  294.                         If IOResult <> 0
  295.                            Then Begin
  296.                                 Write (^G,'  Can''t find file!');
  297.                                 Read (Kbd,Ch);
  298.                             End {of Then}
  299.                            Else Begin
  300.                               Write ('   Record Number [0..',
  301.                                          FileSize(FileVar)-1,']: ');
  302.                               Read (RecNum);
  303.                               Seek (FileVar,RecNum); Read (FileVar,Screen);
  304.                               If IOResult <> 0
  305.                                  Then Write (^G,'   Read Error!')
  306.                                  Else Altered := False;
  307.                               Close (FileVar);
  308.                             End {of Else};
  309.                         {$I+}
  310.                       End {of If OK};
  311.                      If Card = $B000
  312.                         Then MonoBuf := Screen
  313.                         Else ColrBuf := Screen;
  314.                      End {of Load};
  315.  
  316.                 67:  Begin {to save to a 4K file}
  317.                      GoToXY (1,25); ClrEol; Write ('4K FileName for Saving: ');
  318.                      Read (FileName); Assign (FileVar,FileName);
  319.                      {$I-}
  320.                      ReSet (FileVar);
  321.                      If IOResult <> 0
  322.                         Then Begin
  323.                            Write (^G,'   Can''t Find File!  Create? [Y/N] ');
  324.                            Repeat Read (KBD,Ch) Until UpCase (Ch) in ['Y','N'];
  325.                            If UpCase (Ch) = 'Y'
  326.                               Then ReWrite (FileVar)
  327.                               Else FileName := '';
  328.                          End {of If IOResult is a bust};
  329.                      {$I+}
  330.                      If FileName <> '' Then Begin
  331.                         GoToXY (1,25); ClrEol;
  332.                         Write ('   Record Number [0..',
  333.                                    FileSize(FileVar),']: ');
  334.                         Repeat
  335.                            Read (RecNum)
  336.                         Until RecNum <= FileSize(FileVar);
  337.                         Seek (FileVar,RecNum);
  338.                         Write (FileVar,Screen);
  339.                         Close (FileVar);
  340.                         Altered := False;
  341.                       End {of ok to Save};
  342.                      If Card = $B000
  343.                         Then MonoBuf := Screen
  344.                         Else ColrBuf := Screen;
  345.                      End {of Save};
  346.  
  347.                 68:  Begin
  348.                      Check (OK);
  349.                      If OK Then Finished := True;
  350.                      If Card = $B000
  351.                         Then MonoBuf := Screen
  352.                         Else ColrBuf := Screen;
  353.                      End;
  354.  
  355.                 71:  Col := 1;                         {Home}
  356.                 72:  If Row > 1 Then Row := Row - 1;   {Up Arrow}
  357.                 73:  Row := 1;                         {PgUp}
  358.                 75:  If Col > 1 Then Col := Col - 1;   {Left Arrow}
  359.                 77:  If Col < 80 Then Col := Col + 1;  {Right Arrow}
  360.                 79:  Col := 80;                        {End}
  361.                 80:  If Row < 25 Then Row := Row + 1;  {Down Arrow}
  362.                 81:  Row := 25;                        {PgDn}
  363.  
  364.                 82:  Begin                             {Ins char}
  365.                      For i := (Row*160)-2 downto (ScrnSub+2) do If Card = $B000
  366.                         Then MonoBuf[i] := MonoBuf[i-2]
  367.                         Else ColrBuf[i] := ColrBuf[i-2];
  368.                      If Card = $B000
  369.                         Then MonoBuf[ScrnSub] := 32
  370.                         Else ColrBuf[ScrnSub] := 32;
  371.                      End {of Ins Character};
  372.  
  373.                 83:  Begin                             {Del char}
  374.                      For i := ScrnSub to (Row*160)-2 do If Card = $B000
  375.                         Then MonoBuf[i] := MonoBuf[i+2]
  376.                         Else ColrBuf[i] := ColrBuf[i+2];
  377.                      If Card = $B000
  378.                         Then MonoBuf[(Row*160)-2] := 32
  379.                         Else ColrBuf[(Row*160)-2] := 32;
  380.                      End {of Del Character};
  381.  
  382.                111:  Begin {to load a 2K file}
  383.                      Check (OK);
  384.                      If OK Then Begin
  385.                         GoToXY (1,25); ClrEol; Write ('2K FileName to Load from: ');
  386.                         Read (FileName); Assign (SmallFileVar,FileName);
  387.                         {$I-}
  388.                         ReSet (SmallFileVar);
  389.                         If IOResult <> 0
  390.                            Then Begin
  391.                                 Write (^G,'  Can''t find file!');
  392.                                 Read (Kbd,Ch);
  393.                             End {of Then}
  394.                            Else Begin
  395.                               Write ('   Record Number [0..',
  396.                                          FileSize(SmallFileVar)-1,']: ');
  397.                               Read (RecNum);
  398.                               Seek (SmallFileVar,RecNum);
  399.                               Read (SmallFileVar,SmallScreen);
  400.                               If IOResult <> 0
  401.                                  Then Write (^G,'   Read Error!')
  402.                                  Else Altered := False;
  403.                               Close (SmallFileVar);
  404.                             End {of Else};
  405.                         {$I+}
  406.                       End {of If OK};
  407.                      LowVideo; ClrScr; Altered := False;
  408.                      For i := 0 to 2047 do If Card = $B000
  409.                         Then MonoBuf[i*2] := SmallScreen[i]
  410.                         Else ColrBuf[i*2] := SmallScreen[i];
  411.                      End {of Load};
  412.  
  413.                112:  Begin {to save to a 2K file}
  414.                      GoToXY (1,25); ClrEol; Write ('2K FileName for Saving: ');
  415.                      Read (FileName); Assign (SmallFileVar,FileName);
  416.                      {$I-}
  417.                      ReSet (SmallFileVar);
  418.                      If IOResult <> 0
  419.                         Then Begin
  420.                            Write (^G,'   Can''t Find File!  Create? [Y/N] ');
  421.                            Repeat Read (KBD,Ch) Until UpCase (Ch) in ['Y','N'];
  422.                            If UpCase (Ch) = 'Y'
  423.                               Then ReWrite (SmallFileVar)
  424.                               Else FileName := '';
  425.                          End {of If IOResult is a bust};
  426.                      {$I+}
  427.                      If FileName <> '' Then Begin
  428.                         GoToXY (1,25); ClrEol;
  429.                         Write ('   Record Number [0..',
  430.                                    FileSize(SmallFileVar),']: ');
  431.                         Repeat
  432.                            Read (RecNum)
  433.                         Until RecNum <= FileSize(SmallFileVar);
  434.                         Seek (SmallFileVar,RecNum);
  435.                         i := 0;
  436.                         For i := 0 to 2047 do
  437.                            SmallScreen[i] := Screen[i*2];
  438.                         Write (SmallFileVar,SmallScreen);
  439.                         Close (SmallFileVar);
  440.                         Altered := False;
  441.                       End {of ok to Save};
  442.                      If Card = $B000
  443.                         Then MonoBuf := Screen
  444.                         Else ColrBuf := Screen;
  445.                      End {of Save};
  446.             End {of Case ScanCode};
  447.  
  448.          End {of If CharCode = 0}
  449.  
  450.         Else {if CharCode <> 0 Then} Begin
  451.            If (CharCode=9) And (ScanCode=15) Then {Real Tab}
  452.               Begin {to Tab over}
  453.                  Col := ((Col+8) div 8) * 8;
  454.                  If Col > 80 Then Col := 80;
  455.             End {of Real Tab}
  456.            Else Begin
  457.               If Card = $B000 Then Begin
  458.                  MonoBuf[ScrnSub]   := CharCode;
  459.                  MonoBuf[ScrnSub+1] := Attribute;
  460.                End
  461.               Else Begin
  462.                  ColrBuf[ScrnSub]   := CharCode;
  463.                  ColrBuf[ScrnSub+1] := Attribute;
  464.                End;
  465.               CharValue := CharCode; Altered := True;
  466.             End;
  467.            If Col < 81 Then Col := Col + 1;
  468.          End {of Else};
  469.       End {of While Not Finished};
  470.       ClrScr;
  471.  
  472. End.
  473.