home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / modem / wxmodem.arc / WXMOWIND.INC < prev    next >
Text File  |  1986-10-30  |  9KB  |  312 lines
  1. {$U-,C-,R-,K-}
  2. { A set of routines for text window manipulation
  3.   By Bela Lubkin
  4.   Borland International Technical Support
  5.   1/10/85
  6.   2/20/85 Bug fix: DisposeWindow left a bunch of junk on the heap, causing
  7.     uncontrolled growth!
  8.   (For PC-DOS Turbo Pascal version 2 or greater)
  9. }
  10. Type
  11.   XTCoord=1..80;   { X Text coordinate }
  12.   YTCoord=1..25;   { Y Text coordinate }
  13.   XTCoord0=0..80;  { X Text coordinate + 0 for nothing }
  14.   YTCoord0=0..25;  { Y Text coordinate + 0 for nothing }
  15.   WindowRec=Record
  16.               XSize: XTCoord;
  17.               YSize: YTCoord;
  18.               XPosn: XTCoord;
  19.               YPosn: YTCoord;
  20.               Contents: Array [0..1999] Of Integer;
  21.             End;
  22.   WindowPtr=^WindowRec;
  23.  
  24. Var
  25.   WindowXLo: XTCoord;
  26.   WindowYLo: YTCoord;
  27.   WindowXHi: XTCoord;
  28.   WindowYHi: YTCoord;
  29.   ScreenBase: Integer;
  30.  
  31. Procedure TurboWindow(XL: XTCoord; YL: YTCoord; XH: XTCoord; YH: YTCoord);
  32. { This procedure provides an entry to Turbo's built in Window procedure }
  33.   Begin
  34.     Window(XL,YL,XH,YH);
  35.   End;
  36.  
  37. Procedure Window(XL: XTCoord; YL: YTCoord; XH: XTCoord; YH: YTCoord);
  38. { This procedure replaces Turbo's built in Window procedure.  It calls the
  39.   original Window procedure, and also keeps track of the window boundaries. }
  40.  
  41.   Begin
  42.     TurboWindow(XL,YL,XH,YH);
  43.     WindowXLo:=XL;
  44.     WindowYLo:=YL;
  45.     WindowXHi:=XH;
  46.     WindowYHi:=YH;
  47.   End;
  48.  
  49. Function SaveWindow(XLow: XTCoord; YLow: YTCoord;
  50.                     XHigh: XTCoord; YHigh:YTCoord): WindowPtr;
  51. { Allocate a WindowRec of the precise size needed to save the window, then
  52.   fill it with the text that is in the window XLow..XHigh, YLow..YHigh.
  53.   Return a pointer to this WindowRec. }
  54.  
  55.   Var
  56.     SW: WindowPtr;
  57.     I: Integer;
  58.     XS: XTCoord;
  59.     YS: YTCoord;
  60.  
  61.   Begin
  62.     XS:=XHigh-XLow+1;
  63.     YS:=YHigh-YLow+1;
  64.     GetMem(SW,2*XS*YS + 4);
  65.     { Allocate 2 bytes for each screen position, + 4 for size and position }
  66.     With SW^ Do
  67.      Begin
  68.       XSize:=XS;
  69.       YSize:=YS;
  70.       XPosn:=XLow;
  71.       YPosn:=YLow;
  72.       For I:=0 To YSize-1 Do
  73.         Move(Mem[ScreenBase:((YPosn+I-1)*80+XPosn-1) Shl 1],
  74.              Contents[I*XSize],XSize Shl 1);
  75.       { For each line of the window,
  76.           Move XSize*2 bytes (1 for char, 1 for attribute) into the Contents
  77.                array.  Leave no holes in the array. }
  78.      End;
  79.     SaveWindow:=SW;
  80.   End;
  81.  
  82. Function SaveCurrentWindow: WindowPtr;
  83.   Begin
  84.     SaveCurrentWindow:=SaveWindow(WindowXLo,WindowYLo,WindowXHi,WindowYHi);
  85.   End;
  86.  
  87. Procedure RestoreWindow(WP: WindowPtr; XPos: XTCoord0; YPos: YTCoord0);
  88. { Given a pointer to a WindowRec, restore the contents of the window.  If
  89.   XPos or YPos is 0, use the XPosn or YPosn that the window was originally
  90.   saved with.  If either is nonzero, use it.  Thus a window can be restored
  91.   exactly with  RestoreWindow(wp,0,0);  or its upper left corner can be
  92.   placed at (2,3) with  RestoreWindow(wp,2,3); }
  93.  
  94.   Var
  95.     I: Integer;
  96.  
  97.   Begin
  98.     With WP^ Do
  99.      Begin
  100.       If XPos=0 Then XPos:=XPosn;
  101.       If YPos=0 Then YPos:=YPosn;
  102.       For I:=0 To YSize-1 Do
  103.         Move(Contents[I*XSize],
  104.              Mem[ScreenBase:2*((YPos+I-1)*80+XPos-1)],XSize*2);
  105.       { For each line of the window,
  106.           Move XSize*2 bytes (1 for char, 1 for attribute) from the Contents
  107.                array onto the screen. }
  108.      End;
  109.   End;
  110.  
  111. Procedure DisposeWindow(Var WP: WindowPtr);
  112. { Dispose of a WindowPtr.  The built in procedure Dispose cannot be used,
  113.   because it will deallocate SizeOf(WindowRec) bytes, even though less may
  114.   have been allocated. }
  115.  
  116.   Begin
  117.     With WP^ Do FreeMem(WP,2*XSize*YSize+4);
  118.     WP:=Nil;
  119.   End;
  120.  
  121. Procedure DRestoreWindow(Var WP: WindowPtr; XPos: XTCoord0; YPos: YTCoord0);
  122. { Restore the contents of a window, then dispose of the saved image }
  123.  
  124.   Begin
  125.     RestoreWindow(WP, XPos, YPos);
  126.     DisposeWindow(WP);
  127.   End;
  128.  
  129. Procedure DRestoreCurrentWindow(Var WP: WindowPtr;
  130.                                 XPos: XTCoord0; YPos: YTCoord0);
  131. { Restore the contents of a window, set the current window to fit the restored
  132.   window, and dispose of the saved image.  A similar procedure
  133.   RestoreCurrentWindow could be written by changing DRestoreWindow to
  134.   RestoreWindow in the last line of the procedure, but I have assumed that
  135.   when you select a window area, you are going to modify it, and not want the
  136.   old image }
  137.  
  138.   Begin
  139.     With WP^ Do
  140.      Begin
  141.       If XPos=0 Then XPos:=XPosn;
  142.       If YPos=0 Then YPos:=YPosn;
  143.       Window(XPos,YPos,XPos+XSize-1,YPos+YSize-1);
  144.      End;
  145.     DRestoreWindow(WP, XPos, YPos);
  146.   End;
  147.  
  148. {****** My interface - S. Murphy ******}
  149.  
  150. type
  151.     WindowParms = record
  152.         col1, col2,
  153.         row1, row2 : integer;          {corner co-ordinates}
  154.         frame : 0..2;                  {border type}
  155.         CursorX, CursorY : integer;          {cursor position}
  156.     end;
  157.  
  158.     WindowDescriptor = ^WindowParms;
  159. Var
  160.    StatWin, TermWin,
  161.    CurrentWin, border    : WindowDescriptor;
  162.    TempWin               : WindowPtr;
  163.    StackedPage           : WindowPtr;
  164.  
  165. procedure UsePermWindow(var w : WindowDescriptor);
  166. begin
  167.      with CurrentWin^ do
  168.      begin
  169.           CursorX := WhereX;
  170.           CursorY := WhereY
  171.      end;
  172.      CurrentWin := w;
  173.      with w^ do
  174.      begin
  175.           window(col1,row1,col2,row2);
  176.           GotoXY(CursorX, CursorY)
  177.      end
  178. end;
  179.  
  180. procedure Status(slot :integer; msg : bigstring);
  181. var
  182.    i : integer;
  183. begin
  184.      if not displayfl then
  185.         exit;
  186.      UsePermWindow(StatWin);
  187.      GotoXY(20*slot+1,1);
  188.      if slot < 3 then
  189.          write('                    ')
  190.      else
  191.          write('                   ');
  192.      GotoXY(20*slot+1,1);
  193.      write(msg);
  194.      UsePermWindow(TermWin)
  195. end;
  196.  
  197.  
  198. procedure InitWindow(var w : WindowDescriptor;
  199.                          x1, y1, x2, y2 : integer);
  200. begin
  201.      new(w);
  202.      with w^ do
  203.      begin
  204.           col1 := x1;
  205.           col2 := x2;
  206.           row1 := y1;
  207.           row2 := y2;
  208.           CursorX := 1;
  209.           CursorY :=1
  210.      end
  211. end;
  212.  
  213. procedure DrawBox(col1, row1, col2, row2, frame : integer);
  214. type
  215.     cvec6 = array[1..6] of char;
  216.     cptr = ^cvec6;
  217. const
  218.      V1 = #179;   UR1 = #191;   UL1 = #218;
  219.      V2 = #186;   UR2 = #187;   UL2 = #201;
  220.      H1 = #196;   LR1 = #217;   LL1 = #192;
  221.      H2 = #205;   LR2 = #188;   LL2 = #200;
  222.  
  223.      SFRAME : cvec6 = (UL1,H1,UR1,V1,LL1,LR1);
  224.      DFRAME : cvec6 = (UL2,H2,UR2,V2,LL2,LR2);
  225.  
  226. var
  227.    framedef : cptr;
  228.    i,j : integer;
  229. begin
  230.      if frame <> 0 then
  231.      begin
  232.           case frame of
  233.              1 : framedef := ptr(seg(SFRAME),ofs(SFRAME));
  234.              2 : framedef := ptr(seg(DFRAME),ofs(DFRAME))
  235.           end;
  236.           GotoXY(col1, row1);
  237.           write(framedef^[1]);
  238.           for i := col1 + 1 to col2 - 1 do
  239.               write(framedef^[2]);
  240.           write(framedef^[3]);
  241.           for i := row1 + 1 to row2 - 1 do
  242.           begin
  243.                 GotoXY(col1, i);
  244.                 write(framedef^[4]);
  245.                 GotoXY(col2, i);
  246.                 write(framedef^[4])
  247.           end;
  248.           GotoXY(col1, row2);
  249.           write(framedef^[5]);
  250.           for i := col1 + 1 to col2 - 1 do
  251.               write(framedef^[2]);
  252.           write(framedef^[6])
  253.     end
  254. end;
  255.  
  256. Procedure OpenTemp(x1,y1,x2,y2,border : integer);
  257. begin
  258.      if not displayfl then
  259.         exit;
  260.      with CurrentWin^ do
  261.      begin
  262.        CursorX := WhereX;
  263.        CursorY := WhereY;
  264.        TempWin := SaveWindow(col1,row1,col2,row2)
  265.      end;
  266.      DrawBox(x1,y1,x2,y2,border);
  267.      TurboWindow(x1+1, y1+3, x2-1, y2+1);
  268.      ClrScr;
  269.      GotoXY(1,1)
  270. end;
  271.  
  272. Procedure CloseTemp;
  273. begin
  274.      if not displayfl then
  275.         exit;
  276.      DRestoreWindow(TempWin,0,0);
  277.      with CurrentWin^ do
  278.      begin
  279.         TurboWindow(col1,row1,col2,row2);
  280.         GotoXY(CursorX,CursorY)
  281.      end
  282. end;
  283.  
  284. procedure PushPage;
  285. const
  286.      MEMNEEDED = 3696; {memory overhead to store a page}
  287. Var
  288.    c : char;
  289. begin
  290.      if MemAvail >= MEMNEEDED then
  291.      begin
  292.           OpenTemp(20,5,75,10,2);
  293.           write('Save this screen? (Y/N; default N) ');
  294.           readln(c);
  295.           CloseTemp;
  296.           if c in  ['Y','y'] then
  297.                StackedPage := SaveWindow(1,3,80,25)
  298.      end
  299.      else begin
  300.           OpenTemp(30,5,70,10,2);
  301.           writeln('Out of Memory: Can''t save page.');
  302.           write('Type <cr> to continue.');
  303.           readln
  304.      end
  305. end;
  306.  
  307. procedure PopPage;
  308. begin
  309.      if StackedPage <> NIL then
  310.           DRestoreWindow(StackedPage,0,0)
  311. end;
  312.