home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURBOGEN.ZIP / PIBSCREN.INC < prev    next >
Encoding:
Text File  |  1987-09-25  |  39.7 KB  |  910 lines
  1. (*-----------------------------------------------------------------*)
  2. (*       PIBSCREN.PAS --- Screen Handling Routines for Turbo Pascal*)
  3. (*-----------------------------------------------------------------*)
  4. (*                                                                 *)
  5. (*  Author:  Philip R. Burns                                       *)
  6. (*                                                                 *)
  7. (*  Date:    Version 1.0: January, 1985 (Part of PibMenus)         *)
  8. (*           Version 1.1: March, 1985   (Part of PibMenus)         *)
  9. (*           Version 1.2: May, 1985     (Part of PibMenus)         *)
  10. (*           Version 2.0: June, 1985    (Split from PibMenus)      *)
  11. (*           Version 3.0: October, 1985                            *)
  12. (*           Version 3.1: October, 1985                            *)
  13. (*           Version 3.2: November, 1985                           *)
  14. (*                                                                 *)
  15. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.     *)
  16. (*           Note:  I have checked these on Zenith 151s under      *)
  17. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.         *)
  18. (*                                                                 *)
  19. (*  History: These routines provide a simple windowing facility for*)
  20. (*           Turbo Pascal as well as routines for direct access to *)
  21. (*           screen memory area.                                   *)
  22. (*                                                                 *)
  23. (*           The windowing facility provides windows similar to tho*)
  24. (*           implemented in QMODEM by John Friel III.              *)
  25. (*                                                                 *)
  26. (*           Version 1.0 of these routines formed part of the      *)
  27. (*           PIBMENUS.PAS include file.  These routines were split *)
  28. (*           into a separate PIBSCREN.PAS file at version 2.0.     *)
  29. (*                                                                 *)
  30. (*           Starting with version 3.2, PibScren uses a (hopefully)*)
  31. (*           version-independent method for ascertaining the size  *)
  32. (*           of the current window.  The method relies on the 1-pas*)
  33. (*           construction of Turbo, so that the standard built-in  *)
  34. (*           procedure WINDOW can be replaced by one defined here, *)
  35. (*           the built-in version then referred to by the name     *)
  36. (*           TurboWindow.                                          *)
  37. (*                                                                 *)
  38. (*           Suggestions for improvements or corrections are welcom*)
  39. (*           Please leave messages on Gene Plantz's BBS(312)8824145*)
  40. (*           or Ron Fox's BBS (312) 940 6496.                     *)
  41. (*                                                                *)
  42. (*           If you use this code in your own programs, please be *)
  43. (*           and give all of us credit.                           *)
  44. (*                                                                *)
  45. (*----------------------------------------------------------------*)
  46. (*                                                                *)
  47. (*  Needs:  These routines need the include files MINMAX.PAS,     *)
  48. (*          GLOBTYPE.PAS, ASCII.PAS, and INT24.PAS.               *)
  49. (*                                                                *)
  50. (*----------------------------------------------------------------*)
  51. (*                                                                *)
  52. (*   Note that code for stacked windows is available here. You may*)
  53. (*  want to modify this to use compile-time window spaces,or remove*)
  54. (*   the current push-down stack structure.                       *)
  55. (*                                                                *)
  56. (*----------------------------------------------------------------*)
  57.  
  58. (*----------------------------------------------------------------*)
  59. (*           Constants, Types, and Variables for Screen Access    *)
  60. (*----------------------------------------------------------------*)
  61.  
  62. CONST
  63.    Color_Screen_Address   = $B800;   (* Address of color screen   *)
  64.    Mono_Screen_Address    = $B000;   (* Address of mono screen    *)
  65.    Screen_Length          = 4000;    (* 80 x 25 x 2 = screen area *)
  66.    Max_Saved_Screen       = 1;       (* Maximum no. saved screens *)
  67.  
  68. TYPE
  69.                                      (* A screen image            *)
  70.  
  71.    Screen_Type       = ARRAY[ 1 .. Screen_Length ] OF BYTE;
  72.  
  73.    Screen_Ptr        = ^Screen_Image_Type;
  74.  
  75.    Screen_Image_Type = RECORD
  76.                           Screen_Image: Screen_Type;
  77.                        END;
  78.  
  79.                                               (* Screen stack entries *)
  80.    Saved_Screen_Ptr  = ^Saved_Screen_Type;
  81.  
  82.    Saved_Screen_Type = RECORD
  83.                           Screen_Image  : Screen_Type;
  84.                           Screen_Row    : INTEGER;
  85.                           Screen_Column : INTEGER;
  86.                           Screen_X1     : INTEGER;
  87.                           Screen_Y1     : INTEGER;
  88.                           Screen_X2     : INTEGER;
  89.                           Screen_Y2     : INTEGER;
  90.                        END;
  91.  
  92. VAR
  93.                                               (* Memory-mapped screen area *)
  94.    Actual_Screen        : Screen_Ptr;
  95.                                               (* Saves screen behind menus *)
  96.  
  97.    Saved_Screen         : Saved_Screen_Ptr;
  98.  
  99.                                               (* Stack of saved screens    *)
  100.  
  101.    Saved_Screen_List    : ARRAY[ 1 .. Max_Saved_Screen ] OF Saved_Screen_Ptr;
  102.  
  103. (* STRUCTURED *) CONST
  104.                                               (* Depth of saved screen stack *)
  105.    Current_Saved_Screen : 0 .. Max_Saved_Screen = 0;
  106.  
  107.                                    (* Upper left corner of      *)
  108.                                    (* current TURBO window      *)
  109. CONST
  110.    Upper_Left_Column  : Byte = 1;
  111.    Upper_Left_Row     : Byte = 1;
  112.  
  113.                                    (* Lower right corner of     *)
  114.                                    (* current TURBO window      *)
  115. CONST
  116.    Lower_Right_Column  : Byte = 80;
  117.    Lower_Right_Row     : Byte = 25;
  118.  
  119. (*-----------------------------------------------------------------*)
  120. (*       Turbo_Window --- allow access to built-in WINDOW procedure*)
  121. (*-----------------------------------------------------------------*)
  122.  
  123. PROCEDURE Turbo_Window( X1, Y1, X2, Y2 : INTEGER );
  124.  
  125. (*-----------------------------------------------------------------*)
  126. (*                                                                 *)
  127. (*     Procedure:  Turbo_Window                                    *)
  128. (*                                                                 *)
  129. (*     Purpose:    Allows access to built-in Turbo procedure WINDOW*)
  130. (*                 after Window is re-defined below.               *)
  131. (*                                                                 *)
  132. (*-----------------------------------------------------------------*)
  133.  
  134. BEGIN (* Turbo_Window *)
  135.  
  136.    Window( X1, Y1, X2, Y2 );
  137.  
  138. END   (* Turbo_Window *);
  139.  
  140. (*-----------------------------------------------------------------*)
  141. (*          Window --- Redefines Turbo's built-in WINDOW procedure *)
  142. (*-----------------------------------------------------------------*)
  143.  
  144. PROCEDURE Window( X1, Y1, X2, Y2 : INTEGER );
  145.  
  146. (*-----------------------------------------------------------------*)
  147. (*                                                                 *)
  148. (*     Procedure:  Window                                          *)
  149. (*                                                                 *)
  150. (*     Purpose:    Redefines built-in Turbo procedure WINDOW so tha*)
  151. (*                 we can keep track of window boundaries.         *)
  152. (*                                                                 *)
  153. (*-----------------------------------------------------------------*)
  154.  
  155. BEGIN (* Window *)
  156.  
  157.    Turbo_Window( X1, Y1, X2, Y2 );
  158.  
  159.    Upper_Left_Column  := X1;
  160.    Upper_Left_Row     := Y1;
  161.    Lower_Right_Column := X2;
  162.    Lower_Right_Row    := Y2;
  163.  
  164. END   (* Window *);
  165.  
  166. (*-----------------------------------------------------------------*)
  167. (*    Color_Screen_Active --- Determine if color or mono screen    *)
  168. (*-----------------------------------------------------------------*)
  169.  
  170. FUNCTION Color_Screen_Active : BOOLEAN;
  171.  
  172. (*-----------------------------------------------------------------*)
  173. (*                                                                 *)
  174. (*     Function:   Color_Screen_Active                             *)
  175. (*                                                                 *)
  176. (*     Purpose:    Determines if color or mono screen active       *)
  177. (*                                                                 *)
  178. (*     Calling Sequence:                                           *)
  179. (*                                                                 *)
  180. (*        Color_Active := Color_Screen_Active : BOOLEAN;           *)
  181. (*                                                                 *)
  182. (*           Color_Active --- set to TRUE if the color screen is   *)
  183. (*                            active, FALSE if the mono screen is  *)
  184. (*                            active.                              *)
  185. (*                                                                 *)
  186. (*     Calls:   INTR                                               *)
  187. (*                                                                 *)
  188. (*-----------------------------------------------------------------*)
  189.  
  190. VAR
  191.    Regs : RegPack;
  192.  
  193. BEGIN  (* Color_Screen_Active *)
  194.  
  195.    Regs.Ax := 15 SHL 8;
  196.  
  197.    INTR( $10 , Regs );
  198.  
  199.    Color_Screen_Active := ( Regs.Al <> 7 );
  200.  
  201. End    (* Color_Screen_Active *);
  202.  
  203. (*-----------------------------------------------------------------*)
  204. (*     Current_Video_Mode --- Determine current video mode setting *)
  205. (*-----------------------------------------------------------------*)
  206.  
  207. FUNCTION Current_Video_Mode: INTEGER;
  208.  
  209. (*-----------------------------------------------------------------*)
  210. (*                                                                 *)
  211. (*     Function:   Current_Video_Mode                              *)
  212. (*                                                                 *)
  213. (*     Purpose:    Gets current video mode setting from system     *)
  214. (*                                                                 *)
  215. (*     Calling Sequence:                                           *)
  216. (*                                                                 *)
  217. (*        Current_Mode := Current_Video_Mode : INTEGER;            *)
  218. (*                                                                 *)
  219. (*           Current_Mode --- set to integer representing current  *)
  220. (*                            video mode inherited from system.    *)
  221. (*                                                                 *)
  222. (*     Calls:   INTR                                               *)
  223. (*                                                                 *)
  224. (*-----------------------------------------------------------------*)
  225.  
  226. VAR
  227.    Regs : RegPack;
  228.  
  229. BEGIN  (* Current_Video_Mode *)
  230.  
  231.    Regs.Ax := 15 SHL 8;
  232.  
  233.    INTR( $10 , Regs );
  234.  
  235.    Current_Video_Mode := Regs.Al;
  236.  
  237. End    (* Current_Video_Mode *);
  238.  
  239. (*-----------------------------------------------------------------*)
  240. (*        Get_Screen_Address --- Get address of current screen     *)
  241. (*-----------------------------------------------------------------*)
  242.  
  243. PROCEDURE Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );
  244.  
  245. (*-----------------------------------------------------------------*)
  246. (*                                                                 *)
  247. (*     Procedure:  Get_Screen_Address                              *)
  248. (*                                                                 *)
  249. (*     Purpose:    Gets screen address for current type of display *)
  250. (*                                                                 *)
  251. (*     Calling Sequence:                                           *)
  252. (*                                                                 *)
  253. (*        Get_Screen_Address( Var Actual_Screen : Screen_Ptr );    *)
  254. (*                                                                 *)
  255. (*           Actual_Screen --- pointer whose value receives the    *)
  256. (*                             current screen address.             *)
  257. (*                                                                 *)
  258. (*     Calls:   Color_Screen_Active                                *)
  259. (*              PTR                                                *)
  260. (*                                                                 *)
  261. (*-----------------------------------------------------------------*)
  262.  
  263. BEGIN  (* Get_Screen_Address *)
  264.  
  265.    IF Color_Screen_Active THEN
  266.       Actual_Screen := PTR( Color_Screen_Address , 0 )
  267.    ELSE
  268.       Actual_Screen := PTR( Mono_Screen_Address , 0 );
  269.  
  270. END    (* Get_Screen_Address *);
  271.  
  272. (*-----------------------------------------------------------------*)
  273. (*                Video Display Control Routines                   *)
  274. (*-----------------------------------------------------------------*)
  275. (*                                                                 *)
  276. (*       RvsVideoOn  --- Turn On Reverse Video                     *)
  277. (*       RvsVideoOff --- Turn Off Reverse Video                    *)
  278. (*                                                                 *)
  279. (*-----------------------------------------------------------------*)
  280.  
  281. PROCEDURE RvsVideoOn( Foreground_Color, Background_Color : INTEGER );
  282.  
  283. BEGIN (* RvsVideoOn *)
  284.  
  285.    TextColor     ( Background_color );
  286.    TextBackGround( Foreground_color );
  287.  
  288. END   (* RvsVideoOn *);
  289.  
  290. (*-----------------------------------------------------------------*)
  291.  
  292. PROCEDURE RvsVideoOff( Foreground_Color, Background_Color : INTEGER );
  293.  
  294. BEGIN (* RvsVideoOff *)
  295.  
  296.    TextColor     ( Foreground_color );
  297.    TextBackGround( Background_color );
  298.  
  299. END   (* RvsVideoOff *);
  300.  
  301. (*-----------------------------------------------------------------*)
  302. (*            Upper_Left ---  Upper Position of current window     *)
  303. (*-----------------------------------------------------------------*)
  304.  
  305. PROCEDURE Upper_Left( VAR X1, Y1 : INTEGER );
  306.  
  307. (*-----------------------------------------------------------------*)
  308. (*                                                                 *)
  309. (*     Procedure:   Upper_Left                                     *)
  310. (*                                                                 *)
  311. (*     Purpose:     Returns upper position of current TURBO window *)
  312. (*                                                                 *)
  313. (*     Calling Sequence:                                           *)
  314. (*                                                                 *)
  315. (*        Upper_Left( VAR X1, Y1 : INTEGER );                      *)
  316. (*                                                                 *)
  317. (*           X1   --- returned upper left column                   *)
  318. (*           Y1   --- returned upper left row                      *)
  319. (*                                                                 *)
  320. (*     Calls:   None                                               *)
  321. (*                                                                 *)
  322. (*-----------------------------------------------------------------*)
  323.  
  324. BEGIN  (* Upper_Left *)
  325.  
  326.     Y1 := Upper_Left_Row;          (* get Row *)
  327.     X1 := Upper_Left_Column        (* get Column *)
  328.  
  329. END    (* Upper_Left *);
  330.  
  331.  
  332. (*-----------------------------------------------------------------*)
  333. (*                Set/Reset Text Color Routines                    *)
  334. (*-----------------------------------------------------------------*)
  335. (*                                                                 *)
  336. (*   These routines set and reset the global text foreground and   *)
  337. (*   background colors.                                            *)
  338. (*                                                                 *)
  339. (*-----------------------------------------------------------------*)
  340.  
  341.                    (* Global Text Color Variables *)
  342.  
  343. VAR
  344.    Global_ForeGround_Color : INTEGER;
  345.    Global_BackGround_Color : INTEGER;
  346.  
  347. (*-----------------------------------------------------------------*)
  348. (*  Set_Global_Colors --- Reset global foreground, background cols.*)
  349. (*-----------------------------------------------------------------*)
  350.  
  351. PROCEDURE Set_Global_Colors( ForeGround, BackGround : INTEGER );
  352.  
  353. (*-----------------------------------------------------------------*)
  354. (*                                                                 *)
  355. (*     Procedure:  Set_Global_Colors                               *)
  356. (*                                                                 *)
  357. (*     Purpose:    Sets global text foreground, background colors. *)
  358. (*                                                                 *)
  359. (*     Calling Sequence:                                           *)
  360. (*                                                                 *)
  361. (*        Set_Global_Colors( ForeGround, BackGround : INTEGER );   *)
  362. (*                                                                 *)
  363. (*           ForeGround --- Default foreground color               *)
  364. (*           BackGround --- Default background color               *)
  365. (*                                                                 *)
  366. (*     Calls:   TextColor                                          *)
  367. (*              TextBackGround                                     *)
  368. (*                                                                 *)
  369. (*-----------------------------------------------------------------*)
  370.  
  371. BEGIN  (* Set_Global_Colors *)
  372.  
  373.    Global_ForeGround_Color := ForeGround;
  374.    GLobal_BackGround_Color := BackGround;
  375.  
  376.    TextColor     ( Global_ForeGround_Color );
  377.    TextBackground( Global_BackGround_Color );
  378.  
  379. END    (* Set_Global_Colors *);
  380.  
  381. (*-----------------------------------------------------------------*)
  382. (*Reset_Global_Colors --- Reset global foreground, background cols.*)
  383. (*-----------------------------------------------------------------*)
  384.  
  385. PROCEDURE Reset_Global_Colors;
  386.  
  387. (*-----------------------------------------------------------------*)
  388. (*                                                                 *)
  389. (*     Procedure:  Reset_Global_Colors                             *)
  390. (*                                                                 *)
  391. (*     Purpose:Resets text foreground, background colors to global *)
  392. (*                 defaults.                                       *)
  393. (*                                                                 *)
  394. (*     Calling Sequence:                                           *)
  395. (*                                                                 *)
  396. (*        Reset_Global_Colors;                                     *)
  397. (*                                                                 *)
  398. (*     Calls:   TextColor                                          *)
  399. (*              TextBackGround                                     *)
  400. (*                                                                 *)
  401. (*-----------------------------------------------------------------*)
  402.  
  403. BEGIN  (* Reset_Global_Colors *)
  404.  
  405.    TextColor     ( Global_ForeGround_Color );
  406.    TextBackground( Global_BackGround_Color );
  407.  
  408. END    (* Reset_Global_Colors *);
  409.  
  410. (*-----------------------------------------------------------------*)
  411. (*                 Screen Manipulation Routines                    *)
  412. (*-----------------------------------------------------------------*)
  413. (*                                                                 *)
  414. (*These routines save and restore screen images in support of the  *)
  415. (*windowing facility.  Also, the current screen image can be printed*)
  416. (*and text extracted from the screen memory.                       *)
  417. (*                                                                 *)
  418. (*-----------------------------------------------------------------*)
  419.  
  420. (*-----------------------------------------------------------------*)
  421. (*       Get_Screen_Text_Line --- Extract text from screen image   *)
  422. (*-----------------------------------------------------------------*)
  423.  
  424. PROCEDURE Get_Screen_Text_Line( VAR Text_Line     : AnyStr;
  425.                                     Screen_Line   : INTEGER;
  426.                                     Screen_Column : INTEGER );
  427.  
  428. (*-----------------------------------------------------------------*)
  429. (*                                                                 *)
  430. (*     Procedure:  Get_Screen_Text_Line                            *)
  431. (*                                                                 *)
  432. (*     Purpose:    Extracts text from current screen image         *)
  433. (*                                                                 *)
  434. (*     Calling Sequence:                                           *)
  435. (*                                                                 *)
  436. (*       Get_Screen_Text_Line( Var  Text_Line     : AnyStr;        *)
  437. (*                                  Screen_Line   : INTEGER;       *)
  438. (*                                  Screen_Column : INTEGER );     *)
  439. (*                                                                 *)
  440. (*           Text_Line        --- receives text extracted from scrn*)
  441. (*           Screen_Line      --- line on screen to extract        *)
  442. (*           Screen_Column    --- starting column to extract       *)
  443. (*                                                                 *)
  444. (*     Calls:   None                                               *)
  445. (*                                                                 *)
  446. (*     Remarks:                                                    *)
  447. (*                                                                 *)
  448. (*        Only the text -- not attributes -- from the screen is    *)
  449. (*        returned.                                                *)
  450. (*                                                                 *)
  451. (*-----------------------------------------------------------------*)
  452.  
  453. VAR
  454.    First_Pos  : INTEGER;
  455.    Last_Pos   : INTEGER;
  456.    I          : INTEGER;
  457.  
  458. BEGIN  (* Get_Screen_Text_Line *)
  459.  
  460.    Screen_Line   := Max( Min( Screen_Line   , 25 ) , 1 );
  461.    Screen_Column := Max( Min( Screen_Column , 80 ) , 1 );
  462.  
  463.    Text_Line     := '';
  464.    First_Pos     := ( ( Screen_Line - 1 ) * 80 + Screen_Column ) * 2 - 1;
  465.    Last_Pos      := First_Pos + ( 80 - Screen_Column ) * 2 + 1;
  466.  
  467.    REPEAT
  468.       Text_Line := Text_Line + CHR( Actual_Screen^.Screen_Image[ First_Pos ] );
  469.       First_Pos := First_Pos + 2;
  470.    UNTIL ( First_Pos > Last_Pos );
  471.  
  472. END    (* Get_Screen_Text_Line *);
  473.  
  474. (*-----------------------------------------------------------------*)
  475. (*                Print_Screen --- Print current screen image      *)
  476. (*-----------------------------------------------------------------*)
  477.  
  478. PROCEDURE Print_Screen;
  479.  
  480. (*-----------------------------------------------------------------*)
  481. (*                                                                 *)
  482. (*     Procedure:  Print_Screen                                    *)
  483. (*                                                                 *)
  484. (*     Purpose:    Prints current screen image (memory mapped area)*)
  485. (*                                                                 *)
  486. (*     Calling Sequence:                                           *)
  487. (*                                                                 *)
  488. (*        Print_Screen;                                            *)
  489. (*                                                                 *)
  490. (*     Calls:   None                                               *)
  491. (*                                                                 *)
  492. (*     Remarks:                                                    *)
  493. (*                                                                 *)
  494. (*   Only the text from the screen is printed, not the attributes. *)
  495. (*                                                                 *)
  496. (*-----------------------------------------------------------------*)
  497.  
  498. VAR
  499.    I         : INTEGER;
  500.    Text_Line : AnyStr;
  501.  
  502. BEGIN  (* Print_Screen *)
  503.  
  504.    FOR I := 1 TO 25 DO
  505.       BEGIN
  506.          Get_Screen_Text_Line( Text_Line, I, 1 );
  507.          WRITELN( Lst , Text_Line );
  508.       END;
  509.    Writeln(Lst,chr(12));
  510. END    (* Print_Screen *);
  511.  
  512. (*-----------------------------------------------------------------*)
  513. (*        Write_Screen --- Write current screen image to file      *)
  514. (*-----------------------------------------------------------------*)
  515.  
  516. PROCEDURE Write_Screen( Fname : AnyStr );
  517.  
  518. (*-----------------------------------------------------------------*)
  519. (*                                                                 *)
  520. (*     Procedure:  Write_Screen                                    *)
  521. (*                                                                 *)
  522. (*     Purpose:    Write current screen image (memory mapped area) *)
  523. (*                 a file.                                         *)
  524. (*                                                                 *)
  525. (*     Calling Sequence:                                           *)
  526. (*                                                                 *)
  527. (*        Write_Screen( Fname : AnyStr );                          *)
  528. (*                                                                 *)
  529. (*           Fname --- Name of file to write screen to             *)
  530. (*                                                                 *)
  531. (*     Calls:   None                                               *)
  532. (*                                                                 *)
  533. (*     Remarks:                                                    *)
  534. (*                                                                 *)
  535. (*   Only the text from the screen is written, not the attributes. *)
  536. (*   If the file already exists, then the new screen is appended   *)
  537. (*   to the end of the file.                                       *)
  538. (*                                                                 *)
  539. (*-----------------------------------------------------------------*)
  540.  
  541. VAR
  542.    I         : INTEGER;
  543.    Text_Line : STRING[80];
  544.    F         : TEXT [512];
  545.  
  546. BEGIN  (* Write_Screen *)
  547.  
  548.       (*$I-*)
  549.    ASSIGN( F , Fname );
  550.    RESET ( F );
  551.  
  552.    IF Int24Result = 0 THEN
  553.       BEGIN
  554.          CLOSE( F );
  555.          APPEND( F );
  556.       END
  557.    ELSE
  558.       BEGIN
  559.          CLOSE  ( F );
  560.          REWRITE( F );
  561.       END;
  562.  
  563.    FOR I := 1 TO 25 DO
  564.       BEGIN
  565.          Get_Screen_Text_Line( Text_Line, I, 1 );
  566.          WRITELN( F , Text_Line );
  567.       END;
  568.  
  569.    CLOSE( F );
  570.      (*$I+*)
  571.  
  572. END    (* Write_Screen *);
  573.  
  574. (*-----------------------------------------------------------------*)
  575. (*                WriteSLin --- Write text string to screen        *)
  576. (*-----------------------------------------------------------------*)
  577.  
  578. PROCEDURE WriteSLin( S: AnyStr; Color: INTEGER );
  579.  
  580. (*-----------------------------------------------------------------*)
  581. (*                                                                 *)
  582. (*     Procedure:  WriteSLin                                       *)
  583. (*                                                                 *)
  584. (*Purpose:    Writes text string to current line in screen memory  *)
  585. (*                                                                 *)
  586. (*     Calling Sequence:                                           *)
  587. (*                                                                 *)
  588. (*        WriteSLin( S: AnyStr; Color: INTEGER );                  *)
  589. (*                                                                 *)
  590. (*           S      --- String to be written                       *)
  591. (*           Color  --- Color in which to write string             *)
  592. (*                                                                 *)
  593. (*     Calls:   None                                               *)
  594. (*                                                                 *)
  595. (*-----------------------------------------------------------------*)
  596.  
  597. VAR
  598.    Length_S : INTEGER;
  599.    S_Column : INTEGER;
  600.    S_Row    : INTEGER;
  601.    I        : INTEGER;
  602.    Regs     : RegPack;
  603.  
  604. BEGIN (* WriteSLin *)
  605.  
  606.    Length_S := LENGTH( S );
  607.  
  608.    IF ( NOT Write_Screen_Memory ) THEN
  609.       BEGIN
  610.  
  611.          S_Row := WhereY;
  612.  
  613.          FOR I := 1 TO Length_S DO
  614.             BEGIN
  615.  
  616.                GoToXY( I , S_Row );
  617.  
  618.                Regs.AH := 9;
  619.                Regs.AL := ORD( S[I] );
  620.                Regs.BH := 0;
  621.                Regs.BL := Color;
  622.                Regs.CX := 1;
  623.  
  624.                INTR( $10 , Regs );
  625.  
  626.             END
  627.  
  628.       END
  629.    ELSE
  630.       BEGIN
  631.  
  632.          S_Column := 1;
  633.          S_Row    := ( WhereY - 1 ) * 160;
  634.  
  635.          FOR I := 1 TO Length_S DO
  636.             WITH Actual_Screen^ DO
  637.                BEGIN
  638.                   Screen_Image[ S_Column + S_Row ]     := ORD( COPY( S, I, 1 ) );
  639.                   Screen_Image[ S_Column + S_Row + 1 ] := Color;
  640.                   S_Column := S_Column + 2;
  641.                END;
  642.  
  643.          S_Row := S_Row + 160;
  644.  
  645.          IF S_Row > 3800 THEN
  646.             InsLine;
  647.  
  648.       END;
  649.  
  650. END   (* WriteSLin *);
  651.  
  652. (*-----------------------------------------------------------------*)
  653. (*          WriteSXY --- Write text string to specified row/column *)
  654. (*-----------------------------------------------------------------*)
  655.  
  656. PROCEDURE WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );
  657.  
  658. (*-----------------------------------------------------------------*)
  659. (*                                                                 *)
  660. (*     Procedure:  WriteSXY                                        *)
  661. (*                                                                 *)
  662. (*     Purpose:    Writes text string at specified row and column  *)
  663. (*                 position on screen.                             *)
  664. (*                                                                 *)
  665. (*     Calling Sequence:                                           *)
  666. (*                                                                 *)
  667. (*   WriteSXY( S: AnyStr; X: INTEGER; Y: INTEGER; Color: INTEGER );*)
  668. (*                                                                 *)
  669. (*           S      --- String to be written                       *)
  670. (*           X      --- Column position to write string            *)
  671. (*           Y      --- Column position to write string            *)
  672. (*           Color  --- Color in which to write string             *)
  673. (*                                                                 *)
  674. (*     Calls:   None                                               *)
  675. (*                                                                 *)
  676. (*-----------------------------------------------------------------*)
  677.  
  678. VAR
  679.    Length_S : INTEGER;
  680.    S_Column : INTEGER;
  681.    S_Row    : INTEGER;
  682.    I        : INTEGER;
  683.    S_Pos    : INTEGER;
  684.    Regs     : RegPack;
  685.  
  686. BEGIN (* WriteSXY *)
  687.  
  688.    Length_S := LENGTH( S );
  689.    S_Pos    := 0;
  690.  
  691.    IF ( NOT Write_Screen_Memory ) THEN
  692.       FOR I := 1 TO Length_S DO
  693.          BEGIN
  694.  
  695.             GoToXY( X + I - 1 , Y );
  696.  
  697.             Regs.AH := 9;
  698.             Regs.AL := ORD( S[I] );
  699.             Regs.BH := 0;
  700.             Regs.BL := Color;
  701.             Regs.CX := 1;
  702.  
  703.             INTR( $10 , Regs );
  704.  
  705.          END
  706.    ELSE
  707.       FOR I := 1 TO Length_S DO
  708.          WITH Actual_Screen^ DO
  709.             IF S_Pos < 4001 THEN
  710.                BEGIN
  711.                   S_Pos                     := ( ( Y - 1 ) * 80 + X ) * 2 - 1;
  712.                   Screen_Image[ S_Pos     ] := ORD( COPY( S, I, 1 ) );
  713.                   Screen_Image[ S_Pos + 1 ] := Color;
  714.                   X                         := X + 1;
  715.                END;
  716.  
  717. END   (* WriteSXY *);
  718.  
  719. (*-----------------------------------------------------------------*)
  720. (*  WriteCXY --- Write character to screen  at specified row/column*)
  721. (*-----------------------------------------------------------------*)
  722.  
  723. PROCEDURE WriteCXY( C: CHAR; X: INTEGER; Y: INTEGER; Color: INTEGER );
  724.  
  725. (*-----------------------------------------------------------------*)
  726. (*                                                                 *)
  727. (*     Procedure:  WriteCXY                                        *)
  728. (*                                                                 *)
  729. (*     Purpose:    Writes a character at specified row and column  *)
  730. (*                 position on screen.                             *)
  731. (*                                                                 *)
  732. (*     Calling Sequence:                                           *)
  733. (*                                                                 *)
  734. (*   WriteCXY( C: CHAR; X: INTEGER; Y: INTEGER; Color: INTEGER );  *)
  735. (*                                                                 *)
  736. (*           C      --- Character to be written                    *)
  737. (*           X      --- Column position to write character         *)
  738. (*           Y      --- Column position to write character         *)
  739. (*           Color  --- Color in which to write character          *)
  740. (*                                                                 *)
  741. (*     Calls:   INTR                                               *)
  742. (*                                                                 *)
  743. (*-----------------------------------------------------------------*)
  744.  
  745. VAR
  746.    S_Pos   : INTEGER;
  747.    Regs    : RegPack;
  748.  
  749. BEGIN (* WriteCXY *)
  750.  
  751.    IF ( NOT Write_Screen_Memory ) THEN
  752.       BEGIN
  753.  
  754.          GoToXY( X , Y );
  755.  
  756.          Regs.AH := 9;
  757.          Regs.AL := ORD( C );
  758.          Regs.BH := 0;
  759.          Regs.BL := Color;
  760.          Regs.CX := 1;
  761.  
  762.          INTR( $10 , Regs );
  763.  
  764.       END
  765.    ELSE
  766.       WITH Actual_Screen^ DO
  767.          BEGIN
  768.             S_Pos                     := ( ( Y - 1 ) * 80 + X ) * 2 - 1;
  769.             Screen_Image[ S_Pos     ] := ORD( C );
  770.             Screen_Image[ S_Pos + 1 ] := Color;
  771.          END;
  772.  
  773. END   (* WriteCXY *);
  774.  
  775. (*-----------------------------------------------------------------*)
  776. (*           Save_Screen --- Save current screen image             *)
  777. (*-----------------------------------------------------------------*)
  778.  
  779. PROCEDURE Save_Screen( VAR Saved_Screen_Pointer : Saved_Screen_Ptr );
  780.  
  781. (*-----------------------------------------------------------------*)
  782. (*                                                                 *)
  783. (*Procedure:  Save_Screen                                          *)
  784. (*                                                                 *)
  785. (*Purpose:    Saves current screen image (memory mapped area)      *)
  786. (*                                                                 *)
  787. (*Calling Sequence:                                                *)
  788. (*                                                                 *)
  789. (*   Save_Screen( Var Saved_Screen_Pointer : Saved_Screen_Ptr );   *)
  790. (*                                                                 *)
  791. (*      Saved_Screen_Pointer  --- pointer to record receiving      *)
  792. (*                                screen image, window location,   *)
  793. (*                                and current cursor location.     *)
  794. (*                                                                 *)
  795. (*Calls:   Move                                                    *)
  796. (*         Upper_Left                                              *)
  797. (*                                                                 *)
  798. (*Remarks:                                                         *)
  799. (*                                                                 *)
  800. (*   This version checks for stack overflow.                       *)
  801. (*                                                                 *)
  802. (*-----------------------------------------------------------------*)
  803.  
  804. BEGIN  (* Save_Screen *)
  805.                                    (* Overwrite last screen if no room *)
  806.  
  807.    IF Current_Saved_Screen >= Max_Saved_Screen THEN
  808.       Saved_Screen_Pointer := Saved_Screen_List[ Max_Saved_Screen ]
  809.    ELSE
  810.       BEGIN
  811.          Current_Saved_Screen := Current_Saved_Screen + 1;
  812.          NEW( Saved_Screen_Pointer );
  813.          Saved_Screen_List[ Current_Saved_Screen ] := Saved_Screen_Pointer;
  814.       END;
  815.  
  816.    WITH Saved_Screen_Pointer^ DO
  817.       BEGIN
  818.  
  819.          Upper_Left( Screen_X1, Screen_Y1 );
  820.  
  821.          Screen_X2     := Lower_Right_Column;
  822.          Screen_Y2     := Lower_Right_Row;
  823.  
  824.          Screen_Row    := WhereY;
  825.          Screen_Column := WhereX;
  826.  
  827.          MOVE( Actual_Screen^.Screen_Image, Screen_Image, Screen_Length );
  828.  
  829.       END;
  830.  
  831. END   (* Save_Screen *);
  832.  
  833. (*-----------------------------------------------------------------*)
  834. (*         Restore_Screen --- Restore saved screen image           *)
  835. (*-----------------------------------------------------------------*)
  836.  
  837. PROCEDURE Restore_Screen( VAR Saved_Screen_Pointer : Saved_Screen_Ptr );
  838.  
  839. (*-----------------------------------------------------------------*)
  840. (*                                                                 *)
  841. (*Procedure:  Restore_Screen                                       *)
  842. (*                                                                 *)
  843. (*Purpose:    Restores previously saved screen image.              *)
  844. (*                                                                 *)
  845. (*Calling Sequence:                                                *)
  846. (*                                                                 *)
  847. (*   Restore_Screen( Var Saved_Screen_Pointer: Saved_Screen_Ptr ); *)
  848. (*                                                                 *)
  849. (*      Saved_Screen_Pointer  --- pointer to record with saved     *)
  850. (*                                screen image, window location,   *)
  851. (*                                and cursor location.             *)
  852. (*                                                                 *)
  853. (*Calls:   Window                                                  *)
  854. (*         Move                                                    *)
  855. (*         GoToXY                                                  *)
  856. (*         WriteCXY                                                *)
  857. (*                                                                 *)
  858. (*Remarks:                                                         *)
  859. (*                                                                 *)
  860. (*   All saved screen pointers from the last saved down to the     *)
  861. (*   argument pointer are popped from the saved screen list.       *)
  862. (*                                                                 *)
  863. (*-----------------------------------------------------------------*)
  864.  
  865. VAR
  866.    X: BYTE;
  867.    Y: BYTE;
  868.    I: INTEGER;
  869.  
  870. BEGIN  (* Restore_Screen *)
  871.  
  872.    WITH Saved_Screen_Pointer^ DO
  873.       BEGIN
  874.  
  875.          Window( 1, 1, 80, 25 );
  876.  
  877.          IF Write_Screen_Memory THEN
  878.             MOVE( Screen_Image, Actual_Screen^.Screen_Image, Screen_Length )
  879.          ELSE
  880.             BEGIN
  881.                I := 1;
  882.                FOR Y := 1 TO 25 DO
  883.                   FOR X := 1 TO 80 DO
  884.                      BEGIN
  885.                         WriteCXY( CHR(Screen_Image[I]), X, Y, Screen_Image[I+1] );
  886.                         I := I + 2;
  887.                      END;
  888.             END;
  889.  
  890.          Window( Screen_X1, Screen_Y1, Screen_X2, Screen_Y2 );
  891.          GoToXY( Screen_Column, Screen_Row );
  892.  
  893.       END;
  894.  
  895.  
  896.    WHILE( Saved_Screen_List[ Current_Saved_Screen ] <> Saved_Screen_Pointer ) DO
  897.       BEGIN
  898.          DISPOSE( Saved_Screen_List[ Current_Saved_Screen ] );
  899.          Current_Saved_Screen := Current_Saved_Screen - 1;
  900.       END;
  901.  
  902.    IF Current_Saved_Screen > 0 THEN
  903.       Current_Saved_Screen := Current_Saved_Screen - 1;
  904.  
  905.    DISPOSE( Saved_Screen_Pointer );
  906.  
  907.   Saved_Screen_Pointer := NIL;
  908.  
  909. END    (* Restore_Screen *);
  910.