Initial import of MPL stuff

scripts/blackjack.ans

@@ -0,0 +1,22 @@
+ﾜﾜﾜﾜﾜﾜﾜﾜ  ﾜﾜﾜｰｲ    ﾜﾜﾜﾜﾜﾜ   ﾜﾜﾜﾜﾜ ﾜﾜ  ﾜﾜﾜﾜ     ﾜﾜﾜ ﾜﾜﾜﾜﾜﾜ   ﾜﾜﾜﾜﾜ ﾜﾜ  ﾜﾜﾜﾜ  ﾜ
+ﾞM  ﾜﾜ ﾟﾛﾛｰﾞﾛｰ       ﾞｲﾛﾝ  ｰﾛﾟ  ﾞﾛｰﾞﾛ  ﾞﾛｰ      ｱﾛﾝ  ﾞﾛﾛﾝ  ｰﾛﾟ  ﾞﾛｰﾞﾛ  ﾞﾛｱｰgj!ﾝ
+ Y  ﾞﾛ  ﾞﾛﾝﾞﾛ  ﾜﾜ    ﾛﾝﾞﾛ  ﾞﾛ   ﾞｲｰﾞﾛ  ﾞﾛﾝ   ﾜﾜ ｰﾛﾝ  ﾛﾝﾞﾛ  ﾞﾛ   ﾞﾛｰﾞﾛ  ﾞﾛﾝ    ｲ
+ S  ﾞﾛ ﾜﾛﾟ ﾞﾛ  ｰﾛﾛﾜ ﾞﾛ  ﾛﾝ ﾞﾛ   ﾞﾛ ﾞﾛ ﾜﾛﾟ  ﾜﾛﾛ   ﾛﾝ ﾞﾛ  ﾛﾝ ﾞﾛ   ﾞﾛ ﾞﾛ ﾜﾛﾟ     ｰ
+ T  ﾞﾛ  ﾟﾛﾜ ﾛ   ﾛﾝｱ ﾛﾝ  ﾞﾛ ﾞﾛ   ﾟ  ﾞﾛ  ﾟﾛﾜ  ﾞﾛ  ｰﾛﾝ ﾛﾝ  ﾞﾛ ﾞﾛｰ  ﾟ  ﾞﾛ  ﾟﾛﾜ    ｰ
+ I  ﾞｲｰ  ﾞﾝﾞﾜ  ﾛﾝ ﾞﾛ ﾟﾟﾟﾛﾝｰﾛﾝ  ﾞﾜ ﾞﾛｰ  ﾞﾛﾝ ﾞﾛ  ﾜﾛﾝﾞﾛｱﾟﾟﾟﾛﾝｱﾛﾝ  ﾞﾜ ﾞｲ   ﾞﾛﾝ   ｰ
+ C ﾟﾞﾛﾟﾟﾟﾟﾟ ﾟﾟﾟﾟﾛﾝﾟﾟﾟﾟ  ﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟ  ﾟﾟﾟ ﾞﾛｲﾟﾟﾟﾟﾟﾟﾟ  ﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟﾟ  ﾟﾟﾟ   ｰ
+     ｰ         ﾟﾟﾟﾟ                        ﾟﾟﾟﾟ                               ｰ
+  ﾉﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄｻ  ﾉﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄｻ 
+  ｳ ﾝｳ ﾝｳ ﾝｳ ﾝｳ ﾝｳ  ｳｲｱｰ Dealer:ｰｱｲｳｰ
+  ｳ ﾝｳ ﾝｳ ﾝｳ ﾝｳ ﾝｳ  ﾈﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄｼﾛ
+  ｳ ﾝｳ ﾝｳ ﾝｳ ﾝｳ ﾝｳ  ﾛﾛﾟﾟﾛﾛ
+  ﾈﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄｼ  ﾛﾝﾞﾛ
+                                                  ﾛﾝﾞﾛ
+ ﾛｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰﾛ ﾛﾛﾜﾜﾛﾛ
+ ｰﾉﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄﾋﾄﾄﾄﾄﾄﾄﾄﾄｻｰ ﾉﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄｻﾛ
+ ｰｳﾛﾝｳﾛﾝｳﾛﾝｳﾛﾝｳﾛﾝｳｰ ｳｲｱｰ    You:ｰｱｲｳｰ
+ ｰｳﾛﾝｳﾛﾝｳﾛﾝｳﾛﾝｳﾛﾝｳｰ ﾌﾍﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾍｹｰ
+ ｰｳﾛﾝｳﾛﾝｳﾛﾝｳﾛﾝｳﾛﾝｳｰ ｳｲｱｰ  Cash $            ｰｱｲｳｰ
+ ｰﾈﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄﾊﾄﾄﾄﾄﾄﾄﾄﾄｼｰ ｳｲｱｰ Wager :            ｰｱｲｳｰ
+ﾞﾛｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰﾛﾛﾈﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄｼﾝ
+ ﾟ                                                                           ﾟ

scripts/blackjack.mps

