Programmer 7500/MAX_PROGRAMMERS.iso/INFO/BBSDOORS/BVOTE.ARC/BVOTE1.PAS

Pascal/Delphi Source File | 1989-11-24 | 26.0 KB | 1,173 lines

program voter;
uses dos, crt;

type
    booth = record
          question : array[1..3] of string[75];
          choices : array[1..20,1..3] of string[50];
          votes : array[1..20] of word;
          creator : string[35];
          created : longint;
          available : byte;
          totalvotes : word;
          responseto : integer;
          track, killed, addons, titleit, multi : boolean;
          end;
    linestring = string[80];
    pollplace = record
             addsec, syssec : integer;
             atrack, aaddons, amulti : boolean;
             booths : byte;
             lmessage : string[78];
             end;
    user = record
         name : string[35];
         seclvl : integer;
         bbsname : string[78];
         end;

var
   pplace : file of pollplace;
   pp : pollplace;
   booths, tbfile : file of booth;
   bb,tb : booth;
   doorinfo, logfile, trackfile, textfile : text;
   i, j, k, linecount, code : integer;
   ch, cr, bs, del, ctlx, tab : char;
   buflen, chn : byte;
   aline : linestring;
   abort, letemout : boolean;
   vfilename : string[6];
   whoson : user;
   commands : string[9];

procedure beep;
begin
write(chr(7));
end;

procedure YesNo(default:char);
begin
write(default+chr(8));
repeat
     ch := upcase(readkey);
     if ch = cr then ch := default;
until ch in ['Y','N'];
if ch = 'Y' then writeln('Yes') else writeln('No');
end;

function ucase(tempstr:linestring):linestring;
var
   i : integer;
begin
for i := 1 to length(tempstr) do tempstr[i] := upcase(tempstr[i]);
ucase := tempstr;
end;

function qowner:boolean;
begin
if (ucase(bb.creator) = ucase(whoson.name)) or (whoson.seclvl >= pp.syssec) then
   qowner := true else qowner := false;
end;

function uplow(tempstr:linestring):linestring;
var
   i : integer;
begin
for i := 1 to length(tempstr) do
    if (ord(tempstr[i]) > 64) and (ord(tempstr[i]) < 91) then
      tempstr[i] := chr(ord(tempstr[i])+32);
tempstr[1] := upcase(tempstr[1]);
uplow := tempstr;
end;

function exist(filename:linestring) : boolean;
var
   sample : text;
begin
assign(textfile,filename);
{$I-}
reset(textfile);
{$I+}
if ioresult = 0 then
   begin
   exist := true;
   close(textfile);
   end
else
    exist := false;
end;

function instring:linestring;
var
   instr : linestring;
   j : integer;
const
    blanks : linestring = '                                                                                ';
begin
instr := blanks;
j := 0;
repeat
     ch := readkey;
     if (ch > chr(31)) and (ch < chr(127)) then
        begin
        if j < buflen then
          begin
          j := succ(j);
          instr[j] := ch;
          write(ch);
          end
        else
           beep;
        end
     else
        begin
        if ch = cr then
           begin
           mem[seg(instr):ofs(instr)] := j;
           writeln;
           end
        else
            begin
            if (ch = bs) or (ch = del) then
              begin
              if j >= 1 then
                begin
                j := pred(j);
                write(bs+' '+bs);
                end
              else
                 begin
                 beep;
                 end;
              end
            else
               begin
               if ch = ctlx then
                 begin
                 while j > 0 do
                      begin
                      j := pred(j);
                      write(bs+' '+bs);
                      end;
                 end
               else
                  if ch = tab then
                    begin
                    if j < (buflen - 5) then
                       begin
                       repeat
                            write(' ');
                            j := succ(j);
                       until (j mod 5) = 0;
                       end
                    else
                        beep;
                    end
                  else
                     beep;
               end;
            end;
        end;
until (ch = cr);
instring := instr;
if j = 0 then instring := '';
end;

function startstop:boolean;
begin
startstop := false;
abort := false;
ch := chr(0);
chn := 0;
if keypressed then
   begin
   ch := readkey;
   chn := ord(ch);
   end;
if ((chn = 83) or (chn = 115)) then
   abort := true
