home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / DOORDR50.ZIP / NEWS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-02  |  20.4 KB  |  716 lines
  1. {$M 48000,0,64000}
  2.  
  3. { EXAMPLE DOOR: ONLINE NEWS                                               }
  4. {               By Scott Baker                                            }
  5. {                                                                         }
  6. {      This program was written for some friends who were using various   }
  7. { online news magazines for their bbs system. (i.e. USA TODAY, INFOMAT,   }
  8. { NEWSBYTES, etc). It demonstrates the usage of the ANSI-MENU routines    }
  9. { as well as some general door-writing ideas.                             }
  10. {      Since the program was written in kind of a hurry, the routines     }
  11. { may have a few small programming flaws, but all-in-all, it works. If    }
  12. { you use ANY of the code in this sample program, then please credit me   }
  13. { in your program.                                                        }
  14.  
  15.  
  16. uses Dos, ddScott, Crt, DoorDriv, AnsiMenu;
  17.  
  18. const
  19.  menu1: menutype =
  20.          (header: 'Online News and Magazine System';
  21.           footer: 'Please type a command letter';
  22.           headercolor: green;
  23.           footercolor: lightgreen;
  24.           optioncolor: yellow;
  25.           desccolor: white;
  26.           arrowcolor: lightred;
  27.           bracketcolor: lightgray;
  28.           numoptions: 5;
  29.           options: ('A','B','C','D','Q','','','','','','','','','','',
  30.                     '','','','','');
  31.           desc: ('USA Today Decisionline',       'InfoMat magazine',
  32.                  'NewsBytes magazine',           'BoxOffice magazine',
  33.                  'Quit to bbs',                  '',
  34.                  '',                             '',
  35.                  '','','','','','','','','','','',''));
  36.  
  37.  menu2: menutype =
  38.          (header: 'USA-Today Decisionline';
  39.           footer: 'Please type a command letter';
  40.           headercolor: green;
  41.           footercolor: lightgreen;
  42.           optioncolor: yellow;
  43.           desccolor: white;
  44.           arrowcolor: lightred;
  45.           bracketcolor: lightgray;
  46.           numoptions: 13;
  47.           options: ('A','B','C','D','E','F','G','H','I','J','K','L','M','',
  48.                     '','','','','','');
  49.           desc: ('Advertising',         'Banking',
  50.                  'Bonus',               'Energy',
  51.                  'Health',              'Insurance',
  52.                  'International',       'Issues',
  53.                  'Legal',               '- Next Page -',
  54.                  'Headline Scan',       'KeyWord Scan',
  55.                  'Quit to Main',
  56.                  '','','','','','',''));
  57.  
  58.  
  59.  
  60.  menu22: menutype =
  61.          (header: 'USA-Today Decisionline';
  62.           footer: 'Please type a command letter';
  63.           headercolor: green;
  64.           footercolor: lightgreen;
  65.           optioncolor: yellow;
  66.           desccolor: white;
  67.           arrowcolor: lightred;
  68.           bracketcolor: lightgray;
  69.           numoptions: 13;
  70.           options: ('A','B','C','D','E','F','G','H','I','J','K','L','M','',
  71.                     '','','','','','');
  72.           desc: ('News',
  73.                  'Personal',            'Realtors',
  74.                  'Sports',              'Technology',
  75.                  'TeleCom',             'Travel',
  76.                  'Trends',              'Weather',
  77.                  '- Prev Page -',       'Headline Scan',
  78.                  'KeyWord Search',      'Quit to main',
  79.                  '','','','','','',''));
  80.  
  81.  menu3: menutype =
  82.          (header: 'BoxOffice magazine';
  83.           footer: 'Please type a command letter';
  84.           headercolor: green;
  85.           footercolor: lightgreen;
  86.           optioncolor: yellow;
  87.           desccolor: white;
  88.           arrowcolor: lightred;
  89.           bracketcolor: lightgray;
  90.           numoptions: 11;
  91.           options: ('A','B','C','D','E','F','G','H','I','J','K','','','','',
  92.                     '','','','','');
  93.           desc: ('Top 10 video rentals',           'Top 10 Grossing films',
  94.                  'Coming festivals and events',    'Hollywood news   ',
  95.                  'Sneak previews     ',            'Boxoffice Trailers',
  96.                  'Special Features/interviews',    'Boxoffice Movie Reviews',
  97.                  'Boxoffice Hollywood reports',    'New Video Releases',
  98.                  'Quit to main','','','','','','','','',''));
  99.  
  100.  
  101.  menu4: menutype =
  102.          (header: 'Info-Mat magazine';
  103.           footer: 'Please type a command letter: ';
  104.           headercolor: green;
  105.           footercolor: lightgreen;
  106.           optioncolor: yellow;
  107.           desccolor: white;
  108.           arrowcolor: lightred;
  109.           bracketcolor: lightgray;
  110.           numoptions: 13;
  111.           options: ('A','B','C','D','E','F','G','H','I','J','K','L','M','','',
  112.                     '','','','','');
  113.           desc: ('BBS Index',             'Computer Industry News',
  114.                  'Software news part 1',  'Software news part 2',
  115.                  'HardWare news',         'General computer news',
  116.                  'Telecom news part 1',   'Telecom news part 2',
  117.                  'Networker''s Journal',  'I didn''t know......',
  118.                  'Shareware/PD software', 'The editor Speaks',
  119.                  'Quit to bbs',
  120.                  '','','','','','',''));
  121.  menu5: menutype =
  122.          (header: 'News Bytes Magazine';
  123.           footer: 'Please type a command letter';
  124.           headercolor: green;
  125.           footercolor: lightgreen;
  126.           optioncolor: yellow;
  127.           desccolor: white;
  128.           arrowcolor: lightred;
  129.           bracketcolor: lightgray;
  130.           numoptions: 13;
  131.           options: ('A','B','C','D','E','F','G','H','I','J','K','L','M','','',
  132.                     '','','','','');
  133.           desc: ('Executive Summary',     'The IBM Report',
  134.                  'The Apple Report',      'The UNIX Report',
  135.                  'General News',          'Trends and Technology',
  136.                  'Business News',         'Government News',
  137.                  'Stock Report',          'Telecommunications',
  138.                  'WYSIWYG Column',        'Boston Computer Ex. Prices',
  139.                  'Quit to bbs',
  140.                  '','','','','','',''));
  141.  menu6: menutype =
  142.          (header: 'Box Office Magazine reviews (pg1)';
  143.           footer: 'Please type a command letter';
  144.           headercolor: green;
  145.           footercolor: lightgreen;
  146.           optioncolor: yellow;
  147.           desccolor: white;
  148.           arrowcolor: lightred;
  149.           bracketcolor: lightgray;
  150.           numoptions: 13;
  151.           options: ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',
  152.                     'P','Q','R','S','T');
  153.           desc: ('','','','','','','','','','','','','','','','','','','',''));
  154.  
  155.  menu7: menutype =
  156.          (header: 'Box Office Magazine reviews (pg2)';
  157.           footer: 'Please type a command letter';
  158.           headercolor: green;
  159.           footercolor: lightgreen;
  160.           optioncolor: yellow;
  161.           desccolor: white;
  162.           arrowcolor: lightred;
  163.           bracketcolor: lightgray;
  164.           numoptions: 13;
  165.           options: ('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',
  166.                     'P','Q','R','S','T');
  167.           desc: ('','','','','','','','','','','','','','','','','','','',''));
  168.  
  169. var
  170.  USATodayDir: string;
  171.  InfomatDir: string;
  172.  NewsBytesDir: string;
  173.  BoxOfficeDir: string;
  174.  FidoNewsFile: string;
  175.  RbbsBitsFile: string;
  176.  BBSListFile: string;
  177.  Headercolor, footercolor, optioncolor, desccolor, arrowcolor, bracketcolor: byte;
  178.  CallerFileName: string;
  179.  CallerFile: text;
  180.  
  181. procedure olddisplayfile(s: string);
  182. begin;
  183.  displayfile(s);
  184. end;
  185.  
  186. procedure displayfile(s: string);
  187. begin;
  188.  olddisplayfile(s);
  189.  swriteln('');
  190.  set_foreground(green);
  191.  swrite('PRESS RETURN:');
  192.  set_foreground(default_fore);
  193.  sread_char(ch);
  194. end;
  195.  
  196. procedure getdirs;
  197. var
  198.  f: text;
  199. begin;
  200.  if not exist('NEWS.DIR') then begin;
  201.   swriteln('News.dir missing!');
  202.   halt;
  203.  end;
  204.  assign(f,'News.dir');
  205.  reset(f);
  206.  readln(f,usatodaydir);
  207.  readln(f,infomatdir);
  208.  readln(f,newsbytesdir);
  209.  readln(f,boxofficedir);
  210.  readln(f,FidoNewsFile);
  211.  readln(f,RbbsBitsFile);
  212.  readln(f,BBSListFile);
  213.  readln(f,headercolor);
  214.  readln(f,footercolor);
  215.  readln(f,desccolor);
  216.  readln(f,optioncolor);
  217.  readln(f,arrowcolor);
  218.  readln(f,bracketcolor);
  219.  readln(f,callerfilename);
  220.  close(f);
  221.  if usatodaydir[1]=';' then usatodaydir:='';
  222.  if infomatdir[1]=';' then infomatdir:='';
  223.  if newsbytesdir[1]=';' then newsbytesdir:='';
  224.  if boxofficedir[1]=';' then boxofficedir:='';
  225.  if fidonewsfile[1]=';' then fidonewsfile:='';
  226.  if rbbsbitsfile[1]=';' then rbbsbitsfile:='';
  227.  if bbslistfile[1]=';' then bbslistfile:='';
  228.  if callerfilename[1]=';' then callerfilename:='';
  229. end;
  230.  
  231. function filedate(s: string): string;
  232. var
  233.  f: file;
  234.  s2: string;
  235.  time: longint;
  236.  dt: datetime;
  237. begin;
  238.  s2:='??-??-??';
  239.  filedate:=s2;
  240.  if not exist(s) then exit;
  241.  assign(f,s);
  242.  reset(f);
  243.  getftime(f,time);
  244.  unpacktime(time,dt);
  245.  s2:=va(dt.month)+'-'+va(dt.day)+'-'+va(dt.year-1900);
  246.  filedate:=s2;
  247. end;
  248.  
  249. procedure OpenCaller;
  250. var
  251.  s: string;
  252.  a: integer;
  253. begin;
  254.  s:='';
  255.  for a:=1 to length(CallerFileName) do if callerfilename[a]='%' then s:=s+va(node_num) else s:=s+callerfilename[a];
  256.  if not exist(s) then begin;
  257.   callerfilename:='';
  258.   exit;
  259.  end;
  260.  assign(callerfile,s);
  261.  append(callerfile);
  262. end;
  263.  
  264. procedure CloseCaller;
  265. begin;
  266.  if callerfilename<>'' then close(callerfile);
  267. end;
  268.  
  269. procedure AddCaller(s: string);
  270. begin;
  271.  if callerfilename<>'' then writeln(callerfile,s);
  272. end;
  273.  
  274. procedure DisplayUSA(s: string);
  275. begin;
  276.  AddCaller('     read '+s);
  277.  displayfile(USATodayDir+'\'+s);
  278. end;
  279.  
  280. procedure DisplayBOX(s: string);
  281. begin;
  282.  AddCaller('     read '+s);
  283.  displayfile(BoxOfficeDir+'\'+s);
  284. end;
  285.  
  286. procedure DisplayIMAN(s: string);
  287. begin;
  288.  AddCaller('     read '+s);
  289.  displayfile(infomatdir+'\'+s);
  290. end;
  291.  
  292. procedure DisplayByte(s: string);
  293. begin;
  294.  AddCaller('     read '+s);
  295.  displayfile(NewsBytesdir+'\'+s);
  296. end;
  297.  
  298. function blankline(s: string): boolean;
  299. begin;
  300.  blankline:=false;
  301.  if s='' then begin;
  302.   blankline:=true;
  303.   exit;
  304.  end;
  305.  while s[length(s)]=' ' do delete(s,length(s),1);
  306.  if s='' then begin;
  307.   blankline:=true;
  308.   exit;
  309.  end;
  310. end;
  311.  
  312. procedure keyword_search(fn: string; word: string; var cont: boolean);
  313. var
  314.  f: text;
  315.  tbuff: array[1..20] of string[85];
  316.  trigger: boolean;
  317.  bufcnt: byte;
  318.  s: string;
  319.  a: integer;
  320.  nonstop: boolean;
  321. begin;
  322.  assign(f,fn);
  323.  reset(f);
  324.  nonstop:=false;
  325.  cont:=true;
  326.  trigger:=false;
  327.  bufcnt:=0;
  328.  while (not eof(f)) and (cont) do begin;
  329.   readln(f,s);
  330.   if not blankline(s) then begin;
  331.    if bufcnt<20 then bufcnt:=bufcnt+1;
  332.    tbuff[bufcnt]:=s;
  333.    if pos(stu(word),stu(s))<>0 then trigger:=true;
  334.   end else begin;
  335.    if trigger then begin;
  336.     for a:=1 to bufcnt do swriteln(tbuff[a]);
  337.     swriteln('');
  338.     if (not nonstop) then begin;
  339.      set_foreground(green);
  340.      swrite('[C]ontinue,[S]top,[N]onstop ? ');
  341.      set_foreground(default_fore);
  342.      sread_char(ch);
  343.      while wherex>1 do swrite(#8+' '+#8);
  344.      ch:=upcase(ch);
  345.      if ch='S' then cont:=false;
  346.      if ch='N' then nonstop:=true;
  347.     end;
  348.    end;
  349.    trigger:=false;
  350.    bufcnt:=0;
  351.   end;
  352.  end;
  353.  close(f);
  354. end;
  355.  
  356. procedure KeywordUSA;
  357. const
  358.  usafilenames: array[1..18] of string =
  359.                 ('Advertis','banking','bonus','energy','health','insure',
  360.                  'interntl','issues','legal','news','personal','realtors',
  361.                  'sports','technol','telecom','travel','trends','weather');
  362. var
  363.  word: string;
  364.  cont: boolean;
  365.  a: integer;
  366. begin;
  367.  set_foreground(lightcyan);
  368.  swrite('Enter Keyword for search: ');
  369.  set_foreground(white);
  370.  sread(word);
  371.  set_foreground(default_fore);
  372.  cont:=true;
  373.  a:=1;
  374.  while (a<19) and (cont) do begin;
  375.   keyword_search(usatodaydir+'\'+usafilenames[a]+'.usa',word,cont);
  376.   a:=a+1;
  377.  end;
  378. end;
  379.  
  380. procedure USAToday2(var ch: char);
  381. begin;
  382.  ch:=' ';
  383.  repeat;
  384.   menu22.header:='USA-Today Decisionline '+filedate(usatodaydir+'\'+'advertis.usa');
  385.   ch:=Getansimenu(menu22);
  386.   sclrscr;
  387.   case ch of
  388.    'A': displayUSA('News.usa');
  389.    'B': displayUSA('Personal.usa');
  390.    'C': displayUSA('Realtors.usa');
  391.    'D': displayUSA('Sports.usa');
  392.    'E': displayUSA('Technol.usa');
  393.    'F': displayUSA('Telecom.usa');
  394.    'G': displayUSA('Travel.usa');
  395.    'H': displayUSA('Trends.usa');
  396.    'I': displayUSA('Weather.usa');
  397.    'K': displayUSA('Headline.usa');
  398.    'L': KeyWordUSA;
  399.   end;
  400.  until (ch='M') or (ch='J');
  401. end;
  402.  
  403. procedure USAToday;
  404. var
  405.  ch: char;
  406. begin;
  407.  AddCaller('   Entered USA-Today Section');
  408.  repeat;
  409.   menu2.header:='USA-Today Decisionline '+filedate(usatodaydir+'\'+'advertis.usa');
  410.   ch:=Getansimenu(menu2);
  411.   sclrscr;
  412.   case ch of
  413.    'A': displayUSA('Advertis.usa');
  414.    'B': displayUSA('Banking.usa');
  415.    'C': displayUSA('Bonus.usa');
  416.    'D': displayUSA('Energy.usa');
  417.    'E': displayUSA('Health.usa');
  418.    'F': displayUSA('Insure.usa');
  419.    'G': displayUSA('Interntl.usa');
  420.    'H': displayUSA('Issues.usa');
  421.    'I': displayUSA('Legal.usa');
  422.    'J': USAToday2(ch);
  423.    'K': displayUSA('Headline.usa');
  424.    'L': KeyWordUSA;
  425.   end;
  426.  until ch='M';
  427. end;
  428.  
  429. procedure InfoMat;
  430. var
  431.  ch: char;
  432. begin;
  433.  AddCaller('   Entered InfoMat Magazine Section');
  434.  repeat;
  435.   ch:=Getansimenu(menu4);
  436.   sclrscr;
  437.   case ch of
  438.    'A': displayIMAN('IMAN1.TXT');
  439.    'B': displayIMAN('IMAN2.TXT');
  440.    'C': displayIMAN('IMAN3.TXT');
  441.    'D': displayIMAN('IMAN4.TXT');
  442.    'E': displayIMAN('IMAN5.TXT');
  443.    'F': displayIMAN('IMAN6.TXT');
  444.    'G': displayIMAN('IMAN7.TXT');
  445.    'H': displayIMAN('IMAN8.TXT');
  446.    'I': displayIMAN('IMAN9.TXT');
  447.    'J': displayIMAN('IMAN10.TXT');
  448.    'K': displayIMAN('IMAN11.TXT');
  449.    'L': displayIMAN('IMAN12.TXT');
  450.   end;
  451.  until ch='M';
  452. end;
  453.  
  454. procedure NewsBytes;
  455. var
  456.  ch: char;
  457. begin;
  458.  AddCaller('  Entered NewsBytes Section');
  459.  repeat;
  460.   ch:=Getansimenu(menu5);
  461.   sclrscr;
  462.   case ch of
  463.    'A': displayBYTE('Exec.nsb');
  464.    'B': displayBYTE('IBM.nsb');
  465.    'C': displayBYTE('Apple.nsb');
  466.    'D': displayBYTE('unix.nsb');
  467.    'E': displayBYTE('general.nsb');
  468.    'F': displayBYTE('trends.nsb');
  469.    'G': displayBYTE('business.nsb');
  470.    'H': displayBYTE('governmnt.nsb');
  471.    'I': displayBYTE('stocks.nsb');
  472.    'J': displayBYTE('telecom.nsb');
  473.    'K': displayBYTE('wysiwyg.nsb');
  474.    'L': displayBYTE('bostcomp.nsb');
  475.   end;
  476.  until ch='M';
  477. end;
  478.  
  479. function KillTHE(s: string): string;
  480. begin;
  481.  if pos('THE ',stu(s))=1 then delete(s,1,4);
  482.  if pos('A ',stu(s))=1 then delete(s,1,2);
  483.  KillTHE:=s;
  484. end;
  485.  
  486. procedure boxreview;
  487. type
  488.  boxrec = record
  489.            fname: string[12];
  490.            desc: string[35];
  491.            letter: char;
  492.            menunum: byte;
  493.           end;
  494. const
  495.  letters: string= ('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  496. type
  497.  reviewtype= array[1..512] of boxrec;
  498.  reviewptr= ^reviewtype;
  499. var
  500.  a,b,c: integer;
  501.  ch: char;
  502.  fname: string;
  503.  sr: searchrec;
  504.  reviews1,reviews2: reviewptr;
  505.  s: string;
  506.  num,n,numentries,menunum: word;
  507.  numsort,lowrevnum: word;
  508.  nummenus, highnum: word;
  509.  lowrevdesc: string;
  510.  f: text;
  511.  menu: array[1..20] of menutype;
  512. begin;
  513.  new(reviews1);
  514.  new(reviews2);
  515.  for a:=1 to 512 do begin;
  516.   reviews1^[a].desc:='';
  517.   reviews1^[a].fname:='';
  518.   reviews1^[a].letter:=' ';
  519.  end;
  520.  findfirst(boxofficedir+'\br*.*',anyfile,sr);
  521.  numentries:=0;
  522.  while doserror=0 do begin;
  523.   numentries:=numentries+1;
  524.   s:='';
  525.   for a:=pos('R',sr.name)+1 to pos('.',sr.name)-1 do s:=s+sr.name[a];
  526.   val(s,num,b);
  527.   reviews1^[num].fname:=sr.name;
  528.   assign(f,boxofficedir+'\'+sr.name);
  529.   reset(f);
  530.   readln(f,reviews1^[num].desc);
  531.   close(f);
  532.   findnext(sr);
  533.  end;
  534.  numsort:=0;
  535.  repeat;
  536.   lowrevnum:=0;
  537.   lowrevdesc:='ZZZZZZZZ';
  538.   for a:=1 to 512 do if reviews1^[a].desc<>'' then
  539.    if killTHE(reviews1^[a].desc)<killTHE(lowrevdesc) then begin;
  540.    lowrevnum:=a;
  541.    lowrevdesc:=reviews1^[a].desc;
  542.   end;
  543.   if lowrevnum<>0 then begin;
  544.    numsort:=numsort+1;
  545.    reviews2^[numsort]:=reviews1^[lowrevnum];
  546.    reviews1^[lowrevnum].desc:='';
  547.   end;
  548.  until lowrevnum=0;
  549.  nummenus:=(numsort div 10)+1;
  550.  for a:=1 to nummenus do begin;
  551.   menu[a]:=menu6;
  552.   highnum:=((a-1)*10)+10;
  553.   if highnum>numsort then highnum:=numsort;
  554.   c:=0;
  555.   for b:=((a-1)*10)+1 to highnum do begin;
  556.    c:=c+1;
  557.    menu[a].options[c]:=letters[c];
  558.    menu[a].desc[c]:=reviews2^[b].desc;
  559.    reviews2^[b].letter:=letters[c];
  560.    reviews2^[b].menunum:=a;
  561.   end;
  562.   c:=c+1;
  563.   if a<nummenus then begin;
  564.    menu[a].options[c]:='N';
  565.    menu[a].desc[c]:='Next Menu';
  566.    c:=c+1;
  567.   end;
  568.   if a>1 then begin;
  569.    menu[a].options[c]:='P';
  570.    menu[a].desc[c]:='Previous Menu';
  571.    c:=c+1;
  572.   end;
  573.   menu[a].options[c]:='Q';
  574.   menu[a].desc[c]:='Quit to BoxOffice Menu';
  575.   menu[a].numoptions:=c;
  576.  end;
  577.  menunum:=1;
  578.  repeat;
  579.   ch:=getansimenu(menu[menunum]);
  580.   sclrscr;
  581.   ch:=upcase(ch);
  582.   fname:='';
  583.   for a:=1 to numsort do if (ch=reviews2^[a].letter) and (reviews2^[a].menunum=menunum) then fname:=reviews2^[a].fname;
  584.   if fname<>'' then displayBOX(fname);
  585.   if ch='N' then menunum:=menunum+1;
  586.   if ch='P' then menunum:=menunum-1;
  587.  until ch='Q';
  588.  dispose(reviews1);
  589.  dispose(reviews2);
  590. end;
  591.  
  592. procedure Boxoffice;
  593. var
  594.  ch: char;
  595. begin;
  596.  AddCaller('   Entered BoxOffice Magazine');
  597.  repeat;
  598.   ch:=getansimenu(menu3);
  599.   sclrscr;
  600.   case ch of
  601.    'A': displayBOX('topvid.txt');
  602.    'B': displayBOX('botop10.txt');
  603.    'C': displayBOX('fest.txt');
  604.    'D': displayBOX('hwd.txt');
  605.    'E': displayBOX('sneak.txt');
  606.    'F': displayBOX('trail.txt');
  607.    'G': displayBOX('bfeal.txt');
  608.    'H': boxreview;
  609.    'I': displayBOX('hrl.txt');
  610.    'J': displayBOX('ovnew.txt');
  611.   end;
  612.  until ch='K';
  613. end;
  614.  
  615. procedure SetMenuColor(var menu: menutype);
  616. begin;
  617.  menu.headercolor:=headercolor;
  618.  menu.footercolor:=footercolor;
  619.  menu.optioncolor:=optioncolor;
  620.  menu.desccolor:=desccolor;
  621.  menu.arrowcolor:=arrowcolor;
  622.  menu.bracketcolor:=bracketcolor;
  623. end;
  624.  
  625. procedure mainmenu;
  626. const
  627.  letters: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  628. var
  629.  ch: char;
  630.  select: byte;
  631.  selections: array[1..100] of byte;
  632. begin;
  633.  menu1.numoptions:=0;
  634.  if USATodaydir<>'' then begin;
  635.   menu1.numoptions:=menu1.numoptions+1;
  636.   menu1.options[menu1.numoptions]:=letters[menu1.numoptions];
  637.   menu1.desc[menu1.numoptions]:='USA Today Decisionline';
  638.   selections[ord(letters[menu1.numoptions])]:=1;
  639.  end;
  640.  if InfoMatDir<>'' then begin;
  641.   menu1.numoptions:=menu1.numoptions+1;
  642.   menu1.options[menu1.numoptions]:=letters[menu1.numoptions];
  643.   menu1.desc[menu1.numoptions]:='InfoMat magazine';
  644.   selections[ord(letters[menu1.numoptions])]:=2;
  645.  end;
  646.  if NewsBytesDir<>'' then begin;
  647.   menu1.numoptions:=menu1.numoptions+1;
  648.   menu1.options[menu1.numoptions]:=letters[menu1.numoptions];
  649.   menu1.desc[menu1.numoptions]:='NewsBytes magazine';
  650.   selections[ord(letters[menu1.numoptions])]:=3;
  651.  end;
  652.  if Boxofficedir<>'' then begin;
  653.   menu1.numoptions:=menu1.numoptions+1;
  654.   menu1.options[menu1.numoptions]:=letters[menu1.numoptions];
  655.   menu1.desc[menu1.numoptions]:='BoxOffice Magazine';
  656.   selections[ord(letters[menu1.numoptions])]:=4;
  657.  end;
  658.  if FidonewsFile<>'' then begin;
  659.   menu1.numoptions:=menu1.numoptions+1;
  660.   menu1.options[menu1.numoptions]:=letters[menu1.numoptions];
  661.   menu1.desc[menu1.numoptions]:='FidoNews Newsletter';
  662.   selections[ord(letters[menu1.numoptions])]:=5;
  663.  end;
  664.  if RbbsbitsFile<>'' then begin;
  665.   menu1.numoptions:=menu1.numoptions+1;
  666.   menu1.options[menu1.numoptions]:=letters[menu1.numoptions];
  667.   menu1.desc[menu1.numoptions]:='Rbbsbits Newsletter';
  668.   selections[ord(letters[menu1.numoptions])]:=6;
  669.  end;
  670.  if BBSListFile<>'' then begin;
  671.   menu1.numoptions:=menu1.numoptions+1;
  672.   menu1.options[menu1.numoptions]:=letters[menu1.numoptions];
  673.   menu1.desc[menu1.numoptions]:='Local BBS listing';
  674.   selections[ord(letters[menu1.numoptions])]:=7;
  675.  end;
  676.  menu1.numoptions:=menu1.numoptions+1;
  677.  menu1.options[menu1.numoptions]:='Q';
  678.  menu1.desc[menu1.numoptions]:='Quit to bbs';
  679.  selections[ord('Q')]:=8;
  680.  repeat;
  681.   ch:=Getansimenu(menu1);
  682.   sclrscr;
  683.   select:=selections[ord(ch)];
  684.   case select of
  685.    1: UsaToday;
  686.    2: infomat;
  687.    3: newsbytes;
  688.    4: BoxOffice;
  689.    5: displayfile(fidonewsfile);
  690.    6: displayfile(rbbsbitsfile);
  691.    7: displayfile(bbslistfile);
  692.   end;
  693.  until select=8;
  694. end;
  695.  
  696. begin;
  697.  InitDoorDriver('NEWS.CTL');
  698.  progname:='Online News';
  699.  midscreeny:=12;
  700.  midscreenx:=40;
  701.  getdirs;
  702.  setmenucolor(menu1);
  703.  setmenucolor(menu2);
  704.  setmenucolor(menu22);
  705.  setmenucolor(menu3);
  706.  setmenucolor(menu4);
  707.  setmenucolor(menu5);
  708.  setmenucolor(menu6);
  709.  setmenucolor(menu7);
  710.  swriteln('ONLINE NEWS Version 2.00 by Scott M. Baker');
  711.  swriteln('');
  712.  delay(1000);
  713.  OpenCaller;
  714.  mainmenu;
  715.  CloseCaller;
  716. end.