VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Parser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Klasa Parser
Implements Command
Private stk As Stack
Private actionList As Collection
Private dat As data
Private ptable As ListBox
Private chn As InterpChain
    
Public Sub init(ByVal line As String, k As KidData, ByVal pt As ListBox)
  Set stk = New Stack
  setData k, pt
  
  Set actionList = New Collection 'Umieszczaj tu akcje
  buildStack line                 'Utwórz stos tokenów
  buildChain                      'Oraz łańcuch interpretera
End Sub
'----------------------------------------
Private Sub buildStack(ByVal line As String)
  'Wyodrębnij tokeny i utwórz stos
  Dim tok As New Tokenizer
  tok.init line
  On Local Error GoTo nulltok
  While (tok.hasMoreElements())
    Dim token As ParseObject
    Set token = tokenize(tok.nextToken())
    token.init                    'wymusza błąd gdy Null
    stk.push token
nulltokres:
  Wend
  Exit Sub
nulltok:
  Resume nulltokres               'Pomiń jeśli null
End Sub
'----------------------------------------
Private Sub buildChain()
  Dim vv As VarVarParse, chn1 As InterpChain
  'Konstruuje łańcuch klas
  'Dla interpretera prostego języka
  Set vv = New VarVarParse
  vv.init stk
  Set chn = vv
  Dim vmvp As New VarMultVarParse
  vmvp.init stk
  chn.addToChain vmvp
        
  Dim mvvp As New MultVarVarParse
  mvvp.init stk
  Set chn1 = vmvp
  chn1.addToChain mvvp
        
  Dim vrvp As New VerbMultVarParse
  vrvp.init stk
  Set chn1 = mvvp
  chn1.addToChain vrvp
      
  Dim vvp As New VerbVarParse
  vvp.init stk
  Set chn1 = vrvp
  chn1.addToChain vvp
        
  Dim va As New VerbAction
  va.init actionList, stk
  Set chn1 = vvp
  chn1.addToChain va
End Sub
'----------------------------------------
Public Sub setData(k As KidData, ByVal pt As ListBox)
  Set dat = New data
  dat.init k.getData()
  Set ptable = pt
End Sub
'--------------------------------------
Public Function tokenize(ByVal s As String) As ParseObject
  Dim obj As ParseObject
  Dim typ As Integer
  Set obj = getVerb(s)
  On Local Error GoTo nullobj
  typ = obj.getType               'Spowoduje wyjątek związany z wartością null
exittok:
  'Set obj = getVar(s)
  Set tokenize = obj
  Exit Function
nullobj:
  Set obj = getVar(s)
  Resume exittok
End Function
'----------------------------------------
Private Function getVerb(ByVal s As String) As ParseObject
  Dim v As New ParseVerb
  v.init s ', dat, ptable
  If (v.isLegal()) Then
    Set getVerb = v.getVerb(s)
  Else
    Set getVerb = Nothing
  End If
End Function
'----------------------------------------
Private Function getVar(ByVal s As String) As ParseVar
  Dim v As New ParseVar
  v.init (s)
  If (v.isLegal()) Then
    Set getVar = v
  End If
End Function
    
Private Sub Command_Execute()
  Dim i As Integer
  Dim cmd As Command
  'Redukuj stos aż będzie pusty
  'I twórz listę akcji
  While (stk.hasMoreElements())
    chn.sendToChain stk
  Wend
  'Wykonaj polecenia z listy akcji
  For i = 1 To actionList.Count
    Dim v As ParseObject
    Set v = actionList(i)
    v.setData dat, ptable
    Set cmd = v
    cmd.Execute
  Next i
End Sub
