home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / tttsrc51.zip / WINTTT5.PAS < prev   
Pascal/Delphi Source File  |  1993-03-08  |  29KB  |  997 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.10                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {               Copyright 1986-1993 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:   WinTTT5          }
  14.                      {--------------------------------}
  15.  
  16. {History:    03/05/89   5.00a  corrected Get_ScreenWord procedure
  17.              04/01/89   5.01   added DOS errorlevel 10 on fatal
  18.                                and corrected screen scroll
  19.                         5.01a  added DEBUG compiler directive
  20.              02/19/90   5.02a  changed cursor hide logic
  21.              03/28/90   5.02b  corrected Pos Cursor bug
  22.              01/04/93   5.10   DPMI compatible version
  23. }
  24.  
  25. {$S-,R-,V-}
  26. {$IFNDEF DEBUG}
  27. {$D-}
  28. {$ENDIF}       
  29.  
  30. unit  WinTTT5;
  31.  
  32. interface
  33.  
  34. uses CRT,DOS,FastTTT5,KeyTTT5;
  35.  
  36. Type
  37.  Direction = (Up, Down, Left, Right);
  38. Const
  39.     Shadow = 5;
  40. Var
  41.     Shadcolor    : byte;
  42.     DisplayLines : byte;
  43.  
  44. Procedure MoveFromScreen(var Source,Dest;Length:Word);
  45. Procedure MoveToScreen(var Source,Dest; Length:Word);
  46. Procedure SizeCursor(Top,Bot:byte);
  47. Procedure FindCursor(var X,Y,Top,Bot:byte);
  48. Procedure PosCursor(X,Y: integer);
  49. Procedure Fullcursor;
  50. Procedure HalfCursor;
  51. Procedure OnCursor;
  52. Procedure OffCursor;
  53. Procedure GotoXY(X,Y : byte);
  54. Function  WhereX: byte;
  55. Function  WhereY: byte;
  56. Function  GetScreenChar(X,Y:byte):char;
  57. Function  GetScreenAttr(X,Y:byte):byte;
  58. Procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  59. Procedure CreateScreen(Page:byte;Lines:byte);
  60. Procedure SaveScreen(Page:byte);
  61. Procedure RestoreScreen(Page:byte);
  62. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  63. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  64. Procedure PartSlideRestoreScreen(Page:byte;Way:Direction;X1,Y1,X2,Y2:byte);
  65. Procedure DisposeScreen(Page:byte);
  66. Procedure SetCondensedLines;
  67. Procedure Set25Lines;
  68. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  69. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  70. Procedure Scroll(Way:direction;X1,Y1,X2,Y2:byte);
  71. Procedure PartSave(X1,Y1,X2,Y2:byte; VAR Dest);
  72. Procedure PartRestore(X1,Y1,X2,Y2:byte; VAR Source);
  73. Procedure Mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  74. Procedure GrowMkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  75. Procedure Rmwin;
  76. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  77. Procedure TempMessageCh(X,Y,F,B:integer;St:strscreen;var Ch : char);
  78. Procedure TempMessage(X,Y,F,B:integer;St:strscreen);
  79. Procedure TempMessageBoxCh(X1,Y1,F,B,BoxType:integer;St:strscreen;var Ch : char);
  80. Procedure TempMessageBox(X1,Y1,F,B,BoxType:integer;St:strscreen);
  81. Procedure Activate_Visible_Screen;
  82. Procedure Activate_Virtual_Screen(Page:byte);
  83. Procedure Reset_StartUp_Mode;
  84.  
  85. Const
  86.     Max_Windows = 10;          {Change this constant as necessary}
  87.     Max_Screens = 10;          {Change this constant as necessary}
  88.     WindowCounter : byte = 0;
  89.     ScreenCounter : byte = 0;
  90.     ActiveVScreen: byte = 0;
  91.  
  92. Type
  93.     ScreenImage = record
  94.                        CursorX : byte;
  95.                        CursorY : byte;
  96.                        ScanTop : byte;
  97.                        ScanBot : byte;
  98.                        SavedLines:byte;
  99.                        ScreenPtr: pointer;
  100.                   end;
  101.     ScreenPtr = ^ScreenImage;
  102.     WindowImage = record
  103.                        ScreenPtr: Pointer;             {pointer to screen data}
  104.                        Coord    : array[1..4] of byte; {window coords}
  105.                        CursorX  : byte;                {cursor location}
  106.                        CursorY  : byte;
  107.                        ScanTop  : byte;                {cursor shape}
  108.                        ScanBot  : byte;
  109.                   end;
  110.     WindowPtr = ^WindowImage;
  111.  
  112. Var
  113.     Screen : array[1..Max_Screens] of ScreenPtr;
  114.     Win    : array[1..Max_Windows] of WindowPtr;
  115.     W_error: integer;     {Global error to report winTTT errors}
  116.     W_fatal: boolean;
  117.  
  118. IMPLEMENTATION
  119.  
  120. VAR
  121.     StartTop,      {used to record initial screen state when program is run}
  122.     StartBot   : Byte;
  123.     StartMode  : word;
  124.  
  125. {$L WINTTT5}
  126. {$IFOPT F-}
  127.    {$DEFINE FOFF}
  128.    {$F+}
  129. {$ENDIF}
  130.   Procedure MoveFromScreen(var Source,Dest;Length:Word); external;
  131.   Procedure MoveToScreen(var Source,Dest; Length:Word); external;
  132. {$IFDEF FOFF}
  133.    {$F-}
  134.    {$UNDEF FOFF}
  135. {$ENDIF}
  136.  
  137. Procedure WinTTT_Error(No : byte);
  138. {Updates W_error and optionally displays error message then halts program}
  139. var Msg : String;
  140. begin
  141.     W_error := No;
  142.     If W_fatal = true then
  143.     begin
  144.         Case No of
  145.         1 :  Msg := 'Max screens exceeded';
  146.         2 :  Msg := 'Max Windows Exceeded';
  147.         3 :  Msg := 'Insufficient memory to create screen';
  148.         4 :  Msg := 'Screen not saved cannot activate.';
  149.         5 :  Msg := 'Screen has not been created - cannot activate';
  150.         6 :  Msg := 'Screen has not been created - cannot dispose';
  151.         7 :  Msg := 'Screen has not been created - cannot restore';
  152.         8 :  Msg := 'Screen does not exist cannot clear';
  153.         9 :  Msg := 'Insufficient memory for Screen Copy/Move';
  154.         10:  Msg := 'Visible screen must be active for Window operations';
  155.         11:  Msg := 'Visible screen must be active for Message operations';
  156.         12:; {reserved for non-fatal error settings condensed mode}
  157.         13:  Msg := 'Can only save 25 screen lines - check CONST SavedLines';
  158.         else Msg := '?) -- Utterly confused';
  159.         end; {Case}
  160.         Msg := 'Fatal Error (WinTTT -- '+Msg;
  161.         Writeln(Msg);
  162.         Delay(5000);    {display long enough to read if child process}
  163.         Halt(11);       {returns DOS ERRORLEVEL 11}
  164.     end;
  165. end;
  166.  
  167. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  168. {                                                                     }
  169. {     V I S I B L E    a n d    V I R T U A L  P R O C E D U R E S    }
  170. {                                                                     }
  171. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  172. Procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  173. {transfers data from active virtual screen to Dest}
  174. var
  175.    I,width : byte;
  176.    ScreenAdr: integer;
  177. begin
  178.     width := succ(X2- X1);
  179.     For I :=  Y1 to Y2 do
  180.     begin
  181.      ScreenAdr := Pred(I)*160 + Pred(X1)*2;
  182.      MoveFromScreen(Mem[seg(ActiveScreenPtr^):ofs(ActiveScreenPtr^)+ScreenAdr],
  183.                     Mem[seg(Dest):ofs(dest)+(I-Y1)*width*2],
  184.                     width);
  185.     end;
  186. end;
  187.  
  188. Procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  189. {restores data from Source and transfers to active virtual screen}
  190. var
  191.    I,width : byte;
  192.    ScreenAdr: integer;
  193. begin
  194.     width := succ(X2- X1);
  195.     For I :=  Y1 to Y2 do
  196.     begin
  197.      ScreenAdr := Pred(I)*160 + Pred(X1)*2;
  198.      MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*width*2],
  199.                   Mem[seg(ActiveScreenPtr^):ofs(ActiveScreenPtr^)+ScreenAdr],
  200.                   width);
  201.     end;
  202. end;
  203.  
  204. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  205. var
  206.    I : integer;
  207.    S : string;
  208. begin
  209.     W_error := 0;
  210.     Attrib(X1,Y1,X2,Y2,F,B);
  211.     S := Replicate(Succ(X2-x1),C);
  212.     For I := Y1 to Y2 do
  213.         PlainWrite(X1,I,S);
  214. end;
  215.  
  216. Procedure GetScreenWord(X,Y:byte;var Attr:byte; var Ch : char);
  217. {updates vars Attr and Ch with attribute and character bytes in screen
  218.  location (X,Y) of the active screen}
  219. Type
  220.     ScreenWordRec = record
  221.                          Ch   : char;   {5.00a}
  222.                          Attr : byte;
  223.                     end;
  224. var
  225.    ScreenAdr: integer;
  226.    SW : ScreenWordRec;
  227. begin
  228.     ScreenAdr := Pred(Y)*160 + Pred(X)*2;
  229.     MoveFromScreen(Mem[seg(BaseOfScreen^):ofs(BaseOfScreen^)+ScreenAdr],mem[seg(SW):ofs(SW)],1);
  230.     Attr := SW.Attr;
  231.     Ch   := SW.Ch;
  232. end;
  233.  
  234. Function GetScreenChar(X,Y:byte):char;
  235. var
  236.    A : byte;
  237.    C : char;
  238. begin
  239.     GetScreenWord(X,Y,A,C);
  240.     GetScreenChar := C;
  241. end;
  242.  
  243. Function GetScreenAttr(X,Y:byte):byte;
  244. var
  245.    A : byte;
  246.    C : char;
  247. begin
  248.     GetScreenWord(X,Y,A,C);
  249.     GetScreenAttr := A;
  250. end;
  251.  
  252. Procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  253. var
  254.    I : integer;
  255. begin
  256.     St := '';
  257.     For I := X1 to X2 do
  258.         St := St + GetScreenChar(I,Y);
  259. end;
  260.  
  261. {++++++++++++++++++++++++++++++++++++++++++++++}
  262. {                                              }
  263. {         C U R S O R    R O U T I N E S       }
  264. {                                              }
  265. {++++++++++++++++++++++++++++++++++++++++++++++}
  266.  
  267. Procedure GotoXY(X,Y : byte);
  268. {intercepts normal Turbo GotoXY procedure, in case a virtual screen
  269.  is active.
  270. }
  271. begin
  272.     If ActiveScreenPtr = BaseOfScreen then
  273.        CRT.GotoXY(X,Y)
  274.     else
  275.        with Screen[ActiveVScreen]^ do
  276.        begin
  277.            CursorX := X;
  278.            CursorY := Y;
  279.        end; {with}
  280. end;  {proc GotoXY}
  281.  
  282. Function WhereX: byte;
  283. {intercepts normal Turbo WhereX procedure, in case a virtual screen
  284.  is active.
  285. }
  286. begin
  287.     If ActiveScreenPtr = BaseOfScreen then
  288.        WhereX := CRT.WhereX
  289.     else
  290.        with Screen[ActiveVScreen]^ do
  291.            WhereX := CursorX;
  292. end; {of func WhereX}
  293.  
  294. Function WhereY: byte;
  295. {intercepts normal Turbo WhereX procedure, in case a virtual screen
  296.  is active.
  297. }
  298. begin
  299.     If ActiveScreenPtr = BaseOfScreen then
  300.        WhereY := CRT.WhereY
  301.     else
  302.        with Screen[ActiveVScreen]^ do
  303.            WhereY := CursorY;
  304. end; {of func WhereY}
  305.  
  306. Procedure FindCursor(var X,Y,Top,Bot:byte);
  307. var
  308.    Reg : registers;
  309. begin
  310.   If ActiveScreenPtr = BaseOfScreen then
  311.   begin   
  312.       Reg.Ax := $0F00;              {get page in Bx}
  313.       Intr($10,Reg);
  314.       Reg.Ax := $0300;
  315.       Intr($10,Reg);
  316.       With Reg do
  317.       begin
  318.         X := lo(Dx) + 1;
  319.         Y := hi(Dx) + 1;
  320.         Top := Hi(Cx) and $0F;
  321.         Bot := Lo(Cx) and $0F;
  322.       end;
  323.   end
  324.   else                            {virtual screen active}
  325.      with Screen[ActiveVScreen]^ do
  326.      begin
  327.          X := CursorX;
  328.          Y := CursorY;
  329.          Top := ScanTop;
  330.          Bot := ScanBot;
  331.      end;
  332. end;
  333.  
  334. Procedure PosCursor(X,Y: integer);
  335. var Reg : registers;
  336. begin
  337.     If ActiveScreenPtr = BaseOfScreen then
  338.     begin
  339.         Reg.Ax := $0F00;              {get page in Bx}
  340.         Intr($10,Reg);
  341.         with Reg do
  342.         begin
  343.           Ax := $0200;                             {5.02b}
  344.           Dx := ((Y-1) shl 8) or ((X-1) and $00FF);
  345.         end;
  346.         Intr($10,Reg);
  347.     end
  348.     else                           {virtual screen active}
  349.        with Screen[ActiveVScreen]^ do
  350.        begin
  351.            CursorX := X;
  352.            CursorY := Y;
  353.        end;
  354. end;
  355.  
  356. Procedure SizeCursor(Top,Bot:byte);
  357. var Reg : registers;
  358. begin
  359.     If ActiveScreenPtr = BaseOfScreen then
  360.     begin
  361.        with Reg do
  362.        begin
  363.          Ax := $0100;
  364.          if (Top=0) and (Bot=0) then
  365.             Cx := $2000
  366.          else
  367.             Cx := Top shl 8 + Bot;
  368.          INTR($10,Reg);
  369.        end
  370.     end
  371.     else                           {virtual screen active}
  372.        with Screen[ActiveVScreen]^ do
  373.        begin
  374.            ScanTop := Top;
  375.            ScanBot := Bot;
  376.        end;
  377. end;
  378.  
  379. Procedure HalfCursor;
  380. begin
  381.     If not ColorScreen then    
  382.        SizeCursor(8,13)    
  383.     else
  384.        SizeCursor(4,7);    
  385. end; {Proc HalfCursor}
  386.  
  387. Procedure Fullcursor;
  388. begin
  389.     If not ColorScreen then    
  390.        SizeCursor(0,13)
  391.     else
  392.        SizeCursor(0,7);
  393. end;
  394.  
  395. Procedure OnCursor;
  396. begin
  397.     If not ColorScreen then    
  398.        SizeCursor(12,13)
  399.     else
  400.        SizeCursor(6,7);
  401. end;
  402.  
  403. Procedure OffCursor;
  404. begin
  405.     Sizecursor(0,0);
  406. end;
  407.  
  408. {++++++++++++++++++++++++++++++++++++++++++++++++++++}
  409. {                                                    }
  410. {   S C R E E N   S A V I N G  R O U T I N E S       }
  411. {                                                    }
  412. {++++++++++++++++++++++++++++++++++++++++++++++++++++}
  413.  
  414. Procedure DisposeScreen(Page:byte);
  415. {Free memory and set pointer to nil}
  416. begin
  417.     If Screen[Page] = nil then
  418.     begin
  419.        WinTTT_Error(6);
  420.        exit;
  421.     end
  422.     else
  423.        W_error := 0;
  424.     FreeMem(Screen[Page]^.ScreenPtr,Screen[Page]^.SavedLines*160);
  425.     Freemem(Screen[Page],SizeOf(Screen[Page]^));
  426.     Screen[page] := nil;
  427.     If ActiveVscreen = Page then
  428.        Activate_Visible_Screen;
  429.     dec(ScreenCounter);
  430. end;
  431.  
  432. Procedure SaveScreen(Page:byte);
  433. {Save screen display and cursor details}
  434. begin
  435.     If (Page > Max_Screens) then
  436.     begin
  437.       WinTTT_Error(1);
  438.       exit;
  439.     end;
  440.     If ((Screen[Page] <> nil) and (DisplayLines <> Screen[Page]^.SavedLines)) then
  441.         DisposeScreen(Page);
  442.     If Screen[Page] = nil then            {need to allocate memory}
  443.     begin
  444.         If MaxAvail < SizeOf(Screen[Page]^) then
  445.         begin
  446.             WinTTT_Error(3);
  447.             exit;
  448.         end;
  449.         GetMem(Screen[Page],SizeOf(Screen[Page]^));
  450.         If MaxAvail < DisplayLines*160 then     {do check in two parts 'cos Maxavail is not same as MemAvail}
  451.         begin
  452.             WinTTT_Error(3);
  453.             Freemem(Screen[Page],SizeOf(Screen[Page]^));
  454.             Screen[Page] := nil;
  455.             exit;
  456.         end;
  457.         GetMem(Screen[Page]^.ScreenPtr,DisplayLines*160);
  458.         Inc(ScreenCounter);
  459.     end;
  460.     With Screen[Page]^ do
  461.     begin
  462.        FindCursor(CursorX,CursorY,ScanTop,ScanBot);     {Save Cursor posn. and shape}
  463.        SavedLines := DisplayLines;
  464.        MoveFromScreen(BaseOfScreen^,Screen[Page]^.ScreenPtr^,DisplayLines*80);
  465.     end;
  466.     W_error := 0;
  467. end;
  468.  
  469. Procedure RestoreScreen(Page:byte);
  470. {Display a screen that was previously saved}
  471. begin
  472.     If Screen[Page] = nil then
  473.     begin
  474.        WinTTT_Error(7);
  475.        exit;
  476.     end
  477.     else
  478.        W_error := 0;
  479.     With Screen[Page]^ do
  480.     begin
  481.         MoveToScreen(ScreenPtr^,BaseOfScreen^, 80*SavedLines);
  482.         PosCursor(CursorX,CursorY);
  483.         SizeCursor(ScanTop,ScanBot);
  484.     end;
  485. end;  {Proc RestoreScreen}
  486.  
  487.  
  488. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  489. {Move from heap to screen, part of saved screen}
  490. Var
  491.    I,width     : byte;
  492.    ScreenAdr,
  493.    PageAdr     : integer;
  494. begin
  495.     If Screen[Page] = nil then
  496.     begin
  497.        WinTTT_Error(7);
  498.        exit;
  499.     end
  500.     else
  501.        W_error := 0;
  502.     Width := succ(X2- X1);
  503.     For I :=  Y1 to Y2 do
  504.     begin
  505.         ScreenAdr := pred(Y+I-Y1)*160 + Pred(X)*2;
  506.         PageAdr   := Pred(I)*160 + Pred(X1)*2;
  507.         MoveToScreen(Mem[Seg(Screen[Page]^.ScreenPtr^):ofs(Screen[Page]^.ScreenPtr^)+PageAdr],
  508.                      Mem[seg(BaseOfScreen^):ofs(BaseOfScreen^)+ScreenAdr],
  509.                      width);
  510.     end;
  511. end;
  512.  
  513. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  514. {Display a screen that was previously saved, with fancy slide}
  515. Var I : byte;
  516. begin
  517.     If Screen[Page] = nil then
  518.     begin
  519.        WinTTT_Error(7);
  520.        exit;
  521.     end
  522.     else
  523.        W_error := 0;
  524.     Case Way of
  525.     Up    : begin
  526.                 For I := DisplayLines downto 1 do
  527.                 begin
  528.                     PartRestoreScreen(Page,
  529.                                       1,1,80,succ(DisplayLines -I),
  530.                                       1,I);
  531.                     Delay(50);
  532.                 end;
  533.             end;
  534.     Down  : begin
  535.                 For I := 1 to DisplayLines do
  536.                 begin
  537.                     PartRestoreScreen(Page,
  538.                                       1,succ(DisplayLines -I),80,DisplayLines,
  539.                                       1,1);
  540.                     Delay(50);  {savor the moment!}
  541.                 end;
  542.             end;
  543.     Left  : begin
  544.                 For I := 1 to 80 do
  545.                 begin
  546.                     PartRestoreScreen(Page,
  547.                                       1,1,I,DisplayLines,
  548.                                       succ(80-I),1);
  549.                 end;
  550.             end;
  551.     Right : begin
  552.                 For I := 80 downto 1 do
  553.                 begin
  554.                     PartRestoreScreen(Page,
  555.                                       I,1,80,DisplayLines,
  556.                                       1,1);
  557.                 end;
  558.             end;
  559.     end; {case}
  560.     PosCursor(Screen[Page]^.CursorX,Screen[Page]^.CursorY);
  561.     SizeCursor(Screen[Page]^.ScanTop,Screen[Page]^.ScanBot);
  562. end;   {Proc SlideRestoreScreen}
  563.  
  564.  
  565. Procedure PartSlideRestoreScreen(Page:byte;Way:Direction;X1,Y1,X2,Y2:byte);
  566. {Display a screen that was previously saved, with fancy slide}
  567. Var I : byte;
  568. begin
  569.     If Screen[Page] = nil then
  570.     begin
  571.        WinTTT_Error(7);
  572.        exit;
  573.     end
  574.     else
  575.        W_error := 0;
  576.     Case Way of
  577.     Up    : begin
  578.                 For I := Y2 downto Y1 do
  579.                 begin
  580.                     PartRestoreScreen(Page,
  581.                                       X1,Y1,X2,Y1+Y2-I,
  582.                                       X1,I);
  583.                     Delay(50);
  584.                 end;
  585.             end;
  586.     Down  : begin
  587.                 For I := Y1 to Y2 do
  588.                 begin
  589.                     PartRestoreScreen(Page,
  590.                                       X1,Y1+Y2 -I,X2,Y2,
  591.                                       X1,Y1);
  592.                     Delay(50);  {savor the moment!}
  593.                 end;
  594.             end;
  595.     Left  : begin
  596.                 For I := X1 to X2 do
  597.                 begin
  598.                     PartRestoreScreen(Page,
  599.                                       X1,Y1,I,Y2,
  600.                                       X1+X2-I,Y1);
  601.                 end;
  602.             end;
  603.     Right : begin
  604.                 For I := X2 downto X1 do
  605.                 begin
  606.                     PartRestoreScreen(Page,
  607.                                       I,Y1,X2,Y2,
  608.                                       X1,Y1);
  609.                 end;
  610.             end;
  611.     end; {case}
  612. end;   {Proc PartSlideRestoreScreen}
  613.  
  614.  
  615. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  616. {                                                                              }
  617. {     V I R T U A L    S C R E E N    S P E C I F I C   P R O C E D U R E S    }
  618. {                                                                              }
  619. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  620.  
  621. Procedure Clear_Vscreen(page:byte);
  622. var
  623.    Temp:pointer;
  624. begin
  625.     If Screen[Page] = nil then
  626.     begin
  627.        WinTTT_Error(8);
  628.        exit;
  629.     end
  630.     else
  631.        W_error := 0;
  632.     Temp := ActiveScreenPtr;
  633.     ActiveScreenPtr := Screen[Page]^.ScreenPtr;
  634.     ClearText(1,1,80,Screen[Page]^.SavedLines,yellow,black);
  635.     ActiveSCreenPtr := Temp;
  636. end;
  637.  
  638. Procedure CreateScreen(Page:byte;Lines:byte);
  639. begin
  640.     W_error := 0;
  641.     If (Page > Max_Screens) then
  642.     begin
  643.        WinTTT_Error(1);
  644.        exit;
  645.     end;
  646.     If ((Screen[Page] <> nil) and (Lines <> Screen[Page]^.SavedLines)) then
  647.         DisposeScreen(Page);
  648.     If Screen[Page] = nil then            {need to allocate memory}
  649.     begin
  650.         If MaxAvail < SizeOf(Screen[Page]^) then
  651.         begin
  652.             WinTTT_Error(3);
  653.             exit;
  654.         end;
  655.         GetMem(Screen[Page],SizeOf(Screen[Page]^));
  656.         If MaxAvail < Lines*160 then     {do check in two parts 'cos Maxavail is not same as MemAvail}
  657.         begin
  658.             WinTTT_Error(3);
  659.             Freemem(Screen[Page],SizeOf(Screen[Page]^));
  660.             Screen[Page] := nil;
  661.             exit;
  662.         end;
  663.         GetMem(Screen[Page]^.ScreenPtr,Lines*160);
  664.         Inc(ScreenCounter);
  665.     end;
  666.     With Screen[Page]^ do
  667.     begin
  668.         If not ColorScreen then
  669.         begin
  670.             ScanTop := 12;
  671.             ScanBot := 13;
  672.         end
  673.         else
  674.         begin
  675.             ScanTop := 6;
  676.             ScanBot := 7;
  677.         end;
  678.         CursorX := 1;
  679.         CursorY := 1;
  680.         SavedLines := Lines;
  681.         Clear_Vscreen(Page);
  682.     end;
  683. end;
  684.  
  685. Procedure Activate_Visible_Screen;
  686. begin
  687.     ActiveScreenPtr := BaseOfScreen;
  688.     ActiveVscreen := 0;
  689. end;
  690.  
  691. Procedure Activate_Virtual_Screen(Page:byte);
  692. {Page zero signifies the visible screen}
  693. begin
  694.     If Screen[Page] = nil then
  695.        WinTTT_Error(4)
  696.     else
  697.     begin
  698.        W_error := 0;
  699.        If Page = 0 then
  700.           Activate_Visible_Screen
  701.        else
  702.        begin
  703.            ActiveScreEnPtr := Screen[Page]^.ScreenPtr;
  704.            ActiveVScreen := page;
  705.        end;
  706.     end;
  707. end;
  708.  
  709. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  710. {                                                                              }
  711. {     V I S I B L E    S C R E E N    S P E C I F I C   P R O C E D U R E S    }
  712. {                                                                              }
  713. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  714.  
  715. Procedure SetCondensedLines;
  716. begin
  717.     If EGAVGASystem then
  718.     begin
  719.         W_Error := 0;
  720.         TextMode(Lo(LastMode)+Font8x8);
  721.         DisplayLines := succ(Hi(WindMax));
  722.     end
  723.     else
  724.         W_Error := 12;
  725. end;  {proc SetCondensedDisplay}
  726.  
  727. Procedure Set25Lines;
  728. begin
  729.     TextMode(Lo(LastMode));
  730.     DisplayLines := succ(Hi(WindMax));
  731. end;
  732.  
  733.  
  734. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  735. {copies text and attributes from one part of screen to another}
  736. Var
  737.    S : word;
  738.    SPtr : pointer;
  739. begin
  740.     W_error := 0;
  741.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  742.     If Maxavail < S then
  743.        WinTTT_Error(9)
  744.     else
  745.     begin
  746.         GetMem(SPtr,S);
  747.         PartSave(X1,Y1,X2,Y2,SPtr^);
  748.         PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  749.         FreeMem(Sptr,S);
  750.     end;
  751. end; {CopyScreenBlock}
  752.  
  753. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  754. {Moves text and attributes from one part of screen to another,
  755.  replacing with Replace_Char}
  756. const
  757.   Replace_Char = ' ';
  758. Var
  759.    S : word;
  760.    SPtr : pointer;
  761.    I : Integer;
  762.    ST : string;
  763. begin
  764.     W_error := 0;
  765.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  766.     If Maxavail < S then
  767.        WinTTT_Error(9)
  768.     else
  769.     begin
  770.         GetMem(SPtr,S);
  771.         PartSave(X1,Y1,X2,Y2,SPtr^);
  772.         St := Replicate(succ(X2-X1),Replace_Char);
  773.         For I := Y1 to Y2 do
  774.             PlainWrite(X1,I,St);
  775.         PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  776.         FreeMem(Sptr,S);
  777.     end;
  778. end; {Proc MoveScreenBlock}
  779.  
  780. Procedure Scroll(Way:direction;X1,Y1,X2,Y2:byte);
  781. {used for screen scrolling, uses Copy & Plainwrite for speed}
  782. const
  783.   Replace_Char = ' ';
  784. var
  785.   I : integer;
  786. begin
  787.     W_error := 0;
  788.     Case Way of
  789.     Up   : begin
  790.                CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
  791.                PlainWrite(X1,Y2,replicate(succ(X2-X1),Replace_Char));
  792.            end;
  793.     Down : begin
  794.                CopyScreenBlock(X1,Y1,X2,pred(Y2),X1,succ(Y1));
  795.                PlainWrite(X1,Y1,replicate(succ(X2-X1),Replace_Char));
  796.            end;
  797.     Left : begin
  798.                CopyScreenBlock(succ(X1),Y1,X2,Y2,X1,Y1);
  799.                For I := Y1 to Y2 do
  800.                    PlainWrite(X2,I,Replace_Char);   {5.01}
  801.            end;
  802.     Right: begin
  803.                CopyScreenBlock(X1,Y1,pred(X2),Y2,succ(X1),Y1);
  804.                For I := Y1 to Y2 do
  805.                    PlainWrite(X1,I,Replace_Char);   {5.01}
  806.            end;
  807.     end; {case}
  808. end;
  809.  
  810. procedure CreateWin(x1,y1,x2,y2,F,B,boxtype:integer);
  811. {called by MkWin and GrowMkWin}
  812. begin
  813.     If WindowCounter >= Max_Windows then
  814.     begin
  815.        WinTTT_Error(2);
  816.        exit;
  817.     end;
  818.     If MaxAvail < sizeOf(Win[WindowCounter]^) then
  819.     begin
  820.        WinTTT_Error(3);
  821.        exit;
  822.     end
  823.     else
  824.        W_error := 0;
  825.     Inc(WindowCounter);
  826.     GetMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));    {allocate space}
  827.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  828.     begin
  829.         X1 := pred(X1);    {increase dimensions for the box}
  830.         Y2 := succ(Y2);
  831.     end;
  832.     If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  833.     begin
  834.        WinTTT_Error(3);
  835.        exit;
  836.     end;
  837.     GetMem(Win[WindowCounter]^.ScreenPtr,succ(Y2-Y1)*succ(X2-X1)*2);
  838.     PartSave(X1,Y1,X2,Y2,Win[WindowCounter]^.ScreenPtr^);
  839.     with Win[WindowCounter]^ do
  840.     begin
  841.       Coord[1] := X1;
  842.       Coord[2] := Y1;
  843.       Coord[3] := X2;
  844.       Coord[4] := Y2;
  845.       FindCursor(CursorX,CursorY,ScanTop,ScanBot);
  846.     end;  {with}
  847. end; {Proc CreateWin}
  848.  
  849. procedure mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  850. {Main procedure for creating window}
  851. var I : integer;
  852. begin
  853.     If ActiveVscreen <> 0 then
  854.     begin
  855.         W_error := 10;
  856.         exit;
  857.     end
  858.     else
  859.         W_error := 0;
  860.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  861.     If (BoxType in [5..9]) and (X1 > 1) then
  862.        FBox(x1,y1,x2,y2,F,B,boxtype-shadow)
  863.     else
  864.        FBox(x1,y1,x2,y2,F,B,boxtype);
  865.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  866.     begin
  867.         For I := succ(Y1) to succ(Y2) do
  868.             WriteAt(pred(X1),I,Shadcolor,black,chr(219));
  869.         WriteAt(X1,succ(Y2),Shadcolor,black,
  870.                 replicate(X2-succ(X1),chr(219)));
  871.     end;
  872. end;
  873.  
  874. procedure GrowMKwin(x1,y1,x2,y2,F,B,boxtype:integer);
  875. {same as MKwin but window explodes}
  876. var I : integer;
  877. begin
  878.     If ActiveVscreen <> 0 then
  879.     begin
  880.         W_error := 10;
  881.         exit;
  882.     end
  883.     else
  884.         W_error := 0;
  885.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  886.     If (BoxType in [5..9]) and (X1 > 1) then
  887.        GrowFBox(x1,y1,x2,y2,F,B,boxtype-shadow)
  888.     else
  889.        GrowFBox(x1,y1,x2,y2,F,B,boxtype);
  890.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  891.     begin
  892.         For I := succ(Y1) to succ(Y2) do
  893.             WriteAt(pred(X1),I,Shadcolor,black,chr(219));
  894.         WriteAt(X1,succ(Y2),Shadcolor,black,
  895.                 replicate(X2-succ(X1),chr(219)));
  896.     end;
  897. end;
  898.  
  899. Procedure RmWin;
  900. begin
  901.     If ActiveVscreen <> 0 then
  902.     begin
  903.         W_error := 10;
  904.         exit;
  905.     end
  906.     else
  907.         W_error := 0;
  908.     If WindowCounter > 0 then
  909.     begin
  910.         with  Win[WindowCounter]^ do
  911.         begin
  912.             PartRestore(Coord[1],Coord[2],Coord[3],Coord[4],ScreenPtr^);
  913.             PosCursor(CursorX,CursorY);
  914.             SizeCursor(ScanTop,ScanBot);
  915.             FreeMem(ScreenPtr,succ(Coord[4]-coord[2])*succ(coord[3]-coord[1])*2);
  916.             FreeMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));
  917.         end; {with}
  918.         Dec(WindowCounter);
  919.     end;
  920. end;
  921.  
  922. procedure TempMessageCh(X,Y,F,B:integer;St:strscreen;var Ch : char);
  923. var
  924.  CX,CY,CT,CB,I,locC:integer;
  925.  SavedLine : array[1..160] of byte;
  926. begin
  927.     If ActiveVscreen <> 0 then
  928.     begin
  929.         W_error := 11;
  930.         exit;
  931.     end
  932.     else
  933.         W_error := 0;
  934.     PartSave(X,Y,pred(X)+length(St),Y,SavedLine);
  935.     WriteAT(X,Y,F,B,St);
  936.     Ch := GetKey;
  937.     PartRestore(X,Y,pred(X)+length(St),Y,SavedLine);
  938. end;
  939.  
  940. Procedure TempMessage(X,Y,F,B:integer;St:strscreen);
  941. var Ch : char;
  942. begin
  943.     TempMessageCH(X,Y,F,B,ST,Ch);
  944. end;              
  945.  
  946. Procedure TempMessageBoxCh(X1,Y1,F,B,BoxType:integer;St:strscreen;var Ch : char);
  947. begin
  948.     If ActiveVscreen <> 0 then
  949.     begin
  950.         W_error := 11;
  951.         exit;
  952.     end
  953.     else
  954.         W_error := 0;
  955.     MkWin(X1,Y1,succ(X1)+length(St),Y1+2,F,B,Boxtype);
  956.     WriteAt(succ(X1),Succ(Y1),F,B,St);
  957.     Ch := getKey;
  958.     Rmwin;
  959. end;
  960.  
  961. Procedure TempMessageBox(X1,Y1,F,B,BoxType:integer;St:strscreen);
  962. var Ch : char;
  963. begin
  964.     TempMessageBoxCh(X1,Y1,F,B,Boxtype,St,Ch);
  965. end;
  966.  
  967. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  968.  
  969. Procedure InitWinTTT;
  970. {set Pointers to nil for validity checking}
  971. Var
  972.   I : integer;
  973.   X,Y : byte;
  974. begin
  975.     For I := 1 to Max_Screens do
  976.         Screen[I] := nil;
  977.     StartMode := LastMode;           { record the initial state of screen when program was executed}
  978.     DisplayLines := succ(Hi(WindMax));
  979.     FindCursor(X,Y,StartTop,StartBot);
  980. end;
  981.  
  982.  
  983. Procedure Reset_StartUp_Mode;
  984. {resets monitor mode and cursor settings to the state they
  985.  were in at program startup}
  986. begin
  987.     TextMode(StartMode);
  988.     SizeCursor(StartTop,StartBot);
  989. end; {proc StartUp_Mode}
  990.  
  991. begin
  992.     InitWinTTT;
  993.     W_error := 0;
  994.     W_fatal := false;   {don't terminate program if fatal error}
  995.     Shadcolor := darkgray;
  996. end.
  997.