eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A36 stuff

This commit is contained in:
mysticbbs 2013-05-27 02:57:34 -04:00
parent 7ffca01cdb
commit 9909d064a5
8 changed files with 254 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
mystic/bbs_ansi_menubox.pas
View File

@ -354,7 +354,7 @@ Var
Begin Begin
If Not WasOpened Then If Not WasOpened Then
If Shadow Then If Shadow Then
Screen.GetScreenImage(X1, Y1, X2 + 2{3}, Y2 + 1, Image) Screen.GetScreenImage(X1, Y1, X2 + 2, Y2 + 1, Image)
Else Else
Screen.GetScreenImage(X1, Y1, X2, Y2, Image); Screen.GetScreenImage(X1, Y1, X2, Y2, Image);
@ -388,9 +388,9 @@ Begin
If Shadow Then Begin If Shadow Then Begin
For A := Y1 + 1 to Y2 + 1 Do For A := Y1 + 1 to Y2 + 1 Do
For B := X2 to X2 + 1 Do Begin For B := X2 + 1 to X2 + 2 Do Begin
Ch := Screen.ReadCharXY(B, A); Ch := Screen.ReadCharXY(B, A);
WriteXY (B + 1, A, ShadowAttr, Ch); WriteXY (B, A, ShadowAttr, Ch);
End; End;
A := Y2 + 1; A := Y2 + 1;

104
mystic/bbs_core.pas
View File

@ -78,8 +78,6 @@ Type
HistoryULs : Word; HistoryULs : Word;
HistoryULKB : LongInt; HistoryULKB : LongInt;
HistoryHour : SmallInt; HistoryHour : SmallInt;
// PromptFile : File of RecPrompt;
// Prompt : RecPrompt;
LastScanHadNew : Boolean; LastScanHadNew : Boolean;
LastScanHadYou : Boolean; LastScanHadYou : Boolean;
PromptData : Array[0..mysMaxThemeText] of Pointer; PromptData : Array[0..mysMaxThemeText] of Pointer;
@ -96,6 +94,7 @@ Type
Function ElapsedTime : Integer; Function ElapsedTime : Integer;
Function TimeLeft : Integer; Function TimeLeft : Integer;
Function LoadThemeData (Str: String) : Boolean; Function LoadThemeData (Str: String) : Boolean;
Procedure DisposeThemeData;
End; End;
Var Var
@ -153,6 +152,8 @@ End;
Destructor TBBSCore.Destroy; Destructor TBBSCore.Destroy;
Begin Begin
DisposeThemeData;
Pipe.Free; Pipe.Free;
Msgs.Free; Msgs.Free;
FileBase.Free; FileBase.Free;
@ -160,8 +161,6 @@ Begin
User.Free; User.Free;
IO.Free; IO.Free;
// Close (PromptFile);
{$IFNDEF UNIX} {$IFNDEF UNIX}
Client.Free; Client.Free;
{$ENDIF} {$ENDIF}
@ -339,21 +338,19 @@ Begin
End; End;
End; End;
Procedure TBBSCore.DisposeThemeData;
Var
Count : LongInt;
Begin
For Count := mysMaxThemeText DownTo 0 Do Begin
If Assigned(PromptData[Count]) Then
FreeMem(PromptData[Count]);
PromptData[Count] := NIL;
End;
End;
Function TBBSCore.LoadThemeData (Str: String) : Boolean; Function TBBSCore.LoadThemeData (Str: String) : Boolean;
Procedure DisposeThemeData;
Var
Count : LongInt;
Begin
For Count := mysMaxThemeText DownTo 0 Do Begin
If Assigned(PromptData[Count]) Then
FreeMem(PromptData[Count]);
PromptData[Count] := NIL;
End;
End;
Var Var
Count : LongInt; Count : LongInt;
PromptFile : Text; PromptFile : Text;
@ -429,77 +426,4 @@ Begin
If Not Result Then Halt(1); If Not Result Then Halt(1);
End; End;
(*
Function TBBSCore.GetPrompt (N : Word) : String;
Begin
{$I-}
Seek (PromptFile, N);
Read (PromptFile, Prompt);
{$I+}
If IoResult <> 0 Then Begin
FileMode := 66;
{$I-}
Assign (PromptFile, Config.DataPath + Theme.FileName + '.thm');
Reset (PromptFile);
Seek (PromptFile, N);
Read (PromptFile, Prompt);
{$I+}
If IoResult <> 0 Then Begin
io.OutFull ('|CR|12Error reading prompt ' + strI2S(N) + '|DE|DE');
SystemLog ('Error reading prompt ' + strI2S(N));
Halt (1);
End;
End;
If Prompt[1] = '@' Then Begin
io.OutFile (Copy(Prompt, 2, Length(Prompt)), True, 0);
Prompt := '';
End Else
If Prompt[1] = '!' Then Begin
ExecuteMPL (NIL, Copy(Prompt, 2, Length(Prompt)));
Prompt := '';
End;
Result := Prompt;
End;
Function TBBSCore.LoadThemeData (Str: String) : Boolean;
Var
TempTheme : RecTheme;
Begin
Result := False;
Reset (ThemeFile);
While Not Eof(ThemeFile) Do Begin
Read (ThemeFile, TempTheme);
{$IFDEF FS_SENSITIVE}
If TempTheme.FileName = Str Then Begin
{$ELSE}
If strUpper(TempTheme.FileName) = strUpper(Str) Then Begin
{$ENDIF}
If Not FileExist(Config.DataPath + TempTheme.FileName + '.thm') Then Break;
{$I-} Close (PromptFile); {$I+}
If IoResult <> 0 Then;
Assign (PromptFile, Config.DataPath + TempTheme.FileName + '.thm');
Result := ioReset(PromptFile, SizeOf(RecPrompt), fmRWDN);
Break;
End;
End;
Close (ThemeFile);
If Result Then Theme := TempTheme;
End;
*)
End. End.

