Oxygen Basic

Programming => Problems & Solutions => Topic started by: Aurel on June 28, 2012, 06:24:04 AM

Title: Tally slow ?
Post by: Aurel on June 28, 2012, 06:24:04 AM

Hi Charles...
Here is function Tally(src,del) which count delimiters in string ,
put each delimiter position in array dPos[]
and return number of delimiters.
I tested this function in Ebasic and Purebasic and there work fast but i found that in
Oxygen basic need 2 second for such a simple string like :
FORM 0,0,400,300,@min,0,"NewForm"
What might cause such a slow processing?

Code: [Select]

FUNCTION Tally(STRING Main$,STRING Match$) As INT
    DIM i,j,q,mlen,matchlen As INT
DIM t$ As STRING
    mlen = LEN(Main$)
    matchlen = LEN(Match$)
    i = 1
    j = 0
    q = 0
    IF (mlen = 0) OR (matchlen = 0)
        RETURN j
    END IF
   
    WHILE (1)

t$=MID(Main$,i,matchlen)
IF t$ = CHR(39) THEN q = q + 1
IF q=2 THEN q = 0
        IF t$ = Match$ AND q=0
           j = j + 1
'mem del$ position
dpos[j]=i
        END IF

           i = i + 1
        IF i > mlen
           exit while
        END IF
    WEND
'tbreak:
    RETURN j
END FUNCTION
called like:
cc=Tally (src,",")

Title: Re: Tally slow ?
Post by: Peter on June 28, 2012, 06:47:36 AM

Hi Aurel

No problem!

Code: [Select]

sys dpos[100]

FUNCTION Tally(STRING Main$,STRING Match$) As INT
    DIM i,j,q,mlen,matchlen As INT
DIM t$ As STRING
    mlen = LEN(Main$)
    matchlen = LEN(Match$)
    i = 1
    j = 0
    q = 0
    IF matchlen=0 or mlen=0   
       RETURN j
    END IF
   
    WHILE (1)

t$=MID(Main$,i,matchlen)
IF t$ = CHR(39) THEN q = q + 1
IF q=2 THEN q = 0
        IF t$ = Match$ AND q=0
        j = j + 1
'mem del$ position
dpos[j]=i
        END IF

        i = i + 1
        IF i > mlen
        exit while
        END IF
    WEND
'tbreak:
    RETURN j
END FUNCTION

sys c, string sc="hello, banana, and, apple, man, at, home"
c= Tally sc,","
print c


Title: Re: Tally slow ?
Post by: Aurel on June 28, 2012, 08:45:37 AM

Hi Peter...
It looks that is little bit faster but still is not fast enough( i think..)
Here is complete code (require awinh.inc).
I think that something is not good becuse there is problematic part
with array indexes .
And Charles why array is not zero based by default?
When i force Indexbase 0 then i recive few weird errors in For/loop ? ::)

Code: [Select]

$ Filename "NewWindow.exe"
Include "RTL32.inc"
Include "awinh.inc"
#lookahead ' for procedures
'Indexbase 0
'must be in global scope +++++++++++++++++++++++++
string txt = nuls 500000 'buffer
string lines[500000]   'lines array
sys pt = strptr txt    'buffer base pointer
sys i.j,p              'indexes and pointer
string CRLF=chr(13)+chr(10)
string temp$=""
'++++++++++++++++++++++++++++++++++++++++++++++++
% LR_LOADTRANSPARENT = &H20
% LR_LOADMAP3DCOLORS = &H1000
INT TransparentMap3D = LR_LOADTRANSPARENT or LR_LOADMAP3DCOLORS
INT win,win2
INT winstyle
INT button1,button2,button3,button4,button5
INT edit1,edit2,edit3
INT Lbox,static1,static2,static3,richedit1
INT ed1ID,ed2ID,ed3ID
INT b1ID,b2ID,b3ID,b4ID,b5ID,b6ID,b7ID
INT LboxID = 300
INT st1ID,st2ID
INT reID
b1ID=100
b2ID=101
b3ID=102
b4ID=103
b5ID=104
'-----------------
ed1ID=200
ed2ID=201
ed3ID=202
'----------------
st1ID=350
st2ID=351
st3ID=352
'----------------
reID=400
'loadbmp
'##########################################
INT bmpB1,bmpS1
bmpB1 = LoadImage(0,"data/xpBopen.bmp",0,76,20,16)
bmpS1 = LoadImage(0,"data/xpStatic.bmp",0,82,82,16)
'##########################################
STRING src[15000]
'*******************************************
'************* GLOBALS *********************
'*******************************************
String arg[16]
sys dPos[16]
'*******************************************

winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
'create window **************************************************
win = SetWindow("Test o2",100,100,640,400,0,winstyle)
'****************************************************************

'create buttons ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
button1 = SetButton(win,280,14,100,24,"OpenFileDialog",0x50000000,0x200,b1ID)
'set bitmap on button 1
'SendMessage button1 , BM_SETIMAGE, 0, bmpB1
button2 = SetButton(win,390,14,80,24,"FILL->ARRAY",0x50000000,0x200,b2ID)
button3 = SetButton(win,490,14,120,24,"Load scrambled-txt",0x50000000,0x200,b3ID)
button4 = SetButton(win,490,62,84,24,"Get Line Count",0x50000000,0x200,b4ID)
button5 = SetButton(win,490,88,84,24,"RUN",0x50000000,0x200,b5ID)

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'create edit control
edit1 = SetEditBox(win,100,80,380,23,"edit 1",0x50004000,0x200,ed1ID)

'create listbox
Lbox = SetListBox(win,100,140,180,150,"LB 1",0x50000140,0x200,LboxID)

'create static control
static1 = SetStatic(win,10,20,254,16," This is a STATIC text control with EX_CLIENTEDGE",0,0x200,st1ID)
'upper edit
static2 = SetEditBox(win,10,40,600,18,"search for string 'NWF' in source -> scrambled.txt",0x50004000,0x200,st1ID)
'crete static control with bitmap
static3 = SetStatic(win,10,60,82,82,"",0x5000030E,0,st3ID)
SendMessage static3 ,370, 0, bmpS1

'create Rich Edit control
INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4
richedit1 = SetRichEdit(win,300,120,300,200,"WINDOW 0,0,400,300,@min,0,'OK,ready!'",reStyle ,0x200,reID)

INT LCount = 0
'---------------------------------------------------------------------
'GoSub AddListboxItems
'--------------------------------------------------------------------

'--------------------------------------------------------------------
'WHILE GetMessage (&wm,0,0,0)<>0
'TranslateMessage &wm
'DispatchMessage &wm
'WEND
sys bRet
  '
  Do While bRet := GetMessage (&wm, 0, 0, 0)
    If bRet = -1 then
      'show an error message
    Else
      TranslateMessage &wm
      DispatchMessage &wm
    End If
  Wend