else
    if (chn = 80) or (chn = 112) or (linecount = 22) then
      begin
      startstop := true;
      write('  any key to go on; S to stop',cr);
      repeat until keypressed;
      ch := readkey;
      chn := ord(ch);
      if ((chn = 83) or (chn = 115)) then abort := true;
      linecount := 0;
      end;
end;

procedure showfile(filnam:linestring);
var
   filvar : text;
   fillin : linestring;
begin
assign(textfile,filnam);
reset(textfile);
writeln('P to pause; any key to go on; S to stop');
repeat
     linecount := 0;
     repeat
          linecount := succ(linecount);
          readln(textfile,aline);
          writeln(aline);
     until (startstop or abort) or eof(textfile);
until abort or eof(textfile);
writeln;
close(textfile);
abort := false;
end;

procedure createnewsurvey;
begin
writeln;
writeln('Fine, I will create a new polling place called ',vfilename,'.');
writeln('Remember, the following files are created for each survey:');
writeln;
writeln('     o ',vfilename:8,'.VB  - contains all questions and results');
writeln('     o ',vfilename:8,'.LOG - log of all activity in survey');
writeln('     o ',vfilename:8,'.U1 ...');
writeln('       ',vfilename:8,'.Uxx - names of voters for fixed booths');
writeln;
writeln('And you should create ',vfilename,'.WEL as a welcome file for this');
writeln('polling place.');
assign(pplace,vfilename+'.pp');
rewrite(pplace);
with pp do
    begin
    writeln;
    write('Only allow people to vote once?');
    yesno('N');
    if ch = 'N' then atrack := false else atrack := true;
    write('Allow users to add responses (more choices)?');
    yesno('Y');
    if ch = 'N' then aaddons := false else aaddons := true;
    write('Allow multi-line choices?');
    yesno('N');
    if ch = 'N' then amulti := false else amulti := true;
    booths := 0;
    lmessage := '';
    write('Minimum security to create a booth?');
    buflen := 8;
    val(instring,addsec,code);
    write('Minimum sysop security?');
    val(instring,syssec,code);
    end;
seek(pplace,0);
write(pplace,pp);
assign(booths,vfilename+'.VB');
rewrite(booths);
close(booths);
writeln;
writeln('New polling place ',vfilename,' created...');
close(pplace);
end;

function checkforuser:boolean;
var
   number : string[2];
   track : boolean;
   temp : string[36];
begin
str(j,number);
assign(trackfile,vfilename+'.U'+number);
reset(trackfile);
track := false;
repeat
     readln(trackfile,temp);
     if ucase(temp) = ucase(whoson.name) then track := true;
until eof(trackfile) or track;
close(trackfile);
checkforuser := track;
end;

procedure appenduser;
var
   number : string[2];
begin
str(j,number);
assign(trackfile,vfilename+'.U'+number);
append(trackfile);
writeln(trackfile,whoson.name);
close(trackfile);
end;

procedure displayquestion;
var
   i : integer;
begin
writeln;
if bb.responseto > 0 then
   begin
   writeln('In response to Question ',bb.responseto);
   writeln;
   seek(booths,bb.responseto-1);
   read(booths,tb);
   writeln('>',tb.question[1]);
   if pp.amulti then
     begin
     if tb.question[2] <> '' then writeln('>',tb.question[2]);
     if tb.question[3] <> '' then writeln('>',tb.question[3]);
     end;
   writeln;
   end;
if bb.titleit then
   begin
   writeln('     ',bb.creator,' wants to know:');
   writeln;
   end;
writeln(bb.question[1]);
if pp.amulti then
   begin
   if bb.question[2] <> '' then writeln(bb.question[2]);
   if bb.question[3] <> '' then writeln(bb.question[3]);
   end;
writeln;
for i := 1 to bb.available do
    begin
    writeln(i:2,'. ',bb.choices[i,1]);
    if bb.multi then
      begin
      if bb.choices[i,2] <> '' then
        begin
        writeln('    ',bb.choices[i,2]);
        if bb.choices[i,3] <> '' then writeln('    ',bb.choices[i,3]);
        end;
      end;
    end;
if bb.addons and (bb.available < 21) then writeln('99. Other (add your own)');
writeln;
end;

