\ memo
needs core-ext
needs toolkit
needs zstrings
needs ids
needs DataMgr
ID DATA ID memo
2variable _MemoDBR
: MemoDBR _MemoDBR 2@ ;
variable index
: OpenMemoDB ( -- )
dmModeReadWrite memo DATA DmOpenDatabaseByTypeCreator
2dup or 0= throw _MemoDBR 2! ;
: CloseMemoDB ( -- )
MemoDBR DmCloseDatabase throw ;
: WriteNewMemo ( zstring length -- )
0 index ! 1+ s>d 2dup index >abs
MemoDBR ( len. &index. DBR. )
DmNewRecord ( handle. )
MemHandleLock 2>r ( R: pointer. )
rot >abs 0. 2r@
( length. &data. offset. DBR. )
DmWrite throw
2r> MemPtrUnlock throw
true index @ MemoDBR DmReleaseRecord throw ;
: testdata z" One test memo." ;
: testdata1 z" Another test memo..." ;
: test
OpenMemoDB
testdata WriteNewMemo
testdata1 WriteNewMemo
CloseMemoDB ;
create buffer 40 allot
: t bounds ?do i c@ dup bl <
if drop unloop cr exit then
emit loop cr ;
: dir
OpenMemoDB
MemoDBR DmNumRecords
1- 0 ?do
i MemoDBR DmQueryRecord
2dup MemHandleSize drop .
MemHandleLock 2dup
40. 2swap buffer >abs MemMove drop
buffer 40 t
MemPtrUnlock drop
0 i MemoDBR DmReleaseRecord drop
loop
CloseMemoDB .s ;