home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TM40.ZIP / RWINDOW.INC < prev    next >
Encoding:
Text File  |  1985-07-20  |  5.6 KB  |  179 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.                    scr_shade    : byte;
  18.                    text_shade   : byte;
  19.                 end;
  20. var
  21.    win         : record
  22.                     xh,yh : byte;
  23.                     dim   : windimtype;
  24.                     depth : integer;
  25.                     stack : array[1..maxwin] of
  26.                                record
  27.                                   images   : ^imagetype;
  28.                                   dim      : windimtype;
  29.                                   x,y      : integer;
  30.                                end;
  31.                  end;
  32.    crtmode     : byte      absolute $0040:$0049;
  33.    monobuffer  : imagetype absolute $B000:$0000;
  34.    colorbuffer : imagetype absolute $B800:$0000;
  35.    scr_color   : integer;
  36.  
  37. (****************************************************************************)
  38. (*                          Initial Window System                           *)
  39. (****************************************************************************)
  40. procedure
  41.    initwin;
  42. begin
  43.    with win.dim do begin
  44.       x1 := 1;
  45.       y1 := 1;
  46.       x2 := 80;
  47.       y2 := 24;
  48.       scr_shade := BGcolor;
  49.       text_shade := FGcolor;
  50.    end;
  51.    win.depth := 0;
  52.    scr_color := 0;
  53. end;
  54.  
  55. (****************************************************************************)
  56. (*                           DRAW BOX FOR WINDOW                            *)
  57. (****************************************************************************)
  58. procedure
  59.    boxwin(x1,y1,x2,y2 : integer; winlabel : labeltype);
  60. var
  61.    x,y       : integer;
  62. begin
  63.    window(x1,y1,x2,y2);
  64.    scr_color := succ(scr_color);
  65.    if scr_color > 6 then
  66.       scr_color := 1;
  67.    textcolor( white );
  68.    textbackground( scr_color );
  69.    clrscr;
  70.    window(1,1,80,25);
  71.  
  72.    { TOP }
  73.    gotoxy(x1,y1);
  74.    write(#201+bstring(x2-x1-1,#205)+#187);
  75.  
  76.    { SIDES }
  77.    for y := succ(y1) to pred(y2) do begin
  78.       gotoxy(x1,y);
  79.       write(#186);
  80.       gotoxy(x2,y);
  81.       write(#186);
  82.    end;
  83.  
  84.    { BOTTOM }
  85.    gotoxy(x1,y2);
  86.    write(#200+bstring(x2-x1-1,#205)+#188);
  87.  
  88.    if length(winlabel)>0 then begin
  89.       gotoxy(x1+5,y1);
  90.       write(#175+'  ',winlabel,'  '+#174);
  91.    end;
  92.    window(x1+1,y1+1,x2-1,y2-1);
  93.    gotoxy(1,1);
  94. end;
  95.  
  96. (****************************************************************************)
  97. (*                               MAKE A WINDOW                              *)
  98. (****************************************************************************)
  99. procedure
  100.    mkwin(x1,y1,x2,y2 : integer; winlabel : labeltype);
  101. begin
  102.    with win do depth := succ(depth);
  103.    if (win.depth > maxwin) or (memory < 5) then begin
  104.       writeln;
  105.       window(1,1,80,25);
  106.       gotoxy(1,25);
  107.       clreol;
  108.       writeln(^G^G^M^J,' Out of Memory!!! ');
  109.       halt;
  110.    end;
  111.  
  112.    new(win.stack[win.depth].images);
  113.    if crtmode = 7 then
  114.       win.stack[win.depth].images^ := monobuffer
  115.    else
  116.       win.stack[win.depth].images^ := colorbuffer;
  117.  
  118.    win.stack[win.depth].dim := win.dim;
  119.    win.stack[win.depth].x   := wherex;
  120.    win.stack[win.depth].y   := wherey;
  121.  
  122.    boxwin(x1,y1,x2,y2,winlabel);
  123.    win.dim.x1 := succ(x1);
  124.    win.dim.y1 := succ(y1);
  125.    win.dim.x2 := pred(x2);
  126.    win.dim.y2 := pred(y2);
  127.    win.dim.scr_shade := scr_color;
  128.    win.dim.text_shade := white;
  129. end;
  130.  
  131. (****************************************************************************)
  132. (*                       REMOVE THE PREVIOUS WINDOW                         *)
  133. (****************************************************************************)
  134. procedure
  135.    rmwin;
  136. begin
  137.    if crtmode = 7 then
  138.       monobuffer := win.stack[win.depth].images^
  139.    else
  140.       colorbuffer := win.stack[win.depth].images^;
  141.    dispose(win.stack[win.depth].images);
  142.    with win do begin
  143.       dim := stack[depth].dim;
  144.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  145.       textcolor( dim.text_shade );
  146.       textbackground( dim.scr_shade );
  147.       gotoxy(stack[depth].x,stack[depth].y);
  148.       depth := pred(depth);
  149.    end;
  150. end;
  151.  
  152. (****************************************************************************)
  153. (*                           ESCAPE FROM WINDOW                             *)
  154. (****************************************************************************)
  155. procedure
  156.    escape_win;
  157. begin
  158.    with win do begin
  159.       xh:=wherex;
  160.       yh:=wherey;
  161.       window(1,1,80,25);
  162.       textcolor( FGcolor );
  163.       textbackground( BGcolor );
  164.    end;
  165. end;
  166.  
  167. (****************************************************************************)
  168. (*                 REENTER WINDOW PREVIOUSLY ESCAPED FROM                   *)
  169. (****************************************************************************)
  170. procedure
  171.    reset_win;
  172. begin
  173.    with win do begin
  174.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  175.       textcolor( dim.text_shade );
  176.       textbackground( dim.scr_shade );
  177.       gotoxy(xh,yh);
  178.    end;
  179. end;