'===========================================================================
' Subject: SIMPLE VARIABLE CONTROLLER         Date: 11-04-00 (21:49)       
'  Author: dab15151585@yahoo.com              Code: QB, QBasic, PDS        
'  Origin: dab15151585@yahoo.com            Packet: MISC.ABC
'===========================================================================
' DabScription
'
'
'
'
'   REQUIRED:
'    An intermediate knowledge of QuickBasic or Qbasic
'    I have no idea what type of computer would be required, mines a P100
'   and it runs fast. Go from there.
'
'  LIMITS:
'    Well, the limit is how long a string is allowed to be in Basic, 32767
'  charactors are allowed in each line.
'    There is no limit on anything else, Except for IF nesting, I think it
'  will only go up to two, and screw up there.
'
'
'   FiRun sub definition:
'
'    A file to be interpreted and ran.
'
'   FiRun FileName$
'
'   FileName$ - The file name to be specified.
'
'   NOTE: THE FILE WILL BE DELIMETED!!, SO IF YOU NEED TO USE A " or ,..
'   SEE THE CH ACTION.
'  Syntax:
'
'  All commands are defined as "Actions"
'
'   Spaces are ~, these also serve as delimiters.
'   Seperators are /
'   && is used like the qb's Rem.
'
'
'
' Definitions
' If Action Definition:
'
'  Same as Basic's if statement, with some minor differences.
'
' 1) If~Variable~Static~Action~
'
'  Variable - Variable saved in memory
'  Static - Something that isn't variable
'  Action - Same as a Action, called If Actions
'          but with a different syntax. ~ is now -, and / is now \
'
'   Ex:
'Act "If~Dd~Hello~Ps-Hi, how are you?-~"
'
' That won't do any thing cause the variable 'Dd' hasn't been set yet.
'
'  Notes: Sorry, I havn't put any real operators in there yet.
'
' 2) If~Variable~Iso(Static)~True|False~Action
'
'    Variable - Variable saved in memory.
'    Iso(Static) - Isolates a the static value, and then relates it to the
'   true|false value.
'    True|False - Operator for the action.
'    Action - Same as a Action, called If Actions
'   but with a different syntax. ~ is now -, and / is now \
'
'
' Iv Action Definition:
'
'  Kinda like input, except this scrolls.
'
'  Iv~Variable~ScreenLen~StringLen~X~Y~
'
'   Variable - Variable saved in memory.
'   ScreenLen - The actual screen lenght.
'   StringLen - The size the user is allowed to type to.
'   X - The X position, -1 for the current.
'   Y - The Y position, -1 for the current.
'
'   Ex:
'Act "Iv~What the user typed~40~100~-1~-1~"
'
' That will write to the variable 'What the user typed'
'
' Pv action definition:
'
'  Prints a memory stored variable
'
' Pv~Variable~
'
'   Variable - Variable saved in memory.
'
'  Ex:
'Act "Pv~SS~"
'  It won't do anything unless SS is defined.
'
'
'Act "Pva~SS~"
'
' Prints a variable after any statement.
'
' A brief definition of the next two commands.
'
' Ps and Psa are the same as Pv and Pva, except they work with static
'
' Ex:
'
'ACT "Ps~Example~/Psa~ Yet another example.~"
'
'  Set action definition:
'
'    Sets a variable.
'
' Set~Variable~Static~
'
'  Variable - The variables name to be stored in memory.
'  Static - The value of the variable.
'
' Ex:
'
'Act "Set~Some variable~Hello~"
'
'  Ch, Cha action definition:
'
'   Prints a character number, Cha does the same thing, only appended.
'
'  Ch~Num~
'
'  Num - Number (0-255)
'
' Ex:
'Act "Ch~15~"
'
'
' Save, Load action
'
'  Saves all variables to the specified file, for later reloading.
'
' Save|Load~FileName~
'
' Ex:
'Act "Save~File~/Load~File~"
'
'
' Cls action
'   Cls~
'  Clears the screen.
' ex:
' Act "Cls~"
'
' DoFi Action
'
' Runs a file
'
' Dofi~File~
'
'Ex:
'Act "DoFi~SomeFile~"
'
'
'
'$DYNAMIC
DECLARE FUNCTION FW! (B$, A$, C!) : DECLARE FUNCTION GVarN! (Var$) : DECLARE SUB TracePosition (ZZ!, ZZZ!) : DECLARE FUNCTION GetV$ (VarName$) : DECLARE FUNCTION SCRLTEXT$ (L!, SL!, X!, Y!) : DECLARE SUB SetVar (N$, A$) : DECLARE SUB DynParse (Dyn$ _
, Sep$, VZ$()) : DECLARE FUNCTION GLim! (S$, SC$) : DECLARE SUB QParse (S$, SC$, LIMIT!, VA$()) : DECLARE SUB Actif (Strng$) : DECLARE SUB Act (Strng$) : DECLARE SUB Load (Fi$) : DECLARE SUB Save (Fi$) : DECLARE SUB RunFi (Fi$) : DECLARE SUB RG ( _
label$)
DIM SHARED SavedVariable$(1000, 1), Pointer, LimitVar, FileOpened, IB, CurrFi$: LimitVar = 1000
RunFi "test.ai"