Function WndProc(byval win as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback

SELECT wMsg
'----------------------------

CASE WM_DESTROY
DestroyWindow (win)
PostQuitMessage 0
'-------------------------------------------------------------
CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

Select controlID
   CASE b1ID
If notifycode=0 
'Beep(1660,50)
    'Print "Button 1 Clicked!"
Gosub Test
End If

   CASE b2ID ' fill array fast
     If notifycode=0
  FillArray()
 
End If

  CASE b3ID
If notifycode=0
LoadFromFile()
End If

  CASE b4ID
If notifycode=0
GetLineCount()
End If

  CASE b5ID
If notifycode=0
GetLine()
End If




End Select
'-----------------------------------------------------
END SELECT


FUNCTION = DefWindowProc win,wMsg,wParam,lParam


END FUNCTION

'########################################################
SUB AddListboxItems
bstring i$ : i$=""

For n = 0 To 10
i$ = str(n) + "...." + Str(dpos[n])
SendMessage Lbox,LB_ADDSTRING,0,i$
Next n
END SUB
'#########################################################
SUB SetControlText
bstring n$
n$=""

'loop
For i = 0 To 14000
n$ = src[i]
IF n$ = "WINDOW"
print "Command found AT: "+str(i)
'showw()
exit for
END IF
'SendMessage edit1,WM_SETTEXT,0,n$
'UpdateWindow(edit1)
Next

END SUB
'#########################################################
SUB LoadFromFile

string fName = "scrambled.txt"
bstring source =  getfile fName
SendMessage richedit1,WM_SETTEXT,0,source

if not source
    print fName " file not found"
end if

END SUB

'************************************************************

Sub Test
bstring fR
dir=""
bstring sep=chr 0
filter="All Files"+sep+"*.*"+sep+"Text files"+sep+"*.txt"
'filter="text"+sep+"*.txt"+sep+
       '"basic"+sep+"*.bas;*.o2bas"+sep+
       '"include"+sep+"*.inc"+sep+
       '"header"+sep+"*.h"+sep+
       'sep

title="Test File Opening Dialog"
hwnd=0
fR = FileDialog(dir,filter,title,0,0,"txt")

SendMessage edit1,WM_SETTEXT,0,fR
bstring tx =  getfile fR
SendMessage richedit1,WM_SETTEXT,0,tx

End Sub
'*************************************************************

SUB GetLineCount

LCount = SendMessage richedit1,EM_GETLINECOUNT,0,0
bstring count$ = ""
count$ = Str(LCount)
SendMessage edit1,WM_SETTEXT,0,count$
count$=""
END SUB

'*************************************************************

SUB GetLine
INT Lpos
INT LLen
string LText=""
string pText
'---------------
FillArray()
GetLineCount()
'--------------
FOR Lpos = 0 TO LCount

LText = lines[Lpos]

'check command
IF Left(Ltext,6) = "WINDOW" Then
print "Command WINDOW -> found... "

OpenNewWindow()
exit for
END IF

Next
'serch finished exit for
print "EXIT-FOR: "+ str(Lpos)

'test - load file
'with 12560 lines of text
'read line by line ,finished
'cca 7 seconds

END SUB

'////////////////////////////////////////////////////////////////////


'------ FILL ARRAY FAST ------------------------------
Sub FillArray
print "Start..."


'string CRLF=chr(13)+chr(10)
'init...
SendMessage richedit1,WM_GETTEXT,500000,pt

p=pt 'char pointer
b=0  'left boundary
i=0  'lines array index
j=1  'char index
'
byte a at p 'byte linked to pointer p
'
'splitter loop
'=============
'
do
  select a
  case 0
    exit do
  case 10
    b=j
  case 13
    b++
    i++
    lines[i]=mid(txt,b,j-b)
    b=j
  end select
  p++
  j++   
end do

print "Lines: " i CRLF+
      ">" lines[10122] "<" CRLF+
  "Source Loaded into $Array"

End Sub

'------------------------------------------------------

SUB OpenNewWindow
print "SUB WINDOW"
'***********************************************************
Int cc,nArg,n : nArg=7
String buffer=""
bstring tt  'again problem with conversion so i add bString here
temp$ = lines[0]
temp$=Ltrim(temp$)
temp$=Mid(temp$,7,LEN(temp$)-2)
temp$=Ltrim(temp$)
print "Temp$:" + temp$ : tt=temp$
SendMessage edit1,WM_SETTEXT,0,tt
cc=Tally(temp$,",")
print "Number of delimiters: "+ str(cc)
'show coma positions from array dPos[n]
 AddListboxItems()
 ParseArgs()
'if wrong numOfArgs
IF nArg <>(cc+1)
print "Error:Wrong Number of arguments!"
Goto exitW
END IF
'show arguments
for n = 0 TO nArg
buffer = buffer + "arg."+str(n)+ " " + arg[n] + CRLF
next
print buffer

'***********************************************************
'try open new window >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN 'or WS_CHILD
'create window - parent HWND_DESKTOP
win2 = SetWindow("NewWindow",400,100,400,300,0,winstyle)
Dim wm2 as MSG

IF win2 <> 0
DO WHILE GetMessage(&wm2,0,0,0)
TranslateMessage &wm2
DispatchMessage &wm2

Select @wm2
  CASE WM_Quit
  DestroyWindow (win2)
  PostQuitMessage 0

End select

WEND

END IF

exitW:
END SUB

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
FUNCTION Tally(STRING Main$,STRING Match$) As INT
    DIM i,j,q,mlen,matchlen As INT
DIM t$ As STRING
    mlen = LEN(Main$)
    matchlen = LEN(Match$)
    i = 1
    j = 0
    q = 0
    IF (mlen = 0) OR (matchlen = 0)
        RETURN j
    END IF
   
    do

t$=MID(Main$,i,matchlen)
IF t$ = CHR(39) THEN q = q + 1
IF q=2 THEN q = 0
        IF t$ = Match$ AND q=0
           j = j + 1
'mem del$ position
dpos[j]=i
' j = j + 1
        END IF

           i = i + 1
        IF i > mlen
           exit do
        END IF
    end do
'tbreak:
    RETURN j
END FUNCTION
'////////////////////////////////////////////////////////////////////
SUB ParseArgs
'temp$=> 0,0,400,300,@min,0,'OK,ready!'
STRING t$="":t$=temp$
print t$
INT k,i,j
i = 0
j = 1
k = 1

FOR i = 1 TO LEN(t$)
IF i = dPos[k]

arg[k] = MID(t$,j,(i-j))
   arg[k] = Trim(arg[k])
    'print arg[k]
k=k+1
j = i + 1
END IF
NEXT
'+ extract last argument

arg[k] = MID(t$,j,LEN(t$))
PRINT "ParseArgs-finished..."
temp$=""
END SUB

PS...Just click button ' RUN '

Title: Re: Tally slow ?
Post by: Aurel on June 28, 2012, 11:59:11 AM

I really still don't get it why Tally work slow on my computer?
In Peter example there is no other stuff but... ::)
Extract function ParseArgs work fast but i think that require more operation
with strings than Tally..hmmm

