home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / bbp_info.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  7.6 KB  |  241 lines
  1. unit bbp_info;
  2.  
  3. interface
  4.  
  5. uses crt, video, bbp_vars, optimer, extras, grmenus, grwins,
  6.      ferror, mouseio, types, sos;
  7.  
  8. procedure info;
  9. procedure readtopictable(fn:string);
  10.  
  11. type topictype = record
  12.                      topic, subtitle :string;
  13.                      astart, aend    :word;
  14.                    end;
  15.  
  16. var document    :array[1..maxdoclength] of ^string;
  17.     doclength   :word;
  18.     docname     :string;
  19.     topictable  :array[1..20] of ^topictype;
  20.     topiccount  :byte;
  21.  
  22. implementation
  23.  
  24. procedure readtextfile(topic:topictype);
  25. const artpagelen = 16;
  26.       file_maxlen = 1024;
  27. var sfn                :string;
  28.     total_lines        :word;
  29.     t                  :text;
  30.     curl,x,y,z,bar     :word;
  31.     ch                 :char;
  32.     tempstr            :string;
  33.  
  34. procedure readarticle_info;
  35. var ch:char;
  36.     sa:byte;
  37. begin
  38.   sa:=textattr;
  39.   openbox(4,22,7,55,17,true,true,true);
  40.   window(24,8,55,16);
  41.   fadewriteln(' Mr. Doc. Reader Module v2.10');
  42.   fadewriteln('------------------------------');
  43.   fadewriteln('file_maxlen = '+stg(file_maxlen));
  44.   fadewriteln('total_lines = '+stg(total_lines));
  45.   fadewriteln('curl = '+stg(curl));
  46.   fadewriteln('celerity_colorcodes = enabled');
  47.   fadewriteln('percentage_bar = '+stg(bar));
  48.   writeln;
  49.   fadewrite('03/12/1993 (C) Onkel Dittmeyer');
  50.   ch:=readkey;
  51.   closebox(4);
  52.   textattr:=sa;
  53. end;
  54.  
  55. begin
  56.   openbox(1,1,1,80,3,false,true,false);
  57.   openbox(3,1,23,80,25,false,true,false);
  58.   textbackground(colors.win_background);
  59.   gotoxy(3,24); cwrite('|Y'^X^Y' |WScroll        |YPgUp/PgDn |WPage Fl');
  60.                 cwrite('|Wip       |YHome/End |WBegin/End       |YESC |WQuit');
  61.   gotoxy(55,2); cwrite('|WReading: |Y'+topic.topic);
  62.   gotoxy(3,2); cwrite('|1|W                           |0|G       0%');
  63.   openbox(2,1,4,80,4+artpagelen+2,false,true,false);
  64.   curl:=1;
  65.   total_lines:=topic.aend-topic.astart;
  66.   window(4,5,78,4+artpagelen+1);
  67.   repeat
  68.     bar:=round(100/(total_lines-artpagelen)*curl) div 2+2;
  69.     z:=textattr;
  70.     window(3,2,80,2);
  71.     gotoxy(1,1);
  72.     textattr:=colors.progressbar;
  73.     for x:=1 to bar div 2 do write('█');
  74.     if bar mod 2=1 then write('▌');
  75.     for x:=1 to 26-bar div 2 do write(' ');
  76.     if bar mod 2=0 then write(' ');
  77.     if round(100/(total_lines-artpagelen)*curl)=100 then write(^H'█');
  78.     textattr:=colors.win_text;
  79.     write('     ',100/(total_lines-artpagelen)*curl:3:0,'%  ');
  80.     textattr:=z;
  81.     window(4,5,78,21);
  82.     for x:=curl to curl+artpagelen do begin
  83.       gotoxy(1,x-curl+1);
  84.       textattr:=colors.win_background*16+cyan;
  85.       if x<=total_lines then cwrite(document[x+topic.astart]^);
  86.       clreol;
  87.     end;
  88.     if mousepresent then repeat until keypressed or mouseleftclicked or mouserightclicked
  89.     else repeat until keypressed;
  90.     if mouseleftclicked and mouserightclicked and mousepresent then begin
  91.       repeat until not(mouseleftclicked) and not(mouserightclicked);
  92.       window(1,1,80,25);
  93.       closebox(3);
  94.       closebox(2);
  95.       closebox(1);
  96.       exit;
  97.     end;
  98.     if mouseleftclicked and mousepresent then begin
  99.       delayms(5);
  100.       if curl<(total_lines-artpagelen) then inc(curl);
  101.     end;
  102.     if mouserightclicked and mousepresent then begin
  103.       delayms(5);
  104.       if curl>1 then dec(curl);
  105.     end;
  106.     if keypressed then begin
  107.       repeat ch:=readkey until ch in [#27,#0];
  108.       if ch=#0 then ch:=readkey;
  109.       case ch of
  110.         CurUp:if curl>1 then dec(curl);
  111.         CurDn:if curl<(total_lines-artpagelen) then inc(curl);
  112.         PgUp :if curl>artpagelen then dec(curl,artpagelen) else curl:=1;
  113.         PgDn :if curl<(total_lines-(artpagelen*2)) then inc(curl,artpagelen) else curl:=total_lines-artpagelen;
  114.         Home :curl:=1;
  115.         Endk :curl:=total_lines-artpagelen;
  116.         F1   :readarticle_info;
  117.       end;
  118.       if curl>total_lines-artpagelen then begin
  119.         curl:=total_lines-artpagelen;
  120.         sound(1000);
  121.         delayms(100);
  122.         nosound;
  123.       end;
  124.     end;
  125.   until ch=#27;
  126.   window(1,1,80,25);
  127.   closebox(3);
  128.   closebox(2);
  129.   closebox(1);
  130. end;
  131.  
  132. procedure readtopictable(fn:string);
  133. var t   :text;
  134.     buf :array[1..1024] of byte;
  135.     br  :word;
  136. begin
  137.   if not sosexist(fn) then fatalerror('Document file '+fn+' not found in database.');
  138.   topiccount:=0;
  139.   doclength:=0;
  140.   sosopen;
  141.   sosfopen(fn);
  142.   inc(doclength);
  143.   new(document[doclength]);
  144.   document[doclength]^:='';
  145.   repeat
  146.     sosblockread(@buf,sizeof(buf),br);
  147.     for x:=1 to br do begin
  148.       if buf[x]=13 then begin
  149.         inc(doclength);
  150.         new(document[doclength]);
  151.         document[doclength]^:='';
  152.       end else if buf[x]<>10 then document[doclength]^:=document[doclength]^+chr(buf[x]);
  153.     end;
  154.   until br<>sizeof(buf);
  155.   sosclose;
  156.   x:=0;
  157.   repeat inc(x) until copy(document[x]^,1,length('.DOCUMENT'))='.DOCUMENT';
  158.   docname:=copy(document[x]^,length('.DOCUMENT')+2,length(document[x]^)-length('.DOCUMENT'));
  159.   x:=0;
  160.   repeat
  161.     inc(x);
  162.     if copy(document[x]^,1,length('.TOPIC'))='.TOPIC' then begin
  163.       inc(topiccount);
  164.       new(topictable[topiccount]);
  165.       topictable[topiccount]^.topic:=copy(document[x]^,length('.TOPIC')+2,length(document[x]^)-length('.TOPIC'));
  166.       topictable[topiccount]^.astart:=x+1;
  167.       repeat inc(x) until copy(document[x]^,1,length('.SUBTITLE'))='.SUBTITLE';
  168.       topictable[topiccount]^.subtitle:=copy(document[x]^,length('.SUBTITLE')+2,length(document[x]^)-length('.SUBTITLE'));
  169.       repeat inc(x) until copy(document[x]^,1,length('.END'))='.END';
  170.       topictable[topiccount]^.aend:=x-1;
  171.     end;
  172.   until x=doclength;
  173. end;
  174.  
  175. procedure topicread(fn:string);
  176. var s           :string;
  177.     x,result    :word;
  178.     saveatt     :byte;
  179. begin
  180.   saveatt:=colors.win_item;
  181.   colors.win_item:=lightcyan;
  182.   move(mem[vadr:0],save,4000);
  183.   openbox(5,1,1,80,3,false,true,false);   ignbox(5);
  184.   openbox(6,1,4,80,22,false,true,false);  ignbox(6);
  185.   openbox(7,1,23,80,25,false,true,false); ignbox(7);
  186.   gotoxy(3,2);
  187.   cwrite('|WDocEngine V2.o1                             Document: |YLoading...');
  188.   gotoxy(3,24);
  189.   cwrite('|YUp/Down |WChoose paragraph      |YENTER |WRead desired paragraph      |YESC |WBail Out');
  190.   readtopictable(fn);
  191.   vmemwrite(57,2,docname,yellow);
  192.   for x:=1 to topiccount do menuitem[x]:=topictable[x]^.topic;
  193.   for x:=1 to topiccount do vmemwrite(27,4+x,topictable[x]^.subtitle,cyan);
  194.   menucount:=topiccount;
  195.   result:=1;
  196.   repeat
  197.     result:=menu(2,4,result,true,true,false,false,false);
  198.     if result<>0 then readtextfile(topictable[result]^);
  199.   until result=0;
  200.   for x:=1 to topiccount do dispose(topictable[x]);
  201.   for x:=1 to doclength do dispose(document[x]);
  202.   move(save,mem[vadr:0],4000);
  203.   colors.win_item:=saveatt;
  204. end;
  205.  
  206. procedure generatekey;
  207. begin
  208.   openbox(17,10,6,70,13,true,true,true);
  209.   vmemwrite(30,6,' Generate PGP key ',colors.win_title);
  210.   window(12,7,69,12);
  211.   textattr:=colors.win_text;
  212.   clrscr;
  213.   writeln('Writing key to ONKELD.KEY...');
  214.   sos.extract(masterfile,'ONKELD.KEY');
  215.   writeln('SOSexport done!');
  216.   victorioustune;
  217.   window(1,1,80,25);
  218.   tapenter(13);
  219.   closebox(17);
  220. end;
  221.  
  222. procedure info;
  223. var choice:byte;
  224.     save:array[1..4000] of byte;
  225. begin
  226.   choice:=1;
  227.   repeat
  228.     menuitem[1]:='Read Documentation';
  229.     menuitem[2]:='Generate PGP key';
  230.     menuinfo[1]:='Read the BLUEBEEP.DOC documentation file for BlueBEEP!';
  231.     menuinfo[2]:='Generate Onkel Dittmeyer''s 1024-bit PGP key on disk';
  232.     menucount:=2;
  233.     choice:=menu(51,4,choice,true,true,true,true,true);
  234.     case choice of
  235.       1 :topicread('BLUEBEEP.DOC');
  236.       2 :generatekey;
  237.     end;
  238.   until choice=0;
  239. end;
  240. end.
  241.