REM $STATIC
SUB Act (Strng$)
IF Strng$ = "" THEN EXIT SUB
DIM AA$(0)
DIM ZN$(0)
IF MID$(Strng$, 1, 2) = "&&" THEN
IF GLim(Strng$ + "/", "/") = 0 THEN EXIT SUB
IF GLim(Strng$ + "/", "/") > 0 THEN GOTO A
END IF

A:
DynParse Strng$ + "/", "/", AA$()
LoopUntil = GLim(Strng$ + "/", "/")

DO
' Action Interpretur
S$ = AA$(X)
IF MID$(S$, 1, 2) = "&&" THEN GOTO B
DynParse S$, "~", ZN$()
LL = GLim(S$, "~")
Action$ = ZN$(0)
SELECT CASE UCASE$(Action$)
CASE "CLS": CLS
CASE "DOFI": RunFi ZN$(1)
CASE "SAVE": Save ZN$(1)
CASE "LOAD": Load ZN$(2)
CASE "END": END
CASE "IF":
IF UCASE$(MID$(ZN$(2), 1, 3)) = "ISO" THEN
SELECT CASE FW(GetV$(ZN$(1)), MID$(ZN$(2), 5, LEN(ZN$(2)) - 5), 1)
CASE 1: II$ = "True"
CASE -1: II$ = "False"
END SELECT
IF UCASE$(ZN$(3)) = UCASE$(II$) THEN Actif ZN$(4)
END IF

IF UCASE$(GetV$(ZN$(1))) = UCASE$(ZN$(2)) THEN Actif ZN$(3)
CASE "IV"
TracePosition XX, YY
ZX = VAL(ZN$(4))
ZY = VAL(ZN$(5))
IF ZX = -1 THEN ZX = XX
IF ZY = -1 THEN ZY = YY
I$ = SCRLTEXT$(VAL(ZN$(2)), VAL(ZN$(3)), ZX, ZY)
SetVar ZN$(1), I$
CASE "PV"
PRINT GetV$(ZN$(1))
CASE "PVA"
PRINT GetV$(ZN$(1));
CASE "PS"
PRINT ZN$(1)
CASE "PSA"
PRINT ZN$(1);
CASE "CH"
IF VAL(ZN$(1)) < 0 OR VAL(ZN$(1)) > 255 THEN GOTO B
PRINT CHR$(VAL(ZN$(1)))
CASE "CHA"
IF VAL(ZN$(1)) < 0 OR VAL(ZN$(1)) > 255 THEN GOTO B
PRINT CHR$(VAL(ZN$(1)));
CASE "SET"
SetVar ZN$(1), ZN$(2)
CASE "LOC"
LOCATE VAL(ZN$(1)), VAL(ZN$(1))
END SELECT
B:
X = X + 1
LOOP UNTIL X = LoopUntil + 1
END SUB