3
mystic/bbs_filebase.pas
View File

@ -2866,6 +2866,9 @@ Begin
{$I-} Reset (DataFile, 1); {$I+} {$I-} Reset (DataFile, 1); {$I+}
If IoResult <> 0 Then ReWrite (DataFile, 1); If IoResult <> 0 Then ReWrite (DataFile, 1);
If Mode = 1 Then
Session.io.OutFile(FBase.DispFile, True, 0);
Result := 0; Result := 0;
CurPage := 0; CurPage := 0;
TopPage := 0; TopPage := 0;

1
mystic/bbs_io.pas
View File

@ -2246,6 +2246,7 @@ Begin
If TempChar = #0 Then TempChar := ' '; If TempChar = #0 Then TempChar := ' ';
Session.io.BufAddChar(TempChar); Session.io.BufAddChar(TempChar);
Inc (BufPos, 2); Inc (BufPos, 2);
End; End;
End; End;

111
mystic/mpl_common.pas
View File

@ -259,59 +259,70 @@ Begin
AddProc ({$IFDEF MPLPARSER} 'freadrec', {$ENDIF} 'Fx', iNone); // 92 AddProc ({$IFDEF MPLPARSER} 'freadrec', {$ENDIF} 'Fx', iNone); // 92
AddProc ({$IFDEF MPLPARSER} 'real2str', {$ENDIF} 'rb', iString); // 93 AddProc ({$IFDEF MPLPARSER} 'real2str', {$ENDIF} 'rb', iString); // 93
AddProc ({$IFDEF MPLPARSER} 'abs', {$ENDIF} 'l', iLongInt); // 94 AddProc ({$IFDEF MPLPARSER} 'abs', {$ENDIF} 'l', iLongInt); // 94
AddProc ({$IFDEF MPLPARSER} 'classcreate', {$ENDIF} 'Ls', iNone); // 95
AddProc ({$IFDEF MPLPARSER} 'classfree', {$ENDIF} 'l', iNone); // 96
IW := 500; // BEGIN BBS-SPECIFIC STUFF IW := 500; // BEGIN BBS-SPECIFIC STUFF
AddProc ({$IFDEF MPLPARSER} 'input', {$ENDIF} 'bbbs', iString); // 500 AddProc ({$IFDEF MPLPARSER} 'input', {$ENDIF} 'bbbs', iString); // 500
AddProc ({$IFDEF MPLPARSER} 'getuser', {$ENDIF} 'l', iBool); // 501 AddProc ({$IFDEF MPLPARSER} 'getuser', {$ENDIF} 'l', iBool); // 501
AddProc ({$IFDEF MPLPARSER} 'onekey', {$ENDIF} 'so', iChar); // 502 AddProc ({$IFDEF MPLPARSER} 'onekey', {$ENDIF} 'so', iChar); // 502
AddProc ({$IFDEF MPLPARSER} 'getthisuser', {$ENDIF} '', iNone); // 503 AddProc ({$IFDEF MPLPARSER} 'getthisuser', {$ENDIF} '', iNone); // 503
AddProc ({$IFDEF MPLPARSER} 'inputyn', {$ENDIF} 's', iBool); // 504 AddProc ({$IFDEF MPLPARSER} 'inputyn', {$ENDIF} 's', iBool); // 504
AddProc ({$IFDEF MPLPARSER} 'inputny', {$ENDIF} 's', iBool); // 505 AddProc ({$IFDEF MPLPARSER} 'inputny', {$ENDIF} 's', iBool); // 505
AddProc ({$IFDEF MPLPARSER} 'dispfile', {$ENDIF} 's', iBool); // 506 AddProc ({$IFDEF MPLPARSER} 'dispfile', {$ENDIF} 's', iBool); // 506
AddProc ({$IFDEF MPLPARSER} 'filecopy', {$ENDIF} 'ss', iBool); // 507 AddProc ({$IFDEF MPLPARSER} 'filecopy', {$ENDIF} 'ss', iBool); // 507
AddProc ({$IFDEF MPLPARSER} 'menucmd', {$ENDIF} 'ss', iNone); // 508 AddProc ({$IFDEF MPLPARSER} 'menucmd', {$ENDIF} 'ss', iNone); // 508
AddProc ({$IFDEF MPLPARSER} 'stuffkey', {$ENDIF} 's', iNone); // 509 AddProc ({$IFDEF MPLPARSER} 'stuffkey', {$ENDIF} 's', iNone); // 509
AddProc ({$IFDEF MPLPARSER} 'acs', {$ENDIF} 's', iBool); // 510 AddProc ({$IFDEF MPLPARSER} 'acs', {$ENDIF} 's', iBool); // 510
AddProc ({$IFDEF MPLPARSER} 'upuser', {$ENDIF} 'i', iNone); // 511 AddProc ({$IFDEF MPLPARSER} 'upuser', {$ENDIF} 'i', iNone); // 511
AddProc ({$IFDEF MPLPARSER} 'setusertime', {$ENDIF} 'i', iNone); // 512 AddProc ({$IFDEF MPLPARSER} 'setusertime', {$ENDIF} 'i', iNone); // 512
AddProc ({$IFDEF MPLPARSER} 'hangup', {$ENDIF} '', iNone); // 513 AddProc ({$IFDEF MPLPARSER} 'hangup', {$ENDIF} '', iNone); // 513
AddProc ({$IFDEF MPLPARSER} 'getmbase', {$ENDIF} 'l', iBool); // 514 AddProc ({$IFDEF MPLPARSER} 'getmbase', {$ENDIF} 'l', iBool); // 514
AddProc ({$IFDEF MPLPARSER} 'getprompt', {$ENDIF} 'l', iString); // 515 AddProc ({$IFDEF MPLPARSER} 'getprompt', {$ENDIF} 'l', iString); // 515
AddProc ({$IFDEF MPLPARSER} 'getmgroup', {$ENDIF} 'l', iBool); // 516 AddProc ({$IFDEF MPLPARSER} 'getmgroup', {$ENDIF} 'l', iBool); // 516
AddProc ({$IFDEF MPLPARSER} 'purgeinput', {$ENDIF} '', iNone); // 517 AddProc ({$IFDEF MPLPARSER} 'purgeinput', {$ENDIF} '', iNone); // 517
AddProc ({$IFDEF MPLPARSER} 'getfbase', {$ENDIF} 'l', iBool); // 518 AddProc ({$IFDEF MPLPARSER} 'getfbase', {$ENDIF} 'l', iBool); // 518
AddProc ({$IFDEF MPLPARSER} 'getfgroup', {$ENDIF} 'l', iBool); // 519 AddProc ({$IFDEF MPLPARSER} 'getfgroup', {$ENDIF} 'l', iBool); // 519
AddProc ({$IFDEF MPLPARSER} 'sysoplog', {$ENDIF} 's', iNone); // 520 AddProc ({$IFDEF MPLPARSER} 'sysoplog', {$ENDIF} 's', iNone); // 520
AddProc ({$IFDEF MPLPARSER} 'movex', {$ENDIF} 'b', iNone); // 521 AddProc ({$IFDEF MPLPARSER} 'movex', {$ENDIF} 'b', iNone); // 521
AddProc ({$IFDEF MPLPARSER} 'movey', {$ENDIF} 'b', iNone); // 522 AddProc ({$IFDEF MPLPARSER} 'movey', {$ENDIF} 'b', iNone); // 522
AddProc ({$IFDEF MPLPARSER} 'writepipe', {$ENDIF} 's', iNone); // 523 AddProc ({$IFDEF MPLPARSER} 'writepipe', {$ENDIF} 's', iNone); // 523
AddProc ({$IFDEF MPLPARSER} 'writepipeln', {$ENDIF} 's', iNone); // 524 AddProc ({$IFDEF MPLPARSER} 'writepipeln', {$ENDIF} 's', iNone); // 524
AddProc ({$IFDEF MPLPARSER} 'writeraw', {$ENDIF} 's', iNone); // 525 AddProc ({$IFDEF MPLPARSER} 'writeraw', {$ENDIF} 's', iNone); // 525
AddProc ({$IFDEF MPLPARSER} 'writerawln', {$ENDIF} 's', iNone); // 526 AddProc ({$IFDEF MPLPARSER} 'writerawln', {$ENDIF} 's', iNone); // 526
AddProc ({$IFDEF MPLPARSER} 'mci2str', {$ENDIF} 's', iString); // 527 AddProc ({$IFDEF MPLPARSER} 'mci2str', {$ENDIF} 's', iString); // 527
AddProc ({$IFDEF MPLPARSER} 'getusertime', {$ENDIF} '', iInteger); // 528 AddProc ({$IFDEF MPLPARSER} 'getusertime', {$ENDIF} '', iInteger); // 528
AddProc ({$IFDEF MPLPARSER} 'getscreeninfo', {$ENDIF} 'bBBB', iNone); // 529 AddProc ({$IFDEF MPLPARSER} 'getscreeninfo', {$ENDIF} 'bBBB', iNone); // 529
AddProc ({$IFDEF MPLPARSER} 'setprompt', {$ENDIF} 'ls', iNone); // 530 AddProc ({$IFDEF MPLPARSER} 'setprompt', {$ENDIF} 'ls', iNone); // 530
AddProc ({$IFDEF MPLPARSER} 'moreprompt', {$ENDIF} '', iChar); // 531 AddProc ({$IFDEF MPLPARSER} 'moreprompt', {$ENDIF} '', iChar); // 531
AddProc ({$IFDEF MPLPARSER} 'pause', {$ENDIF} '', iNone); // 532 AddProc ({$IFDEF MPLPARSER} 'pause', {$ENDIF} '', iNone); // 532
AddProc ({$IFDEF MPLPARSER} 'setpromptinfo', {$ENDIF} 'bs', iNone); // 533 AddProc ({$IFDEF MPLPARSER} 'setpromptinfo', {$ENDIF} 'bs', iNone); // 533
AddProc ({$IFDEF MPLPARSER} 'bufflush', {$ENDIF} '', iNone); // 534 AddProc ({$IFDEF MPLPARSER} 'bufflush', {$ENDIF} '', iNone); // 534
AddProc ({$IFDEF MPLPARSER} 'strmci', {$ENDIF} 's', iString); // 535 AddProc ({$IFDEF MPLPARSER} 'strmci', {$ENDIF} 's', iString); // 535
AddProc ({$IFDEF MPLPARSER} 'getcharxy', {$ENDIF} 'bb', iChar); // 536 AddProc ({$IFDEF MPLPARSER} 'getcharxy', {$ENDIF} 'bb', iChar); // 536
AddProc ({$IFDEF MPLPARSER} 'getattrxy', {$ENDIF} 'bb', iByte); // 537 AddProc ({$IFDEF MPLPARSER} 'getattrxy', {$ENDIF} 'bb', iByte); // 537
AddProc ({$IFDEF MPLPARSER} 'putthisuser', {$ENDIF} '', iNone); // 538 AddProc ({$IFDEF MPLPARSER} 'putthisuser', {$ENDIF} '', iNone); // 538
AddProc ({$IFDEF MPLPARSER} 'putuser', {$ENDIF} 'l', iNone); // 539 AddProc ({$IFDEF MPLPARSER} 'putuser', {$ENDIF} 'l', iNone); // 539
AddProc ({$IFDEF MPLPARSER} 'isuser', {$ENDIF} 's', iBool); // 540 AddProc ({$IFDEF MPLPARSER} 'isuser', {$ENDIF} 's', iBool); // 540
AddProc ({$IFDEF MPLPARSER} 'getmbstats', {$ENDIF} 'looLLL', iBool); // 541 AddProc ({$IFDEF MPLPARSER} 'getmbstats', {$ENDIF} 'looLLL', iBool); // 541
AddProc ({$IFDEF MPLPARSER} 'writexy', {$ENDIF} 'bbbs', iNone); // 542 AddProc ({$IFDEF MPLPARSER} 'writexy', {$ENDIF} 'bbbs', iNone); // 542
AddProc ({$IFDEF MPLPARSER} 'writexypipe', {$ENDIF} 'bbbis', iNone); // 543 AddProc ({$IFDEF MPLPARSER} 'writexypipe', {$ENDIF} 'bbbis', iNone); // 543
AddProc ({$IFDEF MPLPARSER} 'msgeditor', {$ENDIF} 'iIiiosS', iBool); // 544 AddProc ({$IFDEF MPLPARSER} 'msgeditor', {$ENDIF} 'iIiiosS', iBool); // 544
AddProc ({$IFDEF MPLPARSER} 'msgeditget', {$ENDIF} 'i', iString); // 545 AddProc ({$IFDEF MPLPARSER} 'msgeditget', {$ENDIF} 'i', iString); // 545
AddProc ({$IFDEF MPLPARSER} 'msgeditset', {$ENDIF} 'is', iNone); // 546 AddProc ({$IFDEF MPLPARSER} 'msgeditset', {$ENDIF} 'is', iNone); // 546
AddProc ({$IFDEF MPLPARSER} 'onekeyrange', {$ENDIF} 'sll', iChar); // 547 AddProc ({$IFDEF MPLPARSER} 'onekeyrange', {$ENDIF} 'sll', iChar); // 547
AddProc ({$IFDEF MPLPARSER} 'getmbasetotal', {$ENDIF} 'o', iLongInt); // 548 AddProc ({$IFDEF MPLPARSER} 'getmbasetotal', {$ENDIF} 'o', iLongInt); // 548
AddProc ({$IFDEF MPLPARSER} 'getmailstats', {$ENDIF} 'LL', iNone); // 549 AddProc ({$IFDEF MPLPARSER} 'getmailstats', {$ENDIF} 'LL', iNone); // 549
AddProc ({$IFDEF MPLPARSER} 'boxopen', {$ENDIF} 'lbbbb', iNone); // 550
AddProc ({$IFDEF MPLPARSER} 'boxclose', {$ENDIF} 'l', iNone); // 551
AddProc ({$IFDEF MPLPARSER} 'boxheader', {$ENDIF} 'lbbs', iNone); // 552
AddProc ({$IFDEF MPLPARSER} 'boxoptions', {$ENDIF} 'lbobbbbob', iNone); // 553
AddProc ({$IFDEF MPLPARSER} 'inputstring', {$ENDIF} 'lbbbbbs', iString); // 554
AddProc ({$IFDEF MPLPARSER} 'inputoptions', {$ENDIF} 'lbbcss', iNone); // 555
AddProc ({$IFDEF MPLPARSER} 'inputexit', {$ENDIF} 'l', iChar); // 556
AddProc ({$IFDEF MPLPARSER} 'inputnumber', {$ENDIF} 'lbbbblll', iLongInt); // 557
AddProc ({$IFDEF MPLPARSER} 'inputenter', {$ENDIF} 'lbbbs', iBool);
{ END OF PROCEDURE DEFINITIONS } { END OF PROCEDURE DEFINITIONS }