procedure getstats;
begin
if exist('dorinfo1.def') then
   begin
   assign(doorinfo,'dorinfo1.def');
   reset(doorinfo);
   readln(doorinfo,whoson.bbsname);
   for i := 1 to 6 do readln(doorinfo,aline);
   whoson.name := aline;
   readln(doorinfo,aline);
   whoson.name := uplow(whoson.name) + ' ' + uplow(aline);
   for i := 1 to 3 do readln(doorinfo,aline);
   val(aline,whoson.seclvl,code);
   close(doorinfo);
   end
else
    begin
    writeln('LOCAL mode...');
    writeln;
    buflen := 35;
    write('What name would you like to use: ');
    whoson.name := instring;
    whoson.seclvl := pp.syssec;
    whoson.bbsname := 'LOCAL TEST';
    end;
writeln;
writeln('User name: ',whoson.name);
writeln(' Security: ',whoson.seclvl);
writeln;
end;

procedure viewlog;
var
   temp : string[79];
begin
close(logfile);
reset(logfile);
writeln('Log of recent voter activity...');
writeln;
writeln('P to pause; A to abort');
writeln;
linecount := 0;
repeat
repeat
readln(logfile,temp);
writeln(temp);
linecount := succ(linecount);
until eof(logfile) or startstop or abort;
until eof(logfile) or abort;
close(logfile);
append(logfile);
writeln(logfile,'Viewed log file');
end;

procedure killlog;
begin
close(logfile);
rewrite(logfile);
writeln(logfile,'----------------------------------------');
writeln(logfile,whoson.name,' killed log ');
writeln;
writeln('It''s dead, Jim.');
writeln;
end;

procedure getresponse;
begin
buflen := 50;
write(k:2,'. ');
bb.choices[k,1] := instring;
if (bb.choices[k,1] <> '') and bb.multi then
   begin
   write('    ');
   bb.choices[k,2] := instring;
   if bb.choices[k,2] <> '' then
     begin
     write('    ');
     bb.choices[k,3] := instring;
     end;
   end;
end;

procedure newbooth;
var
   q : integer;
   number : string[2];
begin
if i = 51 then bb.responseto := j else bb.responseto := 0;
writeln;
if pp.booths = 99 then
   begin
   writeln('Sorry, there are already 99 booths...');
   exit;
   end;
writeln('This will be booth #',pp.booths+1);
write('What''s the survey question?  ');
if pp.amulti then write('(Up to 3 lines)');
writeln;
writeln('[---------------------------------------------------------------------------]');
write('>');
buflen := 75;
aline := instring;
if aline = '' then
   begin
   writeln('Okay, never mind ...');
   exit;
   end;
bb.question[1] := aline;
if pp.amulti then
   begin
   write('>');
   bb.question[2] := instring;
   write('>');
   bb.question[3] := instring;
   end
else
    begin
    bb.question[2] := '';
    bb.question[3] := '';
    end;
writeln;
write('Would you like your name associated with this question?');
yesno('Y');
if ch = 'N' then bb.titleit := false else bb.titleit := true;
if pp.atrack then
   begin
   write('Should people only be allowed to vote once?');
   yesno('Y');
   if ch = 'N' then bb.track := false else bb.track := true;
   end
else
    bb.track := false;
if pp.aaddons then
   begin
   write('Can users add additional responses (choices) to your question?');
   yesno('Y');
   if ch = 'N' then bb.addons := false else bb.addons := true;
   end
else
    bb.addons := false;
if pp.amulti then
   begin
   write('Do you want any of your answers to be more than one line?');
   yesno('N');
   if ch = 'N' then bb.multi := false else bb.multi :=true
   end
else
    bb.multi := false;
writeln;
write('Okay, now you can enter up to 20 possible responses.  ');
if bb.multi then write('(Up to 3 lines)');
k := 0;
writeln;
writeln('   [--------------------------------------------------]');
buflen := 50;
repeat
     k := succ(k);
     getresponse;
until (bb.choices[k,1] = '') or (k = 20);
if (bb.choices[1,1] = '') or (k < 3) then
   begin
   writeln;
   writeln('You need more than one choice!');
   exit;
   end;