Title: Re: Tally slow ?
Post by: Charles Pegge on June 28, 2012, 12:40:09 PM

Hi Aurel,

In general I would avoid creating strings in this sort of function.
Strings (and division and trig functions ) are the most expensive operations.

Indexbase 1 is a bit easier to use. String character indexing is also based to 1. Naturally professionals prefer indexbase 0 :). I would advise using this directive before dimensioning any arrays. However it can also be placed inside a local scope, like a function or class and it will not effect other parts of the program.

This one should approach assembly code speeds:

Code: OxygenBasic

1.  
2. function tally(string main,delim, sys *dp, max) as sys
3. '=====================================================
4.  
5. sys a,p,le,ld,tal,ascd
6.  
7. le=len main
8. ld=len delim
9. if ld=0 or le= 0 then exit function 'NULL STRINGS
10. ascd=asc delim
11. '
12. p=strptr main 'string pointer
13. byte *b       'pointered byte
14. @b=p          'map to main string
15. do
16.   if b=0 then exit do
17.   if b=39 then 'SKIP QUOTE
18.    do
19.       @b++
20.       if b=39 or a<=le then exit do
21.     end do
22.     @b++
23.     continue do  
24.   end if
25.   if b=ascd then
26.     a=@b-p+1
27.     if a=instr(a,main,delim) then 'CONFIRM MATCH
28.      if tal>=max then exit do 'ARRAY LIMIT EXCEEDED
29.      tal++
30.       dp[tal]=a
31.       @b+=ld
32.       continue do
33.     end if
34.   end if
35.   @b++
36. end do
37. return tal
38. end function
39.  
40. '====
41. 'TEST
42. '====
43.  
44. sys dp[1000]
45.  
46. '4 delimters  !       !       x      !      !
47. a=tally "apple//orange// 'pear//drop'// / / //banana", "//", dp,1000
48.  
49. pr="positions: "
50. for i=1 to a
51.   pr+=" " dp[ i ]
52. next
53. print pr
54.  

Charles

Title: Re: Tally slow ?
Post by: Peter on June 28, 2012, 01:10:31 PM

Aurel,

try this.

Code: [Select]

sys dpos[1000]

Sub Tally (String Main,String Match)
    sys i,j,q,mlen,matchlen, string t
    mlen = LEN(Main)
    matchlen = LEN(Match)
    i=1: j=0: q=0
    iF matchlen=0 or mlen=0 Then Return    
    WHILE (1)
t=MID(Main,i,matchlen)
IF t = CHR(39) THEN q = q+1
IF q=2 THEN q=0
        IF t = Match AND q=0
        inc j
dpos[j]=i
        END IF
        inc i
        IF i> mlen
        Exit While
        End iF
    WEND
    Return j
End Sub

sys c, string sc="hello,,,banana,,,and,,,apple,,,man,,,at,,,home,,,,,,go outside,,,,,,"
c= Tally sc,","
print c


Title: Re: Tally slow ?
Post by: Charles Pegge on June 28, 2012, 02:08:50 PM

The problem here is that string t is created for every character in the text.

Title: Re: Tally slow ?
Post by: Peter on June 28, 2012, 02:35:40 PM

Code: [Select]

sys dpos[1000]
string t[1000]

Sub Tally (String Main,String Match)
    sys i,j,q,mlen,matchlen  
    mlen = LEN(Main)
    matchlen = LEN(Match)
    i=1: j=0: q=0
    iF matchlen=0 or mlen=0 Then Return    
    WHILE (1)
t[j]=MID(Main,i,matchlen)
IF t[j] = CHR(39) THEN q = q+1
IF q=2 THEN q=0
        IF t[j] = Match AND q=0
        inc j
dpos[j]=i
        END IF
        inc i
        IF i> mlen
        Exit While
        End iF
    WEND
    Return j
End Sub

sys c, string sc="HELLO,HELLO,HELLO,HELLO,HELLO,HELLO,HELLO,HELLO,HELLO,HELLO"
c= Tally sc,"HELLO"
print c

Title: Re: Tally slow ?
Post by: Aurel on June 29, 2012, 06:29:30 AM

Hmm...
I know that string processing is time consuming but in this case something is really
strange and not very good.
I tested this function on DLib and work on speed of light ,dlib is just a bycode interpreter.
Then i try even in mine Abasic and is executed instantly to ???
If such a small and slow interpreter can do this in less then a second what
Oxygen doing  ???
when he need so much time,must be something connected with array filling... ::)