@@ -0,0 +1,470 @@
+// ==========================================================================
+// BLACKJACK.MPS
+//
+// This is a simple BlackJack game that I wrote to test out MPL features
+// about a year or two ago.  I decided to port it to the later MPL version
+// for the same purposes.
+//
+// Changelog:
+//   - Added an improved AI for the dealer.  He's a lot less predictable and
+//     makes more logical decisions now.
+//   - When the player busts, the dealers hidden card is now shown.  This is
+//     just for people curious if they would have won by standing.
+//   - Fixed a few display bugs
+// ==========================================================================
+
+Const
+  Version     = '1.2';
+  CashStart   = 1000;
+  CardJack    = 11;
+  CardQueen   = 12;
+  CardKing    = 13;
+  CardAce     = 14;
+  SuitClub    = 1;
+  SuitSpade   = 2;
+  SuitHeart   = 3;
+  SuitDiamond = 4;
+
+Var
+  DataPath      : String;
+  Suit          : Array[1..52] of Byte;
+  Card          : Array[1..52] of Byte;
+  Cash          : LongInt;
+  Wager         : LongInt;
+  Player_Score  : Byte;
+  Player_Cards  : Byte;
+  Dealer_Score  : Byte;
+  Dealer_Hidden : Byte;
+  Dealer_Cards  : Byte;
+  Dealer_Aces   : Byte;
+
+Procedure DeckCreate;
+Var
+  Suits,
+  Numbers,
+  Index    : Byte;
+Begin
+  Index := 1;
+
+  For Suits := 1 to 4 Do
+    For Numbers := 2 to CardAce Do Begin
+      Suit[Index] := Suits;
+      Card[Index] := Numbers;
+      Index       := Index + 1;
+    End;
+End;
+
+Procedure DeckShuffle;
+Var
+  TempSuit,
+  TempCard,
+  Shuffle,
+  CardNum1,
+  CardNum2  : Byte;
+Begin
+  For Shuffle := 1 to 200 Do Begin
+    CardNum1 := Random(51) + 1;
+    CardNum2 := Random(51) + 1;
+    TempSuit := Suit[CardNum1];
+    TempCard := Card[CardNum1];
+
+    Card[CardNum1] := Card[CardNum2];
+    Suit[CardNum1] := Suit[CardNum2];
+    Card[CardNum2] := TempCard;
+    Suit[CardNum2] := TempSuit;
+  End;
+End;
+
+Function GetCardNumber (Num: Byte) : String;
+Var
+  Res,
+  Color : String[3];
+Begin
+  Case Card[Num] of
+    1..10     : Res := PadLT(Int2Str(Card[Num]), 2, ' ');
+    CardJack  : Res := ' J';
+    CardQueen : Res := ' Q';
+    CardKing  : Res := ' K';
+    CardAce   : Res := ' A';
+  End;
+
+  Case Suit[Num] of
+    SuitClub    : GetCardNumber := '|08' + Res + #05;
+    SuitSpade   : GetCardNumber := '|08' + Res + #06;
+    SuitHeart   : GetCardNumber := '|04' + Res + #03;
+    SuitDiamond : GetCardNumber := '|04' + Res + #04;
+  End
+End
+
+Procedure DrawCard (X, Y, Showing, Num: Byte);
+Var
+  Str : String;
+Begin
+  If Y = 1 Then Y := 17 Else Y := 10;
+
+  X   := (X - 1) * 9 + 5;
+  Str := GetCardNumber(Num);
+
+  Case Showing of
+    1 : Begin
+          GotoXY (X, Y);
+          Write  ('|23' + Str + '   ');
+          GotoXY (X, Y + 1);
+          Write  ('      ');
+          GotoXY (X, Y + 2);
+          Write  ('   ' + Str + '|16');
+        End;
+    2 : Begin
+          GotoXY (X, Y);
+          Write  ('|07|20° °° °');
+          GotoXY (X, Y + 1);
+          Write  ('° °° °');
+          GotoXY (X, Y + 2);
+          Write  ('° °° °|16');
+        End;
+  Else
+    GotoXY (X, Y);
+    Write  ('|00|16      ');
+    GotoXY (X, Y + 1);
+    Write  ('      ');
+    GotoXY (X, Y + 2);
+    Write  ('      |07');
+  End;
+End;
+
+Procedure Print (Str1, Str2: String);
+Begin
+  GotoXY (54, 13);
+  Write  (strRep(' ', 23));
+  GotoXY (54, 13);
+  Write  (Str1);
+  GotoXY (54, 14);
+  Write  (strRep(' ', 23));
+  GotoXY (54, 14);
+  Write  (Str2);
+End
+
+Procedure GetNewCard (Dealer: Boolean);
+Var
+  Count,
+  Value,
+  Aces   : Byte;
+Begin
+  Aces        := 0;
+  Dealer_Aces := 0;
+
+  If Dealer Then Begin
+    Dealer_Score := 0;
+    Dealer_Cards := Dealer_Cards + 1;
+
+    DrawCard (Dealer_Cards, 2, 1, Dealer_Cards + 5);
+
+    For Count := 1 to Dealer_Cards Do Begin
+      Value := Card[Count + 5];
+      If Value = CardAce Then Begin
+        Value       := 11;
+        Dealer_Aces := Dealer_Aces + 1;
+      End Else
+      If Value > 10 Then
+        Value := 10;
+
+      Dealer_Score := Dealer_Score + Value;
+    End;
+
+    If Dealer_Score > 21 And Dealer_Aces > 0 Then Begin
+      Repeat
+        Dealer_Score := Dealer_Score - 10;
+        Dealer_Aces  := Dealer_Aces - 1;
+      Until Dealer_Score < 22 or Dealer_Aces = 0;
+
+      If Card[6] = CardAce And Dealer_Aces = 0 Then
+        Dealer_Hidden := 1;
+    End;
+
+  End Else Begin
+
+    Player_Score := 0;
+    Player_Cards := Player_Cards + 1;
+
+    DrawCard (Player_Cards, 1, 1, Player_Cards);
+
+    For Count := 1 to Player_Cards Do Begin
+      Value := Card[Count];
+      If Value = CardAce Then Begin
+        Value := 11;
+        Aces  := Aces + 1;
+      End Else
+      If Value > 10 Then
+        Value := 10;
+
+      Player_Score := Player_Score + Value;
+    End;
+
+    If Player_Score > 21 Then
+      While Player_Score > 21 And Aces > 0 Do Begin
+        Player_Score := Player_Score - 10;
+        Aces         := Aces - 1;
+      End;
+  End;
+End;
+
+Procedure DrawCash
+Begin
+  GotoXY (64, 19);
+  Write  ('|15|17' + PadRT(strComma(Cash), 10, ' ') + '|16');
+End;
+
+Procedure UpdateScores;
+Begin
+  GotoXY (65, 10);
+  Write  ('|15' + Int2Str(Dealer_Score - Dealer_Hidden));
+  GotoXY (65, 17);
+  Write  (Int2Str(Player_Score));
+End
+
+Procedure Initialize;
+
+  Procedure EraseInput;
+  Begin
+    GotoXY (64, 20);
+    Write  ('|17          |16');
+    GotoXY (64, 20);
+  End;
+
+Var
+  X,
+  Y : Byte;
+Begin
+  If Cash = 0 Then Begin
+    Print ('|15No cash|07? |10House loans ya', '|07$|15' + strComma(CashStart) + '|07. |12Press a key');
+    Cash := CashStart;
+    ReadKey;
+  End;
+
+  Print ('  |12|16Shuffling deck...', '');
+
+  DeckShuffle;
+
+  For Y := 1 to 2 Do
+    For X := 1 to 5 Do
+      DrawCard(X, Y, 3, 1);
+
+  GotoXY (65, 10);
+  Write  ('   ');
+  GotoXY (65, 17);
+  Write  ('   ');
+
+  DrawCash;
+
+  Print  ('  |15|16Enter your wager:', '  |02(|14$|15' + Int2Str(Cash) + ' |14max|02)|14|17');
+
+  EraseInput;
+
+  Write('|17');
+
+  Wager := Str2Int(Input(10, 10, 1, ''));
+
+  If Wager > Cash Then Wager := 0;
+
+  If Wager = 0 Then Begin
+    EraseInput;
+    Exit;
+  End;
+
+  Dealer_Cards  := 1;
+  Player_Cards  := 0;
+  Dealer_hidden := Card[6];
+
+  If Dealer_Hidden = CardAce Then
+    Dealer_Hidden := 11
+  Else
+  If Dealer_Hidden > 10 Then
+    Dealer_Hidden := 10
+
+  DrawCard(1, 2, 2, 6)
+
+  GetNewCard(False);
+  GetNewCard(False);
+  GetNewCard(True);
+
+  UpdateScores;
+End;
+
+Procedure AdjustScore (Mode: Byte);
+Begin
+  Case Mode of
+    0 : Begin
+          Cash := Cash - Wager;
+          If Cash < 0 Then Cash := 0;
+        End;
+    1 : Begin
+          Cash := Cash + Wager;
+          If Cash > 99999999 Then Cash := 99999999;
+        End;
+  End;
+
+  DrawCash;
+End;
+
+Var
+  Ch      : Char;
+  GoForIt : Boolean;
+Begin
+  ClrScr;
+
+  If Graphics = 0 Then Begin
+    WriteLn ('Sorry, this game requires ANSI graphics.|CR|PA');
+    Halt;
+  End;
+
+  DataPath := JustPath(ProgName);
+  Cash     := CashStart;
+  Wager    := 0;
+
+  Randomize;
+  DeckCreate;
+
+  DispFile (DataPath + 'blackjack')
+
+  Repeat
+    Print ('  |15Want to play a game?', '  |10(|14Y|02/|14N|10)|08: |07')
+
+    If OneKey('YN', False) = 'N' Then Break;
+
+    Initialize;
+
+    If Wager = 0 Then Continue;
+
+    If Dealer_Score = 21 Then
+      If Card[6] = CardJack or Card[7] = CardJack Then
+        If Suit[6] = SuitClub or Suit[7] = SuitClub or Suit[6] = SuitSpade or Suit[7] = SuitSpade Then Begin
+          DrawCard (1, 2, 1, 6);
+          Dealer_Hidden := 0;
+          AdjustScore(0);
+          UpdateScores;
+          Print (' |12Dealer has Black Jack', ' Press any key.');
+          ReadKey
+          Continue;
+        End
+
+    If Player_Score = 21 Then
+      If Card[1] = CardJack or Card[2] = CardJack Then
+        If Suit[1] = SuitClub or Suit[2] = SuitClub or Suit[1] = SuitSpade or Suit[2] = SuitSpade Then Begin
+          Print (' |12Player has Black Jack', ' Press any key.');
+          AdjustScore(1);
+          ReadKey;
+          Continue;
+        End;
+
+    Repeat
+      If Player_Cards < 5 Then Begin
+        Print ('|10[|14H|10]|07it, |10[|14S|10]|07tand, |10[|14Q|10]|07uit', '|08: |07');
+        Ch := OneKey('HSQ', False);
+      End Else
+        Ch := 'S'
+
+      Case Ch of
+        'Q' : Begin
+                AdjustScore(0);
+                Break;
+              End;
+        'H' : Begin
+                GetNewCard(False);
+
+                UpdateScores;
+
+                If Player_Score > 21 Then Begin
+                  AdjustScore(0);
+                  DrawCard(1,2,1,6); // show dealer hidden card
+                  Print ('  |12Player busted', '  Press a key.');
+                  ReadKey;
+                  Break;
+                End;
+
+                // Dealer AI Rules for Hit
+                // <16 = 100%
+                // 16  =  50% (100 with ace as 1)
+                // 17  =  25% ( 50 with ace as 1)
+                // 18  =  10% ( 25 with ace as 1)
+                // >18 =   0%
+
+                Case Dealer_Score of
+                  1..
+                  15 : GoForIt := True;
+                  16 : If Dealer_Aces = 0 Then
+                         GoForIt := Random(1) = 0
+                       Else
+                         GoForIt := True;
+                  17 : If Dealer_Aces = 0 Then
+                         GoForIt := Random(3) = 0
+                       Else
+                         GoForIt := Random(1) = 0;
+                  18 : If Dealer_Aces = 0 Then
+                         GoForIt := Random(9) = 0
+                       Else
+                         GoForIt := Random(3) = 0;
+                Else
+                  GoForIt := False;    // Dealer decides to stand
+                End;
+
+                If GoForIt Then Begin
+                  GetNewCard(True);
+                  UpdateScores;
+
+                  If Dealer_Score > 21 Then Begin
+                    DrawCard (1, 2, 1, 6);
+                    Dealer_Hidden := 0;
+                    AdjustScore(1);
+                    UpdateScores;
+                    Print('  |12Dealer busted', '  Press a key.');
+                    ReadKey;
+                    Break;
+                  End;
+                End;
+              End;
+        'S' : Begin
+                DrawCard (1, 2, 1, 6);
+                Dealer_Hidden := 0;
+                UpdateScores;
+                While Dealer_Score < Player_Score and Dealer_Score < 22 and Dealer_Cards < 5 Do Begin
+                  GetNewCard(True);
+                  UpdateScores;
+                End
+
+                If Dealer_Score > 21 Then Begin
+                  AdjustScore(1);
+                  Print('  |12Dealer busted', '  Press a key.');
+                  ReadKey;
+                End Else
+                If Player_Score > 21 Then Begin
+                  AdjustScore(0);
+                  Print('  |12Player busted', '  Press a key.');
+                  ReadKey;
+                End Else
+                If Player_Score > Dealer_Score Then Begin
+                  AdjustScore(1);
+                  Print('  |12Player wins!', '  Press a key.');
+                  ReadKey;
+                End Else
+                If Dealer_Score > Player_Score Then Begin
+                  AdjustScore(0);
+                  Print('  |12Dealer wins!', '  Press a key.');
+                  ReadKey;
+                End Else Begin
+                  AdjustScore(2);
+                  Print('  |12Push.  Dealer wins.', '  Press a key.');
+                  ReadKey;
+                End;
+
+                Break;
+              End;
+      End;
+    Until False;
+  Until False;
+
+  ClrScr;
+  WriteLn ('|07|16Mystic BlackJack Version ' + Version);
+  WriteLn ('|CRWritten using the Mystic Programming Language (MPL)|CR');
+  WriteLn ('Code: g00r00, Artwork: Grymmjack|CR|CR|PA');
+End.
+

