'****************************************************************************
Option Explicit

Private Declare Sub Db_init Lib "dbd.dll" ()
Private Declare Function Db_FileSpec_set_r& Lib "dbd.dll" (ByVal fileSpec$)
Private Declare Function Db_File_exists_b& Lib "dbd.dll" ()

Private Declare Function Db_File_create_r& Lib "dbd.dll" (ByVal sizeInInts&)
Private Declare Function Db_File_open_r& Lib "dbd.dll" ()

Private Declare Sub Db_File_save Lib "dbd.dll" ()
Private Declare Function Db_File_close_r& Lib "dbd.dll" (ByVal sizeInInts&)

Private Declare Sub Db_FileSpecDef_get_r Lib "dbd.dll" (ByVal sFileSpec_r$, ByVal strSz&)
Private Declare Sub Db_FileSpec_get_r Lib "dbd.dll" (ByVal sFileSpec_r$, ByVal strSz&)

Private Declare Function Db_MemSize_get Lib "dbd.dll" ()
Private Declare Function Db_MemSizeAvail_get Lib "dbd.dll" ()
Private Declare Function Db_MemSizeAvail_b Lib "dbd.dll" (ByVal szWanted&)
Private Declare Function Db_Mem_isLow_b Lib "dbd.dll" ()
Private Declare Function Db_Version_get& Lib "dbd.dll" ()
Private Declare Function Db_Mem_defrag_r& Lib "dbd.dll" ()
Private Declare Function Db_verify_r& Lib "dbd.dll" ()

Private Declare Function N_create& Lib "dbd.dll" (ByVal pSrc&, ByVal pGate&)

Private Declare Function Xp_Node& Lib "dbd.dll" (ByVal pN&, ByRef p&)
Private Declare Function Xp_S_getSVO& Lib "dbd.dll" (ByVal eS&, ByRef p&)


Private Declare Function N_SV_get& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal x&)
Private Declare Function N_SV_getElseCreate& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal x&)
Private Declare Function N_SV_getSVO& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal x&)
Private Declare Function N_SV_getO& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal x&)
Private Declare Function N_SVO_get_y& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal eO&, ByRef p&, ByVal x&)
Private Declare Function N_SVO_get& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObj&, ByVal x&)
Private Declare Function N_SVO_set_y& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal eO&, ByRef p&)
Private Declare Function N_SVO_set& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObj&)
Private Declare Function N_SVO_set_wRR_y& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal eO&, ByRef p&)
Private Declare Function N_SVO_set_wRR& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObj&)
Private Declare Function N_VO_getSVO& Lib "dbd.dll" (ByVal pVb&, ByVal pObj&, ByVal x&)
Private Declare Function N_VO_getS& Lib "dbd.dll" (ByVal pVb&, ByVal pObj&, ByVal x&)
Private Declare Function N_O_getSVO& Lib "dbd.dll" (ByVal pObj&, ByVal x&)
Private Declare Function N_O_getS& Lib "dbd.dll" (ByVal pObj&, ByVal x&)
Private Declare Function N_SVO_getElem& Lib "dbd.dll" (ByVal pN&, ByVal seqElem&)
Private Declare Function N_SVO_getRecip Lib "dbd.dll" (ByVal pN&)
Private Declare Function N_SVO_getSymm& Lib "dbd.dll" (ByVal pN&)
Private Declare Function N_Vb_getRecip& Lib "dbd.dll" (ByVal pVb&)

Private Declare Function N_Elem_change_r& Lib "dbd.dll" (ByVal pN&, ByVal pElemNew&)
Private Declare Function N_SV_changeO& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObjOld&, ByVal pObjNew&)
Private Declare Function N_ClsInst_getSVO& Lib "dbd.dll" (ByVal pCls&, ByVal pInstNameStr&, ByVal create_b As Boolean)
Private Declare Function N_ClsInst_get& Lib "dbd.dll" (ByVal pCls&, ByVal pInstNameStr&, ByVal create_b As Boolean)
Private Declare Function N_EA_getV& Lib "dbd.dll" (ByVal pEn&, ByVal pAttrib&, ByRef pQ, ByRef p, ByVal searchCls_b As Boolean)
Private Declare Function N_EA_setV_wAStr& Lib "dbd.dll" (ByVal pEn&, ByVal pAttrib&, ByVal sVal$, ByVal replace_b As Boolean)