134
mystic/mpl_execute.pas
View File

@ -13,8 +13,18 @@ Uses
Const Const
mplExecuteBuffer = 8 * 1024; mplExecuteBuffer = 8 * 1024;
mplMaxClassStack = 50;
Const
mplClass_Box = 1;
mplClass_Input = 2;
Type Type
TClassStack = Record
ClassPtr : Pointer;
ClassType : Byte;
End;
TInterpEngine = Class TInterpEngine = Class
Owner : Pointer; Owner : Pointer;
ErrStr : String; ErrStr : String;
@ -22,8 +32,8 @@ Type
DataFile : TFileBuffer; DataFile : TFileBuffer;
CurVarNum : Word; CurVarNum : Word;
CurVarID : Word; CurVarID : Word;
// CurClassNum : Word;
VarData : VarDataRec; VarData : VarDataRec;
ClassData : Array[1..mplMaxClassStack] of TClassStack;
Ch : Char; Ch : Char;
W : Word; W : Word;
IoError : LongInt; IoError : LongInt;
@ -102,6 +112,10 @@ Type
Procedure GetFGroupVars (Var G: RecGroup); Procedure GetFGroupVars (Var G: RecGroup);
Function GetFGroupRecord (Num: LongInt) : Boolean; Function GetFGroupRecord (Num: LongInt) : Boolean;
Procedure ClassCreate (Var Num: LongInt; Str: String);
Function ClassValid (Num: LongInt; cType: Byte) : Boolean;
Procedure ClassFree (Num: LongInt);
Constructor Create (O: Pointer); Constructor Create (O: Pointer);
Destructor Destroy; Override; Destructor Destroy; Override;
Function Execute (FN: String) : Byte; Function Execute (FN: String) : Byte;
@ -123,7 +137,8 @@ Uses
BBS_Core, BBS_Core,
BBS_IO, BBS_IO,
BBS_General, BBS_General,
BBS_Ansi_MenuBox; BBS_Ansi_MenuBox,
BBS_Ansi_MenuInput;
{$I MPL_COMMON.PAS} {$I MPL_COMMON.PAS}
@ -342,6 +357,8 @@ Begin
End; End;
Constructor TInterpEngine.Create (O: Pointer); Constructor TInterpEngine.Create (O: Pointer);
Var
Count : LongInt;
Begin Begin
Inherited Create; Inherited Create;
@ -351,6 +368,11 @@ Begin
Ch := #0; Ch := #0;
W := 0; W := 0;
For Count := 1 to mplMaxClassStack Do Begin
ClassData[Count].ClassPtr := NIL;
ClassData[Count].ClassType := 0;
End;
{$IFDEF LOGGING} {$IFDEF LOGGING}
Depth := 0; Depth := 0;
{$ENDIF} {$ENDIF}
@ -369,6 +391,12 @@ Begin
CurVarNum := 0; CurVarNum := 0;
For Count := 1 to mplMaxClassStack Do
If Assigned(ClassData[Count].ClassPtr) Then
Case ClassData[Count].ClassType of
mplClass_Box : TAnsiMenuBox(ClassData[Count].ClassPtr).Free;
End;
Inherited Destroy; Inherited Destroy;
End; End;
@ -384,6 +412,9 @@ Begin
mpxBadInit : Result := 'Unable to initialize variable'; mpxBadInit : Result := 'Unable to initialize variable';
mpxDivisionByZero : Result := 'Division by zero'; mpxDivisionByZero : Result := 'Division by zero';
mpxMathematical : Result := 'Parsing error'; mpxMathematical : Result := 'Parsing error';
mpxTooManyClasses : Result := 'Too many open classes';
mpxInvalidClass : Result := 'Invalid class type: ' + ErrStr;
mpxInvalidClassH : Result := 'Invalid class handle';
End; End;
End; End;
@ -1209,6 +1240,60 @@ Begin
IoError := IoResult; IoError := IoResult;
End; End;
Procedure TInterpEngine.ClassCreate (Var Num: LongInt; Str: String);
Var
Count : LongInt;
Begin
Num := -1;
For Count := 1 to mplMaxClassStack Do
If Not Assigned(ClassData[Count].ClassPtr) Then Begin
Num := Count;
Break;
End;
If Num = -1 Then Begin
Error(mpxTooManyClasses, '');
Exit;
End;
If Str = 'BOX' Then Begin
ClassData[Num].ClassPtr := TAnsiMenuBox.Create;
ClassData[Num].ClassType := mplClass_Box;
End Else
If Str = 'INPUT' Then Begin
ClassData[Num].ClassPtr := TAnsiMenuInput.Create;
ClassData[Num].ClassType := mplClass_Input;
End Else
Error(mpxInvalidClass, Str);
End;
Procedure TInterpEngine.ClassFree (Num: LongInt);
Begin
If (Num > 0) and (Num <= mplMaxClassStack) Then
If Assigned(ClassData[Num].ClassPtr) Then Begin
Case ClassData[Num].ClassType of
mplClass_Box : TAnsiMenuBox(ClassData[Num].ClassPtr).Free;
mplClass_Input : TAnsiMenuInput(ClassData[Num].ClassPtr).Free;
End;
ClassData[Num].ClassPtr := NIL;
End;
End;
Function TInterpEngine.ClassValid (Num: LongInt; cType: Byte) : Boolean;
Begin
If Assigned(ClassData[Num].ClassPtr) and (ClassData[Num].ClassType = cType) Then
Result := True
Else Begin
Result := False;
Error(mpxInvalidClassH, '');
End;
End;
Function TInterpEngine.ExecuteProcedure (DP: Pointer) : TIdentTypes; Function TInterpEngine.ExecuteProcedure (DP: Pointer) : TIdentTypes;
// okay... change this to: // okay... change this to:
// array[1..mplmaxprocparams] of record // array[1..mplmaxprocparams] of record
@ -1780,6 +1865,8 @@ Begin
TempLong := Abs(Param[1].L); TempLong := Abs(Param[1].L);
Store (TempLong, 4); Store (TempLong, 4);
End; End;
95 : ClassCreate(LongInt(Pointer(Param[1].vData)^), strUpper(Param[2].S));
96 : ClassFree(Param[1].L);
500 : Begin 500 : Begin
TempStr := Session.io.GetInput(Param[1].B, Param[2].B, Param[3].B, Param[4].S); TempStr := Session.io.GetInput(Param[1].B, Param[2].B, Param[3].B, Param[4].S);
Store (TempStr, 256); Store (TempStr, 256);
@ -1947,6 +2034,48 @@ Begin
Store (TempLong, 4); Store (TempLong, 4);
End; End;
549 : Session.Msgs.GetMailStats (LongInt(Pointer(Param[1].vData)^), LongInt(Pointer(Param[2].vData)^)); 549 : Session.Msgs.GetMailStats (LongInt(Pointer(Param[1].vData)^), LongInt(Pointer(Param[2].vData)^));
550 : If ClassValid(Param[1].L, mplClass_Box) Then
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).Open(Param[2].B, Param[3].B, Param[4].B, Param[5].B);
551 : If ClassValid(Param[1].L, mplClass_Box) Then
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).Close;
552 : If ClassValid(Param[1].L, mplClass_Box) Then Begin
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).HeadType := Param[2].B;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).HeadAttr := Param[3].B;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).Header := Param[4].S;
End;
553 : If ClassValid(Param[1].L, mplClass_Box) Then Begin
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).FrameType := Param[2].B;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).Box3D := Param[3].O;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).BoxAttr := Param[4].B;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).BoxAttr2 := Param[5].B;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).BoxAttr3 := Param[6].B;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).BoxAttr4 := Param[7].B;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).Shadow := Param[8].O;
TAnsiMenuBox(ClassData[Param[1].L].ClassPtr).ShadowAttr := Param[9].B;
End;
554 : If ClassValid(Param[1].L, mplClass_Input) Then Begin
TempStr := TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).GetStr(Param[2].B, Param[3].B, Param[4].B, Param[5].B, Param[6].B, Param[7].S);
Store (TempStr, 255);
End;
555 : If ClassValid(Param[1].L, mplClass_Input) Then Begin
TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).Attr := Param[2].B;
TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).FillAttr := Param[3].B;
TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).FillChar := Param[4].C;
TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).LoChars := Param[5].S;
TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).HiChars := Param[6].S;
End;
556 : If ClassValid(Param[1].L, mplClass_Input) Then Begin
TempChar := TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).ExitCode;
Store (TempChar, 1);
End;
557 : If ClassValid(Param[1].L, mplClass_Input) Then Begin
TempLong := TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).GetNum(Param[2].B, Param[3].B, Param[4].B, Param[5].B, Param[6].L, Param[7].L, Param[8].L);
Store (TempLong, 4);
End;
558 : If ClassValid(Param[1].L, mplClass_Input) Then Begin
TempBool := TAnsiMenuInput(ClassData[Param[1].L].ClassPtr).GetEnter(Param[2].B, Param[3].B, Param[4].B, Param[5].S);
Store (TempBool, 1);
End;
End; End;
End; End;
@ -1954,6 +2083,7 @@ Procedure TInterpEngine.SkipBlock;
begin begin
NextChar; NextChar;
NextWord; NextWord;
MoveToPos (CurFilePos + W); MoveToPos (CurFilePos + W);
end; end;