scripts/mpldemo.mps

@@ -0,0 +1,276 @@
+// ---------------------------------------------------------------------------
+// MPLDEMO.MPS : Mystic Programming Language (MPL) Demonstration Program
+// ---------------------------------------------------------------------------
+// Written by g00r00 for Mystic BBS Version 1.07.  Feel free to do whatever
+// you want with this source code!  This is just something quick I put
+// together.  Updated for Mystic 1.10
+// ---------------------------------------------------------------------------
+
+USES CFG;
+USES USER;
+
+Procedure FadeWrite (X, Y: Byte; S: String);
+Begin
+  GotoXY (X, Y);
+  Write  ('|08' + S);
+  Delay  (250);
+  GotoXY (X, Y);
+  Write  ('|07' + S);
+  Delay  (250);
+  GotoXY (X, Y);
+  Write  ('|15' + S);
+  Delay  (250);
+  GotoXY (X, Y);
+  Write  ('|07' + S);
+End;
+
+Procedure Draw_M (X: Byte);
+Begin
+  GotoXY (X - 1, 9);
+  Write  (' |17|09²|16|01ÛÛÛßÛßÛ');
+  GotoXY (X - 1, 10);
+  Write  (' |17|09±|16|01ÛÛÛ   Û');
+  GotoXY (X - 1, 11);
+  Write  (' |01ÛÛÛÛ   Û');
+End;
+
+Procedure Draw_P (Y: Byte)
+Begin
+  GotoXY (39, Y - 1);
+  Write  ('      ');
+  GotoXY (39, Y);
+  Write  ('|09|17²|01|16ÛÛÛßÛ');
+  GotoXY (39, Y + 1);
+  Write  ('|09|17±|01|16ÛÛÛÜÛ');
+  GotoXY (39, Y + 2);
+  Write  ('ÛÛÛÛ');
+End;
+
+Procedure Draw_L (X : Byte)
+Begin
+  GotoXY (X, 9);
+  Write  ('|09|17²|01|16ÛÛÛ ');
+  GotoXY (X, 10);
+  Write  ('|09|17±|01|16ÛÛÛ ');
+  GotoXY (X, 11);
+  Write  ('ÛÛÛÛÜÛ ');
+End;
+
+Procedure Draw_Animated_Intro;
+Var
+  Count : Byte;
+Begin
+  ClrScr;
+
+  For Count := 2 to 30 Do Begin
+    Draw_M(Count);
+    Delay(5);
+  End;
+
+  For Count := 1 to 9 Do Begin
+    Draw_P(Count);
+    Delay(20);
+  End;
+
+  For Count :=  74 DownTo 46 Do Begin
+    Draw_L(Count);
+    Delay(5);
+  End;
+
+  FadeWrite (24, 13, 'The Mystic BBS Programming Language');
+  FadeWrite (34, 15, 'Press Any Key');
+  Write     ('|PN');
+End;
+
+Procedure DrawHeader;
+Begin
+  WriteLn ('|CL');
+  WriteLn ('       |09|17²|01|16ÛÛÛßÛßÛ            |09|17²|01|16ÛÛÛßÛ                    |09|17²|01|16ÛÛÛ');
+  WriteLn ('       |09|17±|01|16ÛÛÛ   Û            |09|17±|01|16ÛÛÛÜÛ                    |09|17±|01|16ÛÛÛ');
+  WriteLn ('       ÛÛÛÛ   Û |11y s t i c  |01ÛÛÛÛ |11r o g r a m m i n g  |01ÛÛÛÛÜÛ |11a n g u a g e');
+  WriteLn ('       |09ÄÄÄÄÄÄ |01ß |09ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ|07');
+  WriteLn ('');
+End;
+
+Procedure InputDemo;
+Var
+  Str : String;
+Begin
+  DrawHeader;
+
+  WriteLn ('       This demonstrates some of the types of input functions which');
+  WriteLn ('       are available within the Mystic Programming Language.|CR');
+  Write   ('       |09Regular input  ') Str := Input(30, 30, 11, '');
+  Write   ('       |09Caps input     ') Str := Input(30, 30, 12, '');
+  Write   ('       |09Proper input   ') Str := Input(30, 30, 13, '');
+  Write   ('       |09Phone input    ') Str := Input(12, 12, 14, '');
+  Write   ('       |09Date input     ') Str := Input(8,  8,  15, '');
+  Write   ('       |09Password input ') Str := Input(20, 20, 16, '');
+
+  WriteLn ('|CR       |07Text can also be pushed into the input buffer:|CR');
+  Write   ('|09       Regular Input  ') Str := Input(30, 30, 11, 'Default Text');
+  WriteLn ('|CR       |07Input can be used without the input field:|CR');
+  Write   ('|09       Regular Input  |11') Str := Input(30, 30, 1, 'Default Text');
+
+  DrawHeader;
+
+  WriteLn ('|07       The input functions also make full use of ANSI editing.  Arrow');
+  WriteLn ('       keys can be used to move around the field, as well as the HOME,');
+  WriteLn ('       END, DEL, and CTRL-Y keys.  Up arrow restores previously entered text!');
+  WriteLn ('|CR       Text longer than the input box can be entered in both ANSI and');
+  WriteLn ('       non-ansi terminal modes.  For example: Type more than 30 characters');
+  WriteLn ('       below, while experimenting with the other ANSI editing functions');
+  WriteLn ('       mentioned above.');
+
+  Write   ('|CR       |09Scroll Input   ') Str := Input(30, 255, 11, '');
+  Write   ('|CR       |PA');
+End;
+
+Procedure UserListingHeader;
+Begin
+  DrawHeader;
+
+  WriteLn ('       User Name                  Location                   SecLev   Sex');
+  WriteLn ('       ------------------------------------------------------------------');
+End;
+
+Procedure UserListing;
+Var
+  Count : Word = 1;
+Begin
+  UserListingHeader;
+
+  While GetUser(Count) Do Begin
+    WriteLn ('       ' + PadRT(UserAlias, 25, ' ') + '  ' + PadRT(UserAddress, 25, ' ') + '  ' +
+                         PadLT(Int2Str(UserSec), 6, ' ') + '    ' + UserSex);
+
+    If Count % 10 = 0 Then Begin
+      Write ('       Continue? (Y/N): ');
+
+      Case OneKey('YN', True) of
+        'Y' : UserListingHeader;
+        'N' : Break;
+      End;
+    End;
+
+    Count := Count + 1;
+  End;
+
+  WriteLn ('|CR       Total of |15' + Int2Str(Count - 1) + ' |07users listed.|CR');
+  Write   ('       |PA');
+End;
+
+Procedure PlayNumberGame;
+Var
+  GuessNum : Byte;
+  Answer,
+  Temp     : Integer;
+Begin
+  DrawHeader;
+
+  WriteLn ('       |12Choose a number between 1 and 1000.  You have 10 guesses.')
+
+  GuessNum := 0;
+  Answer   := Random(999) + 1;
+
+  Repeat
+    GuessNum := GuessNum + 1;
+
+    Write ('|CR|03       Guess #' + Int2Str(GuessNum) + ': ');
+
+    Temp := Str2Int(Input(4, 4, 12, ''))
+
+    If Temp > Answer Then
+      WriteLn ('|CR       |07The number is less than ' + Int2Str(Temp))
+    Else
+    If Temp < Answer Then
+      WriteLn ('|CR       |07The number is greater than ' + Int2Str(Temp))
+    Else
+      GuessNum := 10;
+  Until GuessNum = 10;
+
+  If Temp = Answer Then
+    WriteLn ('|CR       |12You won!  The number was: ' + Int2Str(Answer))
+  Else
+    WriteLn ('|CR       |12You lost.  The number was: ' + Int2Str(Answer));
+
+  Write ('|CR       |PA');
+End;
+
+Function MainMenu : Byte;
+Var
+  Ch   : Char;
+  Done : Boolean = False;
+  Bar  : Byte = 1;
+  Ops  : Array[1..4] of String[20];
+Begin
+  DrawHeader;
+
+  WriteLn ('       The Mystic BBS Programming Language (MPL for short) allows for the');
+  WriteLn ('       ultimate in  flexibility.   With it''s  Pascal-like syntax, the MPL');
+  WriteLn ('       provides an  easy  and flexible way to  modify internal Mystic BBS');
+  WriteLn ('       functions, or  even create  your own online  games!  Check it out!');
+  WriteLn ('|09|CR       |$D66Ä|CR');
+
+  WriteLn ('       |09(|101|09)  |03Input demo    |08-> |07See some example input functions');
+  WriteLn ('       |09(|102|09)  |03User listing  |08-> |07See a list of user accounts');
+  WriteLn ('       |09(|103|09)  |03Number game   |08-> |07Play a simple number game');
+  WriteLn ('       |09(|10Q|09)  |03Quit Demo     |08-> |07Return to the BBS menu');
+
+  WriteLn ('|09|CR       |$D66Ä');
+  Write   ('       |07Select an option with arrow keys, or enter option number ');
+
+  Ops[1] := 'Input demo';
+  Ops[2] := 'User listing';
+  Ops[3] := 'Number game';
+  Ops[4] := 'Quit Demo';
+
+  Repeat
+    If Graphics > 0 Then Begin
+      GotoXY (12, 13 + Bar);
+      Write  ('|01|23 ' + Ops[Bar] + ' |16');
+    End;
+
+    Ch := ReadKey;
+
+    If Graphics > 0 and IsArrow Then Begin
+      GotoXY (12, 13 + Bar);
+      Write  ('|03 ' + Ops[Bar] + ' ');
+
+      Case Ch of
+        #72 : If Bar > 1 Then Bar := Bar - 1;
+        #80 : If Bar < 4 Then Bar := Bar + 1;
+      End;
+    End Else
+      Case Upper(Ch) of
+        #13 : If Graphics > 0 Then Begin
+                MainMenu := Bar;
+                Done     := True;
+              End;
+        'Q' : Begin
+                MainMenu := 4;
+                Done     := True;
+              End;
+      Else
+        If Str2Int(Ch) > 0 And Str2Int(Ch) < 4 Then Begin
+          MainMenu := Str2Int(Ch);
+          Done     := True;
+        End;
+      End;
+  Until Done;
+End;
+
+Begin
+  Draw_Animated_Intro;
+
+  Repeat
+    Case MainMenu of
+      1 : InputDemo;
+      2 : UserListing;
+      3 : PlayNumberGame;
+      4 : Break;
+    End;
+  Until False;
+
+  GotoXY (1, 20);
+End.