SUB Actif (Strng$)
DIM ZAA$(0)
DynParse Strng$ + "\", "\", ZAA$()
LoopUntil = GLim(Strng$ + "\", "\")

DIM ZZZ$(0)
DO
' Action Interpretur
S$ = ZAA$(X)
DynParse S$, "-", ZZZ$()
LL = GLim(S$, "-")
Action$ = ZZZ$(0)
SELECT CASE UCASE$(Action$)
CASE "IF": Actif ZZZ$(1)
CASE "IV"
TracePosition XX, YY
ZX = VAL(ZZZ$(4))
ZY = VAL(ZZZ$(5))
IF ZX = -1 THEN ZX = XX
IF ZY = -1 THEN ZY = YY
I$ = SCRLTEXT$(VAL(ZZZ$(2)), VAL(ZZZ$(3)), ZX, ZY)
SetVar ZZZ$(1), I$
CASE "PV"
PRINT GetV$(ZZZ$(1))
CASE "PVA"
PRINT GetV$(ZZZ$(1));
CASE "PS"
PRINT ZZZ$(1)
CASE "PSA"
PRINT ZZZ$(1);
CASE "SET"
SetVar ZZZ$(1), ZZZ$(2)
END SELECT
X = X + 1
LOOP UNTIL X = LoopUntil + 1

END SUB

SUB CVLN (S1, P1, P2, SN$)
IF S1 < P1 THEN PRINT "Too little variables for "; SN$
IF S1 > P2 THEN PRINT "Too many variables for "; SN$
END SUB

SUB DynParse (Dyn$, Sep$, VZ$())
REDIM VZ$(GLim(Dyn$, Sep$))
QParse Dyn$, Sep$, GLim(Dyn$, Sep$), VZ$()
END SUB

FUNCTION FW (B$, A$, C)
DO
I = I + 1
IF I = LEN(B$) THEN FW = -1: EXIT FUNCTION

SELECT CASE C
CASE 1: IF UCASE$(MID$(B$, I, LEN(A$))) = UCASE$(A$) THEN EXIT DO
CASE -1: IF MID$(B$, I, LEN(A$)) = A$ THEN EXIT DO
END SELECT
LOOP
FW = 1
END FUNCTION

FUNCTION GetV$ (VarName$)
DO
IF UCASE$(SavedVariable$(X, 0)) = UCASE$(VarName$) THEN EXIT DO
X = X + 1
LOOP UNTIL X = LimitVar
GetV$ = SavedVariable$(X, 1)
END FUNCTION

FUNCTION GLim (S$, SC$)
S$ = S$ + SC$
Address = SADD(S$)

DO
A$ = A$ + CHR$(PEEK(Address + X))
IF CHR$(PEEK(Address + X)) = SC$ THEN DD = DD + 1
X = X + 1
LOOP UNTIL X = LEN(S$)
GLim = DD - 2
END FUNCTION

FUNCTION GVarN (Var$)
DO
IF UCASE$(SavedVariable$(X, 0)) = UCASE$(VarName$) THEN EXIT DO
X = X + 1
LOOP UNTIL X = LimitVar
GVarN = X - 1
END FUNCTION

SUB Load (Fi$)
OPEN Fi$ FOR BINARY AS #1
IF LOF(1) = -1 THEN EXIT SUB
OPEN Fi$ FOR INPUT AS #1
INPUT #1, Pointer
DO
INPUT #1, SavedVariable$(O, 0)
INPUT #1, SavedVariable$(O, 1)
O = O + 1
LOOP UNTIL O = Pointer
CLOSE #1
END SUB

SUB QParse (S$, SC$, LIMIT, VA$())
S$ = S$ + SC$
Address = SADD(S$)

DO
A$ = A$ + CHR$(PEEK(Address + X))
IF CHR$(PEEK(Address + X)) = SC$ THEN VA$(DD) = MID$(A$, 1, LEN(A$) - 1): A$ = "": DD = DD + 1
X = X + 1
LOOP UNTIL X = LEN(S$) OR DD = LIMIT
END SUB

SUB RunFi (Fi$)
CurrFi$ = Fi$
CLOSE
OPEN Fi$ FOR INPUT AS #1
FileOpened = 1
DO
IF EOF(1) = -1 THEN CLOSE : END
INPUT #1, S$
Act S$
LOOP
END SUB

SUB Save (Fi$)
OPEN Fi$ FOR OUTPUT AS #1
PRINT #1, Pointer
DO
PRINT #1, SavedVariable$(O, 0)
PRINT #1, SavedVariable$(O, 1)
O = O + 1
LOOP UNTIL O = Pointer
CLOSE #1
END SUB

FUNCTION SCRLTEXT$ (L, SL, X, Y)
DO
Z:
K$ = INKEY$
SELECT CASE K$
CASE ""
' Special keys
CASE CHR$(0) + "K"'left
CASE CHR$(0) + "M"'right
CASE CHR$(0) + "H"'up
CASE CHR$(0) + "P"'down
CASE CHR$(0) + ";" ' f1
CASE CHR$(0) + "<" ' f2
CASE CHR$(0) + "=" ' f3
CASE CHR$(0) + ">" ' f4
CASE CHR$(0) + "?" ' f5
CASE CHR$(0) + "@" ' f6
CASE CHR$(0) + "A" ' f7
CASE CHR$(0) + "B" ' f8
CASE CHR$(0) + "C" ' f9
CASE CHR$(0) + "D" ' f10
CASE CHR$(0) + "…" ' f11
CASE CHR$(0) + "†" ' f12
CASE "" ' Ctrl-C
CASE "
" ' Ctrl-A
CASE "" ' Ctrl-B
CASE "" ' Ctrl-D
CASE "" ' Ctrl-E
CASE "" ' Ctrl-F
CASE CHR$(0) + "." ' Alt-C
CASE CHR$(9)
'
CASE CHR$(27): KV$ = "": LOCATE X, Y: PRINT STRING$(L, " ")
CASE CHR$(8):
IF LEN(KV$) = 0 THEN GOTO Z
IF LEN(KV$) > L THEN KV$ = MID$(KV$, 1, LEN(KV$) - 1): LOCATE X, Y: PRINT MID$(KV$, LEN(KV$) - L + 1, L): GOTO Z
IF LEN(KV$) > 0 THEN OL = LEN(KV$): KV$ = MID$(KV$, 1, LEN(KV$) - 1): LOCATE X, Y: PRINT KV$ + STRING$(OL - LEN(KV$), " ")

CASE CHR$(13): EXIT DO
CASE ELSE
IF LEN(KV$) >= SL THEN GOTO Z
KV$ = KV$ + K$
LOCATE X, Y
IF LEN(KV$) < L THEN PRINT KV$
IF LEN(KV$) > L THEN PRINT MID$(KV$, LEN(KV$) - L + 1, L)
END SELECT
LOOP
SCRLTEXT$ = KV$

END FUNCTION

SUB SetVar (N$, A$)
IF GetV$(N$) <> "" THEN
' N$ - Variable Name
' A$ - Variable Attribute
'PRINT " Redefining "; N$; " from "; GetV$(N$); " to "; A$
'PRINT " Variable number is"; GVarN(N$)
SavedVariable$(GVarN(N$), 1) = A$
EXIT SUB
END IF


IF Pointer = LimitVar THEN PRINT "Limit for set variables has been reached!": END
IF N$ = "" OR A$ = "" THEN PRINT "Invalid set variable"
SavedVariable$(Pointer, 0) = N$
SavedVariable$(Pointer, 1) = A$
Pointer = Pointer + 1

END SUB

SUB TracePosition (ZZ, ZZZ)
LN = POS(0) + CSRLIN
ZZ = LN - POS(0)
ZZZ = LN - CSRLIN
END SUB