bb.available := k - 1;
bb.killed := false;
bb.creator := whoson.name;
bb.created := 0;
bb.totalvotes := 0;
pp.booths := succ(pp.booths);
for q := 1 to 20 do bb.votes[q] := 0;
seek(pplace,0);
write(pplace,pp);
seek(booths,pp.booths-1);
write(booths,bb);
writeln('New booth added!  Thank You!');
if bb.track then
   begin
   str(pp.booths,number);
   assign(trackfile,vfilename+'.U'+number);
   rewrite(trackfile);
   close(trackfile);
   end;
writeln(logfile,'Created new booth #',pp.booths,' with ',bb.available,' choices.');
writeln(logfile,'  Question: ',bb.question[1]);
if bb.multi then
   begin
   if bb.question[2] <> '' then
     writeln(logfile,'            ',bb.question[2]);
   if bb.question[3] <> '' then
     writeln(logfile,'            ',bb.question[3]);
   end;
end;

procedure goodbye;
begin
write('Are you sure you want to leave?');
yesno('Y');
if ch = 'Y' then
   begin
   writeln;
   letemout := true;
   writeln('Enter a one line message for the next voter:');
   write('>');
   buflen := 78;
   pp.lmessage := instring;
   seek(pplace,0);
   write(pplace,pp);
   if pp.lmessage <> '' then
     begin
     writeln(logfile,'Left log off message:');
     writeln(logfile,' ',pp.lmessage);
     end;
   end
else
    writeln('Okay, we will stay!');
end;

procedure help;
begin
if exist (vfilename+'.hlp') then
   showfile(vfilename+'.hlp')
else
    begin
    writeln;
    writeln('Sorry, file ',vfilename,'.HLP is missing!');
    writeln;
    end;
end;

procedure showresults;
var
   stuff : string[50];
begin
writeln;
if bb.totalvotes = 0 then
   begin
   writeln('Sorry, no one has voted on that topic yet.  Why don''t you?');
   exit;
   end;
writeln('Results of Booth #',j:2);
writeln('--------------------');
writeln(bb.question[1]);
if pp.amulti then
   begin
   if bb.question[2] <> '' then writeln(bb.question[2]);
   if bb.question[3] <> '' then writeln(bb.question[3]);
   end;
for i := 1 to bb.available do
    begin
    write(' (',bb.votes[i]:3,' votes');
    write('  ',((bb.votes[i] * 100) div bb.totalvotes):3,'%)  ');
    writeln(bb.choices[i,1]);
    if bb.multi then
      begin
      if bb.choices[i,2] <> '' then
        begin
        writeln('                    ',bb.choices[i,2]);
        if bb.choices[i,3] <> '' then
           writeln('                    ',bb.choices[i,3]);
        end;
      end;
    end;
write('press any key to continue');
repeat until keypressed;
ctlx := readkey;
writeln;
end;

procedure listbooths;
begin
if pp.booths > 0 then
   begin
   writeln;
   writeln('Current voting booth questions:');
   for i := 0 to (pp.booths-1) do
      begin
      seek(booths,i);
      read(booths,bb);
      if pp.amulti then
        begin
        writeln((i+1):2,'. ',bb.question[1]);
        if bb.question[2] <> '' then writeln('    ',bb.question[2]);
        if bb.question[3] <> '' then writeln('    ',bb.question[3]);
        if bb.responseto > 0 then writeln('     *** Response to Question ',bb.responseto,' ***');
        end
      else
         begin
         writeln(i,'. ',bb.question[1]);
         if bb.responseto > 0 then writeln('     *** Response to Question ',bb.responseto,' ***');
         end;
      end;
   end
else
    begin
    writeln;
    write('There are currently no voting booths.  ');
    if whoson.seclvl >= pp.addsec then write('Why not create one.');
    writeln;
    writeln;
end;
end;

procedure displayrec;
begin
writeln('Record #',j,' of ',pp.booths-1);
writeln('[1] ',bb.question[1]);
writeln('    ',bb.question[2]);
writeln('    ',bb.question[3]);
writeln('[2] Created by: ',bb.creator,' (',bb.created,')');
writeln('[3] Response to Question: ',bb.responseto);
writeln('[4] Track: ',bb.track,' [5] Killed: ',bb.killed,' [6] Addons: ',bb.addons);
writeln('[7] Titleit: ',bb.titleit,' [8] Multi: ',bb.multi);
writeln('[9] Alter votes (',bb.totalvotes,' total) [0] Alter responses (',bb.available,' total)');
writeln('[Q] Quit [~] Pack file [+] Next record [-] Previous record [J] Jump');
end;

