home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / UTILITYS / FONTM2A.ARC / WINDOWS.INC < prev   
Text File  |  1989-09-27  |  4KB  |  131 lines
  1. {This is the windows.inc window handling module.
  2. It needs some of the constructs etc defined for the SCRH.INC module
  3.  
  4. VAR
  5.   screen_data:array[1..8192] of byte;
  6.   screen_pointer:integer; <---- this is the pointer into the array!
  7.  
  8. NB this same sort of routine was whipped up by me in assembler, but i have no
  9. idea how to interface T.P. to it!
  10.  
  11. Summary of accessible routines contained in this file:
  12.  
  13. PushWind (x,y,w,h)        Takes the screen data at x,y and saves w columns
  14.                           and h rows (including colour and attributes) to
  15.                           memory
  16. PopWind                   Pops the most recent window off the stack
  17. Window (x,y,w,h,title,opt) Draws a border around the area w by h at x,y and
  18.                           titles it. What's behind it is saved if opt is true
  19. }
  20.  
  21. procedure get_ret(i:integer;opt:boolean;var t2:integer);
  22. begin
  23.   if opt then
  24.   begin
  25.     screen_data[t2]:=mem[i]; t2:=t2+1;
  26.     if colour then
  27.     begin
  28.       port [8]:=$40; screen_data[t2]:=mem[i+2048]; port[8]:=0; t2:=t2+1;
  29.     end;
  30.     if premium then
  31.     begin
  32.       port[$1c]:=port[$1c] or $10;
  33.       screen_data[t2]:=mem[i]; t2:=t2+1;
  34.       port[$1c]:=port[$1c] and $ef;
  35.     end;
  36.   end
  37.   else
  38.   begin
  39.     if premium then
  40.     begin
  41.       port[$1c]:=port[$1c] or $10;
  42.       t2:=t2-1; mem[i]:=screen_data[t2];
  43.       port[$1c]:=port[$1c] and $ef;
  44.     end;
  45.     if colour then
  46.     begin
  47.       t2:=t2-1; port [8]:=$40; mem[i+2048]:=screen_data[t2]; port[8]:=0;
  48.     end;
  49.     t2:=t2-1; mem[i]:=screen_data[t2];
  50.   end;
  51. end;
  52.  
  53. procedure pushwind(x,y,b,l:integer);
  54. var
  55.   temp,j,k,z:integer;
  56. begin
  57.   if (l>0) and (b>0) and (x>0) and (y>0) then
  58.   begin
  59.     temp:=screen_pointer;
  60.     z:=$f000+(y-1)*80+(x-1);
  61.     for j:=1 to l do
  62.     begin
  63.       for k:=1 to b do
  64.       begin
  65.         get_ret(z+(j-1)*80+k-1,true,temp);
  66.       end;
  67.     end;
  68.     screen_data[temp]:=l;
  69.     temp:=temp+1; screen_data[temp]:=b;
  70.     temp:=temp+1; screen_data[temp]:=x;
  71.     temp:=temp+1; screen_data[temp]:=y; temp:=temp+1;
  72.     if temp<8192 then screen_pointer:=temp;
  73.   end;
  74. end;
  75.  
  76. procedure popwind;
  77. var
  78.   t,i,j,z,x,y,l,b: integer;
  79. begin
  80.   t:=screen_pointer;
  81.   t:=t-1; y:=screen_data[t];
  82.   t:=t-1; x:=screen_data[t];
  83.   t:=t-1; b:=screen_data[t];
  84.   t:=t-1; l:=screen_data[t];
  85.   z:=$f000+(y-1)*80+x-1;
  86.   for i:=l downto 1 do
  87.   begin
  88.     for j:=b downto 1 do get_ret(z+(i-1)*80+j-1,false,t);
  89.   end;
  90.   screen_pointer:=t;
  91. end;
  92.  
  93. {
  94.  This procedure draws a window of width w,height h lines, at
  95.  co-ordinates specified by x,y (1,1 being top right-hand corner
  96.  of screen)
  97.  the dimensions include the delimiting character at the borders
  98.  of the screen.
  99. }
  100.  
  101. procedure window(x,y,w,h:integer;title:str80;opt:boolean);
  102. var
  103.    z,i,j,k,centre:integer;
  104. begin
  105.   if opt then pushwind(x,y,w,h);
  106.   setpcg(0); setcolor(3);
  107.   z:=$f000+(y-1)*80+x-1;
  108.   putchar(z,$a0);
  109.   for i:=1 to w-2 do putchar(z+i,$a0);
  110.   putchar(z+i+1,$a0);
  111.   if h>=2 then
  112.   begin
  113.     for i:= 1 to h-2 do
  114.     begin
  115.       k:=z+i*80;
  116.       putchar(k,$a0);
  117.       for j:=1 to w-2 do putchar(k+j,$20);
  118.       putchar(k+w-1,$a0);
  119.     end;
  120.     k:=z+(h-1)*80;
  121.     putchar(k,$a0);
  122.     for i:=1 to w-2 do putchar(k+i,$a0);
  123.     putchar(k+w-1,$a0);
  124.     i:=(w-length(title)) div 2;
  125.     putat(x+i-1,y); use('P'); setcolor(11); {centre justify the title}
  126.     print (' '+title+' '); setcolor(3); use('p'); {inverse characters}
  127.   end;
  128. end;
  129.  
  130.  
  131.