Title: Re: Tally slow ?
Post by: Charles Pegge on June 29, 2012, 10:33:32 AM

Hi Aurel,

I did a timing analysis of your function. It runs at about 1 microsecond per byte on my PC, which is quite a lot. By not pulling strings my function runs around 50x faster.

By far the most expensive operations were the string comparisons. Those 2 lines accounted for 90% of the time. The procedures I use are not optimised. They support the worst case scenario where each side is treated as a full string expression rather than a simple string. So I think I could substantially improve performance here, possibly by a factor of 5.

Charles

Title: Re: Tally slow ?
Post by: Charles Pegge on June 30, 2012, 10:36:15 AM

Well, I've got a 3X improvement here:

Title: Re: Tally slow ?
Post by: Aurel on July 01, 2012, 01:40:16 AM

Thanks Charles.. :)
I understand what you talking about but is not clear to me how same function work
fast on other compilers which are far slower then oxygen in some other things that quick.
Ok i will try now...thanks again... ;)

Title: Re: Tally slow ?
Post by: Aurel on July 01, 2012, 02:32:03 AM

It looks that now work faster but i found one small catch.
this is not executed correctly:

Code: [Select]

IF t$ = "'" THEN q = q + 1BUT this is correctly executed;

Code: [Select]

IF t$ = chr(39) THEN q = q + 1And work array is filled but still first zero member is empty because i
don't force indexbase to NULL.

Charles i hope that i not bothering you to much with this but
looks really strange such a slow respond on this func.
If you remember you show me way to fill string array with 500000 elements
which is executed like you say in a microsecond...
thanks...

Title: Re: Tally slow ?
Post by: Charles Pegge on July 01, 2012, 04:04:44 AM

Hi Aurel,

I hope I've fixed the bug with this update. I could see what was happening.

When performing string operations, compilers will not give great advantage over interpreters. The low level steps required to process strings will be much the same. So you have to code in a different way to take advantage of compiler performance. Work with integers wherever possible, and use buffers to avoid adding little bits of string together.

I know Oxygen is a little faster than it used to be. I have a program which reads all the words in the bible, builds a word list, sorts them into alphabetic order, and tallies the occurance of each word. 2 years ago it took around 0.1 seconds. Now it is down to around 0.087 seconds on the same PC :)

The bible is over 4 Megs, and a vocabulary of over 13000 words.

Charles

[attachment deleted by admin]

Title: Re: Tally slow ?
Post by: Aurel on July 01, 2012, 04:36:24 AM

Hi Charles...
I hope that i understand whole problematic( 50% for sure  ;D ).

Quote

So you have to code in a different way to take advantage of compiler performance. Work with integers wherever possible, and use buffers to avoid adding little bits of string together.

Hmm..
Well which way you can suggest me ?...
because im not sure how to do this on quick way as possible?

Yes results with bible text are impressive so something similar I need for this operation,right?

thanks for bugfix.. ;)

Aurel

Title: Re: Tally slow ?
Post by: Aurel on July 01, 2012, 04:50:14 AM

Just to compare results of Time Analize i get this results:

Tally  : 29.37 microsecons per call
Tally2 : 1.77 microsecons per call

And yes your way is faster.
I would try replicate results in some other compilers.

And in addition EBasic need 10 microsecond for Tally and of course
this speed come from NASM.

Title: Re: Tally slow ?
Post by: Charles Pegge on July 01, 2012, 07:57:24 AM

Yes. The Tally2 function, runs at 0.020 microseconds per byte on my PC. A little Assembly code would improve it further, by holding some of the pointers in registers, but it would not make a huge difference. I think small programs end up running  inside the CPU core memory, which has fast access.


Charles

PS: Try this version. I replaced the if constructs with a case block, and it runs quite a bit faster. I get 11 ns per byte.

Code: OxygenBasic

1.  
2. function tally2(string main,delim, sys *dp, max) as sys
3. '======================================================
4.  
5. sys a,p,le,ld,tal,ascd
6.  
7. le=len main
8. ld=len delim
9. if ld=0 or le= 0 then exit function 'NULL STRINGS
10. ascd=asc delim
11. '
12. p=strptr main 'string pointer
13. byte *b       'pointered byte
14. @b=p          'map to main string
15. do
16.   select b
17.   case 0  : exit do
18.   case 39 : 'SKIP QUOTE
19.    do
20.       @b++
21.       if b=39 or a<=le then exit do
22.     end do
23.     @b++
24.     continue do  
25.   case ascd
26.     a=@b-p+1
27.     if a=instr(a,main,delim) then 'CONFIRM MATCH
28.      if tal>=max then exit do 'ARRAY LIMIT EXCEEDED
29.      tal++
30.       dp[tal]=a
31.       @b+=ld
32.       continue do
33.     end if
34.   end select
35.   @b++
36. end do
37. return tal
38. end function
39.  

