Δευτέρα 26 Ιουνίου 2017

Αναθεώρηση 11 (Έκδοση 8.8)

Μερκά 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)

 
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$()
      }
}



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.