Private Declare Function N_delete& Lib "dbd.dll" (ByVal pN&)

Private Declare Function AStr_getStr& Lib "dbd.dll" (ByVal str$, ByVal create_b As Boolean)
Private Declare Function AStr_getNamed& Lib "dbd.dll" (ByVal str$)
Private Declare Sub N_Name_getEx Lib "dbd.dll" (ByVal pN&, ByVal str_r$, ByVal strSz&, ByVal fullName_b As Boolean, ByVal addParen_b As Boolean, ByVal ignMnCls_b As Boolean, ByVal Ign1&, ByVal pIgn2&)
Private Declare Sub N_Name_get Lib "dbd.dll" (ByVal pN&, ByVal str_r$, ByVal strSz&)

Private Declare Function Xp_compile& Lib "dbd.dll" (ByVal str$)
Private Declare Function Xp_execute& Lib "dbd.dll" (ByVal pE&)
Private Declare Function Xp_process_r& Lib "dbd.dll" (ByVal expr$)

'This function trims strings returned by DLL
Private Function TrimStr$(str$)
  TrimStr$ = Left(str$, InStr(str$, Chr(0)) - 1)
End Function

'This code manages dynamic data structures via dbd
Private Sub Form_Load()
  Const kDbSzDef_g = 256000
  Dim errCode&
  
  Db_init
  errCode& = Db_FileSpec_set_r("Db1.dbd")
  If (False = Db_File_exists_b) Then
    '****************************************
    '* This code is executed during 1st run *

    'Create db file
      errCode = Db_File_create_r(kDbSzDef_g)

    'Open db file
      errCode = Db_File_open_r()

    'Create gender
      Xp_process_r ("(new 'gender)")

    'Create a person named john and set his gender to male
      Xp_process_r ("(new 'john 'person)")
      Xp_process_r ("(set+ john gender 'male)")

    'Create a person named mary and set her gender to female
      Xp_process_r ("(new 'mary 'person)")
      Xp_process_r ("(set+ mary gender 'female)")
  Else
    'Open db file
      errCode = Db_File_open_r()

    'If bob is missing in db
      Dim pBob&: pBob& = AStr_getNamed("bob")
      If (0 = pBob) Then
        '*******************************************
        '* This is code is executed during 2nd run *

        'Create age,
          Xp_process_r ("(new 'age)")

        'Create a person named bob
        'Set his gender to male and age to 35
          Xp_process_r ("(new 'bob 'person)")
          Xp_process_r ("(set+ bob gender 'male)")
          Xp_process_r ("(set+ bob age '35)")

        'Set john's age to 30
          Xp_process_r ("(set+ john age '30)")

        'Get all person that are male
        'Following prints john and bob
          Dim pQry&
          pQry& = Xp_compile("(and (get person instance *) (get * gender male))")
          Dim pPersonX&: pPersonX& = Xp_execute(pQry&)
          Do While (pPersonX&)
            Const strSz = 255
            Dim sName$: sName$ = Space(strSz)
            Call N_Name_get(pPersonX&, sName$, strSz)
            sName$ = TrimStr$(sName$)
            Debug.Print sName
              
            pPersonX& = Xp_execute(pQry&)
          Loop
      Else
          Dim pBuild&: pBuild& = AStr_getNamed&("build")
          If (0 = pBuild) Then
            '*******************************************
            '* This is code is executed during 3nd run *

            'Create body build
              Xp_process_r ("(new 'build)")

            'Set bob's build to tall
              Xp_process_r ("(set+ bob build 'tall)")

            'Set mary's build to thin and petite
              Xp_process_r ("(set+ mary build 'thin)")
              Xp_process_r ("(set+ mary build 'petite)")
          Else
            Dim pSue&: pSue& = AStr_getNamed("sue")
            If (0 = pSue) Then
              '*******************************************
              '* This is code is executed during 4th run *
              'It uses low-level methods

              'Create a person named sue
                pSue& = N_create(0, 0)
                Dim pPerson&: pPerson& = AStr_getNamed("person")
                Dim pInst_g&: pInst_g& = AStr_getNamed("instance")
                Call N_SVO_set(pPerson&, pInst_g&, pSue&)
                Dim pStrSue&: pStrSue& = AStr_getStr("sue", True)
                Dim pName_g&: pName_g& = AStr_getNamed("name")
                Call N_SVO_set(pSue&, pName_g&, pStrSue&)

              'Set sue's gender to female
                Dim pGender&: pGender& = AStr_getNamed("gender")
                Dim pFemale&: pFemale& = AStr_getNamed("female")
                Call N_SVO_set(pSue&, pGender&, pFemale&)

              'Set sue's age to 21
                Dim pAge&: pAge& = AStr_getNamed("age")
                Dim pStr21&: pStr21& = AStr_getStr("21", True)
                Dim pAge21&: pAge21& = N_ClsInst_get(pAge&, pStr21&, True)
                Call N_SVO_set(pSue&, pAge&, pAge21&)

              'Set sue's build to fat and short
                Call N_EA_setV_wAStr(pSue&, pBuild&, "fat", False)
                Call N_EA_setV_wAStr(pSue&, pBuild&, "short", False)

              'Change john's age from 30 to 40
                Dim pJohn&: pJohn& = AStr_getNamed("john")
                Dim pStr30&: pStr30& = AStr_getStr("30", True)
                Dim pAge30&: pAge30& = N_ClsInst_get(pAge&, pStr30&, True)
                Dim pStr40&: pStr40& = AStr_getStr("40", True)
                Dim pAge40&: pAge40& = N_ClsInst_get(pAge&, pStr40&, True)
                Call N_SV_changeO(pJohn&, pAge&, pAge30&, pAge40&)

              'Delete mary's build is thin
                Dim pMary&: pMary& = AStr_getNamed("mary")
                Dim pThin&: pThin& = AStr_getNamed("thin")
                Dim pSVO&: pSVO& = N_SVO_get(pMary&, pBuild&, pThin&, 1)
                N_delete (pSVO&)
            End If
          End If
      End If
  End If
  
  
  '********************************************
  '* This is code is executed during all runs *
  'Print each person's attributes and values

  'During 1st run, prints:
  '  john gender male
  '  mary gender female
  
  'During 2nd run, prints:
  '  john gender male
  '  john age 30
  '  mary gender female
  '  bob gender male
  '  bob age 35

  'During 3rd run, prints:
  '  john gender male
  '  john age 30
  '  mary gender female
  '  mary build thin
  '  mary build petite
  '  bob gender male
  '  bob age 35
  '  bob build tall

  'During 4th run, prints:
  '  john gender male
  '  john age 40
  '  mary gender female
  '  mary build petite
  '  bob gender male
  '  bob age 35
  '  bob build tall
  '  sue gender female
  '  sue age 21
  '  sue build fat
  '  sue build short

    pName_g& = AStr_getNamed("name")
    pQry& = Xp_compile("(get person instance *)")
    Dim pPtX&: pPtX& = Xp_execute(pQry&)
    Do While (pPtX&)
      Dim pA&(256)
      Dim p&: p& = VarPtr(pA(0))
      Dim eS&: eS& = Xp_Node(pPtX, p&)
      Dim eSVO&: eSVO& = Xp_S_getSVO(eS, p&)
      pSVO& = Xp_execute(eSVO&)
      Do While (pSVO&)
        Dim pSub&: pSub& = N_SVO_getElem(pSVO&, 0)
        Dim pVb&: pVb& = N_SVO_getElem(pSVO&, 1)
        Dim pObj&: pObj& = N_SVO_getElem(pSVO&, 2)
        If (pVb& <> pName_g&) Then
          'Print "person attribute value"
            Dim sEntity$: sEntity$ = Space$(strSz)
            Call N_Name_get(pSub, sEntity$, strSz)
            sEntity$ = TrimStr$(sEntity$)

            Dim sProp$: sProp$ = Space$(strSz)
            Call N_Name_get(pVb&, sProp$, strSz)
            sProp$ = TrimStr$(sProp$)

            Dim sVal$: sVal$ = Space$(strSz)
            Call N_Name_get(pObj&, sVal$, strSz)
            sVal$ = TrimStr$(sVal$)

            Debug.Print sEntity$, sProp, sVal
        End If
        
        pSVO = Xp_execute(eSVO)
        
      Loop
      
      pPtX& = Xp_execute(pQry&)
    Loop


  Db_File_save
  Db_File_close_r (0)
  
End Sub
'****************************************************************************