7
mystic/mpl_types.pas
View File

@ -77,7 +77,7 @@ Type
); );
Const Const
mplVer = '11Z'; mplVer = '11Y';
mplVersion = '[MPX ' + mplVer +']' + #26; mplVersion = '[MPX ' + mplVer +']' + #26;
mplVerLength = 10; mplVerLength = 10;
mplExtSource = '.mps'; mplExtSource = '.mps';
@ -90,7 +90,7 @@ Const
mplMaxCaseNums = 20; mplMaxCaseNums = 20;
mplMaxVarDeclare = 20; mplMaxVarDeclare = 20;
mplMaxArrayDem = 3; //cannot be changed yet mplMaxArrayDem = 3; //cannot be changed yet
mplMaxProcParams = 8; mplMaxProcParams = 12;
mplMaxRecords = 20; mplMaxRecords = 20;
mplMaxRecFields = 40; mplMaxRecFields = 40;
mplMaxDataSize = 65535; mplMaxDataSize = 65535;
@ -111,6 +111,9 @@ Const
mpxBadInit = 5; mpxBadInit = 5;
mpxDivisionByZero = 6; mpxDivisionByZero = 6;
mpxMathematical = 7; mpxMathematical = 7;
mpxTooManyClasses = 8;
mpxInvalidClass = 9;
mpxInvalidClassH = 10;
{$ELSE} {$ELSE}
mpsEndOfFile = 1; mpsEndOfFile = 1;
mpsFileNotfound = 2; mpsFileNotfound = 2;