procedure updatebooth;
begin
seek(booths,j);
write(booths,bb);
end;

procedure revisebooth;
var
   q, r, s : integer;
begin
q := 0;
j := 0;
repeat
seek(booths,j);
read(booths,bb);
displayrec;
write('Choice [0..9,Q,J,+,-]: +',bs);
repeat
ch := upcase(readkey);
if ch = chr(13) then ch := '+';
until pos(ch,'0123456789QJ+-~') > 0;
writeln(ch);
q := ord(ch);
case q of
    43 : {+} begin
            j := succ(j);
            if j > (pp.booths-1) then
              begin
              writeln('You are at the last record!');
              j := pp.booths-1;
              end;
            end;
    45 : {-} begin
            j := pred(j);
            if j < 0 then
              begin
              writeln('You are at the first record!');
              j := 0;
              end;
            end;
    74 : {J} begin
            write('Question # to jump to: ');
            readln(s);
            if (s > -1) and (s < pp.booths) then
              j := s
            else
               writeln('Invalid number');
            end;
    81 : {Q} exit;
    126 : {~} begin
            write('Are you sure you want to pack file (y/N)?');
            yesno('N');
            if ch = 'N' then
              writeln('Fine, we will not!')
            else
               begin
               assign(tbfile,'0000000.XXX');
               rewrite(tbfile);
               s := 0;
               for r := 1 to pp.booths do
                  begin
                  seek(booths,r-1);
                  read(booths,bb);
                  if bb.killed = false then
                    begin
                    write(tbfile,bb);
                    s := succ(s);
                    end;
                  end;
               close(tbfile);
               close(booths);
               erase(booths);
               rename(tbfile,vfilename+'.vb');
               assign(booths,vfilename+'.vb');
               reset(booths);
               seek(pplace,0);
               pp.booths := s;
               write(pplace,pp);
               j := 0;
               end;
            end;
    48 : {0} begin
            for r := 1 to bb.available do
               begin
               write('Question #',r:2,': ');
               buflen := 50;
               aline := instring;
               if aline <> '' then
                 begin
                 bb.choices[r,1] := aline;
                 if bb.multi then
                    begin
                    write('            : ');
                    bb.choices[r,2] := instring;
                    if bb.choices[r,2] <> '' then
                      begin
                      write('             : ');
                      bb.choices[r,3] := instring;
                      end;
                    end;
                 end;
               end;
            updatebooth;
            end;
    49 : {1} begin
            writeln('Enter new survey question (up to three lines):');
            write('>');
            buflen := 75;
            aline := instring;
            if aline = '' then
              writeln('Okay, we will leave it the same!')
            else
               begin
               bb.question[1] := aline;
               if pp.amulti then
                 begin
                 write('>');
                 bb.question[2] := instring;
                 write('>');
                 bb.question[3] := instring;
                 end;
               updatebooth;
               end;
            end;
    50 : {2} begin
            write('Created by: ');
            buflen := 35;
            aline := instring;
            if aline <> '' then bb.creator := aline;
            updatebooth;
            end;
    51 : {3} begin
            write('Make this a response to question #');
            buflen := 5;
            aline := instring;
            val(instring,r,code);
            if r > (pp.booths -1) then
              writeln('There is no booth ',r,'.!')
            else
               begin
               bb.responseto := r;
               updatebooth;
               end;
            end;
    52 : {4} begin
            bb.track := not bb.track;
            updatebooth;
            end;
    53 : {5} begin
            bb.killed := not bb.killed;
            updatebooth;
            end;
    54 : {6} begin
            bb.addons := not bb.addons;
            updatebooth;
            end;
    55 : {7} begin
            bb.titleit := not bb.titleit;
            updatebooth;
            end;
    56 : {8} begin
            bb.multi := not bb.multi;
            updatebooth;
            end;
    57 : {9} begin
            for r := 1 to bb.available do
               begin
               write('Resp to #',r:2,' "',bb.choices[r,1],'" (',bb.votes[r],'): ');
               buflen := 5;
               aline := instring;
               if aline <> '' then val(aline,bb.votes[r],code);
               end;
            bb.totalvotes := 0;
            for r := 1 to bb.available do bb.totalvotes := bb.totalvotes + bb.votes[r];
            updatebooth;
            end;
    end;
