home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / WINDOWS.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-30  |  4KB  |  212 lines
  1. {$R-,S-,I-,D-,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,23,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,23);
  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,23);
  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. var baud:string;
  169. begin
  170.   if inuse=0 then exit;
  171.   o:=inuse;
  172.   wholescreen;
  173.   gotoxy (1,24);
  174.   textcolor (0);
  175.   textbackground (statlinecolor);
  176.   if timelock then settimeleft (lockedtime);
  177. write (usr,unam,'  Lvl:',ulvl,'  FLvl:',urec.udlevel,'  GLvl:',urec.gflevel,'  Time:',timeleft,'  ');
  178.   if timelock then settimeleft (lockedtime);
  179.   str (baudrate,baud);
  180.   if local then baud:='[Local]' else baud:='['+baud+'] baud';
  181.   if useqr then begin
  182.    with urec do
  183.    qr:=qrmultifactor*(urec.uploads+urec.nbu)-urec.downloads;
  184.    write (usr,'QR:',qr,'  ');
  185.   end;
  186.   write (usr,baud);
  187.   clreol; gotoxy(1,25); clreol;
  188.   if scrambled then flash ('Scramble');
  189.   if timelock then flash (' TimeLock');
  190.   if modeminlock then flash (' InLock');
  191.   if modemoutlock then flash (' OutLock');
  192.   if tempsysop then flash (' Sysop');
  193.   if texttrap then flash (' Trap');
  194.   if printerecho then flash (' Print');
  195.   if sysnext then write (usr,' Sysop Next');
  196.   textcolor(0);
  197.   gotoxy(25,25);
  198.   if chatmode then begin
  199.             flash('CHAT');
  200.             write(usr,' (',chatreason,')');
  201.            end else
  202.             write(usr,'Avail: ',sysopavailstr);
  203.   gotoxy(55,25); write(usr,copy(urec.note,1,25):25);
  204.   textbackground (statlinecolor);
  205.   clreol;
  206.   usewind (o);
  207. end;
  208.  
  209. begin
  210. end.
  211.  
  212.