home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 276.img / FORUM21S.ZIP / WINDOWS.PAS < prev   
Pascal/Delphi Source File  |  1988-02-13  |  3KB  |  194 lines
  1. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit windows;
  5.  
  6. interface
  7.  
  8. uses gentypes,crt,subs1,configrt;
  9.  
  10. var winds:array [0..2] of windowrec;
  11.     split,inuse:integer;
  12.  
  13. procedure getcoor;
  14. procedure usewind (n:byte);
  15. procedure setwind (n:byte; nx1,ny1,nx2,ny2:byte);
  16. procedure initwind (n,nx1,ny1,nx2,ny2,ncolor:byte);
  17. procedure top;
  18. procedure bottom;
  19. procedure wholescreen;
  20. procedure drawsplit;
  21. procedure initwinds;
  22. procedure unsplit;
  23. procedure splitscreen (v:byte);
  24. procedure setoutlock (b:boolean);
  25. procedure bottomline;
  26.  
  27. implementation
  28.  
  29. procedure getcoor;
  30. begin
  31.   with winds[inuse] do begin
  32.     cx:=wherex;
  33.     cy:=wherey;
  34.     if cy<1 then cy:=1;
  35.     if cy>(y2-y1)+1 then cy:=(y2-y1)+1
  36.   end
  37. end;
  38.  
  39. procedure usewind (n:byte);
  40. begin
  41.   getcoor;
  42.   inuse:=n;
  43.   with winds[n] do begin
  44.     window (x1,y1,x2,y2);
  45.     gotoxy (cx,cy);
  46.     textcolor (color);
  47.     textbackground (0);
  48.     lasty:=y2-y1+1
  49.   end
  50. end;
  51.  
  52. procedure setwind (n:byte; nx1,ny1,nx2,ny2:byte);
  53. var i:integer;
  54. begin
  55.   i:=inuse;
  56.   usewind(n);
  57.   with winds[n] do begin
  58.     x1:=nx1;
  59.     y1:=ny1;
  60.     x2:=nx2;
  61.     y2:=ny2
  62.   end;
  63.   usewind(n);
  64.   if n<>i then usewind(i)
  65. end;
  66.  
  67. procedure initwind (n,nx1,ny1,nx2,ny2,ncolor:byte);
  68. begin
  69.   with winds[n] do begin
  70.     x1:=nx1;
  71.     y1:=ny1;
  72.     x2:=nx2;
  73.     y2:=ny2;
  74.     cx:=1;
  75.     cy:=1;
  76.     color:=ncolor
  77.   end
  78. end;
  79.  
  80. procedure top;
  81. begin
  82.   usewind (1)
  83. end;
  84.  
  85. procedure bottom;
  86. begin
  87.   usewind (2)
  88. end;
  89.  
  90. procedure wholescreen;
  91. begin
  92.   usewind (0)
  93. end;
  94.  
  95. procedure drawsplit;
  96. var cnt:integer;
  97. begin
  98.   usewind (0);
  99.   textcolor (splitcolor);
  100.   gotoxy (1,split);
  101.   for cnt:=0 to 79 do write (usr,chr(196));
  102.   bottom
  103. end;
  104.  
  105. procedure initwinds;
  106. begin
  107.   splitmode:=false;
  108.   initwind (0,1,1,80,25,splitcolor);
  109.   initwind (2,1,1,80,24,normbotcolor);
  110.   split:=0;
  111.   inuse:=0;
  112.   bottom
  113. end;
  114.  
  115. procedure unsplit;
  116. var y:integer;
  117. begin
  118.   if not splitmode then exit;
  119.   if inuse=2
  120.     then y:=wherey
  121.     else y:=winds[2].cy;
  122.   y:=y+split;
  123.   setwind (2,1,1,80,24);
  124.   setwind (1,1,1,80,split);
  125.   top;
  126.   clrscr;
  127.   splitmode:=false;
  128.   bottom;
  129.   gotoxy (wherex,y)
  130. end;
  131.  
  132. procedure splitscreen (v:byte);
  133. var x,y:integer;
  134. begin
  135.   if splitmode then unsplit;
  136.   x:=wherex;
  137.   y:=wherey-v;
  138.   splitmode:=true;
  139.   split:=v;
  140.   drawsplit;
  141.   initwind (1,1,1,80,split-1,normtopcolor);
  142.   setwind (2,1,split+1,80,24);
  143.   top;
  144.   clrscr;
  145.   bottom;
  146.   gotoxy (x,y)
  147. end;
  148.  
  149. procedure setoutlock (b:boolean);
  150. begin
  151.   modemoutlock:=b;
  152.   if b
  153.     then winds[2].color:=outlockcolor
  154.     else winds[2].color:=normbotcolor;
  155.   if inuse=2 then usewind (2)
  156. end;
  157.  
  158. procedure bottomline;
  159. var o:integer;
  160.  
  161.   procedure flash (q:mstr);
  162.   begin
  163.     textcolor (16);
  164.     write (usr,q);
  165.     textcolor (0)
  166.   end;
  167.  
  168. begin
  169.   if inuse=0 then exit;
  170.   o:=inuse;
  171.   wholescreen;
  172.   gotoxy (1,25);
  173.   textcolor (0);
  174.   textbackground (statlinecolor);
  175.   if timelock then settimeleft (lockedtime);
  176.   write (usr,unam,', Lvl ',ulvl,', ',timeleft,' left.');
  177.   if chatmode
  178.     then flash (' CHAT!')
  179.     else write (usr,' ',sysopavailstr);
  180.   if timelock then flash (' Timelock');
  181.   if modeminlock then flash (' InLock');
  182.   if modemoutlock then flash (' OutLock');
  183.   if tempsysop then flash (' *Sysop*');
  184.   if texttrap then flash (' Trap');
  185.   if printerecho then flash (' Print');
  186.   if sysnext then write (usr,' Sysop next');
  187.   clreol;
  188.   usewind (o);
  189. end;
  190.  
  191. begin
  192. end.
  193.  
  194.