until q = 81;
end;

procedure killbooth;
begin
writeln('It is now marked for deletion!');
end;

procedure voterchoice;
begin
if bb.track then
   if checkforuser then
     begin
     writeln('Sorry, you have already voted in this booth!');
     exit;
     end
   else
      appenduser;
if i = 97 then
   displayquestion
else
    if i = 98 then
      begin
      killbooth;
      i := 0;
      end
    else
       if (i > 0) and (i <= bb.available) then
         begin
         bb.votes[i] := succ(bb.votes[i]);
         bb.totalvotes := succ(bb.totalvotes);
         seek(booths,j-1);
         write(booths,bb);
         writeln(logfile,'Voted response #',i,' to question #',j);
         writeln;
         writeln('Thank you for voting!');
         write('See results (Y/n)?');
         yesno('Y');
         if ch = 'Y' then showresults;
         i := 0;
         end
       else
          if i = 99 then
            begin
            k := succ(bb.available);
            getresponse;
            if bb.choices[k,1] = '' then
               writeln('Okay, never mind!')
            else
                begin
                seek(booths,j-1);
                bb.available := k;
                bb.votes[k] := 1;
                bb.totalvotes := succ(bb.totalvotes);
                write(booths,bb);
                writeln(logfile,'Added response #',k,' to question #',j);
                writeln(logfile,'     Response: ',bb.choices[k,1]);
                writeln;
                writeln('Thank you for voting');
                write('See the results?');
                yesno('Y');
                if ch = 'Y' then showresults;
                i := 0;
                end;
            end
          else
             if i = 51 then
                begin
                writeln;
                writeln('This will be a response to the question:');
                writeln(bb.question[1]);
                if bb.multi then
                  begin
                  if bb.question[2] <> '' then writeln(bb.question[2]);
                  if bb.question[3] <> '' then writeln(bb.question[3]);
                  end;
                newbooth;
                i := 0;
          end;
end;

procedure ccpick;
begin
write('Your choice? [1-',bb.available,',');
if bb.addons and (bb.available < 21) then write('99,');
write('L=list,');
if qowner then write('K=kill,');
write('R=reply,[RETURN]=skip,0=quit] ');
buflen := 2;
aline := ucase(instring);
if aline = '' then aline := '52';
if aline = 'L' then aline := '97';
if aline = 'R' then aline := '51';
if qowner and (aline = 'K') then
   aline := '98'
else
    if aline = 'K' then aline := '50';
if not bb.addons and (aline = '99') then aline := '-1';
val(aline,i,code);
end;

procedure scanbooths;
begin
for j := pp.booths downto 1 do
    begin
    seek(booths,j-1);
    read(booths,bb);
    writeln;
    writeln('Question #',j);
    displayquestion;
    buflen := 2;
    repeat
        repeat
             ccpick;
        until (i >= 0) and (i < 100);
        if i = 0 then
           exit
        else
            if i <> 52 then voterchoice;
    until i <> 97;
    end;
writeln;
writeln('That''s all folks...');
if whoson.seclvl >= pp.addsec then
   begin
   write('Would you like to add a booth (y/N)?');
   yesno('N');
   if ch = 'Y' then newbooth;
   end;
end;

procedure vpick;
var
   q : string[2];
begin
repeat
writeln;
write('Which One? [1-',pp.booths,',L=list] ');
buflen := 2;
q := instring;
if ucase(q) = 'L' then
   listbooths;
val(q,j,code);
until ucase(q) <> 'L';
end;

procedure vcpick;
begin
write('Your choice? [1-',bb.available,',');
if bb.addons and (bb.available < 21) then write('99,');
write('L=list,');
if qowner then write('K=kill,');
write('R=reply,0=quit] ');
buflen := 2;
aline := ucase(instring);
if aline = '' then aline := '-1';
if aline = 'L' then aline := '97';
if aline = 'R' then aline := '51';
if qowner and (aline = 'K') then
   aline := '98'
