{$I DIRECT.INC}
unit menuSys2;
interface
procedure mDoMenuSystem;
procedure mChangeMenu(newMenu : string);
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
implementation
uses GenTypes, DosMem, ConfigRt, FileLock, GenSubs, Crt, StatRet, Subs1, Windows,
Subs2, SubsOvr, Mainr2, OverRet1, News, TopUser, Rumors, Mess0, Mess1, Mess2,
Mess3, Mess4, Bulletin, MessSys0, Configur, Doors, Email0, Group, Group1, Email,
Archive, Viewer, ACS, File0, File1, File2, File3, File4, Filexfer, Voting,Mycomman,
Feedback, NUV, FileSort, FileSys0, FileSys1, FileSys2, New_FS, UserList, Login2,
MainMenu, InfuIRC, Config, bbsList, getLogin, mkAvatar,little;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
type
rawRec = record
command : string[2];
param : sStr;
end;
pullRec = record
last : shortInt;
current : shortInt;
total : byte;
upKey : byte;
downKey : byte;
rightKey: byte;
leftKey : byte;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
var
mMenuName : string[8];
mLastMenu : string[8];
mMenuData : ^menuRec;
mGlobals : ^commandArray;
mAutoRun : boolean;
mEnterRun : boolean;
mTotalC : byte;
mTotalG : byte;
mExecNum : byte;
mResult : word;
mUserInpt : string[80];
mDone : boolean;
mPullData : pullRec;
mRawData : rawRec;
mTemp : integer;
mRedisplay: boolean;
mChanged : boolean;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function mLoadMenuData : boolean;
var f : file;
begin
mLoadMenuData := true;
if not exist(cfg.menuDir+mMenuName+'.MNU') then
begin
sendCr('Error, Infusion cannot load '+mMenuName+'.MNU ..');
mLoadMenuData := false;
exit;
end;
assign(f,cfg.menuDir+mMenuName+'.MNU');
reset(f,1);
if (mMenuData<>nil) then dos_freeMem(mMenuData);
dos_getMem(mMenuData,sizeOf(menuRec));
nBlockRead(f,mMenuData^,sizeOf(menuRec),mResult);
close(f);
if (copy(mMenuData^.prompt1,1,2) = '%%') then
if not exist(cfg.textFileDir+copy(mMenuData^.prompt1,3,$FF)) then
begin
sendCr('Error, Infusion cannot find the prompt file for this menu ('
+cfg.textFileDir+copy(mMenuData^.prompt1,3,$FF)+')');
mLoadMenuData := false;
exit;
end;
if (mMenuData^.passWord<>'') then
begin
multiColor(strng^.enter_menu_password);
if upString(inpt)<>upString(mMenuData^.passWord) then
begin
multiColor(strng^.incorrect_menu_password);
mLoadMenuData := false;
exit;
end;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mLoadMenuCommands;
var f : file;
x : byte;
begin
mAutoRun := false;
mEnterRun := false;
assign(f,cfg.menuDir+mMenuName+'.MNU');
reset(f,1);
if (mCommands<>nil) then dos_freeMem(mCommands);
dos_getMem(mCommands,fileSize(f)-sizeOf(menuRec));
mTotalC := (fileSize(f)-sizeOf(menuRec)) div sizeOf(commandRec);
seek(f,sizeOf(menuRec));
for x := 1 to mTotalC do
begin
nBlockRead(f,mCommands^[x],sizeOf(commandRec),mResult);
if (mCommands^[x].keys='//') then mAutoRun := true;
if (mCommands^[x].keys='~~') then mEnterRun := true;
end;
close(f);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mLoadGlobals;
var f : file;
x : byte;
begin
if not exist(cfg.menuDir+'GLOBAL.MNU') then exit;
if (mGlobals<>nil) then dos_freeMem(mGlobals);
assign(f,cfg.menuDir+'GLOBAL.MNU');
reset(f,1);
dos_getMem(mGlobals,fileSize(f)-sizeOf(menuRec));
mTotalG := (fileSize(f)-sizeOf(menuRec)) div sizeOf(commandRec);
seek(f,sizeOf(menuRec));
for x := 1 to mTotalG do
nBlockRead(f,mGlobals^[x],sizeOf(commandRec),mResult);
close(f);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mGenericMenu;
var mCount : array[1..2] of byte;
mTmpKey : string;
mTmpDesc : string;
mRealNum : byte;
begin
Sr.C[1] := 'TI'; Sr.S[1] := mMenuData^.title; Sr.T[1] := length(mMenuData^.title);
listingFile(cfg.textFileDir+cfg.genHeaderFile,false);
if (cfg.genCmndsPerLine=0) then cfg.genCmndsPerLine := 1;
for mCount[1] := 1 to (mTotalC div cfg.genCmndsPerLine)+1 do
for mCount[2] := 1 to cfg.genCmndsPerLine do
begin
if ((pred(mCount[1])*cfg.genCmndsPerLine)+mCount[2]<=mTotalC) and
(mCommands^[(pred(mCount[1])*cfg.genCmndsPerLine)+mCount[2]].hidden=true) then
begin
goXY(1,cfg.genStartYPos+mCount[1]);
if (mCount[2]=1) then printFile(cfg.textFileDir+cfg.genMiddleFile);
goXY(cfg.genStartXPos+(pred(mCount[2])*cfg.genDescriptionPadding),cfg.genStartYPos+mCount[1]);
ansiColor(cfg.genKeyBoxColor);
sendFull(cfg.genKeyBoxCharz[1]); ansiColor(cfg.genKeyColor);
sendFull(mCommands^[(pred(mCount[1])*cfg.genCmndsPerLine)+mCount[2]].keys); ansiColor(cfg.genKeyBoxColor);
sendFull(cfg.genKeyBoxCharz[2]+' '); ansiColor(cfg.genDescriptionColor);
sendFull(tab(mCommands^[(pred(mCount[1])*cfg.genCmndsPerLine)+mCount[2]].descrip,cfg.genDescriptionPadding));
end;
end;
if (mTotalC mod cfg.genCmndsPerline>0) then sendCr('');
listingFile(cfg.textFileDir+cfg.genFooterFile,true);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mGenPrint(fileName : string);
begin
if exist(cfg.textFileDir+fileName) then printFile(cfg.textFileDir+fileName)
else if (fileName=mMenuData^.helpMenu) then mGenericMenu;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mCheckMenuData;
begin
if (mMenuData^.clrScrBefore=true) then ansiCls;
if (urec.level<=mMenuData^.forceHelpLevel) or (mMenuData^.usePullBar=true) then
mGenPrint(mMenuData^.helpMenu);
if (mMenuData^.mes_conf>0) then changeConf(true, mMenuData^.mes_conf);
if (mMenuData^.file_conf>0) then changeConf(false,mMenuData^.file_conf);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mLoadLastMenu;
begin
mMenuName := mLastMenu;
mLoadMenuData;
mLoadMenuCommands;
mCheckMenuData;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mExecCommand(command : lStr; param : sStr);
var c2 : char;
begin
c2 := upCase(command[2]);
case Upcase(command[1]) of
'^' : Begin
Check_Is_Okay:=False;
UpdateNode('','');
CASE C2 OF
'P' : HoldScreen;
'@' : WriteStr(Param);
'H' : Begin
MultiColor(Param);
Inpt[1] := WaitForChar(True);
End;
'B' : SendFull(^G);
'$' : Begin
mChangeMenu(Param);
mUserInpt := '';
Exit;
End;
'M' : SendLn('');
'F' : PrintFile(cfg.textFileDir+Param);
'I' : InputFile(cfg.textFileDir+Param);
'D' : DataFile(cfg.textFileDir+Param);
'S' : Begin
MultiColor(Param);
SendLn('');
End;
'V' : ShowCredits;
'L' : ANSiCLS;
'X' : WriteHdr(Param);
'R' : Begin
Write_All_Door_Files;
ExecuteWithSwap(Param,'',false);
End;
'E' : Begin
ShutDownSystem;
Halt(Valu(Param));
End;
END;
End;
'F' : Begin
UpdateNode('In the File Area...','');
Check_Is_Okay:=False;
If Init_FileXfer(1) Then
CASE C2 Of
'D' : Download(0,False);
'A' : Add_To_Batch(0,'',0,True,False);
'V' : ListArchive(False);
'T' : TypeFile(False);
'R' : RemoveFromBatch(0,'');
'I' : FileInfo;
'U' : Upload;
'L' : FileXfer.ListFiles(False,False,0);
'W' : FileXfer.ListFiles(True,False,0);
'*' : GetArea;
'S' : SearchFile;
'N' : NewScanALL;
'B' : ListBatch;
'Z' : File2.FixNewScan;
'E' : EditUpload;
']' : ScrollForward;
'[' : ScrollBackward;
'C' : Clear_BatchDown;
'K' : ConfigFileListings;
END;
End;
'$' : Begin
UpdateNode('In the File Area...','');
Check_Is_Okay:=False;
If Init_FileXfer(1) Then
CASE C2 OF
'S' : SortArea;
'A' : GetArea;
']' : ScrollForward;
'[' : ScrollBackward;
'X' : ViewTransLog;
'W' : AddMultipleFiles;
'F' : SysOpAdd;
'*' : Directory(Area.XmodemDir);
'M' : ModAREA;
'K' : KillAREA(CurArea);
'O' : ReorderAREAS;
'B' : AddBatch(0);
'D' : Begin
Def := 0;
Delete_All;
End;
'E' : Edit_All;
'V' : View_All;
'P' : MoveFiles;
'=' : RenameFile(0);
'N' : NewFiles;
'L' : New_FS.ListFiles(False,False,0);
'!' : New_FS.ListFiles(True,False,0);
END;
End;
'M' : Begin
UpdateNode('In the Message Bases...','');
Check_Is_Okay:=False;
If Init_Message Then
CASE C2 OF
'P' : PostBul;
'N' : Bulletin.NewScanAll(False);
'R' : Bulletin.NewScanAll(True);
'K' : KillBul;
'L' : ListBuls;
'E' : EditBul;
']' : NextSubBoard(True);
'[' : NextSubBoard(False);
'F' : Mess3.FixNewScan;
'T' : ToggleNewScan;
'U' : ProcessRep;
'D' : MakeQwk;
'G' : GetMaxQwk;
'A' : ActiveBoard;
'H' : GetHeaderType;
END;
End;
'&' : Begin
UpdateNode('In the SysOp Menu...','');
Check_Is_Okay:=False;
If Init_Message Then
CASE C2 OF
'S' : SetNameAccess;
'A' : SetAllAccess;
'L' : ListAccess;
'M' : MoveBulletin;
'B' : Bul_To_Text;
'E' : EditBoard;
'K' : KillBoard;
'O' : OrderBoards;
'C' : cConfig0;
'U' : cUserEdit;
'D' : cMiniDos;
'X' : cMenuEdit;
'P' : cProtocolEdit;
END;
END;
'N' : Begin
UpdateNode('Voting on New Users...','');
Check_Is_Okay:=False;
If Init_NUV Then
CASE C2 OF
'L' : ListAccounts;
'N' : NewScan(True);
'S' : NewScan(False);
'V' : VoteOn(Valu(Inpt),False,True);
'X' : VoteOn(Valu(Inpt),False,False);
END;
END;
'E' : Begin
UpdateNode('In E-Mail...','');
Check_Is_Okay:=False;
If Init_EMail Then
CASE C2 OF
'L' : ListMail(Incoming^);
'O' : ListMail(Outgoing^);
'F' : Write_To_File;
'E' : EditMailUser;
'C' : CopyMail;
'W' : ForwardMail;
'S' : If Valu(Param)>0 then SendMail(Param) else SendMail('0');
'Z' : ZippyMail;
'N' : MailRead(True);
'R' : MailRead(False);
'B' : SomeoneElse;
'*' : ScanAll;
'D' : DeleteRange;
'A' : Announcement;
'Q' : QueryDelete(Incoming^);
'-' : NextMail;
'K' : DeleteIncoming;
'V' : ViewOutGoing;
'!' : KillOutGoing;
'#' : ReadNum(Valu(Inpt));
END;
END;
'G' : Begin
UpdateNode('In E-Mail...','');
Check_Is_Okay:=False;
If Init_Email Then
CASE C2 OF
'A' : SelectGroup;
'D' : DeleteGroup;
'L' : ListMembers;
'R' : ReadDMember;
'K' : RemoveMember;
'C' : SetClass;
'S' : SetCreator;
'B' : AddbyLevel;
END;
END;
'B' : Begin
UpdateNode('Looking at the BBS List...','');
Check_Is_Okay:=False;
CASE C2 OF
'L' : ListBBS;
'A' : AddBBS;
'C' : ChangeBBS;
'V' : ViewAnsi;
'D' : DeleteBBS;
END;
END;
'@' : begin
Check_is_okay:=false;
case c2 of
'L' : lGetLoginProc;
'A' : lApplyProc('');
'F' : lFeedback;
'S' : lSysopChat;
'C' : lCheckAcs;
'R' : mRedisplay := true;
end;
end;
'R' : Begin
Check_Is_Okay:=False;
CASE C2 Of
'L' : ListRumors;
'A' : AddRumor;
'N' : RumorsNewscan;
'S' : SearchForText;
'D' : DeleteRumor;
'*' : RandomRumor;
END;
END;
'D' : Begin
UpdateNode('In the Doors Area...','');
Check_Is_Okay:=False;
If Init_Doors Then
CASE C2 OF
'L' : ListDoors;
'O' : OpenDoor(0);
'I' : GetInfo;
'C' : ChangeDoor;
'D' : DeleteDoor;
'M' : MaybeMakeDoor;
'*' : OpenDoor(Valu(mUserInpt));
'@' : OpenDoor(Valu(Param));
END;
END;
'C' : CASE C2 OF
'F' : ChangeConf(False,0);
'M' : ChangeConf(True,0);
'Y' : ChangeConf(False,Valu(Param));
'Z' : ChangeConf(True,Valu(Param));
END;
'A' : Begin
UpdateNode('','');
Check_Is_Okay:=False;
CASE C2 OF
'A' : Add_Auto_Sig;
'T' : TimeBank;
'E' : Pick_Theme;
'S' : SummonSysOp;
'I' : Infoforms;
'G' : LogOff;
'D' : ShowDailyLog;
'F' : MainMenu.SendFeedback;
'P' : ChangePwd;
'-' : Infoforms;
'Y' : ShowSystemStatus;
'L' : SetLastCall;
'W' : ShowLastCallers;
'C' : DoItYerSelfConfig;
'U' : UserListUtils;
'M' : Auto_Message;
'O' : Begin
Inpt[0] := #0;
Urec.lastnummsgs := Status.TotalMSGS;
Urec.lastnumfiles:= Status.TotalFILES;
ForceHangup := True;
Exit;
End;
END;
END;
'V' : Begin
UpdateNode('In the Voting Area...','');
Check_Is_Okay:=False;
if Init_Voting Then
CASE C2 OF
'L' : ListChoices;
'V' : GetVote(False);
'S' : ShowResults;
'T' : ListTopics;
'P' : SelectTopic;
'A' : mTemp := AddChoice;
'*' : AddTopic;
'D' : DelTopic;
'R' : RemoveChoice;
'N' : NextTopic;
'M' : VoteOnMandatory;
END;
END;
'S' : Begin
UpdateNode('Viewing the Top Ten..','');
Check_Is_Okay:=False;
IF C2 = 'T' THEN ViewTopTen(Valu(Param));
End;
'%' : Begin
UpdateNode('In SysOp Menu..','');
Check_Is_Okay:=False;
CASE C2 OF
'A' : AddToNUV('');
'U' : EditUsers;
'S' : EditStatus;
'B' : BlackList;
'X' : TransferName;
'O' : AddNews;
'N' : EditNews;
'K' : DelErrLog;
'T' : SetTheTime;
'M' : MakeUser;
'H' : InfoFormHunt;
'V' : ViewSysLog;
'D' : DelSysLog;
'L' : ShowAllSysOps;
'E' : ReadErrLog;
'*' : RemoveAllForms;
'&' : RemoteDOSShell;
END;
END;
'I' : Begin
UpdateNode('In SysOp Menu...','');
Check_Is_Okay:=False;
CASE C2 OF
'W' : WriteCurFeedback;
'D' : DelFeedback;
'E' : EditFeedbackUser;
'I' : FeedbackInfoform;
'N' : NextFeedback;
'A' : ReadAgain;
'R' : ReplyFeedback;
'L' : ListFeedback;
'Q' : QuickFeedbackRead(False);
'*' : QuickFeedbackRead(True);
'#' : ReadFNum(Valu(Inpt));
END;
END;
'L' : Begin
Check_Is_Okay:=False;
UpdateNode('','');
CASE C2 OF
'W' : RandomWelcome;
'S' : RandomStat;
'M' : Check_Waiting_Mail;
'F' : Check_Feedback;
'N' : Check_Notices;
'A' : Show_AutoMessage;
'U' : ShowNewUsers;
'L' : ShowLastFive;
'O' : One_Liners;
'C' : Check_NewNUV;
'E' : PrintNews(0,True);
'V' : PrintNews(0,False);
END;
END;
'!' : Begin
CASE C2 OF
'C' : DoInfusionIrc;
'S' : Send_Node_Message(false);
'N' : Send_Node_Message(true);
'L' : Begin
UpdateNode('Listing nodes...','');
Node_Listing;
End;
'U' : UpdateNode(Param,'');
'R' : ResetNode;
end;
end;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mRunCommand(commandStr : lStr; global : boolean; acs : string);
var mAcsPass : boolean;
mCommand : string[2];
mParam : sStr;
mTotStack : byte;
mCount : byte;
mStackPos : array[1..20] of byte;
mStackEnd : array[1..20] of byte;
procedure mSetStackNum;
var x : byte;
begin
fillChar(mStackPos,sizeOf(mStackPos),1);
fillChar(mStackEnd,sizeOf(mStackEnd),1);
mTotStack := 1;
for x := 1 to length(commandStr) do
if (commandStr[x]=';') then
begin
inc(mTotStack);
mStackPos[mTotStack] := x+1;
mStackEnd[mTotStack-1] := x-1;
end;
mStackEnd[mTotStack] := length(commandStr);
end;
procedure mGetStackData(num : byte);
begin
if (num=1) and (mTotStack=1) then
begin
mCommand := copy(commandStr,1,2);
mParam := copy(commandStr,3,length(commandStr)-2);
end else
begin
mCommand := copy(commandStr,mStackPos[num],2);
mParam := copy(commandStr,mStackPos[num]+2,mStackEnd[num]-2);
end;
end;
begin
if (commandStr='') then exit;
mAcsPass := acsPass(acs);
if (mAcsPass=true) then
begin
mSetStackNum;
if (mTotStack>1) then
for mCount := 1 to mTotStack do
begin
mGetStackData(mCount);
mExecCommand(mCommand,mParam);
end else mExecCommand(copy(commandStr,1,2),copy(commandStr,3,length(commandStr)-2));
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mCheckEnterRun;
var x : byte;
begin
if not mEnterRun then exit;
for x := 1 to mTotalC do
begin
if (mCommands^[x].keys='~~') then
mRunCommand(mCommands^[x].command,false,mCommands^[x].acs);
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mCheckAutoRun;
var x : byte;
begin
if not mAutoRun then exit;
for x := 1 to mTotalC do
begin
if (mCommands^[x].keys='//') then
mRunCommand(mCommands^[x].command,false,mCommands^[x].acs);
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mResetPullBars;
begin
mPullData.current := 1;
mPullData.last := 1;
mPullData.total := mTotalC;
mPullData.upKey := mMenuData^.upKey;
mPullData.downKey := mMenuData^.downKey;
mPullData.rightKey := mMenuData^.rightKey;
mPullData.leftKey := mMenuData^.leftKey;
mRedisplay := false;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mChangeMenu(newMenu : string);
var mContinue : boolean;
begin
mLastMenu := mMenuName;
mMenuName := newMenu;
mContinue := true;
if not mLoadMenuData then
begin
mLoadLastMenu;
mContinue := false;
end;
if (acsPass(mMenuData^.acs)=false) and (mContinue=true) then
begin
if (mMenuData^.fallBack='') or (mMenuData^.fallBack=mMenuName) then
begin
mLoadLastMenu;
mContinue := false;
end else
mMenuName := mMenuData^.fallBack;
if not mLoadMenuData then
begin
mLoadLastMenu;
mContinue := false;
end;
end;
if (mContinue=true) then
begin
mLoadMenuCommands;
mCheckMenuData;
mCheckAutoRun;
{ mGenPrint(mMenuData^.helpMenu);}
if (mMenuData^.usePullBar=true) then mResetPullBars;
mChanged := true;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mGetKeyInput;
procedure mDisplay(str : string);
begin
if (str='') then exit;
if (str[1] = '@') then
begin
Sr.C[1] := 'MN';
Sr.S[1] := copy(str,2,length(str));
if (pos('%%',str)=1) then delete(str,1,2);
subs1.multiColor(urec.prompt);
end else multiColor(str);
end;
begin
mDisplay(mMenuData^.prompt1);
mDisplay(mMenuData^.prompt2);
if (mMenuData^.usePrompt=true) then writeStr('*');
mUserInpt := inpt;
if (mUserInpt='') then sendLn('');
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mGetPullBarInput;
var
pDone : boolean;
pInkey : char;
pIDData : pullRec;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mGetIDData;
var x : byte;
found: boolean;
begin
found := false;
x := 0;
repeat
inc(x);
if (mCommands^[x].IDNumber=mPullData.last) then
begin pIDData.last := x; found := true; end;
until (x>=mPullData.total) or (found=true);
found := false;
x := 0;
repeat
inc(x);
if (mCommands^[x].IDNumber=mPullData.current) then
begin pIDData.current := x; found := true; end;
until (x>=mPullData.total) or (found=true);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mDrawBars;
begin
mGetIDData;
goXY(mCommands^[pIDData.last].barX,mCommands^[pIDData.last].barY);
multiColor(mCommands^[pIDData.last].barUnLit);
goXY(mCommands^[pIDData.current].barX,mCommands^[pIDData.current].barY);
multiColor(mCommands^[pIDData.current].barLit);
ansiColor(7);
goXY(1,1);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
begin
if (mRedisplay=true) then
begin
mGenPrint(mMenuData^.helpMenu);
mRedisplay := false;
end;
mDrawBars;
repeat
pInkey := arrowKey(true);
case pInKey of
^A : begin
mPullData.last := mPullData.current;
dec(mPullData.current,mPullData.upKey);
if (mPullData.current<1) then mPullData.current := mPullData.total;
mDrawBars;
end;
^B : begin
mPullData.last := mPullData.current;
inc(mPullData.current,mPullData.downKey);
if (mPullData.current>mPullData.total) then mPullData.current := 1;
mDrawBars;
end;
^C : begin
mPullData.last := mPullData.current;
inc(mPullData.current,mPullData.rightKey);
if (mPullData.current>mPullData.total) then mPullData.current := 1;
mDrawBars;
end;
^D : begin
mPullData.last := mPullData.current;
dec(mPullData.current,mPullData.leftKey);
if (mPullData.current<1) then mPullData.current := mPullData.total;
mDrawBars;
end;
^M : begin
mGetIDData;
mExecNum := pIDData.current;
pDone := true;
end;
#32 : mGenPrint(mMenuData^.helpMenu);
end;
until (pDone=true);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function mGlobalEntry : boolean;
var x : byte;
found : boolean;
begin
x := 0;
mExecNum := 0;
repeat
inc(x);
if (upString(mUserInpt)=upString(mGlobals^[x].keys)) then
found := true;
until (found=true) or (x>=mTotalG);
if (found=true) then
begin
mExecNum := x;
mGlobalEntry := true;
end else mGlobalEntry := false;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function mFindCommand : boolean;
var x : byte;
found : boolean;
begin
x := 0;
mExecNum := 0;
repeat
inc(x);
if (upString(mUserInpt)=upString(mCommands^[x].keys)) then
found := true;
until (found=true) or (x>=mTotalC);
if (found=true) then
begin
mFindCommand := true;
mExecNum := x;
end else mFindCommand := false;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function mRawCommand : boolean;
begin
fillChar(mRawData,sizeOf(mRawData),0);
if (copy(mUserInpt,1,4)<>'//\\') or (isSysop=false) then exit;
delete(mUserInpt,1,4);
mRawCommand := true;
mRawData.command := copy(mUserInpt,1,2);
mRawData.param := copy(mUserInpt,3,length(mUserInpt)-2);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mCheckTimeLeft;
begin
if (timeLeft<1) and (isSysop=false) then
begin
printFile(cfg.textFileDir+'TIMESUP.ANS');
forceHangUp := true;
mDone := true;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mCheckEventTime;
begin
if (timeTillEvent<=5) then
begin
printFile(cfg.textFileDir+'EVENTNOW.ANS');
forceHangUp := true;
mDone := true;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mInitVideo;
begin
StopTimer (Status.MinutesIdle);
StartTimer (Status.MinutesUsed);
textattr:=9;
initwinds;
fillchar (urec,sizeof(urec),0);
Urec.Handle := '';
Urec.Config := [lowercase,linefeeds,eightycols,asciigraphics,ansigraphics,fseditor];
Urec.Color1 := cfg.Defcolor1;
Urec.Color2 := cfg.Defcolor2;
Urec.Color3 := cfg.Defcolor3;
Urec.Color4 := cfg.Defcolor4;
Urec.Color5 := cfg.Defcolor5;
Urec.Color6 := cfg.Defcolor6;
Urec.Color7 := cfg.Defcolor7;
Uselinefeeds:=true;
usecapsonly:=false;
UseBottom:=cfg.DefBottomLine;
InitWinds;
Case UseBottom Of
0:SetScreenSize(80,25);
1,2:SetScreenSize(80,24);
3:Begin
TextMode(Co80+Font8x8);
SetUpBottom;
End;
End;
Bottomline;
Unam := '';
Inpt[0] := #0;
ChainStr[0] := #0;
urec.timetoday:=10;
logontime:=timer;
logofftime:=timer+10;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure mDoMenuSystem;
begin
mInitVideo;
mMenuName := cfg.startMenu;
mLastMenu := '';
if not mLoadMenuData then
begin
sendCr('Error, Infusion cannot find the starting menu for your system.. Halting');
dos_freeMem(mCommands);
dos_freeMem(mMenuData);
exit;
end;
mLoadMenuCommands;
mLoadGlobals;
mCheckAutoRun;
if (mChanged=false) then mCheckMenuData else mChanged := false;
mResetPullBars;
repeat
mCheckTimeLeft;
mCheckEventTime;
if (mDone=true) then exit;
if (mMenuData^.usePullBar=true) then
begin
mGetPullBarInput;
mRunCommand(mCommands^[mExecNum].command,false,mCommands^[mExecNum].acs);
end else
begin
mGetKeyInput;
if (mUserInpt='') then begin mCheckEnterRun; mGenPrint(mMenuData^.helpMenu) end else
if (mRawCommand=true) then mExecCommand(mRawData.command,mRawData.param) else
if (mGlobalEntry=true) then mRunCommand(mGlobals^[mExecNum].command,true,mGlobals^[mExecNum].acs) else
if (mFindCommand=true) then mRunCommand(mCommands^[mExecNum].command,false,mCommands^[mExecNum].acs) else
mGenPrint(mMenuData^.helpMenu);
end;
if (hungUpOn=true) then exit;
until (0=1);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
begin end.