eric
/
renegadebbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
renegadebbs/SOURCE/VOTE.PAS

549 lines
14 KiB
Plaintext
Raw Normal View History

Initial commit
2016-03-05 11:28:50 -08:00
{$IFDEF WIN32}
{$I DEFINES.INC}
{$ENDIF}
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
UNIT Vote;
INTERFACE
USES
Common;
FUNCTION GetTopics: Byte;
FUNCTION UnVotedTopics: Byte;
PROCEDURE ListTopics(UsePause: Boolean);
PROCEDURE VoteAll;
PROCEDURE VoteOne(TopicNum: Byte);
PROCEDURE Results(ListVoters: Boolean);
PROCEDURE TrackUser;
PROCEDURE AddTopic;
IMPLEMENTATION
USES
Common5,
MiscUser;
VAR
AvailableTopics: ARRAY [1..25] OF Byte;
FUNCTION GetTopics: Byte;
VAR
TopicNum,
NumTopics: Byte;
BEGIN
FillChar(AvailableTopics,SizeOf(AvailableTopics),0);
Abort := FALSE;
Next := FALSE;
NumTopics := 0;
Reset(VotingFile);
TopicNum := 1;
WHILE (TopicNum <= NumVotes) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(VotingFile,(TopicNum - 1));
Read(VotingFile,Topic);
IF AACS(Topic.ACS) THEN
BEGIN
Inc(NumTopics);
AvailableTopics[NumTopics] := TopicNum;
END;
Inc(TopicNum);
END;
Close(VotingFile);
LastError := IOResult;
GetTopics := NumTopics;
END;
FUNCTION UnVotedTopics: Byte;
VAR
TopicNum,
NumTopics: Byte;
BEGIN
Abort := FALSE;
Next := FALSE;
NumTopics := 0;
Reset(VotingFile);
TopicNum := 1;
WHILE (TopicNum <= NumVotes) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(VotingFile,(TopicNum - 1));
Read(VotingFile,Topic);
IF AACS(Topic.ACS) AND (ThisUser.Vote[TopicNum] = 0) THEN
Inc(NumTopics);
Inc(TopicNum);
END;
Close(VotingFile);
LastError := IOResult;
UnVotedTopics := NumTopics;
END;
PROCEDURE ListTopics(UsePause: Boolean);
VAR
TopicNum,
NumTopics: Byte;
BEGIN
NumTopics := GetTopics;
IF (NumTopics = 0) THEN
BEGIN
NL;
Print('There are no topics available.');
PauseScr(FALSE);
Exit;
END;
Abort := FALSE;
Next := FALSE;
(*
CLS;
PrintACR('|03<30><33><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
PrintACR('<27>|11|17 Num |03|16<31>|11|17Votes|03|16<31>|11|17 Choice '+
' |03|16<31>');
PrintACR('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
*)
lRGLngStr(61,FALSE);
Reset(VotingFile);
TopicNum := 1;
WHILE (TopicNum <= NumTopics) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Seek(VotingFile,(AvailableTopics[TopicNum] - 1));
Read(VotingFile,Topic);
PrintACR('|07'+PadRightInt(TopicNum,5)+
'|10'+PadRightInt(Topic.NumVotedQuestion,7)+
'|14 '+Topic.Question1);
IF (Topic.Question2 <> '') THEN
PrintACR(PadRightStr('',12)+'|14 '+Topic.Question2);
WKey;
Inc(TopicNum);
END;
Close(VotingFile);
LastError := IOResult;
IF (UsePause) THEN
BEGIN
NL;
PauseScr(FALSE);
END;
END;
PROCEDURE TopicResults(TopicNum: Byte; User: UserRecordType; ListVoters: Boolean);
VAR
ChoiceNum: Byte;
NumVoted,
UNum,
TempMaxUsers: Integer;
BEGIN
Reset(VotingFile);
Seek(VotingFile,(TopicNum - 1));
Read(VotingFile,Topic);
Close(VotingFile);
Abort := FALSE;
Next := FALSE;
CLS;
PrintACR('^5Topic: ^3'+Topic.Question1);
IF (Topic.Question2 <> '') THEN
PrintACR('^5 : ^3'+Topic.Question2);
NL;
PrintACR('^5Created By: ^3'+Topic.CreatedBy);
NL;
(*
PrintACR('|03<30><33><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
PrintACR('<27>|11|17 N |03|16<31>|11|17 % |03|16'+
'<27>|11|17 Choice |03|16<31>');
PrintACR('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
*)
lRGLngStr(62,FALSE);
ChoiceNum := 1;
WHILE (ChoiceNum <= Topic.ChoiceNumber) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
PrintACR('^3'+PadRightInt(Topic.Answers[ChoiceNum].NumVotedAnswer,4)+
CTP(Topic.Answers[ChoiceNum].NumVotedAnswer,Topic.NumVotedQuestion)+
AOnOff(User.Vote[TopicNum] = ChoiceNum,' |12',' |10')+
PadRightInt(ChoiceNum,2)+
'.'+Topic.Answers[ChoiceNum].Answer1);
IF (Topic.Answers[ChoiceNum].Answer2 <> '') THEN
PrintACR(PadLeftStr('',14)+Topic.Answers[ChoiceNum].Answer2);
IF (ListVoters) AND (Topic.Answers[ChoiceNum].NumVotedAnswer > 0) THEN
BEGIN
NumVoted := Topic.Answers[ChoiceNum].NumVotedAnswer;
Reset(UserFile);
TempMaxUsers := (MaxUsers - 1);
UNum := 1;
WHILE (UNum <= TempMaxUsers) AND (NumVoted > 0) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
LoadURec(User,UNum);
IF (User.Vote[TopicNum] = ChoiceNum) THEN
BEGIN
PrintACR(PadLeftStr('^1',14)+Caps(User.Name)+' #'+IntToStr(UNum));
Dec(NumVoted);
END;
Inc(UNum);
END;
Close(UserFile);
END;
Inc(ChoiceNum);
END;
LastError := IOResult;
NL;
PauseScr(FALSE);
END;
PROCEDURE GoVote(TopicNum: Byte);
VAR
InputStr: Str2;
ChoiceNum: Byte;
BEGIN
Reset(VotingFile);
Seek(VotingFile,(TopicNum - 1));
Read(VotingFile,Topic);
Abort := FALSE;
Next := FALSE;
CLS;
Print('^5Renegade Voting:');
NL;
PrintACR('^5Topic: ^3'+Topic.Question1);
IF (Topic.Question2 <> '') THEN
PrintACR('^5 : ^3'+Topic.Question2);
NL;
PrintACR('^5Created by: ^3'+Topic.CreatedBy);
NL;
ChoiceNum := 1;
WHILE (ChoiceNum <= Topic.ChoiceNumber) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
PrintACR('^3'+PadRightInt(ChoiceNum,3)+'.^9 '+Topic.Answers[ChoiceNum].Answer1);
IF (Topic.Answers[ChoiceNum].Answer2 <> '') THEN
PrintACR(' ^9'+Topic.Answers[ChoiceNum].Answer2);
Inc(ChoiceNum);
END;
Dec(ChoiceNum);
IF (AACS(Topic.AddAnswersACS)) AND (ChoiceNum < 25) THEN
BEGIN
Inc(ChoiceNum);
Print('^3'+PadRightInt(ChoiceNum,3)+'.^9 <Pick this one to add your own choice>');
END;
IF (ThisUser.Vote[TopicNum] >= 1) AND (ThisUser.Vote[TopicNum] <= Topic.ChoiceNumber) THEN
BEGIN
NL;
IF PYNQ('Change your vote? ',0,FALSE) THEN
BEGIN
Dec(Topic.Answers[ThisUser.Vote[TopicNum]].NumVotedAnswer);
Dec(Topic.NumVotedQuestion);
ThisUser.Vote[TopicNum] := 0;
Seek(VotingFile,(TopicNum - 1));
Write(VotingFile,Topic);
END
ELSE
BEGIN
Close(VotingFile);
Exit;
END;
END;
NL;
Prt('Your choice: ');
MPL(Length(IntToStr(ChoiceNum)));
ScanInput(InputStr,'Q'^M);
ChoiceNum := StrToInt(InputStr);
IF (ChoiceNum = (Topic.ChoiceNumber + 1)) AND AACS(Topic.AddAnswersACS) AND (ChoiceNum <= 25) THEN
BEGIN
NL;
Prt('Choice '+IntToStr(ChoiceNum)+': ');
MPL(65);
InputWC(Topic.Answers[ChoiceNum].Answer1,65);
IF (Topic.Answers[ChoiceNum].Answer1 <> '') THEN
BEGIN
Prt(PadLeftStr('',7+Length(IntToStr(ChoiceNum)))+': ');
MPL(65);
InputWC(Topic.Answers[ChoiceNum].Answer2,65);
NL;
IF (NOT PYNQ('Add this choice? ',0,FALSE)) THEN
BEGIN
Topic.Answers[ChoiceNum].Answer1 := '';
Topic.Answers[ChoiceNum].Answer2 := '';
END
ELSE
BEGIN
Inc(Topic.ChoiceNumber);
Topic.Answers[ChoiceNum].NumVotedAnswer := 1;
Inc(Topic.NumVotedQuestion);
ThisUser.Vote[TopicNum] := ChoiceNum;
SL1('Added choice to '+Topic.Question1+':');
SysOpLog(Topic.Answers[ChoiceNum].Answer1);
IF (Topic.Answers[ChoiceNum].Answer2 <> '') THEN
SysOpLog(Topic.Answers[ChoiceNum].Answer2);
END;
END;
END
ELSE IF (ChoiceNum >= 1) AND (ChoiceNum <= Topic.ChoiceNumber) THEN
BEGIN
Inc(Topic.Answers[ChoiceNum].NumVotedAnswer);
Inc(Topic.NumVotedQuestion);
ThisUser.Vote[TopicNum] := ChoiceNum;
END;
Seek(VotingFile,(TopicNum - 1));
Write(VotingFile,Topic);
Close(VotingFile);
SaveURec(ThisUser,UserNum);
NL;
IF PYNQ('See results? ',0,TRUE) THEN
TopicResults(TopicNum,ThisUser,FALSE);
IF (InputStr = 'Q') THEN
Abort := TRUE;
LastError := IOResult;
END;
PROCEDURE VoteAll;
VAR
TopicNum,
NumTopics: Byte;
Found: Boolean;
BEGIN
IF (RVoting IN ThisUser.Flags) THEN
BEGIN
NL;
Print('You are restricted from voting.');
PauseScr(FALSE);
Exit;
END;
NumTopics := GetTopics;
IF (NumTopics = 0) THEN
BEGIN
NL;
Print('There are no topics available.');
PauseScr(FALSE);
Exit;
END;
Abort := FALSE;
Next := FALSE;
Found := FALSE;
TopicNum := 1;
WHILE (TopicNum <= NumTopics) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
IF (ThisUser.Vote[AvailableTopics[TopicNum]] = 0) THEN
BEGIN
GoVote(AvailableTopics[TopicNum]);
Found := TRUE;
END;
Inc(TopicNum);
END;
IF (NOT Found) THEN
BEGIN
NL;
Print('You have voted on all available topics.');
PauseScr(FALSE);
END;
END;
PROCEDURE VoteOne(TopicNum: Byte);
VAR
NumTopics: Byte;
BEGIN
IF (RVoting IN ThisUser.Flags) THEN
BEGIN
NL;
Print('You are restricted from voting.');
PauseScr(FALSE);
Exit;
END;
NumTopics := GetTopics;
IF (NumTopics = 0) THEN
BEGIN
NL;
Print('There are no topics available.');
PauseScr(FALSE);
Exit;
END;
IF (TopicNum < 1) AND (TopicNum > NumTopics) THEN
BEGIN
NL;
Print('The range must be from 1 to '+IntToStr(NumTopics)+'.');
PauseScr(FALSE);
Exit;
END;
IF (ThisUser.Vote[AvailableTopics[TopicNum]] > 0) AND (NOT AACS(General.ChangeVote)) THEN
BEGIN
NL;
Print('You can only vote once on this topic.');
PauseScr(FALSE);
Exit;
END;
GoVote(AvailableTopics[TopicNum]);
END;
PROCEDURE Results(ListVoters: Boolean);
VAR
InputStr: Str2;
TopicNum,
NumTopics: Byte;
BEGIN
NumTopics := GetTopics;
IF (NumTopics = 0) THEN
BEGIN
NL;
Print('There are no topics available.');
PauseScr(FALSE);
Exit;
END;
REPEAT
NL;
Prt('Results of which topic? (^51^4-^5'+IntToStr(NumTopics)+'^4) [^5?^4=^5List^4]: ');
MPL(Length(IntToStr(NumTopics)));
ScanInput(InputStr,^M'?');
IF (InputStr = '?') THEN
ListTopics(FALSE);
UNTIL (InputStr <> '?') OR (HangUp);
IF (InputStr <> ^M) THEN
BEGIN
TopicNum := StrToInt(InputStr);
IF (TopicNum >= 1) AND (TopicNum <= NumTopics) THEN
TopicResults(AvailableTopics[TopicNum],ThisUser,ListVoters)
ELSE
BEGIN
NL;
Print('^1The range must be from 1 to '+IntToStr(NumTopics)+'.');
PauseScr(FALSE);
END;
END;
END;
PROCEDURE TrackUser;
VAR
User: UserRecordType;
NumTopics,
TopicNum: Byte;
Unum: Integer;
Found: Boolean;
BEGIN
NumTopics := GetTopics;
IF (NumTopics = 0) THEN
BEGIN
NL;
Print('There are no topics available.');
PauseScr(FALSE);
Exit;
END;
NL;
Print('Track voting for which user (1-'+IntToStr(MaxUsers - 1)+')?');
NL;
Print('Enter User Number, Name, or Partial Search String.');
Prt(': ');
lFindUserWS(Unum);
IF (Unum < 1) THEN
PauseScr(FALSE)
ELSE
BEGIN
LoadURec(User,Unum);
IF (RVoting IN User.Flags) THEN
BEGIN
NL;
Print('^1This user is restricted from voting.');
PauseScr(FALSE);
Exit;
END;
Abort := FALSE;
Next := FALSE;
Found := FALSE;
TopicNum := 1;
WHILE (TopicNum <= NumTopics) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
IF (User.Vote[TopicNum] > 0) THEN
BEGIN
TopicResults(TopicNum,User,FALSE);
Found := TRUE;
END;
Inc(TopicNum);
END;
IF (NOT Found) THEN
BEGIN
NL;
Print('^1This user has not voted on any topics.');
PauseScr(FALSE);
END;
END;
END;
PROCEDURE AddTopic;
VAR
ChoiceNum: Byte;
BEGIN
IF (NumVotes = MaxVotes) THEN
BEGIN
NL;
Prt('No room for additional topics!');
PauseScr(FALSE);
Exit;
END;
FillChar(Topic,SizeOf(Topic),'0');
CLS;
Print('^3Voting addition:');
NL;
Print('^9Now enter your topic. You have up to two lines for your topic.');
Print('^9Press [Enter] on a blank line to leave blank or abort.');
NL;
Prt('Topic: ');
MPL(SizeOf(Topic.Question1) - 1);
InputWC(Topic.Question1,SizeOf(Topic.Question1) - 1);
IF (Topic.Question1 <> '') THEN
BEGIN
Prt(PadLeftStr('',5)+': ');
MPL(SizeOf(Topic.Question2) - 1);
InputWC(Topic.Question2,SizeOf(Topic.Question2) - 1);
NL;
IF PYNQ('Are you sure? ',0,FALSE) THEN
BEGIN
Topic.CreatedBy := Caps(ThisUser.Name);
Topic.NumVotedQuestion := 0;
Topic.ACS := 'VV';
NL;
IF PYNQ('Allow other users to add choices? ',0,FALSE) THEN
Topic.AddAnswersACS := Topic.ACS
ELSE
Topic.AddAnswersACS := General.AddChoice;
NL;
Print('^9Now enter the choices. You have up to two lines for each');
Print('choice. Press [Enter] on a blank first choice line to end.');
NL;
Topic.ChoiceNumber := 0;
Abort := FALSE;
Next := FALSE;
ChoiceNum := 0;
WHILE (ChoiceNum < 25) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Inc(ChoiceNum);
Prt('Choice '+PadRightInt(ChoiceNum,2)+': ');
MPL(SizeOf(Topic.Answers[ChoiceNum].Answer1) - 1);
InputWC(Topic.Answers[ChoiceNum].Answer1,SizeOf(Topic.Answers[ChoiceNum].Answer1) - 1);
IF (Topic.Answers[ChoiceNum].Answer1 = '') THEN
Abort := TRUE
ELSE
BEGIN
Inc(Topic.ChoiceNumber);
Prt(PadLeftStr('',9)+': ');
MPL(SizeOf(Topic.Answers[ChoiceNum].Answer2) - 1);
InputWC(Topic.Answers[ChoiceNum].Answer2,SizeOf(Topic.Answers[ChoiceNum].Answer2) - 1);
Topic.Answers[ChoiceNum].NumVotedAnswer := 0;
END;
END;
IF ((ChoiceNum > 1) OR (Topic.ChoiceNumber > 0)) THEN
BEGIN
NL;
IF (PYNQ('Add this topic? ',0,FALSE)) THEN
BEGIN
Reset(VotingFile);
Seek(VotingFile,FileSize(VotingFile));
Write(VotingFile,Topic);
Close(VotingFile);
Inc(NumVotes);
SysOpLog('Added voting topic: '+Topic.Question1);
IF (Topic.Question2 <> '') THEN
SysOpLog(' : '+Topic.Question2);
END;
END;
END;
END;
LastError := IOResult;
NL;
PauseScr(FALSE);
END;
END.