A36 stuff
This commit is contained in:
mysticbbs
parent
7ffca01cdb
commit
9909d064a5
|
|
@ -354,7 +354,7 @@ Var
|
|||
Begin
|
||||
If Not WasOpened Then
|
||||
If Shadow Then
|
||||
Screen.GetScreenImage(X1, Y1, X2 + 2{3}, Y2 + 1, Image)
|
||||
Screen.GetScreenImage(X1, Y1, X2 + 2, Y2 + 1, Image)
|
||||
Else
|
||||
Screen.GetScreenImage(X1, Y1, X2, Y2, Image);
|
||||
|
||||
|
|
@ -388,9 +388,9 @@ Begin
|
|||
|
||||
If Shadow Then Begin
|
||||
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);
|
||||
WriteXY (B + 1, A, ShadowAttr, Ch);
|
||||
WriteXY (B, A, ShadowAttr, Ch);
|
||||
End;
|
||||
|
||||
A := Y2 + 1;
|
||||
|
|
|
|||
|
|
@ -78,8 +78,6 @@ Type
|
|||
HistoryULs : Word;
|
||||
HistoryULKB : LongInt;
|
||||
HistoryHour : SmallInt;
|
||||
// PromptFile : File of RecPrompt;
|
||||
// Prompt : RecPrompt;
|
||||
LastScanHadNew : Boolean;
|
||||
LastScanHadYou : Boolean;
|
||||
PromptData : Array[0..mysMaxThemeText] of Pointer;
|
||||
|
|
@ -96,6 +94,7 @@ Type
|
|||
Function ElapsedTime : Integer;
|
||||
Function TimeLeft : Integer;
|
||||
Function LoadThemeData (Str: String) : Boolean;
|
||||
Procedure DisposeThemeData;
|
||||
End;
|
||||
|
||||
Var
|
||||
|
|
@ -153,6 +152,8 @@ End;
|
|||
|
||||
Destructor TBBSCore.Destroy;
|
||||
Begin
|
||||
DisposeThemeData;
|
||||
|
||||
Pipe.Free;
|
||||
Msgs.Free;
|
||||
FileBase.Free;
|
||||
|
|
@ -160,8 +161,6 @@ Begin
|
|||
User.Free;
|
||||
IO.Free;
|
||||
|
||||
// Close (PromptFile);
|
||||
|
||||
{$IFNDEF UNIX}
|
||||
Client.Free;
|
||||
{$ENDIF}
|
||||
|
|
@ -339,10 +338,7 @@ Begin
|
|||
End;
|
||||
End;
|
||||
|
||||
|
||||
Function TBBSCore.LoadThemeData (Str: String) : Boolean;
|
||||
|
||||
Procedure DisposeThemeData;
|
||||
Procedure TBBSCore.DisposeThemeData;
|
||||
Var
|
||||
Count : LongInt;
|
||||
Begin
|
||||
|
|
@ -354,6 +350,7 @@ Function TBBSCore.LoadThemeData (Str: String) : Boolean;
|
|||
End;
|
||||
End;
|
||||
|
||||
Function TBBSCore.LoadThemeData (Str: String) : Boolean;
|
||||
Var
|
||||
Count : LongInt;
|
||||
PromptFile : Text;
|
||||
|
|
@ -429,77 +426,4 @@ Begin
|
|||
If Not Result Then Halt(1);
|
||||
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.
|
||||
|
|
|
|||
|
|
@ -2866,6 +2866,9 @@ Begin
|
|||
{$I-} Reset (DataFile, 1); {$I+}
|
||||
If IoResult <> 0 Then ReWrite (DataFile, 1);
|
||||
|
||||
If Mode = 1 Then
|
||||
Session.io.OutFile(FBase.DispFile, True, 0);
|
||||
|
||||
Result := 0;
|
||||
CurPage := 0;
|
||||
TopPage := 0;
|
||||
|
|
|
|||
|
|
@ -2246,6 +2246,7 @@ Begin
|
|||
If TempChar = #0 Then TempChar := ' ';
|
||||
|
||||
Session.io.BufAddChar(TempChar);
|
||||
|
||||
Inc (BufPos, 2);
|
||||
End;
|
||||
End;
|
||||
|
|
|
|||
|
|
@ -259,6 +259,8 @@ Begin
|
|||
AddProc ({$IFDEF MPLPARSER} 'freadrec', {$ENDIF} 'Fx', iNone); // 92
|
||||
AddProc ({$IFDEF MPLPARSER} 'real2str', {$ENDIF} 'rb', iString); // 93
|
||||
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
|
||||
|
||||
|
|
@ -312,6 +314,15 @@ Begin
|
|||
AddProc ({$IFDEF MPLPARSER} 'onekeyrange', {$ENDIF} 'sll', iChar); // 547
|
||||
AddProc ({$IFDEF MPLPARSER} 'getmbasetotal', {$ENDIF} 'o', iLongInt); // 548
|
||||
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 }
|
||||
|
||||
|
|
|
|||
|
|
@ -13,8 +13,18 @@ Uses
|
|||
|
||||
Const
|
||||
mplExecuteBuffer = 8 * 1024;
|
||||
mplMaxClassStack = 50;
|
||||
|
||||
Const
|
||||
mplClass_Box = 1;
|
||||
mplClass_Input = 2;
|
||||
|
||||
Type
|
||||
TClassStack = Record
|
||||
ClassPtr : Pointer;
|
||||
ClassType : Byte;
|
||||
End;
|
||||
|
||||
TInterpEngine = Class
|
||||
Owner : Pointer;
|
||||
ErrStr : String;
|
||||
|
|
@ -22,8 +32,8 @@ Type
|
|||
DataFile : TFileBuffer;
|
||||
CurVarNum : Word;
|
||||
CurVarID : Word;
|
||||
// CurClassNum : Word;
|
||||
VarData : VarDataRec;
|
||||
ClassData : Array[1..mplMaxClassStack] of TClassStack;
|
||||
Ch : Char;
|
||||
W : Word;
|
||||
IoError : LongInt;
|
||||
|
|
@ -102,6 +112,10 @@ Type
|
|||
Procedure GetFGroupVars (Var G: RecGroup);
|
||||
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);
|
||||
Destructor Destroy; Override;
|
||||
Function Execute (FN: String) : Byte;
|
||||
|
|
@ -123,7 +137,8 @@ Uses
|
|||
BBS_Core,
|
||||
BBS_IO,
|
||||
BBS_General,
|
||||
BBS_Ansi_MenuBox;
|
||||
BBS_Ansi_MenuBox,
|
||||
BBS_Ansi_MenuInput;
|
||||
|
||||
{$I MPL_COMMON.PAS}
|
||||
|
||||
|
|
@ -342,6 +357,8 @@ Begin
|
|||
End;
|
||||
|
||||
Constructor TInterpEngine.Create (O: Pointer);
|
||||
Var
|
||||
Count : LongInt;
|
||||
Begin
|
||||
Inherited Create;
|
||||
|
||||
|
|
@ -351,6 +368,11 @@ Begin
|
|||
Ch := #0;
|
||||
W := 0;
|
||||
|
||||
For Count := 1 to mplMaxClassStack Do Begin
|
||||
ClassData[Count].ClassPtr := NIL;
|
||||
ClassData[Count].ClassType := 0;
|
||||
End;
|
||||
|
||||
{$IFDEF LOGGING}
|
||||
Depth := 0;
|
||||
{$ENDIF}
|
||||
|
|
@ -369,6 +391,12 @@ Begin
|
|||
|
||||
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;
|
||||
End;
|
||||
|
||||
|
|
@ -384,6 +412,9 @@ Begin
|
|||
mpxBadInit : Result := 'Unable to initialize variable';
|
||||
mpxDivisionByZero : Result := 'Division by zero';
|
||||
mpxMathematical : Result := 'Parsing error';
|
||||
mpxTooManyClasses : Result := 'Too many open classes';
|
||||
mpxInvalidClass : Result := 'Invalid class type: ' + ErrStr;
|
||||
mpxInvalidClassH : Result := 'Invalid class handle';
|
||||
End;
|
||||
End;
|
||||
|
||||
|
|
@ -1209,6 +1240,60 @@ Begin
|
|||
IoError := IoResult;
|
||||
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;
|
||||
// okay... change this to:
|
||||
// array[1..mplmaxprocparams] of record
|
||||
|
|
@ -1780,6 +1865,8 @@ Begin
|
|||
TempLong := Abs(Param[1].L);
|
||||
Store (TempLong, 4);
|
||||
End;
|
||||
95 : ClassCreate(LongInt(Pointer(Param[1].vData)^), strUpper(Param[2].S));
|
||||
96 : ClassFree(Param[1].L);
|
||||
500 : Begin
|
||||
TempStr := Session.io.GetInput(Param[1].B, Param[2].B, Param[3].B, Param[4].S);
|
||||
Store (TempStr, 256);
|
||||
|
|
@ -1947,6 +2034,48 @@ Begin
|
|||
Store (TempLong, 4);
|
||||
End;
|
||||
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;
|
||||
|
||||
|
|
@ -1954,6 +2083,7 @@ Procedure TInterpEngine.SkipBlock;
|
|||
begin
|
||||
NextChar;
|
||||
NextWord;
|
||||
|
||||
MoveToPos (CurFilePos + W);
|
||||
end;
|
||||
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@ Type
|
|||
);
|
||||
|
||||
Const
|
||||
mplVer = '11Z';
|
||||
mplVer = '11Y';
|
||||
mplVersion = '[MPX ' + mplVer +']' + #26;
|
||||
mplVerLength = 10;
|
||||
mplExtSource = '.mps';
|
||||
|
|
@ -90,7 +90,7 @@ Const
|
|||
mplMaxCaseNums = 20;
|
||||
mplMaxVarDeclare = 20;
|
||||
mplMaxArrayDem = 3; //cannot be changed yet
|
||||
mplMaxProcParams = 8;
|
||||
mplMaxProcParams = 12;
|
||||
mplMaxRecords = 20;
|
||||
mplMaxRecFields = 40;
|
||||
mplMaxDataSize = 65535;
|
||||
|
|
@ -111,6 +111,9 @@ Const
|
|||
mpxBadInit = 5;
|
||||
mpxDivisionByZero = 6;
|
||||
mpxMathematical = 7;
|
||||
mpxTooManyClasses = 8;
|
||||
mpxInvalidClass = 9;
|
||||
mpxInvalidClassH = 10;
|
||||
{$ELSE}
|
||||
mpsEndOfFile = 1;
|
||||
mpsFileNotfound = 2;
|
||||
|
|
|
|||
|
|
@ -3475,3 +3475,38 @@
|
|||
notice. ;)
|
||||
|
||||
<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>
|
||||
|
|
|
|||
Loading…
Reference in New Issue