Oxygen Basic

Programming => Example Code => Data Processing => Topic started by: Aurel on May 12, 2012, 07:57:03 AM

Title: in InProgres/Interpreters
Post by: Aurel on May 12, 2012, 07:57:03 AM

Hi Charles... :)
In folder 'InProgress' is subfolder 'Interpreters' which contain Leanlisp.
It looks cool to me.
What you mean is there a way with few modifications to parsing way - produce
basic-like ,or rexx-like simple interpreter?

Or parsing method must be completely reconstructed?

Title: Re: in InProgres/Interpreters
Post by: Aurel on September 23, 2012, 10:25:39 AM

This example is still clumsey and is just start of presentation for
string processing.
FillArray() func is changed to classic way because line reading not work properly :-\
Click run...

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[4000]   '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]
'---array of global variables -------------
string gArrInt[100]
'*******************************************
'FOR stack--------------------------------
INT forStart,fc[100],forEnd[100]
INT fPush,fStep[100],forPos[100]
STRING fStack[16]
'-----------------------------------------
'###########################################

winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
'create window **************************************************
win = SetWindow("Test String processing...",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,10,150,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,0x200,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 /::src code line::
richedit1 = SetRichEdit(win,200,120,400,240,"WINDOW  0, 0, 400, 300, @MMS,0, 'New Caption!'"+chr(13)+"FOR n,0,s",reStyle ,0x200,reID)
hfont = GetStockObject(11)
SendMessage richedit1,WM_SETFONT,hfont,0
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_CLOSE

IF win2=0 AND win<>0 then
DestroyWindow (win)
win=0
print "w1 closed"
PostQuitMessage
END IF

IF win2 <> 0 then
DestroyWindow (win2)
win2=0
print "w2 closed"
END IF

'IF win=0 then 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
RunCode()
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 RunCode
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
INT Lpos
INT LLen
INT EPos
STRING c$=""
string LText=""
string pText

GetLineCount()
FillArray()

'+++ main loop +++++++++++++++++++++++++++++++
FOR Lpos = 0 TO LCount
'clear locals
c$="":LText="":Epos=0
LText = lines[Lpos]
'skip empty line-----------------
'IF LText = "" THEN GOTO toNext
'Left trim whitespace -----------
LText = LTrim(Ltext)
'get first empty space ----------
Epos = INSTR (LText," ")
print "Epos: "+str(Epos)
'get first arrgument...............
c$=Ucase(Left(Ltext,EPos-1))
'..................................
print "C$:"+c$


'check command >>>>>>>>>>>>>>>>>>>>
IF c$ = "WINDOW"
OpenNewWindow()
END IF

IF c$ = "FOR"
exec_FOR()
END IF

'----------
'toNext:
'----------
Next Lpos
'++++++++++++++++++++++++++++++++++++++++++++

END SUB
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' END RUNTIME
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'////////////////////////////////////////////////////////////////////


'------ FILL ARRAY FAST ------------------------------
Sub FillArray
INT Lpos
INT LLen
bstring LText=""
string pText

FOR Lpos = 0 TO LCount-1
LLen = SendMessage richedit1, EM_LINELENGTH,Lpos, 0 ' not important
'print "LineLen;" + str(LLen)
pText = Space (255)  ' it use 255 without error
SendMessage richedit1,EM_GETLINE,Lpos,strptr(pText)

'convert to bstring & show line in edit control
LText = pText
LText = rtrim(ltrim(LText))
'src[Lpos]=LText
lines[Lpos]=Ltext
 print "LINE: " + lines[LPos]
   
'SendMessage edit1,WM_SETTEXT,0,LText
'UpdateWindow(edit1)
'check command
'IF Ltext = "NWF" then showw()
Next
'array filed
print "Array filled..."

   
   
   
 

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]
print "TEMP:"+temp$
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 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'read arguments from /array of arguments/"WINDOW 0,0,400,300,@min,0,'OK,ready!'"
INT nx,ny,nw,nh
STRING s$,c$
'get dimensions....

nx=VAL(arg[1])
ny=VAL(arg[2])
nw=VAL(arg[3])
nh=VAL(arg[4])
'get style....
n$=arg[5]
IF LCase(n$) = "@mms"
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
ELSE
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN 'or WS_CHILD
END IF
'get caption...
c$=LTrim(arg[7])

'******************************************
'create window - parent HWND_DESKTOP
win2 = SetWindow(c$,nx,ny,nw,nh,0,winstyle)



Dim wm2 as MSG
'return to main
RETURN

'message2 not work becuse need separate procedure
'redirected to main procedure
IF win2 <> 0
DO WHILE GetMessage(&wm2,0,0,0)
TranslateMessage &wm2
DispatchMessage &wm2

Select @wm2
  CASE WM_CLOSE
  DestroyWindow win2
' print "w2 closed"
  'PostQuitMessage 0

End select

WEND

END IF

exitW:
RETURN
END SUB

'exec FOR----------------------------------------------------------
SUB exec_FOR

print "FOR command found!"





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++
   
   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: in InProgres/Interpreters
Post by: Charles Pegge on September 26, 2012, 07:39:45 PM

LeanLisp was an interesting experiment, but not easy to use, with its extremely limited syntax and proliferation of brackets. It is easier to write than it is to read - which is bad news as far as maintaining code is concerned. Basic is at the opposite end of the scale with a complex syntax, but much easier to follow

Charles