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;

86
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,10 +338,7 @@ Begin
End; End;
End; End;
Procedure TBBSCore.DisposeThemeData;
Function TBBSCore.LoadThemeData (Str: String) : Boolean;
Procedure DisposeThemeData;
Var Var
Count : LongInt; Count : LongInt;
Begin Begin
@ -354,6 +350,7 @@ Function TBBSCore.LoadThemeData (Str: String) : Boolean;
End; End;
End; End;
Function TBBSCore.LoadThemeData (Str: String) : Boolean;
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;

11
mystic/mpl_common.pas
View File

@ -259,6 +259,8 @@ 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
@ -312,6 +314,15 @@ Begin
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>