35
mystic/whatsnew.txt
View File

@ -3475,3 +3475,38 @@
notice. ;) notice. ;)
<ALPHA 35 RELEASED> <ALPHA 35 RELEASED>
! Fixed a memory leak in the new theme prompt system. Mystic was leaking
about 30kb per login.
! Mystic should now will properly display the file base "display file"
before listing files.
+ MPL now has the ability to interface directly with internal Mystic BBS
classes. This opens up a whole world of new possibilities in the future
(for example) sockets, full remote ANSI screen library (boxes, listboxes)
data sorting, and more.
Classes must first be created and then freed after using. Mystic will
create the class instance and return a handle to that specific class to
use with the functions. Finally, the class is freed. Two new functions
go with this:
ClassCreate (ClassHandle, ClassType)
ClassFree (ClassHandle)
+ MPL now supports the ANSI box class. There are three functions which
go along with this: BoxOpen, BoxClose, and BoxOptions. The Box class
will automatically save and and subsequently restore the text under the
box when it is closed.
See TESTBOX.MPS for an example.
+ MPL now supports the ANSI input class. There are several functions which
go along with this: InputString, InputNumber, InputEnter, InputOptions.
This class allows you more freedom over input functions than the standard
MPL input functions do.
See TESTINPUT.MPS for an example.
<ALPHA 36 RELEASED>