( dbl Micro )

needs module: modules

api: DmNextOpenDatabase
api: DmNextOpenResDatabase
api: DmOpenDatabaseInfo
api: DmDatabaseInfo
api: DmGetNextDatabaseByTypeCreator

: OpenDatabaseID_old ( dbOR -- ID )
>r 0 sp@ >abs r> swap 0 0 0 0
DmOpenDatabaseInfo throw
;

variable OpenDatabaseID_cardNo
variable OpenDatabaseID_localID
: OpenDatabaseID ( dbOR -- cardNo ID )
OpenDatabaseID_localID >abs
0 0
OpenDatabaseID_cardNo >abs
0
DmOpenDatabaseInfo throw
OpenDatabaseID_cardNo w@
OpenDatabaseID_localID @ ;

create dbName 34 allot
api: StrLen
: DatabaseName
( cardNo ID -- addr u )
	dbName >abs
	0 0 0 0 0 0 0 0 0 0
	DmDatabaseInfo throw
	dbName dup >abs StrLen ;

: .OpenDB
	cr
	dup .
	OpenDatabaseID
	DatabaseName type ;

: EnumOpenDatabases ( xt -- f )
\ xt ( dbOR -- exit )
\ f = prior exit
	>r 0 >r
	begin 
		r> DmNextOpenDatabase
	dup while
		r@ over >r execute
	?dup until rdrop then rdrop ;
: EnumOpenResDatabases
\ xt ( dbOR -- exit )
\ f = prior exit
	>r 0 >r
	begin
		r>
		DmNextOpenResDatabase
	dup while
		r@ over >r execute
	?dup until rdrop then rdrop ;
:noname .OpenDB false ;
: .dbl literal EnumOpenDatabases
	drop ;
:noname .OpenDB false ;
: .rdbl literal EnumOpenResDatabases
	drop ;

module: _
create stateInfo 32 allot
variable cardNo
variable dbID
0 value type
0 value creator
: search ( newSearch -- err )
	stateInfo >abs
	type creator false
	cardNo >abs
	dbID >abs
DmGetNextDatabaseByTypeCreator ;
;module
: EnumDatabasesByTypeCreator
( xt type creator -- f )
\ xt ( cardNo dbID -- exit )
\ f = prior exit
	{{ _ to creator to type }}
	>r
	true >r
	begin
		r> {{ _ search }} 0= dup
	while drop
		{{ _ cardNo }} @
		{{ _ dbID }} @
		r@ execute
		false >r
	?dup until rdrop then rdrop ;
:noname
( addr u cardNo id -- addr u false )
( addr u cardNo id -- cardNo id true )
	2dup 2>r
	DatabaseName
	2over compare if
		rdrop rdrop false
	else
		2drop 2r> true
	then ;
: FindDB
( addr u type crID -- cardNo id true )
( addr u type crID -- false )
	literal -rot
	EnumDatabasesByTypeCreator
	dup 0= if
		nip nip then ;

:noname
( n cardNo dbID -- n+1 false )
	2drop 1+ false ;
: DatabasesNumberByTypeCreator
( type crID -- n )
	0 literal 2swap
	EnumDatabasesByTypeCreator
	drop ;

:noname
( ^dbList cardNo id -- ^dbList1 false )
	DatabaseName
	heap-copy >abs over !
	cell+ false ;
: DatabasesListByTypeCreator
( type crID -- addr n )
	2dup 2>r literal >r
DatabasesNumberByTypeCreator
	?dup if
		dup cells allocate throw
		dup r> 2r>
EnumDatabasesByTypeCreator
		drop drop swap
	else
		rdrop rdrop rdrop 0 0
	then ;

\eof
api: DmOpenDatabase
api: DmCloseDatabase

:noname
	r/o DmOpenDatabase
	dup .OpenDB
	DmCloseDatabase throw
	true
; 'DATA' 'MCNO' EnumDatabasesByTypeCreator cr .