Μερκά Bugs διορθώθηκαν. Ειδικά ένα που είχε μπεί στην αναθεώρηση 10 (λάθος όνομα μεταβλητής, έπεφτε πάνω σε μια γενική μεταβλητή που ρύθμιζε την ανανέωση της οθόνης)
Αρκετές Προσθήκες:
Μια βασική προσθήκη είναι η δυνατότητα να έχουμε προαιρετικές παρεμέτρους σε ιδιότητες αντικειμένων τύπου ομάδα.
Αυτό είναι ένα μεγάλο παράδειγμα:
global inventory z=10,20,30,40
\\ class is a function which return object
\\ class is a global function until this module end
class AnObject {
type$="AnObject"
ttt=12345678
value {
=1000
}
}
Group alfa {
type$="alfa"
inventory m=1,"hello":=10,3:=z,4:=1000, "ok":="yes", "object":=AnObject()
Property kappa {
set () {
link parent m to m
If Empty Then {
If type$(value)="Inventory" Then {
m=value
' we don't want this value saved to .[Kappa]
' so we make a local value, to shadow current value
' by default Local value make a double with value 0
local value
} else Error "Wrong type, need Inventroy"
} Else.If islet Then {
Read k$
If exist(m, k$) Then {
If type$(value)="Group" Then {
Return m, k$:=Group(value)
} else Return m, k$:=value
} else {
If type$(value)="Group" Then {
Append m, k$:=Group(value)
} else Append m, k$:=value
}
} else {
Read k
If exist(m, k) Then {
If type$(value)="Group" Then {
Return m, k:=Group(value)
} else Return m, k:=value
} else {
If type$(value)="Group" Then {
Append m, k:=Group(value)
} else Append m, k:=value
}
}
}
value () {
link parent m to m
If empty Then {
value=m
} Else.If islet Then {
value=m(Letter$)
} else {
value=m(Number)
}
}
}
' Make a clean property , no use of value
Group objKappa {
value () {
link parent m to m
If empty Then {
=m
} Else.If islet Then {
if exist(m, Letter$) then {
=eval(m)
}
} else {
if exist(m, Number) then {
=eval(m)
}
}
}
}
Property strkappa$ {
value () {
link parent m to m
If islet Then {
value$=m$(Letter$)
} else {
value$=m$(Number)
}
}
}
Property typekappa$ {
value () {
link parent m to m
If islet Then {
value$=type$(m(Letter$))
} else {
value$=type$(m(Number))
}
}
}
value (x) {
=.m(x!)
}
}
' Part 1
' Group Alfa return an indexed (from 0) value (number or object)
' .m(x!) always return object
Print alfa(2)
Print alfa.type$
Function check$ (m) {
Print type$(m)
=str$(m(0!))
}
Print check$(alfa(2))
Print alfa.typeKappa$("object") ' is a group
For this {
temp=alfa.Kappa("object")
Print type$(temp), temp ' we get 1000, because object return value
temp2=alfa.objKappa("object")
Print type$(temp2), temp2.type$
}
z= alfa.Kappa()
Print z("object").type$, z("object").ttt
Print alfa.Kappa()("object").ttt
Print alfa.Kappa()("object").ttt
Print alfa.Kappa()("object").type$
Print alfa.Kappa("object")
Print alfa.Kappa("object")
k=each(alfa.m)
while k {
Print eval$(k, k^),
}
Print
Print alfa.Kappa(4)
Print alfa.Kappa("hello"), alfa.strKappa$("ok")
Print alfa.typeKappa$("hello"), alfa.typeKappa$("ok"), alfa.typeKappa$(3)
M=alfa.Kappa(3)
Print m(1!)
Return alfa.Kappa(3), 20:=12345
' it is the same because we have pointer
' read from m(3), inventory so we get key 20
Print alfa.m(3)(20)
\\ using ! we pass position in inventory
Print m(1!)
alfa.Kappa(333)=200
Print alfa.Kappa(333)
alfa.Kappa("Price A")=100.23
Print alfa.Kappa("Price A")
' Part 3, change inventory
inventory allo=1:="ok", 200:=1234
alfa.Kappa()=allo
Print len(alfa.Kappa())
Print alfa.strKappa$(1)
Print alfa.Kappa(200)
Και εδώ είναι η δημιουργία και η ανάγνωση πίνακα σε μορφή json. Προς το παρόν δεν αλλάζουμε τα στοιχεία στη δομή, αλλά μπορούμε να εξάγουμε όποιο τμήματα, ή μια τιμή θέλουμε. Έχει φτιατχεί για να διαβάζει βάσει των κανόνων του json. Όλη η κατασκευή είναι μια κλάση μεγάλη (οι κλάσεις στη Μ2000 δημιουργούν ομάδες) και μια εντολή Parser=ParserClass() δημιουργέι το αντικείμενο Parser.
Μια ενδιαφέρουσα εντολή είναι αυτή:
Report Parser.Ser$(Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2)), 1)
όπου η εντολή Report (Αναφορά) εμφανίζει κείμενο στη κονσόλα. Δείτε όμως ότι το κείμενο βγαίνει από τρεις κλήσεις στο αντικείμενο Parser. Το διαβάζουμε από το εσωτερικό:
η Parser.ReadAnyString$(alfa,"array", 2) δίνει από το json αντικείμενο. εκείνο με το αναγνωριστικό "arrray" και ειδικότερα το 3ο στοιχείο (η βάση είναι το 0, άρα το 2 είναι το 3ο στοιχείο). Αυτή η αυνάρτηση επιστρέφει το στοιχείο σε αλφαριθμητικό. χωρίς να βάλει αλλαγές γραμμών και εσοχές.
Μετά το δίνουμε στην Parser.Eval(). Αυτή παίρνει το κείμενο και δίνει μια δομή δεδομένων.
Αμέσως όμως την δίνουμε στην Parser.Ser$() με δεύτερο όρισμα το 1 (θα βάλει αλλαγές γραμμών και εσοχές).
Οι δομές δεδομένων είναι δυο βασικές, η Κατάσταση (Inventory) και ο δείκτης σε Πίνακα (στην ουσία πίνακας με διαφοτετικές εντολές και χειρισμό). Οι κανονικοί πίνακες στη Μ2000 αντιγράφονται με το σύμβολο εκχώρησης. Δεν συμβαίνει το ίδιο με το δείκτη σε πίνακα. Ουσιαστικά οι Καταστάσεις και οι δείκτες σε πίνακα περνούν με αντιγραφή ενώ είναι με αναφορά (αφπύ περνάμε δείκτη). Στη Μ2000 δεν μπορούμε να χειριστούμε τους δείκτες βάζοντας ότι θέλουμε, υπάρχει εσωτερικός έλεγχος.
Στην Eval() δίνουμε το αλφαριθμητικό που θα το φτιάξει δομή δεδομένων (δηλαδή με εντολές θα διαβάζουμε άμεσα το στοιχείο που θέλουμε). Αυτό λοιπόν μπαίνει ως κλείσιμο σε μια συνάρτηση λάμδα, και μάλιστα σε Διάρθρωση μνήμης (Buffer) όπου την δηλώνουμε ότι θα έχει ακέραιους (στη διάρθρωση οι ακέραιοι (integer) είναι των δυο bytes και unsign, δηλαδή δεν παίρνουν αρνητική τιμή. Και οι διαρθρώσεις είναι δείκτες σε αντικείμενο που εσωτερικά "χειρίζονται" μνήμη. Οπότε αν βγάλουμε αντίγραφο της λάμδα, θα έχουμε απλά αντίγραφο του δείκτη, και στην ουσία αυτό που κάνουμε με την αντιγραφή είναι να αποθηκεύσουμε την τιμή δου δείκτη ανάγνωσης, ώστε αν θέλουμε να επιστρέψουμε στο σημείο της αποθήκευσης.
Στον Parser έχουμε κοινές μεταβλητές ως μεταβλητές του αντικειμένου (αντικείμενο και παρουσία είναι το ίδιο πράγμα για τις ομάδες, οι ομάδες δεν είναι αντικείμενα με δείκτε), Δείτε εδώ το char το οποίο διαβάζει τον επόμενο χαρακτήρα.
Όταν καταχωρούμε αριθμούς, από το κείμενο στη δομή,. διατηρούμε την μορφή που είχε σε αλφαριθμητικό. Μπορούμε όμως να το διαβάσουμε και ως αριθμό.
Για να κρατάμε "σημειώσεις" χρησιμοποιούμε ιδιωτικούς σωρούς, οι οποίοι είναι και αυτοί αντικείμενα με δείκτη, και είναι όπως ο σωρός τιμών, μέσω του οποίου περνάμε τα ορίσματα των συναρτήσεων. Πχ με την εντολή αυτή obj=Stack λέμε ότι η μεταβλητή obj θα έχει ένα αντικείμενο σωρού (άδειο).
Revision 2 ( problem was: if number was 0 then without ." we get error, and nothing parsing)
Revision 3 (empty array not allowed in previous revision)
Revision 4 (u0000 now work perfect)
Parser=ParserClass()
Modules ? \\ Display the name of module and public parts of Parser
Document json$
' We can load from file
'Load.Doc json$, "alfa.json"
json$={{
"alfa":-0.11221e+12,
"array" : [
-0.67,
"alfa1",
[
10,
20
],
"beta1",
1.21e12,
[
],
21.12145,
"ok"
],
"delta": false, "epsilon" : true, "Null Value" : null
}}
Save.Doc json$, "json2.json" \\ by default in Utf-8 with BOM
' just show multiline text
Report json$
\ so now we get text to a new object
alfa=Parser.Eval(json$)
Print Type$(alfa) ' it is a group
Print "alfa.type$=";alfa.type$ \\ this is a read only property
Report "as one line"
Report Parser.Ser$(alfa, 0)
Report "as multiline"
Report Parser.Ser$(alfa, 1)
Print "Using Print"
Print Parser.ReadAnyString$(alfa)
Print "Value for alfa, id alfa"
Print Parser.ReadAnyString$(alfa,"alfa")
Report "as multiline"
\\ here a string returned from Parser.ReadAnyString$(alfa,"array", 2)
\\ Then a group returned ftom Parser.Eval()
\\ Then string returned from that group.
\\ We get specific 0
Report Parser.Ser$(Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2)), 1)
' We get a copy of array
Alfa3=Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2))
Dim B()
B()=Alfa3
N=each(B())
While N {
Print B(N^)
}
Αρκετές Προσθήκες:
Μια βασική προσθήκη είναι η δυνατότητα να έχουμε προαιρετικές παρεμέτρους σε ιδιότητες αντικειμένων τύπου ομάδα.
Αυτό είναι ένα μεγάλο παράδειγμα:
global inventory z=10,20,30,40
\\ class is a function which return object
\\ class is a global function until this module end
class AnObject {
type$="AnObject"
ttt=12345678
value {
=1000
}
}
Group alfa {
type$="alfa"
inventory m=1,"hello":=10,3:=z,4:=1000, "ok":="yes", "object":=AnObject()
Property kappa {
set () {
link parent m to m
If Empty Then {
If type$(value)="Inventory" Then {
m=value
' we don't want this value saved to .[Kappa]
' so we make a local value, to shadow current value
' by default Local value make a double with value 0
local value
} else Error "Wrong type, need Inventroy"
} Else.If islet Then {
Read k$
If exist(m, k$) Then {
If type$(value)="Group" Then {
Return m, k$:=Group(value)
} else Return m, k$:=value
} else {
If type$(value)="Group" Then {
Append m, k$:=Group(value)
} else Append m, k$:=value
}
} else {
Read k
If exist(m, k) Then {
If type$(value)="Group" Then {
Return m, k:=Group(value)
} else Return m, k:=value
} else {
If type$(value)="Group" Then {
Append m, k:=Group(value)
} else Append m, k:=value
}
}
}
value () {
link parent m to m
If empty Then {
value=m
} Else.If islet Then {
value=m(Letter$)
} else {
value=m(Number)
}
}
}
' Make a clean property , no use of value
Group objKappa {
value () {
link parent m to m
If empty Then {
=m
} Else.If islet Then {
if exist(m, Letter$) then {
=eval(m)
}
} else {
if exist(m, Number) then {
=eval(m)
}
}
}
}
Property strkappa$ {
value () {
link parent m to m
If islet Then {
value$=m$(Letter$)
} else {
value$=m$(Number)
}
}
}
Property typekappa$ {
value () {
link parent m to m
If islet Then {
value$=type$(m(Letter$))
} else {
value$=type$(m(Number))
}
}
}
value (x) {
=.m(x!)
}
}
' Part 1
' Group Alfa return an indexed (from 0) value (number or object)
' .m(x!) always return object
Print alfa(2)
Print alfa.type$
Function check$ (m) {
Print type$(m)
=str$(m(0!))
}
Print check$(alfa(2))
Print alfa.typeKappa$("object") ' is a group
For this {
temp=alfa.Kappa("object")
Print type$(temp), temp ' we get 1000, because object return value
temp2=alfa.objKappa("object")
Print type$(temp2), temp2.type$
}
z= alfa.Kappa()
Print z("object").type$, z("object").ttt
Print alfa.Kappa()("object").ttt
Print alfa.Kappa()("object").ttt
Print alfa.Kappa()("object").type$
Print alfa.Kappa("object")
Print alfa.Kappa("object")
k=each(alfa.m)
while k {
Print eval$(k, k^),
}
Print alfa.Kappa(4)
Print alfa.Kappa("hello"), alfa.strKappa$("ok")
Print alfa.typeKappa$("hello"), alfa.typeKappa$("ok"), alfa.typeKappa$(3)
M=alfa.Kappa(3)
Print m(1!)
Return alfa.Kappa(3), 20:=12345
' it is the same because we have pointer
' read from m(3), inventory so we get key 20
Print alfa.m(3)(20)
\\ using ! we pass position in inventory
Print m(1!)
alfa.Kappa(333)=200
Print alfa.Kappa(333)
alfa.Kappa("Price A")=100.23
Print alfa.Kappa("Price A")
' Part 3, change inventory
inventory allo=1:="ok", 200:=1234
alfa.Kappa()=allo
Print len(alfa.Kappa())
Print alfa.strKappa$(1)
Print alfa.Kappa(200)
Και εδώ είναι η δημιουργία και η ανάγνωση πίνακα σε μορφή json. Προς το παρόν δεν αλλάζουμε τα στοιχεία στη δομή, αλλά μπορούμε να εξάγουμε όποιο τμήματα, ή μια τιμή θέλουμε. Έχει φτιατχεί για να διαβάζει βάσει των κανόνων του json. Όλη η κατασκευή είναι μια κλάση μεγάλη (οι κλάσεις στη Μ2000 δημιουργούν ομάδες) και μια εντολή Parser=ParserClass() δημιουργέι το αντικείμενο Parser.
Μια ενδιαφέρουσα εντολή είναι αυτή:
Report Parser.Ser$(Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2)), 1)
όπου η εντολή Report (Αναφορά) εμφανίζει κείμενο στη κονσόλα. Δείτε όμως ότι το κείμενο βγαίνει από τρεις κλήσεις στο αντικείμενο Parser. Το διαβάζουμε από το εσωτερικό:
η Parser.ReadAnyString$(alfa,"array", 2) δίνει από το json αντικείμενο. εκείνο με το αναγνωριστικό "arrray" και ειδικότερα το 3ο στοιχείο (η βάση είναι το 0, άρα το 2 είναι το 3ο στοιχείο). Αυτή η αυνάρτηση επιστρέφει το στοιχείο σε αλφαριθμητικό. χωρίς να βάλει αλλαγές γραμμών και εσοχές.
Μετά το δίνουμε στην Parser.Eval(). Αυτή παίρνει το κείμενο και δίνει μια δομή δεδομένων.
Αμέσως όμως την δίνουμε στην Parser.Ser$() με δεύτερο όρισμα το 1 (θα βάλει αλλαγές γραμμών και εσοχές).
Οι δομές δεδομένων είναι δυο βασικές, η Κατάσταση (Inventory) και ο δείκτης σε Πίνακα (στην ουσία πίνακας με διαφοτετικές εντολές και χειρισμό). Οι κανονικοί πίνακες στη Μ2000 αντιγράφονται με το σύμβολο εκχώρησης. Δεν συμβαίνει το ίδιο με το δείκτη σε πίνακα. Ουσιαστικά οι Καταστάσεις και οι δείκτες σε πίνακα περνούν με αντιγραφή ενώ είναι με αναφορά (αφπύ περνάμε δείκτη). Στη Μ2000 δεν μπορούμε να χειριστούμε τους δείκτες βάζοντας ότι θέλουμε, υπάρχει εσωτερικός έλεγχος.
Στην Eval() δίνουμε το αλφαριθμητικό που θα το φτιάξει δομή δεδομένων (δηλαδή με εντολές θα διαβάζουμε άμεσα το στοιχείο που θέλουμε). Αυτό λοιπόν μπαίνει ως κλείσιμο σε μια συνάρτηση λάμδα, και μάλιστα σε Διάρθρωση μνήμης (Buffer) όπου την δηλώνουμε ότι θα έχει ακέραιους (στη διάρθρωση οι ακέραιοι (integer) είναι των δυο bytes και unsign, δηλαδή δεν παίρνουν αρνητική τιμή. Και οι διαρθρώσεις είναι δείκτες σε αντικείμενο που εσωτερικά "χειρίζονται" μνήμη. Οπότε αν βγάλουμε αντίγραφο της λάμδα, θα έχουμε απλά αντίγραφο του δείκτη, και στην ουσία αυτό που κάνουμε με την αντιγραφή είναι να αποθηκεύσουμε την τιμή δου δείκτη ανάγνωσης, ώστε αν θέλουμε να επιστρέψουμε στο σημείο της αποθήκευσης.
Στον Parser έχουμε κοινές μεταβλητές ως μεταβλητές του αντικειμένου (αντικείμενο και παρουσία είναι το ίδιο πράγμα για τις ομάδες, οι ομάδες δεν είναι αντικείμενα με δείκτε), Δείτε εδώ το char το οποίο διαβάζει τον επόμενο χαρακτήρα.
Όταν καταχωρούμε αριθμούς, από το κείμενο στη δομή,. διατηρούμε την μορφή που είχε σε αλφαριθμητικό. Μπορούμε όμως να το διαβάσουμε και ως αριθμό.
Για να κρατάμε "σημειώσεις" χρησιμοποιούμε ιδιωτικούς σωρούς, οι οποίοι είναι και αυτοί αντικείμενα με δείκτη, και είναι όπως ο σωρός τιμών, μέσω του οποίου περνάμε τα ορίσματα των συναρτήσεων. Πχ με την εντολή αυτή obj=Stack λέμε ότι η μεταβλητή obj θα έχει ένα αντικείμενο σωρού (άδειο).
Revision 2 ( problem was: if number was 0 then without ." we get error, and nothing parsing)
Revision 3 (empty array not allowed in previous revision)
Revision 4 (u0000 now work perfect)
Class
ParserClass {
Private:
Class bStream {
Private:
cnt, Buffer A
Public:
Value (&c) {Try {c=eval(.A, .cnt) : .cnt++:=true}}
Class:
Module final bStream (a$){
Buffer .A as Integer*Len(a$)
Return .A, 0:=a$
}
}
Func=Lambda->false
char=0
\\ using obj as pointer to Stack
obj=Stack
Function final IsId {
If .char=34 Then =.IsString(false)
}
Function final IsTrue {
\\ U+0074 U+0072 U+0075 U+0065
If .char=0x74 Then If .func() Then If .char=0x72 Then If .func() Then If .char=0x75 Then If .func() Then If .char=0x65 Then PushIt() : =True
Sub PushIt()
Stack .obj {
Push .Boolean(True)
}
End Sub
}
Function final IsFalse {
\\ U+0066 U+0061 U+006c U+0073 U+0065
If .char=0x66 Then If .func() Then If .char=0x61 Then If .func() Then If .char=0x6c Then If .func() Then If .char=0x73 Then If .func() Then If .char=0x65 Then PushIt() : =True
Sub PushIt()
Stack .obj {
Push .Boolean(False)
}
End Sub
}
Function final IsNull {
\\ U+006E U+0075 U+006C U+006C
If .char=0x6e Then If .func() Then If .char=0x75 Then If .func() Then If .char=0x6c Then If .func() Then If .char=0x6c Then PushIt() : =True
Sub PushIt()
Stack .obj {
Push .Null()
}
End Sub
}
Function final IsSemiCol {
If .char=0x3a Then =true
}
Function final IsComma {
If .char=0x2c Then =true
}
Function final IsObject {
If .char=123 Else exit
inventory objinv
\\ we push object with a pointer to objinv
Stack .obj { Push .Object(objinv)}
.Trim
While .IsId() {
.Trim
If .IsSemiCol() Then {
.Trim
If .IsValue() Then {
Stack .obj {
Shift 2 ' move top as second
' letter$ is ok If top is string, and throw it
Append objinv, Letter$:=Group
}
}
} Else Exit
.Trim
If not .IsComma() Then exit
.Trim
}
If .char=125 Then { =true } Else .obj<=Stack : .func<=lambda->0
}
Function final IsValue {
If .IsString(True) Then {
=True
} Else.if .IsNumber() Then {
=True
} Else.If .IsTrue() Then {
=True
} Else.If .IsFalse() Then {
=True
} Else.If .IsNull() Then {
=True
} Else.if .IsArray() Then {
=True
} Else.if .IsObject() Then {
=True
} Else {
Print "what", .char
Stack .obj { Stack}
.func<=lambda->0
}
}
Function final Digits (private_stack){
While .func() {
Select Case .char
Case 48 to 57
{
=true
Stack private_stack { Data .char}
}
Else
break
End Select
}
}
Function final IsNumber {
a=Stack
Select Case .char
Case 45 ' -
{
oldfunc=.func
Stack a { Data .char}
If .Func() Then {
Select Case .char
Case 48
{
Stack a { Data .char}
If .func() Then {
If .char=46 Then {
Fraction()
Exponent()
}
}
}
Case 49 to 57
{
Stack a { Data .char}
If .Digits(a) Then {}
Fraction()
Exponent()
}
Else
a=stack
End Select
}
}
Case 48 ' 0
{
oldfunc=.func
Stack a { Data .char}
If .func() Then {
If .char=46 Then {
Fraction()
Exponent()
}
}
}
Case 49 to 57
{
oldfunc=.func
Stack a { Data .char}
If .Digits(a) Then {}
Fraction()
Exponent()
}
End Select
If len(a)>0 Then {
b=each(a)
Document D$
While b {
D$=chrcode$(StackItem(b))
}
.func<=oldfunc
If len(D$)>1 Then For i=2 to len(D$) { .Trim}
Stack .obj { Push .Numeric(D$) }
=True
}
' here is an auto exit from function. Sub as command is an exit
Sub Fraction()
If .char=46 Then Stack a { Data .char}
If .Digits(a) Then { }
End Sub
Sub Exponent()
If .char=101 or .char=61 Then {
Stack a { Data .char}
If .func() Then {
If .char=43 or .char=45 Then {
Stack a { Data .char }
If .Digits(a) Else {
a=Stack ' cleat by point to new Stack
}
} Else.If .char>47 and .char<58 Then {
Stack a { Data .char}
If .Digits(a) Then {}
} Else { a=Stack }
}
}
End Sub
}
Function final IsString (as_object){
If .char=34 Else exit
Document D$
While .func() {
If .char=34 Then 2000
If .char=92 Then {
' special care
If .func() Then {
Select Case .Char
Case 117 'u
GetHex()
Case 114 ' r
.char<=0x0d
Case 110 ' n
.char<=0x0a
Case 116 ' t
.char<=0x09
Case 98 ' b
.char<=0x08
Case 102 ' f
.char<=0x0c
Case 0x22, 0x2f , 0x5c
rem ' need a line always - revision 4
Else
Exit ' not normal
End Select
}
}
D$=chrcode$(.char)
}
Exit
2000 Stack .obj {
If as_object Then {Push .JString$(D$)} Else Push D$
} : =True
Sub GetHex()
Local D$
Document D$="0x"
For i=1 to 4 {
If .func() Then {
\\ Chrcode$() - was an error here in previous code as Chrcode()
If Chrcode$(.char) ~ "[0123456789ABCDEFabcdef]" Then {
D$=Chrcode$(.char)
} Else 3000
}
}
If i<>5 Then 3000
.Char<=Eval(D$)
3000 End Sub
}
Function final IsArray {
If .char=91 Else exit
Dim Gr()
' We place a pointer ro Array
.Trim
If .char=93 Then =true : Stack .obj { Push .Arr(Gr())} : exit
While .IsValue() {
Stack .obj {
Dim Gr(Len(Gr())+1)
Gr(len(Gr())-1)=Group
}
.Trim
If not .IsComma() Then exit
.Trim
}
' Push later pointer to array (maybe altered in redimension)
If .char=93 Then { =true : Stack .obj { Push .Arr(Gr())} } Else .Func<=lambda->false
}
Module final Trim {
While .func() {
If .char<33 or .char=160 Else exit
}
}
Function final IsContainer {
.Trim
Select Case chrcode$(.char)
Case "{"
=.IsObject()
Case "["
=.IsArray()
end select
}
' merge a foreign group here
Module final ReadArrayItem (temp, object){
Select Case temp.type$
Case "String","Boolean","Number", "Null"
{
If object Then Error "No object "+quote$(temp.type$)
Push temp.str$
}
Case "Object"
{
If not Empty Then {
Call .ReadObject temp, object, letter$
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
Case "Array"
{
If not Empty Then {
' recursion only with Call statement for modules
Call .ReadArrayItem, Array(temp, number), object
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
End Select
}
Module final ReadObject (json, object){
If type$(json)="Inventory" Then {
If exist(json, Letter$) Then {
temp=eval(json)
} Else {
push "none"
Break ' exit Module final (Break do something Else in Select End Select)
}
} Else temp=json
Select Case temp.type$
Case "String","Boolean","Number", "Null"
{
If object Then Error "No object "+quote$(temp.type$)
Push temp.str$
}
Case "Object"
{
If not Empty Then {
Call .ReadObject temp, object
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
Case "Array"
{
If not Empty Then {
Call .ReadArrayItem array(temp, number), object
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
End Select
}
Module final Worker (object){
If match("IN") Or match("IS") Then { ' inventory & number or inventory and string
' maybe we have more items in Stack
Push object : ShiftBack 2
.ReadObject
} Else {
read Temp ' get a group which returns Iventoty or an mArray
If Type$(Temp)="mArray" Then {
If not Empty Then {
Call .ReadArrayItem, Array(Temp, number), object
} Else {
If object Then Push Temp : exit
Push .ser$(Temp,0)
}
} Else {
If not Empty Then {
Call .ReadObject Temp, object
} Else {
If not Empty Then {
Call .ReadObject Temp, object
} Else {
If object Then Push Temp : exit
If Type$(Temp)="Inventory" Then {
Push .ser$(.Object(Temp),0)
} Else {
Push .ser$(group(Temp),0)
}
}
}
}
}
}
Public:
\\ This is the Public part
\\ First we set Public some class for later use
\\ Using Pointer to Array in Class Arr
Class Arr {
Private:
MyValue
Public:
Property Type$ {Value} ="Array"
Value {
=.MyValue
}
Class:
Module final Arr (.MyValue) {}
}
Class Null {
Property Type$ {Value} ="Null"
Property Str$ {Value}="null"
Value { =0}
}
Class JString$ {
Private:
MyValue$=""
Public:
Property Type$ {Value} ="String"
Property Str$ {
Value{
Link parent MyValue$ to MyValue$
value$=quote$(string$(MyValue$ as json))
}
}
Value {
=.MyValue$
}
Class:
Module final JString (.MyValue$) {}
}
Class Numeric {
Private:
MyValue$=""
Public:
Property Type$ {Value} ="Number"
Property Str$ {
Value{
Link parent MyValue$ to MyValue$
value$=MyValue$
}
}
Value {
=Val(.MyValue$)
}
Class:
Module final Numeric {
If match("S") Then {
Read .MyValue$
} Else {
\\ using locale 1033 for dot always
.Myvalue$<=trim$(str$(Number, 1033))
}
}
}
Class Boolean {
Private:
MyValue=false
Public:
Property Type$ {Value} ="Boolean"
Property Str$ {
Value{
Link parent MyValue to MyValue
If MyValue Then {
value$="true"
} Else value$="false"
}
}
Value {
=.MyValue
}
Class:
Module final Boolean (.MyValue) {}
}
Class Object {
Private:
Inventory MyValue
Public:
Property Type$ {Value} ="Object"
Value {
=.MyValue
}
Class:
Module final Object (.MyValue) {}
}
\\ Empty group, with $, so we get two vars, Ser and Ser$ ( Ser$ we want to return a value type String)
Group Ser$
Module final SetSpace (.ser.space) { ' set space for values - 6 by default
}
Function final UseDecimalPoint$ {
' use this to change standard decimal point to local decimal point character
=str$(val(letter$),"")
}
Function final ReadNumber$ {
.Worker false 'modules get caller Stack
=.UseDecimalPoint$( Letter$)
}
Function final ReadAnyString$ {
\\ read an inventory
.Worker false
=Letter$
}
Function final ReadAny {
\\ read an inventory
.Worker true
Read A
=A
}
Function final Eval {
' Letter$ pop a string from Stack Else give error
.func<=Lambda z=.bStream(Letter$) -> {
link .char to c
' we can't pass reference in a private member
=z(&c)
}
' In this Parser we use a dedicated Stack
' for use from recuirsive memberts
' .obj is a pointer to Stack
' we can delete it simply setting a new Stack
' .obj<=Stack
' or we can flush all elements Using a command Flush
' .obj, char and .func() are visible from group members
' test
Stack .obj { Flush}
.char<=0
If .IsContainer() Then {
' we get the pointer
=StackItem(.obj)
.obj<=Stack
} Else {
' return an Empty object
inventory emptinv
=.Object(emptinv)
}
}
Group StringValue$ {
Add=false
Del=false
Set (temp) {
' always first read is for the assigned value to Group
Read temp1
If type$(temp)<>"Group" Then error "Need a group"
If not valid(temp.type$="") Then error "not a proper group"
If not valid(temp1.type$="") Then error "not a proper group for value"
' because Null() is out of this scope we have to link
Link parent Null() to MyNull()
Null=MyNull()
Dim Base 1, A(1)
\\ now we get the second interface for arrays
\\ bb() has a reference to b (one reference allowed)
\\ but b is pointer to array and can change to point to other arrrays
\\ we need this to perform some tasks which belong to standard arrray interface
b=(,) : Link b to bb()
A(1)=Group(temp)
Do {
again=false
Select Case A(1).type$
Case "Array"
{
If match("N") Then {
Read where
If len(A(1))<=where and Empty Then {
' only the last array we can redimension
If .add and not .del Then {
cursize=Len(A(1))
b=A(1) ' A(1) has a pointer so now b has the same pointer
' dim preserve values
Dim bb(where+1) ' need one more because all "automatic arrays" have base 0
Stock bb(cursize) sweep Len(b)-cursize, Group(Null)
} Else Error "Index out of limits"+str$(where)
} Else If where<0 Then Error "Index out of limits "+str$(where)
If Empty Then {
If .del Then {
cursize=Len(A(1))
b=A(1) ' A(1) has a pointer so now b has the same pointer
If where<cursize-1 Then {
Stock bb(where+1) Keep cursize-where, bb(where)
}
Dim bb(cursize-1) ' bb(0) is an empty array
} Else Return A(1), where:=Group(temp1)
} Else {
A(1)=Array(A(1),where)
again=True
}
} Else Error "No Index Found"
}
Case "Object"
{
If match("S") Then {
Read k$
If Exist(A(1), k$) Then {
If Empty Then {
If .del Then {
Delete A(1) , k$
} else {
Return A(1), k$:=Group(temp1)
}
} Else {
A(1)=Eval(A(1)) ' Eval(inventory_pointer) return object pointer
again=True
}
} else.if .add and not .del Then {
If Empty Then {
Append A(1), k$:=Group(temp1)
} Else Error "No such Tag "+k$
} Else Error "No such Tag "+k$
} Else Error "No Tag Found"
}
End Select
} until not again
}
Value (temp) {
If type$(temp)<>"Group" Then error "Need a group"
If not valid(temp.type$="") Then error "not a proper group"
Dim Base 1, A(1)
A(1)=Group(temp)
Do {
again=false
Select Case A(1).type$
Case "String", "Number", "Null", "Boolean"
Exit
Case "Array"
{
If match("N") Then {
A(1)=Array(A(1), Number)
} Else Error "No Index Found"
again=True
}
Case "Object"
{
If match("S") Then {
If Exist(A(1), Letter$) Then {
A(1)=Eval(A(1)) ' Eval(inventory_pointer) return object pointer
} Else Error "No such Tag"
} Else Error "No Tag Found"
again=True
}
End Select
} until not again
=A(1).str$
}
}
Class:
\ one time definitions
Class CreatSerialize$ {
Private:
usen=0
n=0
nl1$={
}
Function final Jarray$ (json1, n){
\\ json1 is group type Array
A=json1
\\ A is mArray (pointer to Array)
nl$=.nl1$
If .usen>0 Then {
' If n<.space Then n=.space
nl$=nl$+string$(" ", n+.space)
}
document a$
a$="["
If Len(A)>0 Then {
If .usen>0 Then a$=nl$
k=each(A)
M=len(A)-1
while k {
For This {
\\ temporary group
Temp=array(k)
select Case temp.type$
Case "Number", "Null","Boolean", "String"
a$=temp.str$
Case "Array"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jarray$(Temp, nn, "")
}
Case "Object"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jobject$(Temp, nn,"")
}
Else
a$=" "+temp.type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
}
} else If .usen>0 Then a$=.nl1$
If .usen>0 Then a$=string$(" ", n)
a$="]"
=a$+letter$
}
Function final Jobject$ (json1, n){
json=json1
\\ json has to be an object inventory
nl$=.nl1$
If .usen>0 Then {
' If n<.space Then n=.space
nl$=nl$+string$(" ", n+.space)
}
document a$
a$="{"
If .usen>0 Then a$=nl$
k=each(json)
M=len(json)-1
while k {
a$=quote$(eval$(json, k^)) +" : "
select Case json(k^!).type$
Case "Array"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jarray$(eval(k), nn, "")
}
Case "Boolean", "Null", "Number", "String"
a$=json(k^!).str$
Case "Object"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jobject$(eval(k), nn, "")
}
Else
a$=" "+json( k^!).type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
If .usen>0 Then a$=string$(" ", n)
a$="}"
=a$+letter$
}
Class Object {
Private:
Inventory MyValue
Public:
Property Type$ {Value} ="Object"
Value {
=.MyValue
}
Class:
Module final Object (.MyValue) {}
}
Public:
space=10
Value (json, n) {
a$=.nl1$
b$=""
.usen<=n
n--
If n<=0 Then { a$="" : n=0 } Else b$=string$(" ", n)
If type$(json)<>"Group" Then {
If type$(json)="Inventory" Then {
=b$+.Jobject$(.Object(json),n, a$)
} else.if type$(json)="mArray" Then {
=b$+.Jarray$(json, n, a$)
}
} Else {
If json.type$="Object" Then {
=b$+.Jobject$(json, n,a$)
} else.if json.type$="Array" Then {
=b$+.Jarray$(json, n, a$)
}
}
}
}
Module final ParserClass {
\ constructor
\ Let work as Push .CreatSerialize$() : Read .Ser
\ So now Group Ser loaded from CreatSerialize$()
\ Class CreatSerialize$ is a Function final, and because it is after Class:
\ Deleted before ParserClass return Group
Let .Ser=.CreatSerialize$()
}
}
Private:
Class bStream {
Private:
cnt, Buffer A
Public:
Value (&c) {Try {c=eval(.A, .cnt) : .cnt++:=true}}
Class:
Module final bStream (a$){
Buffer .A as Integer*Len(a$)
Return .A, 0:=a$
}
}
Func=Lambda->false
char=0
\\ using obj as pointer to Stack
obj=Stack
Function final IsId {
If .char=34 Then =.IsString(false)
}
Function final IsTrue {
\\ U+0074 U+0072 U+0075 U+0065
If .char=0x74 Then If .func() Then If .char=0x72 Then If .func() Then If .char=0x75 Then If .func() Then If .char=0x65 Then PushIt() : =True
Sub PushIt()
Stack .obj {
Push .Boolean(True)
}
End Sub
}
Function final IsFalse {
\\ U+0066 U+0061 U+006c U+0073 U+0065
If .char=0x66 Then If .func() Then If .char=0x61 Then If .func() Then If .char=0x6c Then If .func() Then If .char=0x73 Then If .func() Then If .char=0x65 Then PushIt() : =True
Sub PushIt()
Stack .obj {
Push .Boolean(False)
}
End Sub
}
Function final IsNull {
\\ U+006E U+0075 U+006C U+006C
If .char=0x6e Then If .func() Then If .char=0x75 Then If .func() Then If .char=0x6c Then If .func() Then If .char=0x6c Then PushIt() : =True
Sub PushIt()
Stack .obj {
Push .Null()
}
End Sub
}
Function final IsSemiCol {
If .char=0x3a Then =true
}
Function final IsComma {
If .char=0x2c Then =true
}
Function final IsObject {
If .char=123 Else exit
inventory objinv
\\ we push object with a pointer to objinv
Stack .obj { Push .Object(objinv)}
.Trim
While .IsId() {
.Trim
If .IsSemiCol() Then {
.Trim
If .IsValue() Then {
Stack .obj {
Shift 2 ' move top as second
' letter$ is ok If top is string, and throw it
Append objinv, Letter$:=Group
}
}
} Else Exit
.Trim
If not .IsComma() Then exit
.Trim
}
If .char=125 Then { =true } Else .obj<=Stack : .func<=lambda->0
}
Function final IsValue {
If .IsString(True) Then {
=True
} Else.if .IsNumber() Then {
=True
} Else.If .IsTrue() Then {
=True
} Else.If .IsFalse() Then {
=True
} Else.If .IsNull() Then {
=True
} Else.if .IsArray() Then {
=True
} Else.if .IsObject() Then {
=True
} Else {
Print "what", .char
Stack .obj { Stack}
.func<=lambda->0
}
}
Function final Digits (private_stack){
While .func() {
Select Case .char
Case 48 to 57
{
=true
Stack private_stack { Data .char}
}
Else
break
End Select
}
}
Function final IsNumber {
a=Stack
Select Case .char
Case 45 ' -
{
oldfunc=.func
Stack a { Data .char}
If .Func() Then {
Select Case .char
Case 48
{
Stack a { Data .char}
If .func() Then {
If .char=46 Then {
Fraction()
Exponent()
}
}
}
Case 49 to 57
{
Stack a { Data .char}
If .Digits(a) Then {}
Fraction()
Exponent()
}
Else
a=stack
End Select
}
}
Case 48 ' 0
{
oldfunc=.func
Stack a { Data .char}
If .func() Then {
If .char=46 Then {
Fraction()
Exponent()
}
}
}
Case 49 to 57
{
oldfunc=.func
Stack a { Data .char}
If .Digits(a) Then {}
Fraction()
Exponent()
}
End Select
If len(a)>0 Then {
b=each(a)
Document D$
While b {
D$=chrcode$(StackItem(b))
}
.func<=oldfunc
If len(D$)>1 Then For i=2 to len(D$) { .Trim}
Stack .obj { Push .Numeric(D$) }
=True
}
' here is an auto exit from function. Sub as command is an exit
Sub Fraction()
If .char=46 Then Stack a { Data .char}
If .Digits(a) Then { }
End Sub
Sub Exponent()
If .char=101 or .char=61 Then {
Stack a { Data .char}
If .func() Then {
If .char=43 or .char=45 Then {
Stack a { Data .char }
If .Digits(a) Else {
a=Stack ' cleat by point to new Stack
}
} Else.If .char>47 and .char<58 Then {
Stack a { Data .char}
If .Digits(a) Then {}
} Else { a=Stack }
}
}
End Sub
}
Function final IsString (as_object){
If .char=34 Else exit
Document D$
While .func() {
If .char=34 Then 2000
If .char=92 Then {
' special care
If .func() Then {
Select Case .Char
Case 117 'u
GetHex()
Case 114 ' r
.char<=0x0d
Case 110 ' n
.char<=0x0a
Case 116 ' t
.char<=0x09
Case 98 ' b
.char<=0x08
Case 102 ' f
.char<=0x0c
Case 0x22, 0x2f , 0x5c
rem ' need a line always - revision 4
Else
Exit ' not normal
End Select
}
}
D$=chrcode$(.char)
}
Exit
2000 Stack .obj {
If as_object Then {Push .JString$(D$)} Else Push D$
} : =True
Sub GetHex()
Local D$
Document D$="0x"
For i=1 to 4 {
If .func() Then {
\\ Chrcode$() - was an error here in previous code as Chrcode()
If Chrcode$(.char) ~ "[0123456789ABCDEFabcdef]" Then {
D$=Chrcode$(.char)
} Else 3000
}
}
If i<>5 Then 3000
.Char<=Eval(D$)
3000 End Sub
}
Function final IsArray {
If .char=91 Else exit
Dim Gr()
' We place a pointer ro Array
.Trim
If .char=93 Then =true : Stack .obj { Push .Arr(Gr())} : exit
While .IsValue() {
Stack .obj {
Dim Gr(Len(Gr())+1)
Gr(len(Gr())-1)=Group
}
.Trim
If not .IsComma() Then exit
.Trim
}
' Push later pointer to array (maybe altered in redimension)
If .char=93 Then { =true : Stack .obj { Push .Arr(Gr())} } Else .Func<=lambda->false
}
Module final Trim {
While .func() {
If .char<33 or .char=160 Else exit
}
}
Function final IsContainer {
.Trim
Select Case chrcode$(.char)
Case "{"
=.IsObject()
Case "["
=.IsArray()
end select
}
' merge a foreign group here
Module final ReadArrayItem (temp, object){
Select Case temp.type$
Case "String","Boolean","Number", "Null"
{
If object Then Error "No object "+quote$(temp.type$)
Push temp.str$
}
Case "Object"
{
If not Empty Then {
Call .ReadObject temp, object, letter$
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
Case "Array"
{
If not Empty Then {
' recursion only with Call statement for modules
Call .ReadArrayItem, Array(temp, number), object
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
End Select
}
Module final ReadObject (json, object){
If type$(json)="Inventory" Then {
If exist(json, Letter$) Then {
temp=eval(json)
} Else {
push "none"
Break ' exit Module final (Break do something Else in Select End Select)
}
} Else temp=json
Select Case temp.type$
Case "String","Boolean","Number", "Null"
{
If object Then Error "No object "+quote$(temp.type$)
Push temp.str$
}
Case "Object"
{
If not Empty Then {
Call .ReadObject temp, object
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
Case "Array"
{
If not Empty Then {
Call .ReadArrayItem array(temp, number), object
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
End Select
}
Module final Worker (object){
If match("IN") Or match("IS") Then { ' inventory & number or inventory and string
' maybe we have more items in Stack
Push object : ShiftBack 2
.ReadObject
} Else {
read Temp ' get a group which returns Iventoty or an mArray
If Type$(Temp)="mArray" Then {
If not Empty Then {
Call .ReadArrayItem, Array(Temp, number), object
} Else {
If object Then Push Temp : exit
Push .ser$(Temp,0)
}
} Else {
If not Empty Then {
Call .ReadObject Temp, object
} Else {
If not Empty Then {
Call .ReadObject Temp, object
} Else {
If object Then Push Temp : exit
If Type$(Temp)="Inventory" Then {
Push .ser$(.Object(Temp),0)
} Else {
Push .ser$(group(Temp),0)
}
}
}
}
}
}
Public:
\\ This is the Public part
\\ First we set Public some class for later use
\\ Using Pointer to Array in Class Arr
Class Arr {
Private:
MyValue
Public:
Property Type$ {Value} ="Array"
Value {
=.MyValue
}
Class:
Module final Arr (.MyValue) {}
}
Class Null {
Property Type$ {Value} ="Null"
Property Str$ {Value}="null"
Value { =0}
}
Class JString$ {
Private:
MyValue$=""
Public:
Property Type$ {Value} ="String"
Property Str$ {
Value{
Link parent MyValue$ to MyValue$
value$=quote$(string$(MyValue$ as json))
}
}
Value {
=.MyValue$
}
Class:
Module final JString (.MyValue$) {}
}
Class Numeric {
Private:
MyValue$=""
Public:
Property Type$ {Value} ="Number"
Property Str$ {
Value{
Link parent MyValue$ to MyValue$
value$=MyValue$
}
}
Value {
=Val(.MyValue$)
}
Class:
Module final Numeric {
If match("S") Then {
Read .MyValue$
} Else {
\\ using locale 1033 for dot always
.Myvalue$<=trim$(str$(Number, 1033))
}
}
}
Class Boolean {
Private:
MyValue=false
Public:
Property Type$ {Value} ="Boolean"
Property Str$ {
Value{
Link parent MyValue to MyValue
If MyValue Then {
value$="true"
} Else value$="false"
}
}
Value {
=.MyValue
}
Class:
Module final Boolean (.MyValue) {}
}
Class Object {
Private:
Inventory MyValue
Public:
Property Type$ {Value} ="Object"
Value {
=.MyValue
}
Class:
Module final Object (.MyValue) {}
}
\\ Empty group, with $, so we get two vars, Ser and Ser$ ( Ser$ we want to return a value type String)
Group Ser$
Module final SetSpace (.ser.space) { ' set space for values - 6 by default
}
Function final UseDecimalPoint$ {
' use this to change standard decimal point to local decimal point character
=str$(val(letter$),"")
}
Function final ReadNumber$ {
.Worker false 'modules get caller Stack
=.UseDecimalPoint$( Letter$)
}
Function final ReadAnyString$ {
\\ read an inventory
.Worker false
=Letter$
}
Function final ReadAny {
\\ read an inventory
.Worker true
Read A
=A
}
Function final Eval {
' Letter$ pop a string from Stack Else give error
.func<=Lambda z=.bStream(Letter$) -> {
link .char to c
' we can't pass reference in a private member
=z(&c)
}
' In this Parser we use a dedicated Stack
' for use from recuirsive memberts
' .obj is a pointer to Stack
' we can delete it simply setting a new Stack
' .obj<=Stack
' or we can flush all elements Using a command Flush
' .obj, char and .func() are visible from group members
' test
Stack .obj { Flush}
.char<=0
If .IsContainer() Then {
' we get the pointer
=StackItem(.obj)
.obj<=Stack
} Else {
' return an Empty object
inventory emptinv
=.Object(emptinv)
}
}
Group StringValue$ {
Add=false
Del=false
Set (temp) {
' always first read is for the assigned value to Group
Read temp1
If type$(temp)<>"Group" Then error "Need a group"
If not valid(temp.type$="") Then error "not a proper group"
If not valid(temp1.type$="") Then error "not a proper group for value"
' because Null() is out of this scope we have to link
Link parent Null() to MyNull()
Null=MyNull()
Dim Base 1, A(1)
\\ now we get the second interface for arrays
\\ bb() has a reference to b (one reference allowed)
\\ but b is pointer to array and can change to point to other arrrays
\\ we need this to perform some tasks which belong to standard arrray interface
b=(,) : Link b to bb()
A(1)=Group(temp)
Do {
again=false
Select Case A(1).type$
Case "Array"
{
If match("N") Then {
Read where
If len(A(1))<=where and Empty Then {
' only the last array we can redimension
If .add and not .del Then {
cursize=Len(A(1))
b=A(1) ' A(1) has a pointer so now b has the same pointer
' dim preserve values
Dim bb(where+1) ' need one more because all "automatic arrays" have base 0
Stock bb(cursize) sweep Len(b)-cursize, Group(Null)
} Else Error "Index out of limits"+str$(where)
} Else If where<0 Then Error "Index out of limits "+str$(where)
If Empty Then {
If .del Then {
cursize=Len(A(1))
b=A(1) ' A(1) has a pointer so now b has the same pointer
If where<cursize-1 Then {
Stock bb(where+1) Keep cursize-where, bb(where)
}
Dim bb(cursize-1) ' bb(0) is an empty array
} Else Return A(1), where:=Group(temp1)
} Else {
A(1)=Array(A(1),where)
again=True
}
} Else Error "No Index Found"
}
Case "Object"
{
If match("S") Then {
Read k$
If Exist(A(1), k$) Then {
If Empty Then {
If .del Then {
Delete A(1) , k$
} else {
Return A(1), k$:=Group(temp1)
}
} Else {
A(1)=Eval(A(1)) ' Eval(inventory_pointer) return object pointer
again=True
}
} else.if .add and not .del Then {
If Empty Then {
Append A(1), k$:=Group(temp1)
} Else Error "No such Tag "+k$
} Else Error "No such Tag "+k$
} Else Error "No Tag Found"
}
End Select
} until not again
}
Value (temp) {
If type$(temp)<>"Group" Then error "Need a group"
If not valid(temp.type$="") Then error "not a proper group"
Dim Base 1, A(1)
A(1)=Group(temp)
Do {
again=false
Select Case A(1).type$
Case "String", "Number", "Null", "Boolean"
Exit
Case "Array"
{
If match("N") Then {
A(1)=Array(A(1), Number)
} Else Error "No Index Found"
again=True
}
Case "Object"
{
If match("S") Then {
If Exist(A(1), Letter$) Then {
A(1)=Eval(A(1)) ' Eval(inventory_pointer) return object pointer
} Else Error "No such Tag"
} Else Error "No Tag Found"
again=True
}
End Select
} until not again
=A(1).str$
}
}
Class:
\ one time definitions
Class CreatSerialize$ {
Private:
usen=0
n=0
nl1$={
}
Function final Jarray$ (json1, n){
\\ json1 is group type Array
A=json1
\\ A is mArray (pointer to Array)
nl$=.nl1$
If .usen>0 Then {
' If n<.space Then n=.space
nl$=nl$+string$(" ", n+.space)
}
document a$
a$="["
If Len(A)>0 Then {
If .usen>0 Then a$=nl$
k=each(A)
M=len(A)-1
while k {
For This {
\\ temporary group
Temp=array(k)
select Case temp.type$
Case "Number", "Null","Boolean", "String"
a$=temp.str$
Case "Array"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jarray$(Temp, nn, "")
}
Case "Object"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jobject$(Temp, nn,"")
}
Else
a$=" "+temp.type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
}
} else If .usen>0 Then a$=.nl1$
If .usen>0 Then a$=string$(" ", n)
a$="]"
=a$+letter$
}
Function final Jobject$ (json1, n){
json=json1
\\ json has to be an object inventory
nl$=.nl1$
If .usen>0 Then {
' If n<.space Then n=.space
nl$=nl$+string$(" ", n+.space)
}
document a$
a$="{"
If .usen>0 Then a$=nl$
k=each(json)
M=len(json)-1
while k {
a$=quote$(eval$(json, k^)) +" : "
select Case json(k^!).type$
Case "Array"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jarray$(eval(k), nn, "")
}
Case "Boolean", "Null", "Number", "String"
a$=json(k^!).str$
Case "Object"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jobject$(eval(k), nn, "")
}
Else
a$=" "+json( k^!).type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
If .usen>0 Then a$=string$(" ", n)
a$="}"
=a$+letter$
}
Class Object {
Private:
Inventory MyValue
Public:
Property Type$ {Value} ="Object"
Value {
=.MyValue
}
Class:
Module final Object (.MyValue) {}
}
Public:
space=10
Value (json, n) {
a$=.nl1$
b$=""
.usen<=n
n--
If n<=0 Then { a$="" : n=0 } Else b$=string$(" ", n)
If type$(json)<>"Group" Then {
If type$(json)="Inventory" Then {
=b$+.Jobject$(.Object(json),n, a$)
} else.if type$(json)="mArray" Then {
=b$+.Jarray$(json, n, a$)
}
} Else {
If json.type$="Object" Then {
=b$+.Jobject$(json, n,a$)
} else.if json.type$="Array" Then {
=b$+.Jarray$(json, n, a$)
}
}
}
}
Module final ParserClass {
\ constructor
\ Let work as Push .CreatSerialize$() : Read .Ser
\ So now Group Ser loaded from CreatSerialize$()
\ Class CreatSerialize$ is a Function final, and because it is after Class:
\ Deleted before ParserClass return Group
Let .Ser=.CreatSerialize$()
}
}
Parser=ParserClass()
Modules ? \\ Display the name of module and public parts of Parser
Document json$
' We can load from file
'Load.Doc json$, "alfa.json"
json$={{
"alfa":-0.11221e+12,
"array" : [
-0.67,
"alfa1",
[
10,
20
],
"beta1",
1.21e12,
[
],
21.12145,
"ok"
],
"delta": false, "epsilon" : true, "Null Value" : null
}}
Save.Doc json$, "json2.json" \\ by default in Utf-8 with BOM
' just show multiline text
Report json$
\ so now we get text to a new object
alfa=Parser.Eval(json$)
Print Type$(alfa) ' it is a group
Print "alfa.type$=";alfa.type$ \\ this is a read only property
Report "as one line"
Report Parser.Ser$(alfa, 0)
Report "as multiline"
Report Parser.Ser$(alfa, 1)
Print "Using Print"
Print Parser.ReadAnyString$(alfa)
Print "Value for alfa, id alfa"
Print Parser.ReadAnyString$(alfa,"alfa")
Report "as multiline"
\\ here a string returned from Parser.ReadAnyString$(alfa,"array", 2)
\\ Then a group returned ftom Parser.Eval()
\\ Then string returned from that group.
\\ We get specific 0
Report Parser.Ser$(Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2)), 1)
' We get a copy of array
Alfa3=Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2))
Dim B()
B()=Alfa3
N=each(B())
While N {
Print B(N^)
}
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου
You can feel free to write any suggestion, or idea on the subject.