home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / bbsdoors / bvote.arc / BVOTE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-08-28  |  30KB  |  1,172 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('Okey dokey, we''ll 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?');
  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 repsonse 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, fergit it...');
  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 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!  Thanx!');
  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 wanna 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''ll 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('     *** Repsonse to Question ',bb.responseto,' ***');
  632.           end
  633.        else
  634.            begin
  635.            writeln(i,'. ',bb.question[1]);
  636.            if bb.responseto > 0 then writeln('     *** Repsonse to Question ',bb.responseto,' ***');
  637.            end;
  638.        end;
  639.    end
  640. else
  641.     begin
  642.     writeln;
  643.     write('There currently aren''t any 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''re at the last record bonehead!');
  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''re at the first record bonehead!');
  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 won''t!')
  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''ll 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,', you pinhead!')
  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('Okey dokey, it''s 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''ve 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('Thanx fer votin''!');
  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, fergit it!')
  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('Thanx fer votin''!');
  900.                    write('See 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''ll it be? [',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;
  1114. letemout := false;
  1115. if paramcount < 1 then
  1116.    begin
  1117.    writeln('useage: bvote [filename]');
  1118.    writeln('Nothing for me to do!');
  1119.    exit;
  1120.    end;
  1121. vfilename := paramstr(1);
  1122. if not exist(vfilename+'.pp') then
  1123.    begin
  1124.    write(vfilename,'.PP not present!');
  1125.    write('  Do you want to create a new polling place?');
  1126.    yesno('N');
  1127.    if ch = 'N' then
  1128.       begin
  1129.       writeln;
  1130.       writeln('See ya later, then!');
  1131.       exit
  1132.       end
  1133.    else
  1134.        createnewsurvey;
  1135.    end;
  1136. assign(pplace,vfilename+'.pp');
  1137. reset(pplace);
  1138. assign(booths,vfilename+'.vb');
  1139. reset(booths);
  1140. seek(pplace,0);
  1141. read(pplace,pp);
  1142. getstats;
  1143. if not exist(vfilename+'.log') then
  1144.    begin
  1145.    assign(logfile,vfilename+'.log');
  1146.    rewrite(logfile);
  1147.    close(logfile);
  1148.    end;
  1149. assign(logfile,vfilename+'.log');
  1150. append(logfile);
  1151. writeln(logfile,'----------------------------------------');
  1152. writeln(logfile,whoson.name+' logged on ');
  1153. if exist(vfilename+'.wel') then showfile(vfilename+'.wel');
  1154. if pp.lmessage <> '' then
  1155.    begin
  1156.    writeln;
  1157.    writeln('The last voter says:');
  1158.    writeln('"',pp.lmessage,'"');
  1159.    writeln;
  1160.    end;
  1161. repeat
  1162.       menu;
  1163. until letemout;
  1164. close(pplace);
  1165. close(booths);
  1166. writeln(logfile,'Logged off ');
  1167. close(logfile);
  1168. writeln;
  1169. writeln('Thanx fer usin'' Bogusware''s BVote...');
  1170. writeln('Now returning you to yer bulletin board...');
  1171. end.
  1172.