I am in the process of rewriting this code using memory banks from IanM's dll.
It works when you write a new file (it isn't much faster though) but doesn't when trying to add text to an already existant file.
I get an unhandled error:
It's probably just my fault but i haven't found what causes this yet.
here's the code:
SYNC ON
HIDE MOUSE
dir$="C:\Program Files\The Game Creators\Dark Basic Professional\Codebase\"
SET DIR dir$
TYPE ToWrite
pos as integer
wstr as string
ENDTYPE
rem create empty text buffer
global dim wbuffer() as ToWrite
`fill buffer with random letters
DATA "A","C","F","G","L","N","S"
nb=7
dim dat$(6)
FOR t=0 TO 6
READ dat$(t)
NEXT t
dim nbs(26) as boolean
FOR t=1 to nb
remstart
REPEAT
i= RND(25)+1
UNTIL nbs(i)=0
nbs(i)=1
remend
rem u$=CHR$(64+i)
u$=dat$(t-1)
ARRAY INSERT AT BOTTOM wbuffer()
`get the new array pointer each time
BfPtr=get array ptr(wbuffer())
AddStringToBuffer(BfPtr,u$,ASC(u$)-64)
rem AddStringToBuffer(BfPtr,u$,t)
NEXT t
rem DELETE FILE "tmp.txt"
rem if you change 0 to 1 here, you won't get any error
WriteTxtFile(BfPtr,"tmp.txt",0)
`Clear buffer
EMPTY ARRAY wbuffer()
`Delete buffer
undim wbuffer()
EXECUTE FILE "tmp.txt","",dir$ : END
`use this function first to add to the "buffer" i.e a list of what's to be written and where
`arguments are: (array pointer,text string,line number)
` you need to place ARRAY INSERT AT BOTTOM arrayname() before calling
`this command!
`nb: it is possible to use several buffers at a time
FUNCTION AddStringToBuffer(ArrayPtr as dword,Write$,Pos)
dim b() as ToWrite
link array to pointer b(), ArrayPtr
c=ARRAY COUNT(b())
b(c).wstr=Write$
b(c).pos=Pos
unlink array pointer b()
undim b()
ENDFUNCTION
FUNCTION WriteTxtFile(ArrayPtr as dword,File$,overwrite as boolean)
dim b() as ToWrite
local i=-1,c_pos,old_c_pos,maxpos,Lines,j,k,c,bksize,bankpos,maxline,bk2size
link array to pointer b(), ArrayPtr
IF NOT File Exist(File$) THEN overwrite=1
c=ARRAY COUNT(b())
SORT ARRAYPTR ArrayPtr
maxpos=b(c).pos
bank1=FIND FREE BANK()
IF NOT overwrite
Temp$="Temp.dat"
bank2=FIND FREE BANK()
MAKE BANK FROM FILE bank2,File$
bk2size=GET BANK SIZE(bank2)
Lines=CountLinesInFile(bank2)
ENDIF
rem work out the size of the bank that will contain the text file
rem by adding the lengths of the different lines
FOR j=0 TO c
INC bksize,fast len(b(j).wstr)
NEXT j
rem and add the number of bytes necessary to seperate lines
maxline=max(maxpos,Lines)
IF overwrite
INC bksize,maxline*2-2
ELSE
INC bksize,bk2size+Pos(maxpos-Lines)*2-2
ENDIF
MAKE BANK bank1,bksize
stptr=ALLOC ZEROED(4)
REPEAT
INC i
old_c_pos=c_pos
c_pos=b(i).pos
FOR j=old_c_pos TO c_pos-2
IF NOT overwrite
REPEAT
INC k
Data$=ReadString(bank2,stptr)
UNTIL k=j+1
remstart
FOR x=0 TO 200
CLS
rem PRINT PEEK INTEGER(stptr),"/",bk2size
PRINT bankpos,"/",bksize
rem PRINT data$
SYNC
NEXT x
remend
strlen=fast len(Data$)
Write Bank String bank1,bankpos,Data$,strlen
WRITE BANK WORD bank1,bankpos+strlen,2573
INC bankpos,strlen+2
ELSE
`Write go to next line sequence
WRITE BANK WORD bank1,bankpos,2573
INC bankpos,2
ENDIF
NEXT j
strlen=fast len(b(i).wstr)
Write Bank String bank1,bankpos,b(i).wstr,strlen
INC bankpos,strlen
IF c_pos<maxline
WRITE BANK WORD bank1,bankpos,2573
INC bankpos,2
ENDIF
UNTIL i=c
IF NOT overwrite
REPEAT
INC k
Data$=ReadString(bank2,stptr)
UNTIL k=maxpos
FOR i=maxpos TO Lines-1
Data$=ReadString(bank2,stptr)
strlen=fast len(Data$)
Write Bank String bank1,bankpos,Data$,strlen
WRITE BANK WORD bank1,bankpos+strlen,2573
INC bankpos,strlen+2
NEXT i
Delete Bank bank2
ENDIF
free stptr
unlink array pointer b()
undim b()
Delete File File$
IF NOT overwrite
bank3=FIND FREE BANK()
MAKE BANK FROM BANK bank3,bank1,0,bankpos
MAKE FILE FROM BANK File$,bank3
Delete bank bank3
ELSE
MAKE FILE FROM BANK File$,bank1
ENDIF
Delete Bank bank1
ENDFUNCTION
FUNCTION ReadStringAtPos(Bank,pos)
local x=-1,cnt,bb as byte,b as byte,stpos,length,ret$,banksize
banksize=GET BANK SIZE(Bank)
WHILE cnt<pos
INC x
bb=b
b=BANK BYTE(Bank,x)
IF b=10 and bb=13 THEN INC cnt
ENDWHILE
stpos=j+1
IF stpos<>banksize
REPEAT
INC x
bb=b
b=BANK BYTE(Bank,x)
UNTIL (b=10 and bb=13) or x=banksize-1
length=x-1-stpos+2*(x=banksize-1)
ret$=BANK STRING$(Bank,stpos,length)
ENDIF
ENDFUNCTION ret$
FUNCTION CountLinesInFile(Bank)
local j,bb as byte,b as byte,cnt,banksize
banksize=GET BANK SIZE(Bank)
REPEAT
INC j
bb=b
b=BANK BYTE(Bank,j)
IF b=10 and bb=13 THEN INC cnt
UNTIL j=banksize-1
ENDFUNCTION cnt
rem this function will return a string starting at at the byte number contained
rem at the adress startptr till the end of the line
rem the byte number of the start of the next line is written
rem at the adress startptr
FUNCTION ReadString(Bank,startptr)
local j,b as byte,bb as byte,banksize,starting_byte,ret$
starting_byte=PEEK INTEGER(startptr)
IF starting_byte<>-1
j=starting_byte
banksize=GET BANK SIZE(Bank)
REPEAT
bb=b
b=BANK BYTE(Bank,j)
INC j
UNTIL (b=10 and bb=13) or j=banksize
length=j-2-starting_byte+2*(j=banksize)
ret$=BANK STRING$(Bank,starting_byte,length)
IF j=banksize
POKE INTEGER startptr,-1
ELSE
POKE INTEGER startptr,j
ENDIF
ENDIF
ENDFUNCTION ret$
rem Pos(a) returns a if a>0, 0 else
FUNCTION Pos(a)
ret=(a+abs(a))/2
ENDFUNCTION ret
On a side note, i did a few speed tests, and i found out that writing 2*n lines of text takes about 3 times as much as writing n lines;
i.e, on my computer i get these results:
500 lines-> 7ms
1000 lines-> 21ms
2000 lines-> 60ms
4000 lines-> 178ms
I have no idea why though
here's the speed test code :
SYNC ON
HIDE MOUSE
TYPE ToWrite
pos as integer
wstr as string
ENDTYPE
rem create empty text buffer
global dim wbuffer() as ToWrite
LABEL1:
tt=hitimer()
`fill buffer with random letters
nb=1000
FOR t=1 to nb
i= RND(25)+1
u$=CHR$(64+i)
ARRAY INSERT AT BOTTOM wbuffer()
`get the new array pointer each time
BfPtr=get array ptr(wbuffer())
AddStringToBuffer(BfPtr,u$,t)
NEXT t
WriteTxtFile(BfPtr,"tmp.txt",1)
dt=hitimer()-tt
remstart
output$=output$+",["+str$(nb)+","+str$(dt)+"]"
INC counter
IF counter<10
GOTO LABEL1
ELSE
WRITE TO CLIPBOARD output$ :END
ENDIF
remend
DO
CLS
PRINT "number of lines:",nb
PRINT "time:",dt," ms"
SYNC
LOOP
`Clear buffer
EMPTY ARRAY wbuffer()
`Delete buffer
undim wbuffer()
EXECUTE FILE "tmp.txt","",dir$ : END
`use this function first to add to the "buffer" i.e a list of what's to be written and where
`arguments are: (array pointer,text string,line number [starting at 1])
` you need to place ARRAY INSERT AT BOTTOM arrayname() before calling
`this command!
`nb: it is possible to use several buffers at a time
FUNCTION AddStringToBuffer(ArrayPtr as dword,Write$,Pos)
dim b() as ToWrite
link array to pointer b(), ArrayPtr
c=ARRAY COUNT(b())
b(c).wstr=Write$
b(c).pos=Pos
unlink array pointer b()
undim b()
ENDFUNCTION
FUNCTION WriteTxtFile(ArrayPtr as dword,File$,overwrite as boolean)
dim b() as ToWrite
local i=-1,c_pos,old_c_pos,maxpos,Lines,j,k,c,banksize,bankpos,maxline,wstr as string
link array to pointer b(), ArrayPtr
IF NOT File Exist(File$) THEN overwrite=1
c=ARRAY COUNT(b())
SORT ARRAYPTR ArrayPtr
maxpos=b(c).pos
bank1=FIND FREE BANK()
IF NOT overwrite
Temp$="Temp.dat"
bank2=FIND FREE BANK()
MAKE BANK FROM FILE bank2,File$
Lines=CountLinesInFile(bank2)
ENDIF
rem work out the size of the bank that will contain the text file
rem by adding the lengths of the different lines
FOR j=0 TO c
INC banksize,fast len(b(j).wstr)
NEXT j
rem and add the number of bytes necessary to seperate lines
maxline=max(maxpos,Lines)
INC banksize,maxline*2-2
MAKE BANK bank1,banksize
nxt_line$=CHR$(13)+CHR$(10)
REPEAT
INC i
old_c_pos=c_pos
c_pos=b(i).pos
stptr=ALLOC(4)
FOR j=old_c_pos TO c_pos-2
IF NOT overwrite
REPEAT
INC k
Data$=ReadString(bank2,stptr)
UNTIL k=j+1
strlen=fast len(Data$)
Write Bank String bank1,bankpos,Data$,strlen
WRITE BANK WORD bank1,bankpos+strlen,2573
INC bankpos,strlen+2
ELSE
`Write go to next line sequence
WRITE BANK WORD bank1,bankpos+strlen,2573
INC bankpos,2
ENDIF
NEXT j
strlen=fast len(b(i).wstr)
IF c_pos<maxline
Write Bank String bank1,bankpos,b(i).wstr,strlen
WRITE BANK WORD bank1,bankpos+strlen,2573
INC bankpos,strlen+2
ELSE
Write Bank String bank1,bankpos,b(i).wstr,strlen
INC bankpos,strlen
ENDIF
UNTIL i=c
IF NOT overwrite
REPEAT
INC k
Data$=ReadString(bank2,stptr)
UNTIL k=maxpos
FOR i=maxpos TO Lines-1
Data$=ReadString(bank2,stptr)
Write Bank String bank1,bankpos,Data$+nxt_line$,strlen+2
INC bankpos,strlen+2
NEXT i
Delete Bank bank2
ENDIF
free stptr
unlink array pointer b()
undim b()
Delete File File$
MAKE FILE FROM BANK File$,bank1
Delete Bank bank1
ENDFUNCTION
FUNCTION ReadStringAtPos(Bank,pos)
local j=-1,cnt,bb as byte,b as byte,stpos,length,ret$,banksize
banksize=GET BANK SIZE(Bank)
WHILE cnt<pos
INC j
bb=b
b=BANK BYTE(Bank,j)
IF b=10 and bb=13 THEN INC cnt
ENDWHILE
stpos=j+1
IF stpos<>banksize
REPEAT
INC j
bb=b
b=BANK BYTE(Bank,j)
UNTIL (b=10 and bb=13) or j=banksize-1
length=j-1-stpos+2*(j=banksize-1)
ret$=BANK STRING$(Bank,stpos,length)
ENDIF
ENDFUNCTION ret$
FUNCTION CountLinesInFile(Bank)
local j,bb as byte,b as byte,cnt,banksize
banksize=GET BANK SIZE(Bank)
REPEAT
INC j
bb=b
b=BANK BYTE(Bank,j)
IF b=10 and bb=13 THEN INC cnt
UNTIL j=banksize-1
ENDFUNCTION cnt
rem this function will return a string starting at at the byte number contained
rem at the adress startptr till the end of the line
rem the byte number of the start of the next line is written
rem at the adress startptr
FUNCTION ReadString(Bank,startptr)
local j,b as byte,bb as byte,banksize,starting_byte,ret$
starting_byte=PEEK INTEGER(startptr)
IF starting_byte<>-1
j=starting_byte
banksize=GET BANK SIZE(Bank)
REPEAT
bb=b
b=BANK BYTE(Bank,j)
INC j
UNTIL (b=10 and bb=13) or j=banksize
length=j-2-starting_byte+2*(j=banksize)
ret$=BANK STRING$(Bank,starting_byte,length)
IF j=banksize
POKE INTEGER startptr,-1
ELSE
POKE INTEGER startptr,j
ENDIF
ENDIF
ENDFUNCTION ret$