Title: Re: Tally slow ?
Post by: Aurel on July 01, 2012, 09:06:19 AM

Hi Charles...
I just thinking on same frequency.. ;)
Uf i completely forget about option SELECT/CASE  ::)
And WOW this way work really fast...cool  :)
Thanks..!
Here is complete code of program which use new tally2 function:

Code: [Select]

$ Filename "NewWin2.exe"
Include "RTL32.inc"
Include "awinh.inc"
#lookahead ' for procedures
'Indexbase 0
'must be in global scope +++++++++++++++++++++++++
string txt = nuls 500000 'buffer
string lines[500000]   'lines array
sys pt = strptr txt    'buffer base pointer
sys i.j,p              'indexes and pointer
string CRLF=chr(13)+chr(10)
string temp$=""
'++++++++++++++++++++++++++++++++++++++++++++++++
% LR_LOADTRANSPARENT = &H20
% LR_LOADMAP3DCOLORS = &H1000
INT TransparentMap3D = LR_LOADTRANSPARENT or LR_LOADMAP3DCOLORS
INT win,win2
INT winstyle
INT button1,button2,button3,button4,button5
INT edit1,edit2,edit3
INT Lbox,static1,static2,static3,richedit1
INT ed1ID,ed2ID,ed3ID
INT b1ID,b2ID,b3ID,b4ID,b5ID,b6ID,b7ID
INT LboxID = 300
INT st1ID,st2ID
INT reID
b1ID=100
b2ID=101
b3ID=102
b4ID=103
b5ID=104
'-----------------
ed1ID=200
ed2ID=201
ed3ID=202
'----------------
st1ID=350
st2ID=351
st3ID=352
'----------------
reID=400
'loadbmp
'##########################################
INT bmpB1,bmpS1
bmpB1 = LoadImage(0,"data/xpBopen.bmp",0,76,20,16)
bmpS1 = LoadImage(0,"data/xpStatic.bmp",0,82,82,16)
'##########################################
STRING src[15000]
'*******************************************
'************* GLOBALS *********************
'*******************************************
String arg[16]
sys dPos[16]
'*******************************************

winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
'create window **************************************************
win = SetWindow("Test o2",100,100,640,400,0,winstyle)
'****************************************************************

'create buttons ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
button1 = SetButton(win,280,14,100,24,"OpenFileDialog",0x50000000,0x200,b1ID)
'set bitmap on button 1
'SendMessage button1 , BM_SETIMAGE, 0, bmpB1
button2 = SetButton(win,390,14,80,24,"FILL->ARRAY",0x50000000,0x200,b2ID)
button3 = SetButton(win,490,14,120,24,"Load scrambled-txt",0x50000000,0x200,b3ID)
button4 = SetButton(win,490,62,84,24,"Get Line Count",0x50000000,0x200,b4ID)
button5 = SetButton(win,490,88,84,24,"RUN",0x50000000,0x200,b5ID)

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'create edit control
edit1 = SetEditBox(win,100,80,380,23,"edit 1",0x50004000,0x200,ed1ID)

'create listbox
Lbox = SetListBox(win,100,140,180,150,"LB 1",0x50000140,0x200,LboxID)

'create static control
static1 = SetStatic(win,10,20,254,16," This is a STATIC text control with EX_CLIENTEDGE",0,0x200,st1ID)
'upper edit
static2 = SetEditBox(win,10,40,600,18,"search for string 'NWF' in source -> scrambled.txt",0x50004000,0x200,st1ID)
'crete static control with bitmap
static3 = SetStatic(win,10,60,82,82,"",0x5000030E,0,st3ID)
SendMessage static3 ,370, 0, bmpS1

'create Rich Edit control
INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4
richedit1 = SetRichEdit(win,300,120,300,200,"WINDOW 0,0,400,300,@min,0,'OK,ready!'",reStyle ,0x200,reID)

INT LCount = 0
'---------------------------------------------------------------------
'GoSub AddListboxItems
'--------------------------------------------------------------------

'--------------------------------------------------------------------
'WHILE GetMessage (&wm,0,0,0)<>0
'TranslateMessage &wm
'DispatchMessage &wm
'WEND
sys bRet
  '
  Do While bRet := GetMessage (&wm, 0, 0, 0)
    If bRet = -1 then
      'show an error message
    Else
      TranslateMessage &wm
      DispatchMessage &wm
    End If
  Wend



