home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TMODEM.ZIP / RWINDOW.INC < prev    next >
Encoding:
Text File  |  1987-06-15  |  5.1 KB  |  167 lines
  1. (****************************************************************************)
  2. (*                          REMOVABLE WINDOWS                               *)
  3. (*                                                                          *)
  4. (*              Call INITWIN before calling  MKWIN or RMWIN.                *)
  5. (*                                                                          *)
  6. (*              Uses some routines from the BASIC.INC Package.              *)
  7. (****************************************************************************)
  8.  
  9. const
  10.    maxwin    = 30;                { Adjustable !!! }
  11.  
  12. type
  13.    labeltype  = string[60];
  14.    imagetype  = array[1..3840] of char;
  15.    windimtype = record
  16.                    x1,y1,x2,y2  : byte;
  17.                 end;
  18. var
  19.    win         : record
  20.                     xh,yh : byte;
  21.                     dim   : windimtype;
  22.                     depth : integer;
  23.                     stack : array[1..maxwin] of
  24.                                record
  25.                                   images   : ^imagetype;
  26.                                   dim      : windimtype;
  27.                                   x,y      : integer;
  28.                                end;
  29.                  end;
  30.    crtmode     : byte      absolute $0040:$0049;
  31.    monobuffer  : imagetype absolute $B000:$0000;
  32.    colorbuffer : imagetype absolute $B800:$0000;
  33.  
  34. (****************************************************************************)
  35. (*                          Initial Window System                           *)
  36. (****************************************************************************)
  37. procedure
  38.    initwin;
  39. begin
  40.    with win.dim do begin
  41.       x1 := 1;
  42.       y1 := 1;
  43.       x2 := 80;
  44.       y2 := 24;
  45.    end;
  46.    win.depth := 0;
  47. end;
  48.  
  49. (****************************************************************************)
  50. (*                           DRAW BOX FOR WINDOW                            *)
  51. (****************************************************************************)
  52. procedure
  53.    boxwin(x1,y1,x2,y2 : integer; winlabel : labeltype);
  54. var
  55.    x,y       : integer;
  56. begin
  57.    window(x1,y1,x2,y2);
  58.    clrscr;
  59.    window(1,1,80,25);
  60.  
  61.    { TOP }
  62.    gotoxy(x1,y1);
  63.    write(bstring(x2-x1+1,#220));
  64.  
  65.    { SIDES }
  66.    for y := y1+1 to y2-1 do begin
  67.       gotoxy(x1,y);
  68.       write(#221);
  69.       gotoxy(x2,y);
  70.       write(#222);
  71.    end;
  72.  
  73.    { BOTTOM }
  74.    gotoxy(x1,y2);
  75.    write(bstring(x2-x1+1,#223));
  76.  
  77.    if length(winlabel)>0 then begin
  78.       gotoxy(x1+4,y1);
  79.       write('  ',winlabel,'  ');
  80.    end;
  81.  
  82.    window(x1+1,y1+1,x2-1,y2-1);
  83.    gotoxy(1,1);
  84. end;
  85.  
  86. (****************************************************************************)
  87. (*                               MAKE A WINDOW                              *)
  88. (****************************************************************************)
  89. procedure
  90.    mkwin(x1,y1,x2,y2 : integer; winlabel : labeltype);
  91. begin
  92.    normvideo;
  93.    with win do depth := depth+1;
  94.    if (win.depth > maxwin) or ((maxavail > 0) and (maxavail < 320)) then begin
  95.       writeln;
  96.       writeln(^G^G,' Windows nested too deep ');
  97.       halt;
  98.    end;
  99.  
  100.    new(win.stack[win.depth].images);
  101.    if crtmode = 7 then
  102.       win.stack[win.depth].images^ := monobuffer
  103.    else
  104.       win.stack[win.depth].images^ := colorbuffer;
  105.  
  106.    win.stack[win.depth].dim := win.dim;
  107.    win.stack[win.depth].x   := wherex;
  108.    win.stack[win.depth].y   := wherey;
  109.  
  110.    boxwin(x1,y1,x2,y2,winlabel);
  111.    win.dim.x1 := x1+1;
  112.    win.dim.y1 := y1+1;
  113.  
  114.    win.dim.x2 := x2-1;
  115.    win.dim.y2 := y2-1;
  116. end;
  117.  
  118. (****************************************************************************)
  119. (*                       REMOVE THE PREVIOUS WINDOW                         *)
  120. (****************************************************************************)
  121. procedure
  122.    rmwin;
  123. begin
  124.    if crtmode = 7 then
  125.       monobuffer := win.stack[win.depth].images^
  126.    else
  127.       colorbuffer := win.stack[win.depth].images^;
  128.    dispose(win.stack[win.depth].images);
  129.    with win do begin
  130.       dim := stack[depth].dim;
  131.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  132.       gotoxy(stack[depth].x,stack[depth].y);
  133.       depth := depth-1;
  134.       if depth=0 then begin
  135.          textcolor( FGcolor );
  136.          textbackground( BGcolor );
  137.       end;
  138.    end;
  139. end;
  140.  
  141. (****************************************************************************)
  142. (*                           ESCAPE FROM WINDOW                             *)
  143. (****************************************************************************)
  144. procedure
  145.    escape_win;
  146. begin
  147.    with win do begin
  148.       xh:=wherex;
  149.       yh:=wherey;
  150.       window(1,1,80,25);
  151.    end;
  152.    textcolor( FGcolor );
  153.    textbackground( BGcolor );
  154. end;
  155.  
  156. (****************************************************************************)
  157. (*                 REENTER WINDOW PREVIOUSLY ESCAPED FROM                   *)
  158. (****************************************************************************)
  159. procedure
  160.    reset_win;
  161. begin
  162.    with win do begin
  163.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  164.       gotoxy(xh,yh);
  165.       if depth>0 then normvideo;
  166.    end;
  167. end;