else
    if aline = 'K' then aline := '50';
if not bb.addons and (aline = '99') then aline := '-1';
val(aline,i,code);
end;

procedure voteinbooth;
begin
listbooths;
repeat
repeat
     vpick;
until (j >= 0) or (j <= pp.booths);
if j = 0 then
   exit
else
    begin
    seek(booths,j-1);
    read(booths,bb);
    displayquestion;
    end;
buflen := 2;
repeat
repeat
     vcpick;
until (i >= 0) and (i < 100);
voterchoice;
until i = 0;
until j = 0;
end;

procedure viewresults;
begin
listbooths;
repeat
repeat
     vpick;
until (j >= 0) or (j <= pp.booths);
if j = 0 then
   exit
else
    begin
    seek(booths,j-1);
    read(booths,bb);
    writeln;
    showresults;
    end;
until j = 0;
end;

function getcommand(default:char):integer;
begin
write(default,bs);
repeat
     ch := upcase(readkey);
     if ch=cr then ch := default;
until pos(ch,commands) > 0;
writeln(ch);
getcommand := ord(ch);
end;

procedure menu;
begin
writeln;
writeln(whoson.bbsname,' polling place ',vfilename);
writeln;
writeln('[L] List booths and results                [V] Vote in booths');
writeln('[S] Scan booths newest to oldest           [G] Goodbye');
if whoson.seclvl >= pp.addsec then
   begin
   write('[E] Enter a new booth                      ');
   if whoson.seclvl >= pp.syssec then
     begin
     writeln('[R] Revise a booth');
     writeln('[1] View booth logs                        [2] Kill booth logs');
     commands := 'LVSGER12H';
     end
   else
      begin
      writeln;
      commands := 'LVSGEH';
      end;
   end
else
    commands := 'LVSGH';
writeln('[H] Help');
writeln;
write('What would you like to do? [',commands,'] ');
j := getcommand('H');
case j of
    49 : {1} viewlog;
    50 : {2} killlog;
    69 : {E} newbooth;
    71 : {G} goodbye;
    72 : {H} help;
    76 : {L} viewresults;
    82 : {R} revisebooth;
    83 : {S} scanbooths;
    86 : {V} voteinbooth;
    end;
end;

begin
directvideo := false;
cr := chr(13);
bs := chr(8);
del := chr(127);
ctlx := chr(124);
tab := chr(9);
writeln;
writeln('Welcome to BVote 0.1');
writeln('by Chris Rowley  (c) 1989 Bogusware');
writeln('modifications by a more polite, anonymous programmer.');
writeln;
letemout := false;
if paramcount < 1 then
   begin
   writeln('useage: bvote [filename]');
   writeln('Nothing for me to do!');
   exit;
   end;
vfilename := paramstr(1);
if not exist(vfilename+'.pp') then
   begin
   write(vfilename,'.PP not present!');
   write('  Do you want to create a new polling place?');
   yesno('N');
   if ch = 'N' then
     begin
     writeln;
     writeln('See you later, then!');
     exit
     end
   else
      createnewsurvey;
   end;
assign(pplace,vfilename+'.pp');
reset(pplace);
assign(booths,vfilename+'.vb');
reset(booths);
seek(pplace,0);
read(pplace,pp);
getstats;
if not exist(vfilename+'.log') then
   begin
   assign(logfile,vfilename+'.log');
   rewrite(logfile);
   close(logfile);
   end;
assign(logfile,vfilename+'.log');
append(logfile);
writeln(logfile,'----------------------------------------');
writeln(logfile,whoson.name+' logged on ');
if exist(vfilename+'.wel') then showfile(vfilename+'.wel');
if pp.lmessage <> '' then
   begin
   writeln;
   writeln('The last voter says:');
   writeln('"',pp.lmessage,'"');
   writeln;
   end;
repeat
     menu;
until letemout;
close(pplace);
close(booths);
writeln(logfile,'Logged off ');
close(logfile);
writeln;
writeln('Thank you for using BVote...');
writeln('Now returning you to the bulletin board...');
end.