scripts/mpltest.mps

@@ -0,0 +1,488 @@
+// Comment test
+
+/*
+  Comment test! /* comments */ (* comments *)
+  // more comments
+
+*/
+
+(*
+  comment test  (* embedded comments *) /* embedded comments */
+  // more comments
+*)
+
+procedure testcase;
+var
+  number : longint;
+  num2   : longint;
+  num3   : longint;
+  num4   : real;
+  ch1    : char;
+  str1   : string[20];
+begin
+  write ('Testing CASE statement... ')
+
+  number := 73;
+  num2   := 13;
+  num3   := -1;
+  num4   := 12.12;
+  ch1    := 'A';
+  str1   := 'hello';
+
+  case number of
+    68     : begin
+               writeln('number is 68!');
+             end
+    69     : writeln('number is 69!');
+    70, 71 : writeln('number is 70 or 71');
+    72..80 : begin
+               case num2 of
+                 10 : writeln('num2 = 10');
+                 11 : begin
+                        writeln('num2 = 11');
+                      end;
+                 13 : case num3 of
+                       -1: begin
+                             case num4 of
+                               12.12: begin
+                                        case ch1 of
+                                          'A' : case str1 of
+                                                  'hello' : writeln('PASSED');
+                                                end;
+                                        end;
+                                      end;
+                             end;
+                           end;
+                      end;
+               else
+                 writeln('num2 is something else');
+               end;
+             end;
+  else
+    writeln('number is not found!');
+  end;
+end;
+
+procedure testgoto
+begin
+  write('Testing GOTO statement... ')
+  goto start
+:uphere
+  writeln('PASSED');
+  goto end
+:start
+  goto uphere
+:end
+end;
+
+procedure testnumbers;
+var
+  num1,
+  num2 : longint;
+  num3 : array[1..10] of byte;
+  num4 : array[1..10, 1..10, 1..10] of byte;
+  num5 : longint;
+begin
+  write ('Testing NUMBERS... ');
+
+  num1        := 2 + 12 * 2;
+  num2        := -10;
+  num3[1]     := 50;
+  num4[1,1,1] := (6 - 1) + 5 * 4;
+  num5        := 10 % 2 ^ 3;       // 2 to 3rd is 8, 10 modulus 8 = 2
+
+  // floating point, mods, powers, PEDMAS, etc...
+
+  if (num2 = -10) and (num1 = 26) and (num2 = -10) and (num3[1] = 50) and
+     (num4[1,1,1] = 25) and (num5 = 2) then
+    writeln('PASSED')
+  else
+    writeln('FAILED');
+end;
+
+procedure testrecords;
+type
+  testrec = record                 // total 502 bytes:
+    x : byte;
+    y : byte;
+    d : array[1..10,1..5] of string[9];
+  end;
+
+var
+  test   : array[1..2] of testrec;
+  test1  : testrec;
+  test2  : testrec;
+  passed : boolean = false;
+
+begin
+  Write ('Testing RECORDS... ');
+
+  test[1].d[10,5] := 'test1';
+  test[2].x       := 1;
+  test[2].y       := 2;
+  test[2].d[1,1]  := 'hi';
+  test[2].d[2,1]  := 'hello'
+
+  if (test[1].d[10,5][1] = 't') and (test[2].x = 1) and (test[2].y = 2) and
+     (test[2].d[1,1] = 'hi') and (test[2].d[2,1] = 'hello') then
+       passed := true;
+
+  if passed then begin
+    test1.x      := 1;
+    test1.y      := 2;
+    test1.d[1,1] := 'hi';
+    test1.d[2,1] := 'hello';
+
+    test2   := test1;
+    test[1] := test2;
+
+    passed := (test1.x = test2.x) and (test1.y = test2.y) and
+              (test1.d[1,1] = test2.d[1,1]) and (test1.d[2,1] = test2.d[2,1]) and
+              (test[1].x = test2.x) and (test[1].y = test2.y);
+  end;
+
+  if passed then
+    writeln ('PASSED')
+  else
+    writeln ('FAILED');
+
+end;
+
+procedure testprocedures;
+
+  procedure testproc1;
+
+    procedure testproc2
+    begin
+      WriteLn ('PASSED')
+    end;
+
+  begin
+    testproc2
+  end;
+
+begin
+  Write ('Testing PROCEDURES... ');
+  testproc1;
+end;
+
+procedure testrecursive (loop:byte)
+begin
+  If loop = 255 then
+    write('Testing RECURSIVE...');
+
+  loop := loop - 1;
+
+  if loop > 1 then
+    testrecursive(loop)
+  else
+    writeln('PASSED')
+end;
+
+procedure testfunctions;
+
+  function testfunc1 (p1,p2:byte; p3:string) : byte;
+  begin
+    if (p1 <> 10) or (p2 <> 5) or (p3 <> 'hello') then
+      testfunc1 := 5
+    else
+      testfunc1 := 10;
+  end;
+
+{$syntax iplc}
+  func testfunc2 : string {
+    testfunc2 = "ok"
+  }
+
+{$syntax pascal}
+
+begin
+  Write ('Testing FUNCTIONS... ');
+
+  if (testfunc1(10, 5, 'hello') = 10) and (testfunc2 = 'ok') then
+    writeln ('PASSED')
+  else
+    writeln ('FAILED')
+end;
+
+procedure testvarpassing;
+
+  procedure testit (var str: string);
+  begin
+    str := str + ' world';
+  end;
+
+var
+  str : string;
+begin
+  write ('Testing VARPASSING... ');
+  str := 'hello';
+  testit(str);
+  if str = 'hello world' then
+    writeln ('PASSED')
+  else
+    writeln ('FAILED');
+end;
+
+procedure teststringindex;
+var
+  str : string;
+begin
+  write ('Testing STRING IDX...');
+  str := 'hello world';
+  str[6] := #33;
+  if (str[1] = str[1]) and (str[2] = #101) and (str[6] = '!') then
+    writeln ('PASSED')
+  else
+    writeln ('FAILED')
+end;
+
+procedure testloops;
+var
+  count1 : byte;
+  count2 : byte;
+  count3 : byte;
+  count4 : byte;
+  count5 : byte;
+  loop1  : byte;
+  loop2  : byte;
+begin
+ Write ('Testing LOOPS...');
+
+ count1 := 0;
+
+ while count1 < 100 do begin
+   count1 := count1 + 1;
+   if count1 < 5 then continue;
+   if count1 < 5 then writeln('FAIL');
+   if count1 = 10 then break;
+ end;
+
+ count2 := 0;
+
+ repeat
+  count2 := count2 + 1;
+  if count2 < 5 then continue;
+  if count2 < 5 then writeln('FAIL');
+  if count2 = 10 then break;
+ until count2 = 100;
+
+ for count3 := 1 to 100 do begin
+   if count3 < 5 then continue;
+   if count3 < 5 then writeln('FAIL');
+   if count3 = 10 then break;
+ end;
+
+ loop1 := 0;
+
+ for count4 := 1 to 10 do begin
+   count4 := 10;
+   loop1  := loop1 + 1;
+ end;
+
+ loop2 := 0;
+
+ for count5 := 10 downto 1 do begin
+   count5 := 1;
+   loop2  := loop2 + 1;
+ end;
+
+ if (count1 = 10) and (count2 = 10) and (count3 = 10) and (count4 = 10) and
+    (loop1 = 1) and (count5 = 1) and (loop2 = 1) then
+   writeln ('PASSED')
+ else
+   writeln ('FAILED');
+end;
+
+procedure testconsts;
+const
+  const1 = 'hello';
+  const2 = true;
+  const3 = 555;
+  const4 = 'A';
+var
+  str1 : string;
+  bol1 : boolean;
+  ch1  : char;
+  num1 : longint;
+  ok1  : boolean;
+  ok2  : boolean;
+  ok3  : boolean;
+  ok4  : boolean;
+begin
+  write ('Testing CONSTS...');
+
+  ok1  := false;
+  ok2  := false;
+  ok3  := false;
+  ok4  := false;
+
+  str1 := 'hello';
+  bol1 := true;
+  num1 := 555;
+  ch1  := 'A'
+
+  case str1 of
+    const1 : ok1 := true;
+  end;
+
+  case bol1 of
+    const2 : ok2 := true;
+  end;
+
+  case num1 of
+    const3 : ok3 := true;
+  end;
+
+  case ch1 of
+    const4 : ok4 := true;
+  end;
+
+  if ok1 and ok2 and ok3 and ok4 then
+    writeln ('PASSED')
+  else
+    writeln ('FAILED')
+end;
+
+procedure testsyntaxparsing;
+
+{$syntax iplc}  // Iniquity-like syntax for the oldskool or maybe C-heads
+                // been thinking about moving it to be closer to javascript
+                // than IPL?
+
+  proc testiplc {
+    @ byte test1, test2, test3 = 10;
+    write ("PASS");
+    @ string anywhere = "we can do this wherever..."
+  }
+
+{$syntax pascal}
+
+  procedure testpascal;
+  var
+    test1, test2, test3 : byte = 10;  // not a pascal standard!
+  begin
+    writeln('ED');
+    var anywhere : string = 'wait!  pascal doesn''t allow this!';
+  end;
+
+begin
+  write ('Testing SYNTAX... ');
+  testiplc;
+  testpascal;
+end;
+
+procedure testfileio;
+const
+  fmReadWriteDenyNone = 66;
+var
+  f : file;
+  b : array[1..11] of Char;
+  s : string[20];
+  l : longint;
+begin
+  write ('Testing FILEIO... ');
+
+  // file IO is completely random.  no text/file crap like in pascal
+  // but it operates very close to pascal, just easier.  splitting the
+  // fOpen into fassign/frewrite/freset allows us to not have to open
+  // and close files constantly to reset or recreate it as in MPL 1.
+  // And doing away with raw numbers and adding a File type makes things
+  // much more manageable (and gives us virtually unlimited files)
+
+  fassign  (f, 'testmps.dat', fmReadWriteDenyNone);
+  frewrite (f);
+  fwriteln (f, 'Hello world');
+
+  freset   (f);
+  fread    (f, b[1], 11);
+
+  freset   (f);
+  freadln  (f, s);
+
+  freset   (f);
+  fseek    (f, fsize(f));
+
+  if not feof(f) or fpos(f) <> fsize(f) then begin
+    writeln('FAILED');
+    fclose(f);
+    exit;
+  end;
+
+  fclose (f);
+
+  if fileexist('testmps.dat') then fileerase('testmps.dat');
+
+  if ioresult <> 0 or fileexist('testmps.dat') then begin
+    writeln('FAILED');
+    exit;
+  end;
+
+  // we can read data directly in to char arrays or strings as if it were
+  // a char array.  no problems with reading non-pascal structs.
+
+  if b[1] = 'H' and b[2] = 'e' and b[3] = 'l' and s = 'Hello world' then
+    writeln('PASSED')
+  else
+    writeln('FAILED');
+end;
+
+procedure testrecordfileIO;
+type
+  myuserrecord = record
+    username  : string[30];
+    somevalue : array[1..5] of byte;
+  end;
+
+var
+  f : file;
+  u : myuserrecord;
+  a : byte;
+begin
+  Write ('Testing RECORDFILEIO... ');
+
+  u.username := 'testuser';
+
+  for a := 1 to 5 do
+    u.somevalue[a] := 1;
+
+  fassign   (f, 'testmps.dat', 66);
+  frewrite  (f);
+  fwriterec (f, u);
+
+  fillchar(u, sizeof(u), #0);
+
+  freset   (f);
+  freadrec (f, u);
+  fclose   (f);
+
+  if fileexist('testmps.dat') then fileerase('testmps.dat');
+
+  if (u.username = 'testuser') and (u.somevalue[1] = 1) and (u.somevalue[2] = 1) and
+     (u.somevalue[3] = 1) and (u.somevalue[4] = 1) and (u.somevalue[5] = 1) then
+       writeln('PASSED')
+  else
+       writeln('FAILED');
+end;
+
+begin
+  writeln ('|07|16|CLMystic BBS Programming Language Test Module');
+  writeln ('');
+
+  testcase;
+  testgoto;
+  testnumbers;
+  testrecords;
+  testprocedures;
+  testfunctions;
+  testrecursive(255);
+  testvarpassing;
+  teststringindex;
+  testloops;
+  testconsts;
+  testsyntaxparsing;
+  testfileio;
+  testrecordfileio;
+
+  writeln('|CRAll tests complete.  Press a key.|PN');
+end