home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / bbsdoors / bvote.arc / BVOTE1.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-24  |  27KB  |  1,173 lines
  1.  
  2. program voter;
  3. uses dos, crt;
  4.  
  5. type
  6.     booth = record
  7.           question : array[1..3] of string[75];
  8.           choices : array[1..20,1..3] of string[50];
  9.           votes : array[1..20] of word;
  10.           creator : string[35];
  11.           created : longint;
  12.           available : byte;
  13.           totalvotes : word;
  14.           responseto : integer;
  15.           track, killed, addons, titleit, multi : boolean;
  16.           end;
  17.     linestring = string[80];
  18.     pollplace = record
  19.              addsec, syssec : integer;
  20.              atrack, aaddons, amulti : boolean;
  21.              booths : byte;
  22.              lmessage : string[78];
  23.              end;
  24.     user = record
  25.          name : string[35];
  26.          seclvl : integer;
  27.          bbsname : string[78];
  28.          end;
  29.  
  30. var
  31.    pplace : file of pollplace;
  32.    pp : pollplace;
  33.    booths, tbfile : file of booth;
  34.    bb,tb : booth;
  35.    doorinfo, logfile, trackfile, textfile : text;
  36.    i, j, k, linecount, code : integer;
  37.    ch, cr, bs, del, ctlx, tab : char;
  38.    buflen, chn : byte;
  39.    aline : linestring;
  40.    abort, letemout : boolean;
  41.    vfilename : string[6];
  42.    whoson : user;
  43.    commands : string[9];
  44.  
  45. procedure beep;
  46. begin
  47. write(chr(7));
  48. end;
  49.  
  50. procedure YesNo(default:char);
  51. begin
  52. write(default+chr(8));
  53. repeat
  54.      ch := upcase(readkey);
  55.      if ch = cr then ch := default;
  56. until ch in ['Y','N'];
  57. if ch = 'Y' then writeln('Yes') else writeln('No');
  58. end;
  59.  
  60. function ucase(tempstr:linestring):linestring;
  61. var
  62.    i : integer;
  63. begin
  64. for i := 1 to length(tempstr) do tempstr[i] := upcase(tempstr[i]);
  65. ucase := tempstr;
  66. end;
  67.  
  68. function qowner:boolean;
  69. begin
  70. if (ucase(bb.creator) = ucase(whoson.name)) or (whoson.seclvl >= pp.syssec) then
  71.    qowner := true else qowner := false;
  72. end;
  73.  
  74. function uplow(tempstr:linestring):linestring;
  75. var
  76.    i : integer;
  77. begin
  78. for i := 1 to length(tempstr) do
  79.     if (ord(tempstr[i]) > 64) and (ord(tempstr[i]) < 91) then
  80.       tempstr[i] := chr(ord(tempstr[i])+32);
  81. tempstr[1] := upcase(tempstr[1]);
  82. uplow := tempstr;
  83. end;
  84.  
  85. function exist(filename:linestring) : boolean;
  86. var
  87.    sample : text;
  88. begin
  89. assign(textfile,filename);
  90. {$I-}
  91. reset(textfile);
  92. {$I+}
  93. if ioresult = 0 then
  94.    begin
  95.    exist := true;
  96.    close(textfile);
  97.    end
  98. else
  99.     exist := false;
  100. end;
  101.  
  102. function instring:linestring;
  103. var
  104.    instr : linestring;
  105.    j : integer;
  106. const
  107.     blanks : linestring = '                                                                                ';
  108. begin
  109. instr := blanks;
  110. j := 0;
  111. repeat
  112.      ch := readkey;
  113.      if (ch > chr(31)) and (ch < chr(127)) then
  114.         begin
  115.         if j < buflen then
  116.           begin
  117.           j := succ(j);
  118.           instr[j] := ch;
  119.           write(ch);
  120.           end
  121.         else
  122.            beep;
  123.         end
  124.      else
  125.         begin
  126.         if ch = cr then
  127.            begin
  128.            mem[seg(instr):ofs(instr)] := j;
  129.            writeln;
  130.            end
  131.         else
  132.             begin
  133.             if (ch = bs) or (ch = del) then
  134.               begin
  135.               if j >= 1 then
  136.                 begin
  137.                 j := pred(j);
  138.                 write(bs+' '+bs);
  139.                 end
  140.               else
  141.                  begin
  142.                  beep;
  143.                  end;
  144.               end
  145.             else
  146.                begin
  147.                if ch = ctlx then
  148.                  begin
  149.                  while j > 0 do
  150.                       begin
  151.                       j := pred(j);
  152.                       write(bs+' '+bs);
  153.                       end;
  154.                  end
  155.                else
  156.                   if ch = tab then
  157.                     begin
  158.                     if j < (buflen - 5) then
  159.                        begin
  160.                        repeat
  161.                             write(' ');
  162.                             j := succ(j);
  163.                        until (j mod 5) = 0;
  164.                        end
  165.                     else
  166.                         beep;
  167.                     end
  168.                   else
  169.                      beep;
  170.                end;
  171.             end;
  172.         end;
  173. until (ch = cr);
  174. instring := instr;
  175. if j = 0 then instring := '';
  176. end;
  177.  
  178. function startstop:boolean;
  179. begin
  180. startstop := false;
  181. abort := false;
  182. ch := chr(0);
  183. chn := 0;
  184. if keypressed then
  185.    begin
  186.    ch := readkey;
  187.    chn := ord(ch);
  188.    end;
  189. if ((chn = 83) or (chn = 115)) then
  190.    abort := true
  191. else
  192.     if (chn = 80) or (chn = 112) or (linecount = 22) then
  193.       begin
  194.       startstop := true;
  195.       write('  any key to go on; S to stop',cr);
  196.       repeat until keypressed;
  197.       ch := readkey;
  198.       chn := ord(ch);
  199.       if ((chn = 83) or (chn = 115)) then abort := true;
  200.       linecount := 0;
  201.       end;
  202. end;
  203.  
  204. procedure showfile(filnam:linestring);
  205. var
  206.    filvar : text;
  207.    fillin : linestring;
  208. begin
  209. assign(textfile,filnam);
  210. reset(textfile);
  211. writeln('P to pause; any key to go on; S to stop');
  212. repeat
  213.      linecount := 0;
  214.      repeat
  215.           linecount := succ(linecount);
  216.           readln(textfile,aline);
  217.           writeln(aline);
  218.      until (startstop or abort) or eof(textfile);
  219. until abort or eof(textfile);
  220. writeln;
  221. close(textfile);
  222. abort := false;
  223. end;
  224.  
  225. procedure createnewsurvey;
  226. begin
  227. writeln;
  228. writeln('Fine, I will create a new polling place called ',vfilename,'.');
  229. writeln('Remember, the following files are created for each survey:');
  230. writeln;
  231. writeln('     o ',vfilename:8,'.VB  - contains all questions and results');
  232. writeln('     o ',vfilename:8,'.LOG - log of all activity in survey');
  233. writeln('     o ',vfilename:8,'.U1 ...');
  234. writeln('       ',vfilename:8,'.Uxx - names of voters for fixed booths');
  235. writeln;
  236. writeln('And you should create ',vfilename,'.WEL as a welcome file for this');
  237. writeln('polling place.');
  238. assign(pplace,vfilename+'.pp');
  239. rewrite(pplace);
  240. with pp do
  241.     begin
  242.     writeln;
  243.     write('Only allow people to vote once?');
  244.     yesno('N');
  245.     if ch = 'N' then atrack := false else atrack := true;
  246.     write('Allow users to add responses (more choices)?');
  247.     yesno('Y');
  248.     if ch = 'N' then aaddons := false else aaddons := true;
  249.     write('Allow multi-line choices?');
  250.     yesno('N');
  251.     if ch = 'N' then amulti := false else amulti := true;
  252.     booths := 0;
  253.     lmessage := '';
  254.     write('Minimum security to create a booth?');
  255.     buflen := 8;
  256.     val(instring,addsec,code);
  257.     write('Minimum sysop security?');
  258.     val(instring,syssec,code);
  259.     end;
  260. seek(pplace,0);
  261. write(pplace,pp);
  262. assign(booths,vfilename+'.VB');
  263. rewrite(booths);
  264. close(booths);
  265. writeln;
  266. writeln('New polling place ',vfilename,' created...');
  267. close(pplace);
  268. end;
  269.  
  270. function checkforuser:boolean;
  271. var
  272.    number : string[2];
  273.    track : boolean;
  274.    temp : string[36];
  275. begin
  276. str(j,number);
  277. assign(trackfile,vfilename+'.U'+number);
  278. reset(trackfile);
  279. track := false;
  280. repeat
  281.      readln(trackfile,temp);
  282.      if ucase(temp) = ucase(whoson.name) then track := true;
  283. until eof(trackfile) or track;
  284. close(trackfile);
  285. checkforuser := track;
  286. end;
  287.  
  288. procedure appenduser;
  289. var
  290.    number : string[2];
  291. begin
  292. str(j,number);
  293. assign(trackfile,vfilename+'.U'+number);
  294. append(trackfile);
  295. writeln(trackfile,whoson.name);
  296. close(trackfile);
  297. end;
  298.  
  299. procedure displayquestion;
  300. var
  301.    i : integer;
  302. begin
  303. writeln;
  304. if bb.responseto > 0 then
  305.    begin
  306.    writeln('In response to Question ',bb.responseto);
  307.    writeln;
  308.    seek(booths,bb.responseto-1);
  309.    read(booths,tb);
  310.    writeln('>',tb.question[1]);
  311.    if pp.amulti then
  312.      begin
  313.      if tb.question[2] <> '' then writeln('>',tb.question[2]);
  314.      if tb.question[3] <> '' then writeln('>',tb.question[3]);
  315.      end;
  316.    writeln;
  317.    end;
  318. if bb.titleit then
  319.    begin
  320.    writeln('     ',bb.creator,' wants to know:');
  321.    writeln;
  322.    end;
  323. writeln(bb.question[1]);
  324. if pp.amulti then
  325.    begin
  326.    if bb.question[2] <> '' then writeln(bb.question[2]);
  327.    if bb.question[3] <> '' then writeln(bb.question[3]);
  328.    end;
  329. writeln;
  330. for i := 1 to bb.available do
  331.     begin
  332.     writeln(i:2,'. ',bb.choices[i,1]);
  333.     if bb.multi then
  334.       begin
  335.       if bb.choices[i,2] <> '' then
  336.         begin
  337.         writeln('    ',bb.choices[i,2]);
  338.         if bb.choices[i,3] <> '' then writeln('    ',bb.choices[i,3]);
  339.         end;
  340.       end;
  341.     end;
  342. if bb.addons and (bb.available < 21) then writeln('99. Other (add your own)');
  343. writeln;
  344. end;
  345.  
  346. procedure getstats;
  347. begin
  348. if exist('dorinfo1.def') then
  349.    begin
  350.    assign(doorinfo,'dorinfo1.def');
  351.    reset(doorinfo);
  352.    readln(doorinfo,whoson.bbsname);
  353.    for i := 1 to 6 do readln(doorinfo,aline);
  354.    whoson.name := aline;
  355.    readln(doorinfo,aline);
  356.    whoson.name := uplow(whoson.name) + ' ' + uplow(aline);
  357.    for i := 1 to 3 do readln(doorinfo,aline);
  358.    val(aline,whoson.seclvl,code);
  359.    close(doorinfo);
  360.    end
  361. else
  362.     begin
  363.     writeln('LOCAL mode...');
  364.     writeln;
  365.     buflen := 35;
  366.     write('What name would you like to use: ');
  367.     whoson.name := instring;
  368.     whoson.seclvl := pp.syssec;
  369.     whoson.bbsname := 'LOCAL TEST';
  370.     end;
  371. writeln;
  372. writeln('User name: ',whoson.name);
  373. writeln(' Security: ',whoson.seclvl);
  374. writeln;
  375. end;
  376.  
  377. procedure viewlog;
  378. var
  379.    temp : string[79];
  380. begin
  381. close(logfile);
  382. reset(logfile);
  383. writeln('Log of recent voter activity...');
  384. writeln;
  385. writeln('P to pause; A to abort');
  386. writeln;
  387. linecount := 0;
  388. repeat
  389. repeat
  390. readln(logfile,temp);
  391. writeln(temp);
  392. linecount := succ(linecount);
  393. until eof(logfile) or startstop or abort;
  394. until eof(logfile) or abort;
  395. close(logfile);
  396. append(logfile);
  397. writeln(logfile,'Viewed log file');
  398. end;
  399.  
  400. procedure killlog;
  401. begin
  402. close(logfile);
  403. rewrite(logfile);
  404. writeln(logfile,'----------------------------------------');
  405. writeln(logfile,whoson.name,' killed log ');
  406. writeln;
  407. writeln('It''s dead, Jim.');
  408. writeln;
  409. end;
  410.  
  411. procedure getresponse;
  412. begin
  413. buflen := 50;
  414. write(k:2,'. ');
  415. bb.choices[k,1] := instring;
  416. if (bb.choices[k,1] <> '') and bb.multi then
  417.    begin
  418.    write('    ');
  419.    bb.choices[k,2] := instring;
  420.    if bb.choices[k,2] <> '' then
  421.      begin
  422.      write('    ');
  423.      bb.choices[k,3] := instring;
  424.      end;
  425.    end;
  426. end;
  427.  
  428. procedure newbooth;
  429. var
  430.    q : integer;
  431.    number : string[2];
  432. begin
  433. if i = 51 then bb.responseto := j else bb.responseto := 0;
  434. writeln;
  435. if pp.booths = 99 then
  436.    begin
  437.    writeln('Sorry, there are already 99 booths...');
  438.    exit;
  439.    end;
  440. writeln('This will be booth #',pp.booths+1);
  441. write('What''s the survey question?  ');
  442. if pp.amulti then write('(Up to 3 lines)');
  443. writeln;
  444. writeln('[---------------------------------------------------------------------------]');
  445. write('>');
  446. buflen := 75;
  447. aline := instring;
  448. if aline = '' then
  449.    begin
  450.    writeln('Okay, never mind ...');
  451.    exit;
  452.    end;
  453. bb.question[1] := aline;
  454. if pp.amulti then
  455.    begin
  456.    write('>');
  457.    bb.question[2] := instring;
  458.    write('>');
  459.    bb.question[3] := instring;
  460.    end
  461. else
  462.     begin
  463.     bb.question[2] := '';
  464.     bb.question[3] := '';
  465.     end;
  466. writeln;
  467. write('Would you like your name associated with this question?');
  468. yesno('Y');
  469. if ch = 'N' then bb.titleit := false else bb.titleit := true;
  470. if pp.atrack then
  471.    begin
  472.    write('Should people only be allowed to vote once?');
  473.    yesno('Y');
  474.    if ch = 'N' then bb.track := false else bb.track := true;
  475.    end
  476. else
  477.     bb.track := false;
  478. if pp.aaddons then
  479.    begin
  480.    write('Can users add additional responses (choices) to your question?');
  481.    yesno('Y');
  482.    if ch = 'N' then bb.addons := false else bb.addons := true;
  483.    end
  484. else
  485.     bb.addons := false;
  486. if pp.amulti then
  487.    begin
  488.    write('Do you want any of your answers to be more than one line?');
  489.    yesno('N');
  490.    if ch = 'N' then bb.multi := false else bb.multi :=true
  491.    end
  492. else
  493.     bb.multi := false;
  494. writeln;
  495. write('Okay, now you can enter up to 20 possible responses.  ');
  496. if bb.multi then write('(Up to 3 lines)');
  497. k := 0;
  498. writeln;
  499. writeln('   [--------------------------------------------------]');
  500. buflen := 50;
  501. repeat
  502.      k := succ(k);
  503.      getresponse;
  504. until (bb.choices[k,1] = '') or (k = 20);
  505. if (bb.choices[1,1] = '') or (k < 3) then
  506.    begin
  507.    writeln;
  508.    writeln('You need more than one choice!');
  509.    exit;
  510.    end;
  511. bb.available := k - 1;
  512. bb.killed := false;
  513. bb.creator := whoson.name;
  514. bb.created := 0;
  515. bb.totalvotes := 0;
  516. pp.booths := succ(pp.booths);
  517. for q := 1 to 20 do bb.votes[q] := 0;
  518. seek(pplace,0);
  519. write(pplace,pp);
  520. seek(booths,pp.booths-1);
  521. write(booths,bb);
  522. writeln('New booth added!  Thank You!');
  523. if bb.track then
  524.    begin
  525.    str(pp.booths,number);
  526.    assign(trackfile,vfilename+'.U'+number);
  527.    rewrite(trackfile);
  528.    close(trackfile);
  529.    end;
  530. writeln(logfile,'Created new booth #',pp.booths,' with ',bb.available,' choices.');
  531. writeln(logfile,'  Question: ',bb.question[1]);
  532. if bb.multi then
  533.    begin
  534.    if bb.question[2] <> '' then
  535.      writeln(logfile,'            ',bb.question[2]);
  536.    if bb.question[3] <> '' then
  537.      writeln(logfile,'            ',bb.question[3]);
  538.    end;
  539. end;
  540.  
  541. procedure goodbye;
  542. begin
  543. write('Are you sure you want to leave?');
  544. yesno('Y');
  545. if ch = 'Y' then
  546.    begin
  547.    writeln;
  548.    letemout := true;
  549.    writeln('Enter a one line message for the next voter:');
  550.    write('>');
  551.    buflen := 78;
  552.    pp.lmessage := instring;
  553.    seek(pplace,0);
  554.    write(pplace,pp);
  555.    if pp.lmessage <> '' then
  556.      begin
  557.      writeln(logfile,'Left log off message:');
  558.      writeln(logfile,' ',pp.lmessage);
  559.      end;
  560.    end
  561. else
  562.     writeln('Okay, we will stay!');
  563. end;
  564.  
  565. procedure help;
  566. begin
  567. if exist (vfilename+'.hlp') then
  568.    showfile(vfilename+'.hlp')
  569. else
  570.     begin
  571.     writeln;
  572.     writeln('Sorry, file ',vfilename,'.HLP is missing!');
  573.     writeln;
  574.     end;
  575. end;
  576.  
  577. procedure showresults;
  578. var
  579.    stuff : string[50];
  580. begin
  581. writeln;
  582. if bb.totalvotes = 0 then
  583.    begin
  584.    writeln('Sorry, no one has voted on that topic yet.  Why don''t you?');
  585.    exit;
  586.    end;
  587. writeln('Results of Booth #',j:2);
  588. writeln('--------------------');
  589. writeln(bb.question[1]);
  590. if pp.amulti then
  591.    begin
  592.    if bb.question[2] <> '' then writeln(bb.question[2]);
  593.    if bb.question[3] <> '' then writeln(bb.question[3]);
  594.    end;
  595. for i := 1 to bb.available do
  596.     begin
  597.     write(' (',bb.votes[i]:3,' votes');
  598.     write('  ',((bb.votes[i] * 100) div bb.totalvotes):3,'%)  ');
  599.     writeln(bb.choices[i,1]);
  600.     if bb.multi then
  601.       begin
  602.       if bb.choices[i,2] <> '' then
  603.         begin
  604.         writeln('                    ',bb.choices[i,2]);
  605.         if bb.choices[i,3] <> '' then
  606.            writeln('                    ',bb.choices[i,3]);
  607.         end;
  608.       end;
  609.     end;
  610. write('press any key to continue');
  611. repeat until keypressed;
  612. ctlx := readkey;
  613. writeln;
  614. end;
  615.  
  616. procedure listbooths;
  617. begin
  618. if pp.booths > 0 then
  619.    begin
  620.    writeln;
  621.    writeln('Current voting booth questions:');
  622.    for i := 0 to (pp.booths-1) do
  623.       begin
  624.       seek(booths,i);
  625.       read(booths,bb);
  626.       if pp.amulti then
  627.         begin
  628.         writeln((i+1):2,'. ',bb.question[1]);
  629.         if bb.question[2] <> '' then writeln('    ',bb.question[2]);
  630.         if bb.question[3] <> '' then writeln('    ',bb.question[3]);
  631.         if bb.responseto > 0 then writeln('     *** Response to Question ',bb.responseto,' ***');
  632.         end
  633.       else
  634.          begin
  635.          writeln(i,'. ',bb.question[1]);
  636.          if bb.responseto > 0 then writeln('     *** Response to Question ',bb.responseto,' ***');
  637.          end;
  638.       end;
  639.    end
  640. else
  641.     begin
  642.     writeln;
  643.     write('There are currently no voting booths.  ');
  644.     if whoson.seclvl >= pp.addsec then write('Why not create one.');
  645.     writeln;
  646.     writeln;
  647. end;
  648. end;
  649.  
  650. procedure displayrec;
  651. begin
  652. writeln('Record #',j,' of ',pp.booths-1);
  653. writeln('[1] ',bb.question[1]);
  654. writeln('    ',bb.question[2]);
  655. writeln('    ',bb.question[3]);
  656. writeln('[2] Created by: ',bb.creator,' (',bb.created,')');
  657. writeln('[3] Response to Question: ',bb.responseto);
  658. writeln('[4] Track: ',bb.track,' [5] Killed: ',bb.killed,' [6] Addons: ',bb.addons);
  659. writeln('[7] Titleit: ',bb.titleit,' [8] Multi: ',bb.multi);
  660. writeln('[9] Alter votes (',bb.totalvotes,' total) [0] Alter responses (',bb.available,' total)');
  661. writeln('[Q] Quit [~] Pack file [+] Next record [-] Previous record [J] Jump');
  662. end;
  663.  
  664. procedure updatebooth;
  665. begin
  666. seek(booths,j);
  667. write(booths,bb);
  668. end;
  669.  
  670. procedure revisebooth;
  671. var
  672.    q, r, s : integer;
  673. begin
  674. q := 0;
  675. j := 0;
  676. repeat
  677. seek(booths,j);
  678. read(booths,bb);
  679. displayrec;
  680. write('Choice [0..9,Q,J,+,-]: +',bs);
  681. repeat
  682. ch := upcase(readkey);
  683. if ch = chr(13) then ch := '+';
  684. until pos(ch,'0123456789QJ+-~') > 0;
  685. writeln(ch);
  686. q := ord(ch);
  687. case q of
  688.     43 : {+} begin
  689.             j := succ(j);
  690.             if j > (pp.booths-1) then
  691.               begin
  692.               writeln('You are at the last record!');
  693.               j := pp.booths-1;
  694.               end;
  695.             end;
  696.     45 : {-} begin
  697.             j := pred(j);
  698.             if j < 0 then
  699.               begin
  700.               writeln('You are at the first record!');
  701.               j := 0;
  702.               end;
  703.             end;
  704.     74 : {J} begin
  705.             write('Question # to jump to: ');
  706.             readln(s);
  707.             if (s > -1) and (s < pp.booths) then
  708.               j := s
  709.             else
  710.                writeln('Invalid number');
  711.             end;
  712.     81 : {Q} exit;
  713.     126 : {~} begin
  714.             write('Are you sure you want to pack file (y/N)?');
  715.             yesno('N');
  716.             if ch = 'N' then
  717.               writeln('Fine, we will not!')
  718.             else
  719.                begin
  720.                assign(tbfile,'0000000.XXX');
  721.                rewrite(tbfile);
  722.                s := 0;
  723.                for r := 1 to pp.booths do
  724.                   begin
  725.                   seek(booths,r-1);
  726.                   read(booths,bb);
  727.                   if bb.killed = false then
  728.                     begin
  729.                     write(tbfile,bb);
  730.                     s := succ(s);
  731.                     end;
  732.                   end;
  733.                close(tbfile);
  734.                close(booths);
  735.                erase(booths);
  736.                rename(tbfile,vfilename+'.vb');
  737.                assign(booths,vfilename+'.vb');
  738.                reset(booths);
  739.                seek(pplace,0);
  740.                pp.booths := s;
  741.                write(pplace,pp);
  742.                j := 0;
  743.                end;
  744.             end;
  745.     48 : {0} begin
  746.             for r := 1 to bb.available do
  747.                begin
  748.                write('Question #',r:2,': ');
  749.                buflen := 50;
  750.                aline := instring;
  751.                if aline <> '' then
  752.                  begin
  753.                  bb.choices[r,1] := aline;
  754.                  if bb.multi then
  755.                     begin
  756.                     write('            : ');
  757.                     bb.choices[r,2] := instring;
  758.                     if bb.choices[r,2] <> '' then
  759.                       begin
  760.                       write('             : ');
  761.                       bb.choices[r,3] := instring;
  762.                       end;
  763.                     end;
  764.                  end;
  765.                end;
  766.             updatebooth;
  767.             end;
  768.     49 : {1} begin
  769.             writeln('Enter new survey question (up to three lines):');
  770.             write('>');
  771.             buflen := 75;
  772.             aline := instring;
  773.             if aline = '' then
  774.               writeln('Okay, we will leave it the same!')
  775.             else
  776.                begin
  777.                bb.question[1] := aline;
  778.                if pp.amulti then
  779.                  begin
  780.                  write('>');
  781.                  bb.question[2] := instring;
  782.                  write('>');
  783.                  bb.question[3] := instring;
  784.                  end;
  785.                updatebooth;
  786.                end;
  787.             end;
  788.     50 : {2} begin
  789.             write('Created by: ');
  790.             buflen := 35;
  791.             aline := instring;
  792.             if aline <> '' then bb.creator := aline;
  793.             updatebooth;
  794.             end;
  795.     51 : {3} begin
  796.             write('Make this a response to question #');
  797.             buflen := 5;
  798.             aline := instring;
  799.             val(instring,r,code);
  800.             if r > (pp.booths -1) then
  801.               writeln('There is no booth ',r,'.!')
  802.             else
  803.                begin
  804.                bb.responseto := r;
  805.                updatebooth;
  806.                end;
  807.             end;
  808.     52 : {4} begin
  809.             bb.track := not bb.track;
  810.             updatebooth;
  811.             end;
  812.     53 : {5} begin
  813.             bb.killed := not bb.killed;
  814.             updatebooth;
  815.             end;
  816.     54 : {6} begin
  817.             bb.addons := not bb.addons;
  818.             updatebooth;
  819.             end;
  820.     55 : {7} begin
  821.             bb.titleit := not bb.titleit;
  822.             updatebooth;
  823.             end;
  824.     56 : {8} begin
  825.             bb.multi := not bb.multi;
  826.             updatebooth;
  827.             end;
  828.     57 : {9} begin
  829.             for r := 1 to bb.available do
  830.                begin
  831.                write('Resp to #',r:2,' "',bb.choices[r,1],'" (',bb.votes[r],'): ');
  832.                buflen := 5;
  833.                aline := instring;
  834.                if aline <> '' then val(aline,bb.votes[r],code);
  835.                end;
  836.             bb.totalvotes := 0;
  837.             for r := 1 to bb.available do bb.totalvotes := bb.totalvotes + bb.votes[r];
  838.             updatebooth;
  839.             end;
  840.     end;
  841. until q = 81;
  842. end;
  843.  
  844. procedure killbooth;
  845. begin
  846. writeln('It is now marked for deletion!');
  847. end;
  848.  
  849. procedure voterchoice;
  850. begin
  851. if bb.track then
  852.    if checkforuser then
  853.      begin
  854.      writeln('Sorry, you have already voted in this booth!');
  855.      exit;
  856.      end
  857.    else
  858.       appenduser;
  859. if i = 97 then
  860.    displayquestion
  861. else
  862.     if i = 98 then
  863.       begin
  864.       killbooth;
  865.       i := 0;
  866.       end
  867.     else
  868.        if (i > 0) and (i <= bb.available) then
  869.          begin
  870.          bb.votes[i] := succ(bb.votes[i]);
  871.          bb.totalvotes := succ(bb.totalvotes);
  872.          seek(booths,j-1);
  873.          write(booths,bb);
  874.          writeln(logfile,'Voted response #',i,' to question #',j);
  875.          writeln;
  876.          writeln('Thank you for voting!');
  877.          write('See results (Y/n)?');
  878.          yesno('Y');
  879.          if ch = 'Y' then showresults;
  880.          i := 0;
  881.          end
  882.        else
  883.           if i = 99 then
  884.             begin
  885.             k := succ(bb.available);
  886.             getresponse;
  887.             if bb.choices[k,1] = '' then
  888.                writeln('Okay, never mind!')
  889.             else
  890.                 begin
  891.                 seek(booths,j-1);
  892.                 bb.available := k;
  893.                 bb.votes[k] := 1;
  894.                 bb.totalvotes := succ(bb.totalvotes);
  895.                 write(booths,bb);
  896.                 writeln(logfile,'Added response #',k,' to question #',j);
  897.                 writeln(logfile,'     Response: ',bb.choices[k,1]);
  898.                 writeln;
  899.                 writeln('Thank you for voting');
  900.                 write('See the results?');
  901.                 yesno('Y');
  902.                 if ch = 'Y' then showresults;
  903.                 i := 0;
  904.                 end;
  905.             end
  906.           else
  907.              if i = 51 then
  908.                 begin
  909.                 writeln;
  910.                 writeln('This will be a response to the question:');
  911.                 writeln(bb.question[1]);
  912.                 if bb.multi then
  913.                   begin
  914.                   if bb.question[2] <> '' then writeln(bb.question[2]);
  915.                   if bb.question[3] <> '' then writeln(bb.question[3]);
  916.                   end;
  917.                 newbooth;
  918.                 i := 0;
  919.           end;
  920. end;
  921.  
  922. procedure ccpick;
  923. begin
  924. write('Your choice? [1-',bb.available,',');
  925. if bb.addons and (bb.available < 21) then write('99,');
  926. write('L=list,');
  927. if qowner then write('K=kill,');
  928. write('R=reply,[RETURN]=skip,0=quit] ');
  929. buflen := 2;
  930. aline := ucase(instring);
  931. if aline = '' then aline := '52';
  932. if aline = 'L' then aline := '97';
  933. if aline = 'R' then aline := '51';
  934. if qowner and (aline = 'K') then
  935.    aline := '98'
  936. else
  937.     if aline = 'K' then aline := '50';
  938. if not bb.addons and (aline = '99') then aline := '-1';
  939. val(aline,i,code);
  940. end;
  941.  
  942. procedure scanbooths;
  943. begin
  944. for j := pp.booths downto 1 do
  945.     begin
  946.     seek(booths,j-1);
  947.     read(booths,bb);
  948.     writeln;
  949.     writeln('Question #',j);
  950.     displayquestion;
  951.     buflen := 2;
  952.     repeat
  953.         repeat
  954.              ccpick;
  955.         until (i >= 0) and (i < 100);
  956.         if i = 0 then
  957.            exit
  958.         else
  959.             if i <> 52 then voterchoice;
  960.     until i <> 97;
  961.     end;
  962. writeln;
  963. writeln('That''s all folks...');
  964. if whoson.seclvl >= pp.addsec then
  965.    begin
  966.    write('Would you like to add a booth (y/N)?');
  967.    yesno('N');
  968.    if ch = 'Y' then newbooth;
  969.    end;
  970. end;
  971.  
  972. procedure vpick;
  973. var
  974.    q : string[2];
  975. begin
  976. repeat
  977. writeln;
  978. write('Which One? [1-',pp.booths,',L=list] ');
  979. buflen := 2;
  980. q := instring;
  981. if ucase(q) = 'L' then
  982.    listbooths;
  983. val(q,j,code);
  984. until ucase(q) <> 'L';
  985. end;
  986.  
  987. procedure vcpick;
  988. begin
  989. write('Your choice? [1-',bb.available,',');
  990. if bb.addons and (bb.available < 21) then write('99,');
  991. write('L=list,');
  992. if qowner then write('K=kill,');
  993. write('R=reply,0=quit] ');
  994. buflen := 2;
  995. aline := ucase(instring);
  996. if aline = '' then aline := '-1';
  997. if aline = 'L' then aline := '97';
  998. if aline = 'R' then aline := '51';
  999. if qowner and (aline = 'K') then
  1000.    aline := '98'
  1001. else
  1002.     if aline = 'K' then aline := '50';
  1003. if not bb.addons and (aline = '99') then aline := '-1';
  1004. val(aline,i,code);
  1005. end;
  1006.  
  1007. procedure voteinbooth;
  1008. begin
  1009. listbooths;
  1010. repeat
  1011. repeat
  1012.      vpick;
  1013. until (j >= 0) or (j <= pp.booths);
  1014. if j = 0 then
  1015.    exit
  1016. else
  1017.     begin
  1018.     seek(booths,j-1);
  1019.     read(booths,bb);
  1020.     displayquestion;
  1021.     end;
  1022. buflen := 2;
  1023. repeat
  1024. repeat
  1025.      vcpick;
  1026. until (i >= 0) and (i < 100);
  1027. voterchoice;
  1028. until i = 0;
  1029. until j = 0;
  1030. end;
  1031.  
  1032. procedure viewresults;
  1033. begin
  1034. listbooths;
  1035. repeat
  1036. repeat
  1037.      vpick;
  1038. until (j >= 0) or (j <= pp.booths);
  1039. if j = 0 then
  1040.    exit
  1041. else
  1042.     begin
  1043.     seek(booths,j-1);
  1044.     read(booths,bb);
  1045.     writeln;
  1046.     showresults;
  1047.     end;
  1048. until j = 0;
  1049. end;
  1050.  
  1051. function getcommand(default:char):integer;
  1052. begin
  1053. write(default,bs);
  1054. repeat
  1055.      ch := upcase(readkey);
  1056.      if ch=cr then ch := default;
  1057. until pos(ch,commands) > 0;
  1058. writeln(ch);
  1059. getcommand := ord(ch);
  1060. end;
  1061.  
  1062. procedure menu;
  1063. begin
  1064. writeln;
  1065. writeln(whoson.bbsname,' polling place ',vfilename);
  1066. writeln;
  1067. writeln('[L] List booths and results                [V] Vote in booths');
  1068. writeln('[S] Scan booths newest to oldest           [G] Goodbye');
  1069. if whoson.seclvl >= pp.addsec then
  1070.    begin
  1071.    write('[E] Enter a new booth                      ');
  1072.    if whoson.seclvl >= pp.syssec then
  1073.      begin
  1074.      writeln('[R] Revise a booth');
  1075.      writeln('[1] View booth logs                        [2] Kill booth logs');
  1076.      commands := 'LVSGER12H';
  1077.      end
  1078.    else
  1079.       begin
  1080.       writeln;
  1081.       commands := 'LVSGEH';
  1082.       end;
  1083.    end
  1084. else
  1085.     commands := 'LVSGH';
  1086. writeln('[H] Help');
  1087. writeln;
  1088. write('What would you like to do? [',commands,'] ');
  1089. j := getcommand('H');
  1090. case j of
  1091.     49 : {1} viewlog;
  1092.     50 : {2} killlog;
  1093.     69 : {E} newbooth;
  1094.     71 : {G} goodbye;
  1095.     72 : {H} help;
  1096.     76 : {L} viewresults;
  1097.     82 : {R} revisebooth;
  1098.     83 : {S} scanbooths;
  1099.     86 : {V} voteinbooth;
  1100.     end;
  1101. end;
  1102.  
  1103. begin
  1104. directvideo := false;
  1105. cr := chr(13);
  1106. bs := chr(8);
  1107. del := chr(127);
  1108. ctlx := chr(124);
  1109. tab := chr(9);
  1110. writeln;
  1111. writeln('Welcome to BVote 0.1');
  1112. writeln('by Chris Rowley  (c) 1989 Bogusware');
  1113. writeln('modifications by a more polite, anonymous programmer.');
  1114. writeln;
  1115. letemout := false;
  1116. if paramcount < 1 then
  1117.    begin
  1118.    writeln('useage: bvote [filename]');
  1119.    writeln('Nothing for me to do!');
  1120.    exit;
  1121.    end;
  1122. vfilename := paramstr(1);
  1123. if not exist(vfilename+'.pp') then
  1124.    begin
  1125.    write(vfilename,'.PP not present!');
  1126.    write('  Do you want to create a new polling place?');
  1127.    yesno('N');
  1128.    if ch = 'N' then
  1129.      begin
  1130.      writeln;
  1131.      writeln('See you later, then!');
  1132.      exit
  1133.      end
  1134.    else
  1135.       createnewsurvey;
  1136.    end;
  1137. assign(pplace,vfilename+'.pp');
  1138. reset(pplace);
  1139. assign(booths,vfilename+'.vb');
  1140. reset(booths);
  1141. seek(pplace,0);
  1142. read(pplace,pp);
  1143. getstats;
  1144. if not exist(vfilename+'.log') then
  1145.    begin
  1146.    assign(logfile,vfilename+'.log');
  1147.    rewrite(logfile);
  1148.    close(logfile);
  1149.    end;
  1150. assign(logfile,vfilename+'.log');
  1151. append(logfile);
  1152. writeln(logfile,'----------------------------------------');
  1153. writeln(logfile,whoson.name+' logged on ');
  1154. if exist(vfilename+'.wel') then showfile(vfilename+'.wel');
  1155. if pp.lmessage <> '' then
  1156.    begin
  1157.    writeln;
  1158.    writeln('The last voter says:');
  1159.    writeln('"',pp.lmessage,'"');
  1160.    writeln;
  1161.    end;
  1162. repeat
  1163.      menu;
  1164. until letemout;
  1165. close(pplace);
  1166. close(booths);
  1167. writeln(logfile,'Logged off ');
  1168. close(logfile);
  1169. writeln;
  1170. writeln('Thank you for using BVote...');
  1171. writeln('Now returning you to the bulletin board...');
  1172. end.
  1173.