Function WndProc(byval win as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback

SELECT wMsg
'----------------------------

CASE WM_DESTROY
DestroyWindow (win)
PostQuitMessage 0
'-------------------------------------------------------------
CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

Select controlID
   CASE b1ID
If notifycode=0 
'Beep(1660,50)
    'Print "Button 1 Clicked!"
Gosub Test
End If

   CASE b2ID ' fill array fast
     If notifycode=0
  FillArray()
 
End If

  CASE b3ID
If notifycode=0
LoadFromFile()
End If

  CASE b4ID
If notifycode=0
GetLineCount()
End If

  CASE b5ID
If notifycode=0
GetLine()
End If




End Select
'-----------------------------------------------------
END SELECT


FUNCTION = DefWindowProc win,wMsg,wParam,lParam


END FUNCTION

'########################################################
SUB AddListboxItems
bstring i$ : i$=""

For n = 0 To 10
i$ = str(n) + "...." + Str(dpos[n])
SendMessage Lbox,LB_ADDSTRING,0,i$
Next n
END SUB
'#########################################################
SUB SetControlText
bstring n$
n$=""

'loop
For i = 0 To 14000
n$ = src[i]
IF n$ = "WINDOW"
print "Command found AT: "+str(i)
'showw()
exit for
END IF
'SendMessage edit1,WM_SETTEXT,0,n$
'UpdateWindow(edit1)
Next

END SUB
'#########################################################
SUB LoadFromFile

string fName = "scrambled.txt"
bstring source =  getfile fName
SendMessage richedit1,WM_SETTEXT,0,source

if not source
    print fName " file not found"
end if

END SUB

'************************************************************

Sub Test
bstring fR
dir=""
bstring sep=chr 0
filter="All Files"+sep+"*.*"+sep+"Text files"+sep+"*.txt"
'filter="text"+sep+"*.txt"+sep+
       '"basic"+sep+"*.bas;*.o2bas"+sep+
       '"include"+sep+"*.inc"+sep+
       '"header"+sep+"*.h"+sep+
       'sep

title="Test File Opening Dialog"
hwnd=0
fR = FileDialog(dir,filter,title,0,0,"txt")

SendMessage edit1,WM_SETTEXT,0,fR
bstring tx =  getfile fR
SendMessage richedit1,WM_SETTEXT,0,tx

End Sub
'*************************************************************

SUB GetLineCount

LCount = SendMessage richedit1,EM_GETLINECOUNT,0,0
bstring count$ = ""
count$ = Str(LCount)
SendMessage edit1,WM_SETTEXT,0,count$
count$=""
END SUB

'*************************************************************

SUB GetLine
INT Lpos
INT LLen
string LText=""
string pText
'---------------
FillArray()
GetLineCount()
'--------------
FOR Lpos = 0 TO LCount

LText = lines[Lpos]

'check command
IF Left(Ltext,6) = "WINDOW" Then
'print "Command WINDOW -> found... "

OpenNewWindow()
exit for
END IF

Next
'serch finished exit for
'print "EXIT-FOR: "+ str(Lpos)

'test - load file
'with 12560 lines of text
'read line by line ,finished
'cca 7 seconds

END SUB

'////////////////////////////////////////////////////////////////////


'------ FILL ARRAY FAST ------------------------------
Sub FillArray
'print "Start..."


'string CRLF=chr(13)+chr(10)
'init...
SendMessage richedit1,WM_GETTEXT,500000,pt

p=pt 'char pointer
b=0  'left boundary
i=0  'lines array index
j=1  'char index
'
byte a at p 'byte linked to pointer p
'
'splitter loop
'=============
'
do
  select a
  case 0
    exit do
  case 10
    b=j
  case 13
    b++
    i++
    lines[i]=mid(txt,b,j-b)
    b=j
  end select
  p++
  j++   
end do

'print "Lines: " i CRLF+
     ' ">" lines[10122] "<" CRLF+
' "Source Loaded into $Array"

End Sub

'------------------------------------------------------

SUB OpenNewWindow
'print "SUB WINDOW"
'***********************************************************
Int cc,nArg,n : nArg=7
String buffer=""
bstring tt  'again problem with conversion so i add bString here
temp$ = lines[0]
temp$=Ltrim(temp$)
temp$=Mid(temp$,7,LEN(temp$)-2)
temp$=Ltrim(temp$)
'print "Temp$:" + temp$ :
tt=temp$
SendMessage edit1,WM_SETTEXT,0,tt
'tally fn
'cc = Tally temp$,","
'tally2- by Charles
cc = tally2(temp$,",",dpos,100)
print "Number of delimiters: "+ cc
'show coma positions from array dPos[n]
 AddListboxItems()
 ParseArgs()
'if wrong numOfArgs
IF nArg <>(cc+1)
print "Error:Wrong Number of arguments!"
Goto exitW
END IF
'show arguments
for n = 0 TO nArg
buffer = buffer + "arg."+str(n)+ " " + arg[n] + CRLF
next
print buffer

'***********************************************************
'try open new window >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN 'or WS_CHILD
'create window - parent HWND_DESKTOP
win2 = SetWindow("NewWindow",400,100,400,300,0,winstyle)
Dim wm2 as MSG

IF win2 <> 0
DO WHILE GetMessage(&wm2,0,0,0)
TranslateMessage &wm2
DispatchMessage &wm2

Select @wm2
  CASE WM_Quit
  DestroyWindow (win2)
  PostQuitMessage 0

End select

WEND

END IF

exitW:
END SUB

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Function Tally (String Main,String Match) as sys
    sys i,j,q,mlen,matchlen
    string t$=""
    mlen = LEN(Main)
    matchlen = LEN(Match)
    i=1: j=0: q=0
    iF (matchlen=0) OR (mlen=0) Then Return j
   
    'For i =1 to LEN(Main)
    do
     
t$=MID(Main,i,1)
IF t$ = chr(39) THEN q = q + 1
IF q=2 THEN q=0
        IF t$="," AND q=0
        INC j
   dpos[j]=i
        END IF
        INC i
   ' Next
    IF i > mlen then exit do   
    end do

    Return j
End Function
'////////////////////////////////////////////////////////////////////

function tally2(string main,delim, sys *dp, max) as sys
'======================================================

sys a,p,le,ld,tal,ascd

le=len main
ld=len delim
if ld=0 or le= 0 then exit function 'NULL STRINGS
ascd=asc delim
'
p=strptr main 'string pointer
byte *b       'pointered byte
sys q         'quote counter
@b=p          'map to main string
do
  select b
  case 0  : exit do

  case 39 : 'SKIP QUOTE
   
   if b=39 or a<=le
   q++      'inc quote counter
   
   end if
    if q=2 then q=0
    '@b++
     
  case ascd
    a=@b-p+1
    if a=instr(a,main,delim) and q =0 then 'CONFIRM MATCH
      if tal>=max then exit do 'ARRAY LIMIT EXCEEDED
     tal++
      dp[tal]=a

      @b+=ld
      continue do
    end if
  end select
  @b++
end do
return tal
end function

'////////////////////////////////////////////////////////////////////
SUB ParseArgs
'temp$=> 0,0,400,300,@min,0,'OK,ready!'
STRING t$="":t$=temp$
print t$
INT k,i,j
i = 0
j = 1
k = 1

FOR i = 1 TO LEN(t$)
IF i = dPos[k]

arg[k] = MID(t$,j,(i-j))
   arg[k] = Trim(arg[k])
    'print arg[k]
k=k+1
j = i + 1
END IF
NEXT
'+ extract last argument

arg[k] = MID(t$,j,LEN(t$))
'PRINT "ParseArgs-finished..."
temp$=""
END SUB


Title: Re: Tally slow ?
Post by: Charles Pegge on July 03, 2012, 09:53:53 AM

Thanks Aurel. I have a demo OxIde and companion CO2 compiler to post soon. I am keeping them as simple as possible.

Charles

Title: Re: Tally slow ?
Post by: Aurel on July 03, 2012, 11:13:47 AM

Quote

I have a demo OxIde and companion CO2 compiler to post soon. I am keeping them as simple as possible

.

Hi Charles..
That sounds cool.. ;)

So what i need to reconstruct OxyEdit in Oxygen is finish treeview control with images and
implement TAB control for tabs.When i finish this i will post source and exe on forum. :)

Title: Re: Tally slow ?
Post by: Peter on July 03, 2012, 12:10:56 PM

Hi Charles,

Means this, that we have a complete Basic with in built Window ?
Or is the OxIde a sort of SCITE ?

 

Title: Re: Tally slow ?
Post by: Charles Pegge on July 03, 2012, 05:38:39 PM

It is a very slim editor with F5 Execute - doesn't use Scintilla.

Can make customised IDEs and compilers from it.

Charles

Title: Re: Tally slow ?
Post by: Aurel on July 03, 2012, 09:07:47 PM

Aha i see...
When i start doing editor i was thinking about option to use richedit and add syntax coloring
...i will do some experiments ,i think that i have somwhere some similiar piece of code..