===============
'TESTLOG3.O2BAS
'O2TESTS
===============

'see oxylog.rxt
'see oxydatabase.txt

'16/04/2026

/*
'embedded data file
'case 0x71
byte b at @embs
char c at @embs
'print b[100]
print left c,1000
sys ss,ee
ss=@embs
ee=@embe
print ee-ss
end
embs:
'data bytes using o2 machine script
'o2 q "oxydatabase.txt"
embed "oxydatabase.txt"
embe:
*/


/*
$filename "t.exe"
uses rtl32
print version
=12345
*/
/*
'test return code
uses sysutil
print exec "t.exe",1 'wait
'12345
*/

'14/04/2026

/*
'embedded data
byte b at @embed
print b[3]
end
embed:
'db: assembler data bytes
db 0xa1,0xa2,0xa3
*/

/*
'embedded data
byte b at @embed
print b[3]
end
embed:
'data bytes using o2 machine script
o2 { a1 a2
 a3 }
*/

/*
'embedded data file
'case 0x71
byte b at @embs
print b[100]
sys ss,ee
ss=@embs
ee=@embe
print ee-ss
end
embs:
'data bytes using o2 machine script
'o2 q "oxydatabase.txt"
embed "oxydatabase.txt"
embe:
*/

'05/04/2026
'string cases
'as of march 2024

/*
'trap string cases
string s
select s
case "a" :
end select
*/


/*
'select with compound asc expression
string s
s="ab"
int a=asc(s,1)+asc(s,2)*256 '0x61 0x62
select a
  case "ac" : print "AC" '0x61 0x63
  case "ab" : print "AB" '0x61 0x62
  case else : print "no match"
end select
*/

/*
string s
s="ab"
'
select asc s,2
  case "a" : print "A"
  case "b" : print "B"
  case "c" : print "C"
  case else : print "no match"
end select
*/


/*
string s
s="abcd"
select asc s
  'embedded conditional expressions
  case s="abcde" : print "ABCDE"
  case s="abcd"  : print "ABCD"
  case s="abc"   : print "ABC"
  'normal cases
  case "a" : print "A"
  case "b" : print "B"
  '
  case else : print "no match"
end select
*/



'03/03/2026

/*
'exec test:
int p=0xc3 'ret
call @p
print "ok"
*/


/*
'exec test:
string s=chr(0xc3) 'ret
call strptr s
print "ok"
*/

/*
'exec test:
call exec1
int a=edx
print a
end
exec1: 0x7b is 123
o2 ba 7b 00 00 00 c3
*/

/*
'exec test:
byte b={ 0xba, 0x7b, 0x00, 0x00, 0x00, 0xc3 }
call @b
int a=edx
print a
*/


/*
'exec test:
call exec1
int a=edx
print a
end
exec1:
mov edx,123
ret
*/


'25/02/2026

/*
'assigdim
'implicit data assignment
'no '='
float f{1,2,3,4,5}
print f[4]
*/


'24/02/2026

/*
'mixed data input test
type tt string s, float f
tt t = { {"A",1.5},{"B",2.5} }
print t[1].s " " t[1].f cr _
      t[2].s " " t[2].f cr
*/


'23/02/2026

/*
'implicit array udt test
type vector float x,y
vector v={{1,1},{1,2},{1,3}}
print ubound v
*/

'21/02/2026

/*
'replacewd mode 2
macro m(nn)
int nn##x=0, nn##y=0
string s="nn "
end macro

#show m q
*/

/*
'stray code
int i=1
select i
'print 123 stray line
case 1
print 10
end select
*/


/*
dim byref i as int
@i=getmemory 16
'print @i
i=5
print i
'#recordof i
*/


'15/02/2026

/*
'bstring*param
function f(bstring*s)
s="ok"
end function
'
string t=123
f t
print t
*/

'12/02/2026

/*
% noconsole
uses console
uses stringutil
'uses cons
new textarray t
t.load "t.txt"
output "ok"
wait
del t
*/

'09/02/2026

/*
'printl tests
uses console 'must before stringutil
uses parseutil
new textarray t 'check for failure
string s=" text "
printl "1 " tab 1234*10 tab "<<"
printl "2" : printl left ("text",3)
printl left "text",3
print left "text",3
output left "text",3
printl
wait
del t
*/



/*
'quad num literal 'nq' 'hq'
#show {
quad a
mov rcx,16
mov a,rcx
}
print hex a
*/

/*
'08/02/2026
'te'
'ue'
uses console
'extern
class cc
int i
method aa(string s)
print s cr
end method
method bb(string s)
aa(s)
end method
end class

class dd
int j
method m1(string s)
bb(s)
end method
method m2(string s)
bb(s)
end method
method m3(string s)
bb(s)
end method
has cc
has cc
method m4(string s)
bb(s)
end method
end class
#recordof cc
#recordof dd
'
dd c
c.m4 "ok4"
c.m3 "ok3"
c.m2 "ok2"
c.m1 "ok1"
c.aa "okaa"
c.bb "okbb"
c.m2 "ok2"
c.m1 "ok1"
'#show c.bb "ok2"
'#show c.aa "ok1"
'#recordof cc
'#recordof dd
wait
'del c
*/

/*
'okq
uses console
uses parseutil
'class tt
'stringarray
'end class

typedef textarray tt

'#recordof stringarray
'textarray t
tt t
t.load "t.txt"
t.line(2)="ok"
t.line(4)="ok"
for i=1 to 20
  string a=t.line i
  print i tab a cr
next
print cr cr t.lineCount
wait
*/

'30/01/2026

/*
'utf-8 checks
'print "£"
print chr 250

'28/01/2026
*/

/*
'area under normal distribution curve
'integral
int i
double pf=1/sqr(2*pi())
'pf=1
double x1=0.0, x2=0.0
double pa=0.0
double h=0.5
int bg=20000
int en=30000
x1=bg/10000
for i=bg to en
  x2=x1+0.0001
  pa+=exp(-h*x1*x2)
  x1=x2
next
print str(pa*pf,2)" /10000"
*/


/*
'area under normal distribution curve
'integral
int i
double pf=1/sqr(2*pi())
double x=0.0
double pa=0.0
double h=0.5
int bg=0000
int en=1000
x=bg/1000
for i=bg to en
  pa+=exp(-h*x*x)
  x+=0.001
next
'print pf
print str(pa*pf/10,2)" %"
*/



/*
'17/01/2026
'stats pascals triangle binomials
'inverse probability q = m! / n! * (m-n)!

'
'factorial m!
'
function f!(float m) as float
=============================
float t=1
do
  exit when m<2
  t*=m
  m--
loop
return t
end function
'
'
'coefficient  m! / (n! * (m-n)! 
'
function f!(float m, n) as float
================================
float t=1, d=1
do
  exit when n<1
  t*=m
  d*=n
  m--
  n--
loop
return t/d
end function

'TEST
'3 non red balls picked out of 5 in bag of 8
float q1=f!(5,3)
float qq=f!(8,3)/q1
print str(qq,3) cr str(f!(8))
*/


'
/*
'16/10/2025
'storestring iqq
#show wstring s=L"hello world"
string t="x"
string u=""
print s
*/

/*
'13/10/2025
'utft
'quotex iqq cqq
'test string nesting
string s
s=quote {
   quote aa quote bb " `hello` " bb aa 
}
print s
*/


/*
'16/06/2025
uses console
string ans
DO
ans = rtrim INPUT
if lcase(ans) = "y" : goto ExitDo : end if
print ans
END DO

ExitDo:
waitkey
CLS
*/

'16/05/2025

/*
'check bind encoding and mapping
'see splitoperand
sys p=getmemory 0x1000
bind p
int i,j,k
end bind
#recordof j
#show k=j
freememory p
*/

'13/05/2024

/*
$filename "..\u.exe"
uses rtl64
print sizeof sys
*/

'12/05/2024

'print string(10,3)


'06/05/2025

/*
uses console

print "dome panel design"
print "
            p
        --------
       /|     d2\
    s / |h2      \ s
     /w2|       a2\
    ------------------ww
     \w1|       a1/
    h \ |h1      / h
       \|     d1/
        --------
            t

"
float p,h,d1,d2,a1,a2,w1,w2,h1,h2,s,t,ww,sc
sc=40
p=1
h=0.8
d1=118
d2=124
p*=sc
h*=sc
----------
a2=180-d2
a1=180-d1
h1=h*sin(rad(a1))
w1=h*cos(rad(a1))
w2=w1
s=w2/cos(rad(a2))
h2=s*sin(rad(a2))
ww=sc+w2+w2
t=p
print "a1" tab a1 cr
print "a2" tab a2 cr
print cr
print "p"  tab p cr
print "w1" tab w1 cr
print "h1" tab h1 cr
print "h2" tab h2 cr
print "ww" tab ww cr
wait
'w1 0.375
'h1 0.706
'h2 0.556
'ww 1.751
's  0.671
't  1.000
'     
'
*/

/*
uses console

print "square series: 1 to 8 dimensions"cr cr
print "dims" tab "points" tab "lines" tab "faces" tab "volumes"
print tab "p4" tab "p5" tab "p6" tab "p7" tab "p8" cr cr
dim int a[8,9]
int y,x
a[1,1]=2
a[1,2]=1
for y=2 to 8
  a[y,1]=a[y-1,1]*2
  for x=2 to 9
    a[y,x]=a[y-1,x]*2 + a[y-1,x-1]
  next
next
for y=1 to 8
  print y
  for x=1 to 9
    print tab a[y,x]
  next
  print cr
next
print cr
wait
*/

'18/04/2024


'16/04/2024

/*
uses corewin
'%a -1
#show quad a=-1
'#show sleep a
*/


'15/04/2024

/*
'equate evaluation '% 'cword
int n
%k = 100
%wu = %k +1
#show {
select n
case wu
end select
}
*/


'12/04/2025

/*
'typu
uses unicode
*/

'11/04/2025

/*
type unistring
wbstring s
end type


'QSTRING
'
type qstring
sys p
int e
end type
'
function ToQstring(qstring*r,wbstring s)
========================================
  dword a,c,d,e,i
  sys p,q
  e=2*len(s) 'words
print e
  p=getmemory(2*e)
  word *ws : @ws=strptr(s)
  word *wq : @wq=p
  for i=1 to e step 2
    a=ws
    select a
    case 0xd800 to 0xdbff
      c=(a-0xd800)<<16
    case 0xdc00 to 0xdfff
      @wq-=4
      d-=2
      c=c or (a-0xdc00)
    case else
      c=a
    end select
    wq=c
    @ws+=2
    @wq+=4
    d+=2
  next
  if d<e
    'trim back
    q=getmemory d*2
    copy q,p,d*2
    freememory p
    p=q
  endif
  if r.p
    freememory r.p
  endif
  r.p =p
end function
  

function ToWstring(qstring qs) as wbstring
==========================================
dword a,c1,c2,ct,e,i
sys p,q
dword*qd
@qd=qs.p
dword le at qs.p-4
e=le>>1 'wide
q=getmemory le 'buffer
word*wd
@wd=q
for i=1 to e
  'higher unicode
  'convert to surrogate pairs
  if qd and 0xffff0000
    c1=0xd800+(qd>>16)
    wd=c1
    @wd+=2
    ct++
    c2=0xdc00+(qd and 0xffff)
    wd=c2
  else 'use lower 16its
    wd=qd
  endif
  @wd+=2
  @qd+=4
  ct++
next
q=getmemory ct*2
copy q,p,ct*2
freememory p
wbstring w
?w=q
return w  
end function


function append(qstring*r,*s)
=============================
int e
if r.p
  int lr at r.p-4
  e=lr
endif
if s.p
  int ls at s.p-4
  e+=ls
endif
sys q=getmemory lr+ls
if lr
  copy q,r.p,lr
endif
if ls
  copy q+lr,s.p,ls
endif
if r.p
  freememory r.p
endif
r.p=q 
end function

function move(qstring *r,*s)
============================
if r.p
  freememory r.p
endif
if s.p
  int ls at s.p-4
endif
sys q=getmemory ls
if ls
  copy q,s.p,ls
endif
r.p=q
end function


function add(qstring *r,*s1, *s2)
=================================
int e
if s1.p
  int l1 at s1.p-4
  e=l1
endif
if s2.p
  int l2 at s2.p-4
  e+=l2
endif
sys q=getmemory e
if l1
  copy q,s1.p,l1
endif
if l2
  copy q+l1,s2.p,l2
endif
if r.p
  freememory r.p
endif
r.p=q
'itr caller frees s1 and s2? 
end function


function mid(qstring s,int i,e=0) as qstring*
=============================================
i*=4  'index in bytes
e*=4  'length in bytes
int ls,m
sys p,r
if s.p
  int a at s.p-4
  ls=a
endif
if ls
  if e=0
    e=ls 'default
  endif
  if i=0
    i=4
  elseif i<0
    i=ls+i+4
  endif
  m=ls-i+4
  if i>ls
    e=0 'clip
  elseif m<e
    e=m
  endif
endif
p=getmemory e
if e
  copy p,s.p+i-4,e
endif
qstring*r
@r=getmemory sizeof(qstring) '8 or 12
r.p=p
r.e=e
return @r
end function



macro qstring_"conv" (r,a)
'up conv
print "convert"
ToQstring(r,a)
end macro

*/


'09/04/2025

/*
redim bstring s(1000)
mbox "ok"
#show {
del s
}
*/

/*
'left macros
macro ml(s,i) {mid(s,1,i)}
string s="12345"
string t
t=_left("e"s,3+1)
print t
*/


/*
'mixing ascii and unicode
wstring s
string t
s=L"unic "+"ABCD "+wchr(0x03b2)+chr(0x44)
t=L"ansi "+"ABCD "+wchr(0x03b2)+chr(0x44)
#show {
print s cr t
}
*/


'05/04/2025

/*
'test makestrptr
% ag="Helo"
'sys p=strptr("helo")
sys p=strptr(ag)
print p
print strptr(ag)
*/

'04/04/2025
/*
uses console
'print version
'himac capts()
string g_S[100]={"qwerty","asdf"}
print (g_S(1) space(30-len(g_S(1))) " >> " g_S(2) cr )
'print (g_S(1) " >> " g_S(2) cr )
'print (g_S(1) g_S(2) cr )
'print (g_S[1] g_S[2] cr )
'print ( g_S cr )
 'macro print(s="") output s
 'macro printl(s="") output s cr
'print ( ltrim("ok" 1 2 3 space(2)) " = " 42 cr cr)
wait
*/


/*
'test redim with compount types
'_lq_
type tt
int a,b
end type
int i=10
redim tt t[i]
t[5].a=23
redim tt t[i+10]
print t[5].a
*/

'03/04/2025

/*
'inline macro tests himac
int a[100]
macro m(y,x) a[(y)*10+(x)]
'#recordof m
a[23]=45
int yy=2, xx=3
print m(yy,xx)
m(yy,xx)=91
print a[23]
if m(yy,xx)=91 then print "ok" else print "nok"

*/

/*
'assigdim
int a
#show int i=a
*/

'02/04/2025

/*
'check array size
'elct
int a[5]={1,2,3}
print countof a
*/

/*
print true cr false ' -1 0
*/

/*
'test next word
int i
for i=1 to 10
next ii
print "ok"
*/

/*
'fix default print string
uses console.inc
print
printl
print "ok"
wait 
*/


'01/04/2025

/*
'check himac
macro m(
a=1,
b=2,
c=3
)
a=b+c
end macro
#recordof m
*/


'redim symbols
/*
type sizing_data
   int index
   sys hParent
   sys hCtl
   'PFactor pf1                    'placement factors
   'PFactor pf2                    'placement factors
   'RECT ofs                       'offset Left, Top, Right, Bottom
   int unpinned                   '0=pinned, 1=unpinned
   int w, h                       'width and height of parent
end type

'bounds for record data
type MaxPinnedCtls
   int count
end type

type tt
  int i
end type

tt t
t.i=12
redim int j(t.i) 'undefined symbol

'#recordof MaxPinnedCtls
'MaxPinnedCtls MaxPinned ={10} 'ok
'remap sizing_data PinCtl_Rec( MaxPinned.count) 'nok
'redim sizing_data PinCtl_Rec( MaxPinned.count)
'redim int i(MaxPinned.count) 'nok
'int d={MaxPinned.count,MaxPinned.count}
'print d[1] cr d[2] cr ubound d '10 10 2 ok
'redim sizing_data PinCtl_Rec( cco) 'ok
'redim sizing_data PinCtl_Rec( 10)
'print MaxPinned.count '10 ok
*/


'31/03/2025

/*
'test findas replas stripas replacement subsa
function f(int a=1,b,c=4) as int
return a+b+c
end function
'#recordof f
'print f(b=100) '105
'print f(c=40,b=10) '51
'print f(10,20,40) '70
'check stripas a =
*/


/*
'test himac new default values
macro m as int (
r, 
a=1,
b=2,
c=4
)
r=a+b+c
end macro
'#recordof m
print m(10) '16
print m(10,20) '16
*/


/*
'testing del on redims
redim string s(1000)
del s
print "ok"
*/


'30/03/2025

/*
'dynamic records
' maxit sps
print "ok"
*/


/*
'resolve rwpam / local scope problem
'unnest
function ff()
redim int a[150]
int c,d,e,f
print c cr d cr e cr f cr
end function
ff
*/


'27/03/2025

/*
'test local redim
'vot 'remap
function f(int n)
int c
redim int A[N]
int b
dim int d
'int x at @@A
'print x[-7] '0
'print x[-6] '0
'print x[-5] '1
'print x[-4] '100
'print ubound A '100
'int le at @A-4
'print le '400
#recordof c 'ebp-16
#recordof a 'ebp-20
'print @@A-ebp '-20
#recordof b 'ebp-116 '-44 ?
#recordof d 'ebp-120
del A
end function
f 100
*/



'23/03/2025

/*
'namespace notation from '..' to '::'
int i=1
int i=2
print prior i 'namespace compat lookupr
namespace x
int i=4
int i=8
print "prior n: " prior x::i cr i
end namespace

print x::i cr i
*/


'21/03/2025

/*
'fix macro+=
'findop 'cpa>2 'aryh 'accg
'
type buffer
int e
bstring s
end type
'
macro buffer_"move"(a,b)
a.s=b.s
end macro

'macro buffer_"conv"(a,b)
'#if typecodeof(b)>0xa0
'#print "convert b"
'a.s=b
'#endif
'end macro

macro buffer_"+"(a,b,c)
a.s=b.s+c.s
end macro

macro buffer_"+="(a,b)
'if len(a.s)<1024
'  a.s+=nuls(1024)
'endif
'#if typecodeof(b)<0x100
'  mid(a.s,1)=b
'  a.e=len(b)
'#else
'  mid(a.s,1)=b.s
'  a.e=len(b.s)
'#endif
end macro
'
string s,t
buffer m1,m2,m3,m4
'm1=m2+m3
'#show {
'm1+=m2
'}
'#show m1+=s'+t
'#show m1+=m2+m3
#show m1=m2+m3+m4
print "ok"
*/



/*
'ASSIGNING TYPH
'osg accg newclean
type tt
int n
end type
'
macro tt_"move"(a,b)
a.n=b.n
end macro
'
macro tt_"+"(a,b,c)
a.n=b.n+c.n
end macro
'
tt aa,bb,cc
'#show{
'aa=bb +cc
'}
'#show{
function f(tt*p) as tt
p.n=2
'return @p
end function
'}
#show{
'tt*paa=f(bb)
'tt*paa
'aa=f(bb)+f(cc)
'aa=f(bb+cc)
tt*paa
'paa=f(bb) 'copy
'@paa=f[bb] 'assign pointer
}
*/



'18/03/2025

/*
'test bytesof /glsl
function f(int*d,n)
print n
end function
f int{1,2,3},bytesof
*/

/*
type tt r as byte, g as byte, b as byte, a as byte
#recordof tt
*/


'16/03/2025

/*
'pi integral
double a,f
int i
for i=1 to 10000
  f=i/10000
  a+=sqr(1-(f*f))
next
a/=10000
print a cr a*2 cr a*4 cr exp(1)
*/

/*
double a,f
int i
for i=1 to 1000
  f=i/1000
  a+=sin(rad(f*90) )/1000
next
print a cr a*2 cr a*4 cr exp(1)
*/

/*
'area under bell curve
double e,h
int i
for i=0 to 1000000
  e=i/10000
  h=h+1/exp(e)
next
print 2*h/10000 '2
*/

/*
'area under bell curve
double e,h
int i
for i=0 to 1000000
  e=i/10000
  h=h+sqr(1/exp(e))
next
print 2*h/10000 '4
*/

/*
'area under bell curve
double e,h
int i
for i=0 to 1000000
  e=i/10000
  h=h+1/pow(1.618033988,e)
next
h/=10000
print h cr 2*h cr 4*h '2
*/



'13/03/2025

/*
'CONSOLE MENU SYSTEM
'console.inc
uses console


'mouse:
'left  click 1
'right click 2
'


enum nmenus
  NNUL
  NMAIN
  NMENUS
  NSTYLE
  NPREFERENCES
  NSTRUCTURE
  NSCALE
  NABSTRACT
  NBLOCKS
  NCONTROLS
  NCONVARS
  NUTILS
end enum

indexbase 0
SetCursor 0   'invisile
'

'global variables
'================

int menuWidth=24

int mnu=NMAIN   'selected menu
int mnn         'current menu
int k=0         'keypress
int n=0         'case selector
int ki=0        'key memory index
int ks[1024]    'key memory
'
string author   '
string project  '
string indent   '
string unline   '


subroutine keys
===============
k=waitkey()
if k=1 'mouse left click
  if mouseX<24
    if mouseY>=2 and mouseY<=12
      k=mouseY+47 '49-2
      if k=58 then k=48 '0 back'
    endif
  endif
endif
n=k-48
end subroutine


subroutine track
================
if k=27
  mnu=NMAIN
  ki=0
elseif k=48 or k=8 or k=27 'back
  if ki>0
    mnu=ks[ki] 'back
  endif
  if ki>0
    ki--
  endif
elseif mnu<>mnn
  ki++
  ks[ki]=mnn 'remember
endif
end subroutine


procedure gtu(string*inp, prompt) as string
===========================================
'get user input
int y=16 'line location
setpos 0,y
print prompt ": "
SetCursor 1
inp=input()
SetCursor 0
setpos 0,y
print space menuwidth
setpos 0,y
end procedure


procedure display(string s)
===========================
int a,b,c,e,f,g
g=menuWidth
a=3 'omit first crlf
do
  b=a
  c=asc(s,b)
  a=instr(a,s,cr)
  if a=0 then exit do
  e=a-b
  if e>g
    e=g
  endif
  f=g-e
  if c=45
    color 4
    print stringbytes(g,196)+cr
    color 7
    a+=2
    continue do
  elseif c=61
    color 4
    print stringbytes(g,205)+cr
    color 7
    a+=2
    continue do
  elseif c>=65
    color 14 'title
  elseif c<=59
    color 14
    print mid(s,b,2)
    b+=2
    e-=2
    f-=2
    color 7
  endif
  print mid(s,b,e)+space(f)+cr
  color 7
  a+=2 'skip vcr
loop
end procedure

'TESTCODE:
'=========

'
'do
'  k=waitkey
'  if k=27 then exit do
'  if k<4
'    print k tab mouseX tab mouseY cr
'  endif
'loop
'


subroutine ascii
================
int i
for i=160 to 255
  print i tab chr(i) cr
next
wait
end subroutine
'gosub ascii
'198 / 205 horizontal lines --- ===


=======
do 'mnu
=======
setpos 0,0
mnn=mnu
select mnu
'
'
---------------------------
'ruler    10         20  24
---------------------------
'
case NNUL 'mnu
display "
NULL MENU TEMPLATE 
==========================
 1
 2
 3
 4
 5
 6
 7
 8
 9
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 : 
end select
gosub track


case NMAIN 'mnu
display "
MAIN MENU
==========================
 1 Structure required
 2 Scale of project
 3 Preferences
 4 Project details
 5 Author details
 6 New menu
 7 
 8 
 9 
 0 Exit
==========================
 enter choice 0..9
"
gosub keys
select n
  case 1 : mnu=NSTRUCTURE
  case 2 : mnu=NSCALE
  case 3 : mnu=NPREFERENCES 
  case 4 : gtu project, "project name"
  case 5 : gtu author,  "author name"
  case 6 : mnu=NMENUS
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 : exit do
end select
gosub track
'
case NSTRUCTURE 'mnu
display "
STRUCTURE 
==========================
 1 module
 2 class
 3 function
 4 subroutine
 5 macro
 6 def
 7 block
 8 type
 9 array
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : mnu=NBLOCKS
  case 8 : 
  case 9 : 
  case 0 : mnu=NMAIN
end select
gosub track


case NPREFERENCES 'mnu
display "
PREFERENCES 
==========================
 1 Appearance / style
 2 Annotation
 3 Index
 4 References
 5
 6
 7
 8
 9
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
    gtu Indent, "indentation 1..4 chars"
    gtu unline, "underline main blocks"
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 : 
end select
gosub track

case NSCALE 'mnu
display "
ACTIVITY SCALE
==========================
 1 project
 2 program
 3 section
 4 demo
 5 code block
 6 declaration
 7 dim
 8 data block
 9
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : mnu=NCONTROLS 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 :
end select
gosub track

case NABSTRACT 'mnu
display "
ABSTRACTION
==========================
 1 literal
 2 variable
 3 array
 4 function
 5 object
 6 pointer
 7 macro
 8 
 9 
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 : 
end select
gosub track

case NBLOCKS 'mnu
display "
BLOCKS
==========================
 1 scope
 2 namespace
 3 control blocks
 4 macros
 5 modules
 6 var declarations
 7 proc declarations
 8 defintions
 9 menus
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : mnu=NCONTROLS
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 :
  case 0 :  
end select
gosub track

case NCONTROLS 'mnu
display "
CONTROL BLOCKS
==========================
 1 if .. else
 2 select case
 3 for next
 4 while .. wenend
 5 do .. loop
 6 goto .. label
 7 
 8 
 9 
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 : 
end select
gosub track

case NCONVARS 'mnu
display "
CONSTANTS AND VARIABLES
==========================
 1 equates
 2 logical
 3 flags
 4 integer values
 5 floating point values
 6 pointers and handles
 7 memory / space
 8 compound types
 9 
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 : 
end select
track

case NUTILS 'mnu
display "
UTILITIES
==========================
 1 parser
 2 storage
 3 user interface
 4 input 
 5 output
 6 tables
 7 index / filter
 8 format
 9 media
 0 back
==========================
enter choice 0..9
"
gosub keys
select n
  case 1 : 
  case 2 : 
  case 3 : 
  case 4 : 
  case 5 : 
  case 6 : 
  case 7 : 
  case 8 : 
  case 9 : 
  case 0 : 
end select
gosub track

case else 'mnu
  mnu=NMAIN

===============
end select 'mnu
===============
loop
SetCursor 1
*/






'10/03/2025



/*
'test unique symols
'lomac
def m
'dim as int %0j
'dim %0j as int
'dim int a,%0j
int %0j
j=42
print j '42
end def
int j=1
m
print j '1
*/

/*
  'namespace 13
  'setna
  'lw,mw
  'dotm
  'NESTABLE NAMESPACES
  int x=1
  namespace a
    int x=21
    namespace b
      int x=42
      namespace c
        int x=56
      end namespace
    end namespace
    'print x '21
  end namespace
  '
  namespace a..b..c
    print x '56
  end namespace
  '
  'print a..x '21
  'print a..b..x '21 'paren a..x
  print a..b..c..x '56
  'print x '1
*/


/*
'test improved nested namespace
int i=1
namespace n1
  int i=4
  namespace n2
    print i '4
  end namespace
  print i '4
end namespace
print i '1
print n1..i '4
*/


'09/03/2025


'08/03/2025

/*
'test elct dyn remap
int i=32
dyn int d(i)
print countof
d={10,20,30,40}
print countof
print d[3]
*/

/*
  'remap int dat(5,5,2)
  redim int dat(5,5,2)
  print dims(dat)
  print ubound dat
  print elements dat
  print strider dat,1
  print scaler dat,1
  'int i
  'for i=lbound(dat) to ubound(dat)
  'dat[i]=""
  'next
  'mbox "ok" i
*/


/*
'cword himac acewd
macro m(i)
#if ndef i
#else
#recordof i
#endif
end macro
#recordof m
m() '1','2
*/



'07/03/2025

/*
'qot
'combining string literals
#show print "a" "b" "c"
'
'int i=33
'#unquote
'print #unquote "i"
*/



/*
int k=2
macro ubound int(a,b,k)
  '#if flagsof(b) and 2
    '#print flagsof b
    '#print "a" 
    '#print "b"
    #if ndef k
      #print "n k"
      a=elements(b)+indexbase-1
    #else 'if def k
      #print " p k"
      #recordof k
      _diminfo a b (12+(k*8)) 'ubound loc: -16+4
      a+=indexbase-1
    #endif
  '#else 'not an array
  '  a=indexbase
  #endif
  end macro
'
redim float f[5,1]
int k=1
'print ubound(f)
'print elements(f)
;
'for k=1 to ubound(f)
'next
'del f
*/

/*
'acewd
'himac
'test new macro
macro m(a) 
 'print "a a " #a
 'print "ok a##.x "
 print "ok a##a##.a.##x "
end macro
'#recordof m
'#define m(a) print "a a " #a
'
m(hello)
*/





'04/03/2025



'03/03/2025

/*
'area under bell curve
double e,h
int i
for i=0 to 1000000
  e=i/10000
  h=h+1/exp(e)
next
print 2*h/10000 '2
*/


/*
'test initialisation variables
print qu+"infinity"+qu+spc+infinity cr 1/infinity cr 1 cm 2 tab 3 crlf
*/

/*
'test cap sensitivity
int v=123
macro mm(a)
print A
end macro
mm v
*/

/*
'test power
print 2^3
'test exp
print exp(1)
*/


'28/02/2025

/*
dim int*a(10,20)
print ubound(a,2) '20
*/

/*
'#tally
print #tally {a,{v,w,x},c} '3
*/

/*
'test on errortrap
'
int a=2
'
subroutine aa
print 1
end subroutine
'
subroutine bb
print 2
end subroutine
'
subroutine cc
print 3
end subroutine
'
on a gosub {@aa,@bb,@cc} '2
*/

/*
'dyn and stretch
dyn int a(40)
a[10]=123
stretch a(80)
int le=*(@a-4)
print le cr a[10] '320 123
stretch a(20)
int le=*(@a-4)
print le cr a[10] '80 123
*/

/*
'improve anymatch
#if not anymatch " goto gosub call ", "go"
  #error "expecting: goto / gosub / call"
#else
  #print "ok"
#endif
*/

'27/02/2025

/*
'unclosed brackets
'error detection
'int a
'a=((4+1)+(a+4)
def calcPos
  'assume base 0'
  @va=pa+4*( (pz*my*mx) + ((py*mx) +px )
end def
#recordof calcpos
*/


/*
'redim inside an objerct
'
==============
class Object3d
==============
'
sys pa       'array pointer
int mx,my,mz 'dimensions
int ma       'total bytes
float *va    'array access var

def calcPos
  'assume base 0'
  @va=pa+4*( (pz*my*mx) + (py*mx) +px )
end def
'
method in(float *v, int pz,py,px)
  calcPos
  va=v
end method
'
method in(float *v, int pz,py,px,n)
  calcpos
  int i
  for i=1 to n
    va=v
    @v+=4
    @va+=4 'stride float elements
  next
end method
'
method out(int pz,py,px) as float
  calcpos
  return va
end method
'
method clear()
  freememory pa
  mx=0 : my=0 : mz=0 : ma=0 : pa=0
end method
'
method redims(int xx,yy,zz, keep=1)
  int m=xx*yy*zz*4 'sizeof float
  sys q=getmemory m
  if m<ma
    ma=m
  endif
  if pa
    if keep
      copy q, pa, ma
    endif
    freememory pa
  endif
  pa=q
  @va=pa
  ma=m
  mx=xx : my=yy : mz=zz
end method
'
method constructor(int xx,yy,zz)
  redims xx,yy,zz, 0
end method
'
method destructor()
  clear
end method
'
end class
'
'#recordof object3d
'
'======
'TESTS:
=======

new object3d v(4,3,2)
v.in  float {10,20,30,40,50,60}, 3,2,1, 6
print v.out 3,2,2
del v
*/



/*
'OOPIFIED
'STRING STORAGE BUFFER
'for printing in one go
'and other uses
'
class buffer
===========
'
string prbuf 'string buffer
string prw   'expression to store  
int    pri   'index in prbuf
int    lw    'length of prw
'
method in(string prw)
  int lw=len(prw)
  while len(prbuf) < pri+lw
    prbuf+=nuls 1024  'extend prbuf size
  wend                '
  mid prbuf,pri+1,prw 'patch in prw
  pri+=lw             'shift the index
end method
'
method clear()
  'CLEARING THE UFFER TO USE AGAIN
  pri=0    'reset the index
 'prbuf="" 'necessary when using instr to search.
end method
'
method read() as string
  method=left prbuf,pri
end method
'
method out() as string
  method=read
  clear
end method
'
method constructor()
  clear
end method
'
method destructor()
  clear
  del prbuf
end method
'
end class


'TEST:
'=====
new buffer pr
pr.in "Hello" " "
pr.in "world"
pr.in "!"
print pr.out
'
del pr
'
*/


/*
'STRING STORAGE BUFFER
'for printing in one go
'and other uses
'
string prbuf 'string buffer
string prw   'expression to store  
int    pri   'index in prbuf
int    lw    'length of prw
'
def printa
  prw=%1 'expression to store
  lw=len(prw)
  while len(prbuf) < pri+lw
    prbuf+=nuls 1024  'extend prbuf size
  wend                '
  mid prbuf,pri+1,prw 'patch in prw
  pri+=lw             'shift the index
end def

'TEST:
'=====
printa("helo"+" ")
printa("world")
printa("!")
print left prbuf, pri
'
'
'CLEARING THE UFFER TO USE AGAIN
pri=0    'reset the index
prbuf="" 'necessary when using instr to search.
*/


'26/02/2025


/*
'-----------------------
'generic PROGRAM OUTLINE
'=======================
'
'
==============
module 'demos'
==============
'
interface

%   active   1
%   inactive 0
int trace=0
'
==========
class demo
==========
'
% eq1 1
% eq2 2
'
type typ         '
  int i          '
  bstring s      '
  float w,x,y,z  '
end type         '
  '
static int count   '

internal
  '
  def df
    "%1"
  end def
  '
  macro mm(a=1,b=2)
    a+b
  end macro
  '
  '
  static function fn(int a) as int
    '
    '
  end function
  '
end internal
'
typ dat[10] '
float f,g,h '
float x,y,z ' 
int i       '
int j       '
int k       '
int le      '
sys p       '
sys q       '
bstring s   '
bstring t   '
bstring u   '
bstring w   '
'
method constructor()
====================
  count++
  s=""
  t=""
  u=""
  w=""
  if trace
    print "constructor"
  endif
end method
'
method destructor()
===================
  clear
  del s
  del t
  del u
  del w
  count--
  if trace
    print "destructor"
  endif
end method
'
method clear()
==============
  s=""
  t=""
  u=""
  w=""
  i=0
  j=0
  k=0
end method
'
method actor(int a=0)
=====================
  '
  internal function fm(int a) as int
    return a*2
  end function
  '
  subroutine sbr
    if trace
      print "actor "+ fm(21)
    endif
    exit subroutine
  end subroutine
  '
  gosub sbr
  ;
end method
'                   '
method in(int a)
================
  i=a
end method
'
method out() as int
===================
  return i
end method
'
'pseudo variable
'
method pa(int v)
================
  i=v
end method
'
method pa() as int
==================
  return i
end method
'
method getcount() as int
========================
  if trace
    print "count: " count
  end if
  return count
end method
'
================
end class 'demo'
================
'
int i,j,k
int *dat
'
declare function ptr fi(int i) as int
'
end interface
'
scope
  i=1
  function f(int i) as int, link @fi
  end function
  '
  function g(int i) as int
  end function
end scope
'
==================
end module 'demos'
==================

'TESTS:
'======

{
trace=inactive
new demo d()
d.actor
d.getcount
'del d
'undim d
print @d
}
'
'trace=inactive
'int x=2
'int y=2
'redim demo da(y,x)
'del da

print "ok"
*/




/*
'check class calls
==================
'#show {
class cc
static int i
method mm() as int
i+=123
print i
return i
end method
end class
'}
new cc c
new cc d
cc.mm
d.mm
del c
del d
print "ok"
*/



'25/02/2025

/*
uses console

def fieldnames
==============
scope
  int x
  for x=lbound(%1,2) to ubound(%1,2)
    %2
  next
  %3
end scope
end def

def tabulation
==============
scope
  int y,x
  for y=lbound(%1,1) to ubound(%1,1)
    %2
    for x=lbound(%1,2) to ubound(%1,2)
      %3
    next
  next
end scope
end def

def JSONFormat
==============
scope
  int y,x
  print "{" cr
  print "  "+qu+"xn"+qu+":[ "
  for x=lbound(%1,2) to ubound(%1,2)
    print qu+%2+qu
    if x<ubound(%1,2)
      print ","
    endif
  next
  print " ]" cr
  for y=lbound(%1,1) to ubound(%1,1)
    print "  "+qu+"y"+y+qu+":[ "
    for x=lbound(%1,2) to ubound(%1,2)
      print qu+%3+qu
      if x<ubound(%1,2)
        print ","
      endif
    next
    print " ]" cr
  next
  print "}" cr
end scope
end def

redim bstring t[8,4]
'
'INPUT DATA:
tabulation t () (t[y,x]=y*10+x)
'
'DISPLAY:
fieldnames t (print tab "n" x) (print cr)
tabulation t (print cr y) (print tab t[y,x] )
print cr
'
'DISPLAY JSON
JSONformat t ("x"+x) (t[y,x])
wait
del t
*/


/*
function f()
dim static int x
end function
*/

/*
function f()
int ii=10
redim string zc[ii,ii]
zc={1,2,3,4,5}
redim string zc[ii+2,ii]
print dims(zc) cr ubound(zc)
print zc(1,1) cr zc(1,5)
end function
f()
*/

/*
'remap class problem
class cc
float*zc
int ii
method m()
ii=10
int j[2]
j={ii}
remap float zc[ii]
print ubound(zc)
end method
end class
cc c
c.m
*/


/*
'strptr code not printing directly
string s[100]
s={"hello","world"}
print s[2]
int i=1,j,k
j=strptr(s)
k=strptr(s[i+1])
'print j cr k
print str(strptr(s[i])) cr str(strptr(s[i+1])) cr str(strptr(s[2])) cr 
'strptr type?
*/


/*
'adjustbuf macro
'===============
bstring s="Hello World"
adjustbuf (strptr s) (len s) 5
print s
*/

/*
'single rem test
int i=10
int a[8]
redim bstring s(i)
s[1]=1
s[2]=12
s[3]=123
redim string s(9)
'redim int s(14)
'redim int s(i)
'print ubound(s) cr strider(s) cr
print s[1] cr s[2] cr s[3] cr
'not strings!
*/

'24/02/2025

/*
int i=100
int j=2
int k=3
int a[4]
redim int s[i,j,k]
s[10,2,1]=1
s[10,2,2]=12
s[10,2,3]=123
redim int s[i-10,j,k]
print "ubounds " cr +
ubound(s,1) cr ubound(s,2) cr +
ubound(s,3) cr ubound(s) cr
print s[10,2,1] cr s[10,2,2] cr s[10,2,3] cr elements(s) cr +
"0x" hex flagsof(s)
'print ubound(s)
*/




'23/02/2025

/*
'annotation of redim seq
'48 b9
int i=10
int j=2
int k=3
int l=4
'#show "t.txt" {
'int a1,a2,a3 'uf += nuls ... 64it corruption?
redim bstring s[i,j,k,l]
'remap bstring s[i,j,k,l]
'dim bstring s[10,2,3,4]
'}
print ubound(s,1) cr ubound(s,2) cr ubound(s,3) cr ubound(s,4) cr ubound(s) cr
*/

/*
'test for local offsets
'
function f()
#show int a=42
end function
'
function g()
#show int b=43
end function
*/


'23/02/2025

'22/02/2025



'21/02/2025

/*
int i=100
redim string s[i]
print ubound(s) cr strider(s,1)
s[1]=1
s[2]=12
s[3]=123
print s[1] cr s[2] cr s[3] cr
*/

/*
'test flagsof logic
int h[100]
int h
'print flagsof h
#if flagsof(h) and 16
print 123
#endif
*/

/*
'using stringarray techniques
'bstring b=nuls 100*sizeof string
sys p=getmemory 100*sizeof string
bstring *s
@s=p 'strptr(b)
s[2]="helo"
s[1]= s[2] s[2]
print s[1] cr ubound(s) cr
*/


'64bit memory assignment tests
/*
int i=100
int j=sizeof string
sys p
bstring *s[i]
#show p=getmemory i*j'sizeof(string)
@s=p
#show s[2]=""
's[1]="helo"
'print s[2] cr len(s[2]) cr sizeof(s) cr strider(s,1) cr
'print s
print "ok"
*/


'20/02/2025

/*
'redim checks
'rmwops
'flagsof
dim string s[102]
int i=100
'#recordof redim
'quote in text
remap string sd[i]
@sd=getmemory i*sizeof(string)
'for i=1 to ubound(sd)
'  sd[i]=""
'next
#show ForEach sd { sd[i]="" }
print ubound(sd) cr sizeof(string)
freememory @sd
print "ok"
*/


/*
%m "£"
#if flagsof(m)=0
  print "ok"
#else
  print "nok"
#endif
*/

/*
'alignment check (string concat)
string s="ok"
function f() as int
jmp fwd begin
subroutine sr
print "sr"
function=123
end subroutine
begin:
'#show gosub sr
sys p=@sr
#show gosub p
end function
print f
s+=s
print s
*/

/*
'procedural oop

interface
=========
% ObjCreate  0
% ObjAct     1
% ObjDestroy 2
% ObjSet     3
% ObjReset   4
'
'typedef sys obj
type obj
int a[16]
end type
'_del
function obj_proc(sys *p,n,q=0) as int
======================================
  indexbase 0
  jmp fwd begin
  '
  '
  subroutine create
  -----------------
  'print "create"
  n=100
  end subroutine
  '
  subroutine act
  --------------
  'print "act" cr
  n=101
  end subroutine
  '
  subroutine destroy
  ------------------
  'print "destroy"
  n=102
  end subroutine
  '
  subroutine set
  --------------
  n=103
  end subroutine
  '
  subroutine reset
  ----------------
  n=104
  end subroutine
  '
  begin:
  on n gosub {
    @create,@act,@destroy,@set,@reset
  }
  return n
  '
end function
'
TEST:
=====
'2104
char c[100] s="!"
'dim obj bj
'print typeof bj
'print typecodeof(bj)
'#show obj_proc bj,0,sizeof(obj) 'create
'typeof(bj)_proc bj,1 'act
'obj_proc bj,2    'destroy
new obj bj() 'static
'#show mbox  "£"s 'str 123
#show s+=s
obj_proc(bj,1,0)
obj_proc(bj,3,0)
del bj
print "ok"
*/



'19/02/2025
/*
'retest new and del
class cc
int a[16]
method constructor(int n)
print "constructor"
end method
method destructor()
print "destructor"
end method
end class
'test
'new 18
#show new cc c(1)
'#if 2 and 2 =0
'  #print flagsof(c) or 3
'#endif
#show {
  del c
}
*/


/*
'test macro syol concatenation
macro m(a) a' 
int a$
print m(a)$
*/


/*
'test view
string s="Helo"
string t="World"
view s
view t
*/



'18/02/2025

/*
'UNDEF isolating using o2 z
int a
'scope
'function f()
'end function
#show {
function f(int a)
print 456
end function
}
'function f(int a,b)
'end function
'#recordof f
'end scope
'undef f
gosub f
print 123
*/



'17/02/2025


/*
def on
====== 
'%1' name of index variale
'%2' goto or gosub or call
'%3' { @label1,@label2,...}
'$$  reserved name ending
scope
static sys st$$[64]
if not st$$[1]
  st$$[1]={%3}
endif
if %1
  %2 st$$[%1]
endif
end scope
end def
*/

/*
function f(int v,n=0) as int
============================
  '
  on n gosub {@sr1,@sr2,@sr3,@sr4}
  '
  subroutine sr1
  --------------
    print "sr1"
  end subroutine
  '
  subroutine sr2
  --------------
    print "sr2"
  end subroutine
  '
  subroutine sr3
  --------------
    print "sr3"
  end subroutine
  '
  subroutine sr4
  --------------
    print "sr4"
  end subroutine
  '
  return v
end function
'
'TEST:
int i
for i=1 to 4
  f(0,i)
next
*/



'16/02/2025



/*
'filtering and indexing
'======================
uses console
'
'SOME DATA:
===========
dim string s=
{
  "socks","carrots","oranges","desks",
  "zebra","grapes","eternity","arrow","yurt"
}
print ubound(s) cr
'
'SETUP FILTERING AND SORTING SPEC

macro filter(ok,a)
==================
if asc(s[a])>=0x79 'yz'
  ok=0
else
  ok=1
endif
end macro
'
macro comparator(swap,a,b)
==========================
'ascending order
if s[a]>s[b] then swap=1
end macro
'
'BUILD INDEX
'
reindex (idx,ubound(s),count,filter,comparator)


'DISPLAY RESULT USING IDX

print cr count cr
int i,j
for i=1 to count
  j=idx[i]
  print s[j] cr
next
del idx 'when done
wait
*/
  
/*
macro Chances as float(r, n,p)
==============================
'n nomber of opportunities or trials
'p probability of a single coincidence
float np=1.0-p 
r=pow(np,n)
r=1.0-r
end macro
'
'TEST
'going to a party with 50 guests.
'what is the chances that someone at the
'party has the same birthday as you?
print str(chances(50, 1/365)*100,0) "%"  '13%
'also
print str(chances(300, 1/365)*100,0) "%" '56%
*/

/*
def ForEach
===========
scope
int i
for i=lbound(%1) to ubound(%1)
  %2
next
end scope
end def

int a[2]
ForEach a { a[i]=i }
ForEach a { print a[i] }
'ForEach obj { obj[i].id=i }
*/

/*
macro max as int(r,a,b)
=======================
if a>b
  r=a
else
  r=b
endif
end macro

macro min as int(r,a,b)
=======================
if a<b
  r=a
else
  r=b
endif
end macro
'
int a=1,b=2
print "" min(a,b)
print "" max(a,b)
*/


/*
macro mean as float(r,a)
========================
scope
  int i,l,u
  l=lbound(a)
  u=ubound(a)
  float t=0
  for i=l to u
    t+=a[i]
  next
  r=t/(u-l+1)
end scope
end macro

macro variance as float(r,a)
============================
scope
  int i,l,u
  float m,d
  m=mean(a)
  l=lbound(a)
  u=ubound(a)
  float t=0
  for i=l to u
    d=a[i]-m
    d*=d
    t+=d
  next
  r=t/(u-l+1)
end scope
end macro


dim int a={1,2,3,4,5,6}
print mean(a)
'standard deviation
print sqr(variance(a))
*/




'15/02/2025

/*
'vot=
'uses console
'indexbase 1

function dat( bstring s1=null, s2=null) as string
=================================================
  'AssociativeArray 2
  indexbase 1
  static int c[1] 'alignment?
  static string n[1000]
  static string d[1000]
  static int e,i
  '
  if ?s2=0
    for i=e to 1 step-1
      if n[i]=s1
        return d[i]
      endif
    next
    exit function 'not found
  endif
  'storing
  for i=e to 1 step-1 
    if n[i]=s1
      d[i]=s2 'store
      exit function
    endif
  next
  'new record
  e++
  if e>ubound(n)
    'overflow error ...
    exit function
  endif
  n[e]=s1
  d[e]=s2
end function
'
'TEST
dat()
dat("B")=4
dat("B",40)
dat("A")=2 'itr procedures subsas
print dat("A") cr dat("B") cr
wait
*/



/*
change vot 32 to 40
'14/02/2025
indexbase 1
string x=nuls 10
string y=nuls 10
'int k
'int k
string t [1] '=x+y
'int k[1]
'#recordof x
#recordof t
t=t[1]
'#print 456
print 123
*/

/*
uses parseutil
'load save
'class TextArray
textarray t
t.load "oxylog.txt"
t.save "t.txt"
print "ok"
*/

/*
'AssociativeArray 1
dim string n[1000]
dim string d[1000]
int i,e
function dat(string s1,s2)
  for i=1 to e
    if n[i]=s1
      d[i]=s2
      return
    endif
  next
  e++
  n[e]=s1
  d[e]=s2
end function
'
function dat(string s1) as string
  for i=1 to e
    if n[i]=s1
      return d[i]
    endif
  next
end function
'
'pseudo assignment
dat("A")="1"
dat("A","10")
dat("B")="20"
dat("B")="200"
print dat("A")
dat("A")=100
print dat("B")
print e
wait
*/

/*
'len intercept not feasible
indexbase 0
int a[10]
print lbound(a) cr ubound(a)
*/



/*
'mid format check
string s="abcd"
mid(s,3,"C")
print s
mid(s,3)="c"
print s
*/



/*
'test c style if
int a,b,c
'if (a==b) c=4
'if (a<>b){c=4} else {c=1};
'if (a<>b){c=4} elseif (a==b){c=1};
if (a<>b){c=4} elseif (a>b){c=1} else {c=10};
print c
*/


/*
'12/02/2025
'2d array to JSON
'
dim int ar[10,10]
int x,y
'
'DATA
'
for y=1 to 10
  for x=1 to 10
    ar[y,x]=x-11+y*10
  next
next
'
'JSON FORMAT 2D ARRAY
'
uses console
int le
string s
int i=1
string buf=nuls 100000 '100k
'
def append
  le=len  s
  mid buf,i,s
  i+=le
end def
'
s="{"+cr+"  "+qu+"array"+qu+":["+cr
append
for y=1 to 10
  s="    [ "
  append
  for x=1 to 10
    s=str(ar[y,x])
    if x<10
      s+=","
    endif
    append
  next
  s="  ]"+cr
  append
next
s=cr+"  ]"+cr+"}"+cr
append
'
buf=left buf, i-1
print buf
wait(10000)
*/


'10/02/2025
/*
  operator max 1 'name and precedence level
  '
  type hInt int v
  '
  macro hInt_"move"(a,b)
    a.v=b.v
  end macro
  macro hInt_"max"(acc,a,b)
    if b.v>a.v
      acc.v=b.v
    else
      acc.v=a.v
    endif
  end macro
  '
  hInt a,b,c,d
  a.v=1 : b.v=10 : c.v=-10
  d=a max b max c
  print d.v '10
'*/


/*
'"dim '
'dim s as string="ok"
'dim s="ok",t="helo" as string
'dim as string s[]={ "one","two","three" }
'dim as string s[]<=( "one","two","three" )
'dim as string s<={ "one","two","three" }
'print ubound(s)
 'dim c as char*10  'c(10)
 'dim c(10) as char*16*2 'c(10,16,2)
 'print dims(c)
 'print ubound(c,1)
 '"let '
 'let s=32.5 as int 'bstring
 'print typeof s
 'print s
 'let s="This is a fixed length string" as char*50
 'print len(s)
 'print s
 'let p=pi()
 'print typeof p
 'print p
 '
 function f() as float
 return 23
 end function
 let b=f()
 print typeof b
 print b
*/

/*
'test ubound etc
dim int a[20,10]
'print ubound(a,1)
'print ubound(a,2)
'print dims(a)
'print scaler (a,1)
print strider (a,1)
*/


/*
'test subroutine local variables
function f()
  'int a,b,c,d '<-- place main locals here
  subroutine x '<-- place subroutine below
  int a,b,c,d
  #recordof d
  end subroutine
  int a,b,c,d
  #recordof d
end function
*/

'08/02/2025


/*
'JSON PARSING
'10/02/2025
'
uses console
'
'INPUT
'
string s=quote
~~~

{
"employees":[
    {"firstName":"John", "lastName":"Doe", value:30.5 },
    {"firstName":"Anna", "lastName":"Smith"},
    {"firstName":"Peter", "lastName":"Jones"}
]
}

~~~

interface
=========
'
's source strung
'
'outputs:
'
string name[1000] 'names of objects
string  dat[1000] 'data of objects
int    dmap[1000] 'location of name:object
int    dlvl[1000] 'nesting level of objects
int    je         'count of all objects
'
====================
subroutine JsonParse
====================
'
indexbase 1 'arrays lbound
int i,j
int gf,bf,be,cc,sc,db,ty,dm
int qc,qf,qe,td,tf,te,sa,sd,nc
byte*b
@b=strptr(s)-1 'byte overlay
i=0            'char iterator
j=0            'index items
sa=0           'array capture flag
sd=0           'array items flag
nc=0           'nesting depth
'
'
===================================
NextItem: 'clear flags and counters
===================================
'
j++            'increment name / dat index
qf=0           'quote flag start
qe=0           'quote end
qc=0           'quote toggle
tf=0           'text flag
bf=0           'object flag
gf=0           'array fkag stt
cc=0           '{} object depth
sc=0           '[] array depth
td=0           'end of text flag
ty=0           'type of direct data
dm=0           'dmap assigned flag
ty=0           'raw data flgs
db=sa          'data flag

================
do 'parsing loop
================
'
@b++
i++
td=0 'assume delimiting char
'
select b 'byte pointer
'
=========
case   0 ' ' end of string
=========
  '
  exit do
  '
=========
case 1 to 32 ' ' white space
=========
  '
  continue do
  '
=========
case  "\" 'escape char
=========
  @b++ : i++ : td=1
  'itr edit out '\'
  if b=0 then exit do
=========
case  34 '"' quote flag toggle
=========
  qc xor=1
  if qc then
    qf=i
  else
    qe=i
    if gf+bf=0
      if db
        dat(j)=mid(s,qf+1,qe-qf-1)
        if dm=0
          dmap[j]=qf+1
          dlvl[j]=nc
        endif
        goto nextitem
      else
        name(j)=mid(s,qf+1,qe-qf-1)
        dmap[j]=qf+1
        dlvl[j]=nc
        dm=1
        tf=0 'text flag
        db=1 'data flag (expecting)
        continue do
      endif
    endif
  endif
==========
case qc<>0 
==========
  '
  continue do 'till the quote ends
  '
=========
case ","
=========
  'capture unquoted data
  gosub captData
  if ty
    goto nextitem
  endif
=========
case  ":"
=========
  if gf+bf=0
    if qf=0 then 
      name[j]=mid(s,tf,te-tf+1) 'raw name
      dmap[j]=tf
      dlvl[j]=nc
      dm=1
    endif
    qf=0 'clear quote flag
    tf=0 'text flag
    db=1 'data flag (expecting)
    continue do
  endif
=========
case  "["
=========
  nc++
  if db
    sc++
    if gf+bf=0
      if sc=1 'start array
        bf=i
        sa=1 'array capture flag
      endif
    endif
  else 'db=0
    'splitting array into separate items
    'no name assigned
    name(j)=""
    sd=1
  endif
=========
case  "]"
=========
  nc--
  sc--
  gosub CaptData
  if sc=0 'end inner array
    sa=0
    if ty=0
      dat[j]=mid(s,bf,i-bf+1)   'brackets included
      if dm=0
        dmap[j]=bf
        dlvl[j]=nc
      endif
    endif
    goto nextitem
  elseif sc<0
    sc=0
    sa=0
    sd=0
    if nc<=0
      if ty
        j++
      endif
      exit do 'splitting array complete
    else
      goto nextitem
    endif
  endif
=========
case "{"
=========
  nc++
  if sa+sd
    db=1 'objects inside an array
  endif
  if db
    cc++
    if cc=1 'inner object
      gf=i  'start of {} block
    endif
  else 'db=0
    'splitting an object into parts
  endif
=========
case "}"
=========
  nc--
  cc--
  gosub CaptData
  if cc=0 'end inner object
    if sa=0 'not inside array
      dat[j]=mid(s,gf,i-gf+1) 'brackets included
      if dm=0
        dmap[j]=gf
        dlvl[j]=nc
      endif
      goto nextitem
    endif
  elseif cc<0
    cc=0
    if nc<=0
      if ty
        j++
      endif
      exit do 'splitting array complete
    else
      goto nextitem
    endif
  endif
=========
case else 'covers all other ascii
=========
  td=1
  if gf+bf=0
    if tf=0
      tf=i 
      'start of unquoted /
      'name/number/true/flse/null
    endif
    te=i
  endif
end select
'
'
end do 'parsing loop


SubRoutine CaptData 'internal
=============================
'
ty=0
if gf+bf+td+qf=0
  if tf
    if db
      'unquoted data
      dat[j]=mid(s,tf,te-tf+1)
      if dm=0
        dmap[j]=tf
        dlvl[j]=nc
      endif
      'numbers/true/falsr/null
      ty=1
    endif
  endif
endif
end subroutine 'CaptData


je=j-1 'set end of data

end subroutine 'JsonParse
'
'===========
'TEST OUTPUT
'===========
'
int i
print cr
gosub JsonParse
for i=1 to je
  print i " NAME: " name[i] cr
  print i " DATA: " dat[i] cr
next
print cr cr
'
print "split array" cr
s=dat(1)
gosub JsonParse
for i=1 to je
  print i " NAME: " name[i] cr
  print i " DATA: " dat[i] cr
next
print cr

print "split object" cr
s=dat(1)
gosub JsonParse
for i=1 to je
  print i " NAME: " name[i] cr
  print i " DATA: " dat[i] cr
next
print cr

wait
*/


/*
'parseutil

'json parse

FUNCTION JSON_Parse (jsonString AS STRING) AS VARIANT

    ' Entferne führende und nachfolgende Leerzeichen
    jsonString = TRIM$(jsonString)

    ' Überprüfe, ob es sich um ein Objekt oder ein Array handelt
    IF LEFT$(jsonString, 1) = "{" THEN
        ' Objekt parsen
        JSON_Parse = ParseObject(jsonString)
    ELSEIF LEFT$(jsonString, 1) = "[" THEN
        ' Array parsen
        JSON_Parse = ParseArray(jsonString)
    ELSE
        ' Wert parsen
        JSON_Parse = ParseValue(jsonString)
    END IF

END FUNCTION

FUNCTION ParseObject (jsonString AS STRING) AS OBJECT

    ' Erstelle ein leeres Objekt
    DIM obj AS OBJECT
    CREATE OBJECT obj

    ' Entferne die geschweiften Klammern
    jsonString = MID$(jsonString, 2, LEN(jsonString) - 2)

    ' Teile den String in Schlüssel-Wert-Paare auf
    DIM pairs AS STRING
    pairs = SPLIT$(jsonString, ",")

    ' Verarbeite jedes Schlüssel-Wert-Paar
    DIM i AS INTEGER
    FOR i = 0 TO UBOUND(pairs)

        ' Teile das Paar in Schlüssel und Wert auf
        DIM pair AS STRING
        pair = TRIM$(pairs(i))
        DIM keyValue AS STRING
        keyValue = SPLIT$(pair, ":")

        ' Extrahiere Schlüssel und Wert
        DIM key AS STRING
        key = TRIM$(MID$(keyValue(0), 2, LEN(keyValue(0)) - 2))
        DIM value AS STRING
        value = TRIM$(keyValue(1))

        ' Füge den Wert dem Objekt hinzu
        obj.Add key, JSON_Parse(value)

    NEXT i

    ParseObject = obj

END FUNCTION

FUNCTION ParseArray (jsonString AS STRING) AS VARIANT

    ' Erstelle ein leeres Array
    DIM arr AS VARIANT
    REDIM arr(0)

    ' Entferne die eckigen Klammern
    jsonString = MID$(jsonString, 2, LEN(jsonString) - 2)

    ' Teile den String in Werte auf
    DIM values AS STRING
    values = SPLIT$(jsonString, ",")

    ' Verarbeite jeden Wert
    DIM i AS INTEGER
    FOR i = 0 TO UBOUND(values)

        ' Füge den Wert dem Array hinzu
        arr(i) = JSON_Parse(TRIM$(values(i)))

    NEXT i

    ParseArray = arr

END FUNCTION

FUNCTION ParseValue (jsonString AS STRING) AS VARIANT

    ' Überprüfe den Datentyp des Werts
    IF LEFT$(jsonString, 1) = """ THEN
        ' String
        ParseValue = MID$(jsonString, 2, LEN(jsonString) - 2)
    ELSEIF jsonString = "true" THEN
        ' Boolesch (wahr)
        ParseValue = TRUE
    ELSEIF jsonString = "false" THEN
        ' Boolesch (falsch)
        ParseValue = FALSE
    ELSEIF ISNUMERIC(jsonString) THEN
        ' Zahl
        ParseValue = VAL(jsonString)
    ELSE
        ' Null
        ParseValue = NULL
    END IF

END FUNCTION
'
'TEST
'====
'
' JSON-String
DIM jsonString AS STRING
jsonString = "{""name"": ""John Doe"", ""age"": 30, ""city"": ""New York""}"

' JSON parsen
DIM jsonObject AS OBJECT
SET jsonObject = JSON_Parse(jsonString)

' Auf Werte zugreifen
DIM name AS STRING
name = jsonObject.name
DIM age AS INTEGER
age = jsonObject.age
DIM city AS STRING
city = jsonObject.city

' Werte ausgeben
PRINT "Name: " + name
PRINT "Age: " + STR$(age)
PRINT "City: " + city
*/


/*
'THEN'
int a,b,c
a=5
b=5
if a<b     : c=1
elseif a=b : c=2
elseif a>b : c=3
endif
print c
*/

/*
'CASE'
int a,b,c
a=5
b=5
select a
case a<b : c=1
case a=b : c=2
case a>b : c=3
end select
print c
*/


/*
'32/64 bit compatible Assrmbler
'ms64 calling convention
'using a stack frame instead of push/pop
'passing params in registers
'
'8 byte register width is automatically 
'down-sized to 4 bytes on 32bit system
'this is a feature of OxygenBasic

macro FunI as int(r, n,a=0,b=0,c=0,d=0)
=======================================
sub rsp,32 'create stack frame
mov ecx,a 'param 1
mov edx,b 'param 2
#if sizeof(sys)=8
  mov r8, c
  mov r9, d
#else 'sizeof(sys)=4
  mov [rsp+16],c
  mov [rsp+24],d
#endif
call n
'release srack frame
add rsp,32
mov r,eax
end macro


subroutine Calc
===============
'assume int32 params
mov eax,ecx 'param 1
mov ecx,edx 'param 2
#if sizeof(sys)=8
  #define aj 8
  sub rsp,aj 'maintain 16 byte alignment
  'mov edx,r8d param 3
  'mov edx,r9d param 4
#else 'sizeof(sys)=4
  #define aj 12
  sub rsp,aj 'maintain 16 byte alignment
  'mov edx,[rsp+32] 'param 3
  'mov edx,[rsp+40] 'param 4
#endif
add eax,ecx
'sub eax,ecx
'imul ecx
'cdq 'needed for div or idiv
'idiv ecx
'shl eax,2
'shr eax,2
'rol eax,1
'ror eax,1
'
'result in eax
add rsp,aj 'adjust stack ptr for return
'implicit ret
===============
end subroutine

'TEST
'====
print FunI(Calc,-1,3) '2
*/


'07/02/2025

/*
'test api
$ filename "..\t.exe"
uses rtl32
uses OxygenApiDeclare
o2_mode 9
string s=quote 
~~
print "Hello World!"
~~
'print s
o2_basic s
if o2_errno()
  print o2_error
else
  o2_exec
endif
*/

/*
macro ng(v)
print (v)
end macro
ng (-45)
*/

/*
'32bit platform only

macro SubFun as int(r, n,a,b,c,d)
=================================
#ifdef d
  push d
  def p 16
#endif
#ifdef c
  push c
  def p 12
#endif
#ifdef b
  push b
  def p 8
#endif
#ifdef a
  push a
  def p 4
#else
  def p 0
#endif
call n
add esp,p 'cdecl to stdcall stack adjust
mov r,eax
end macro

macro FunI as int(r, n,a=0,b=0,c=0,d=0)
=======================================
push d
push c
push b
push a
call n
'stack ptr adjustment
add esp,16
mov r,eax
end macro




subroutine Calc
===============
mov eax,[esp+4] 'param 1
mov ecx,[esp+8] 'param 2
'mov edx,[esp+8] 'param 3
add eax,ecx
'sub eax,ecx
'imul ecx
'cdq 'needed for div or idiv
'idiv ecx
'shl eax,2
'shr eax,2
'rol eax,1
'ror eax,1
'push eax
'pop eax
'
'result in eax
'implicit ret
===============
end subroutine

'TEST
'====
print FunI(Calc,-1,3)
*/



'06/02/2025

/*
def varptr @%1

def codeptr @%1

macro peek$ as string(r,pt,le)
==============================
r=nuls le
copy strptr(r),pt,le
end macro

macro poke$ (s,pt)
==================
copy pt, strptr(s),len(s)
end macro

'copy to an array address, source address,item count
====================================================
'demo copy %1,%2,2*%3 'ArrayPeekShort 
'demo copy %1,%2,4*%3 'ArrayPeekLong
'demo copy %1,%2,8*%3 'ArrayPeekDouble


function Hexabyte$(string s) as string
======================================
int a
int i
int j=1
int le=len(s)
string t=space(le*3)
for i=1 to len(s)
  a=asc(s,i)
  mid(t,j)=hex(a,2)
  j+=3
next
return t
end function



'TEST
'====
string s="Hello World!"
sys p=strptr(s)
poke$("Ha",p)
'print s 'Hallo
string t=peek$(s,3)
'print t 'Hal
'print hexabyte$ t
ubyte x[10]
copy @x,strptr(t),3 'PeekBytes to array
print x[2] '97
*/

/*
'TEST FIXED LENGTH STRING ARRAY
'#majorminor
char c[100,64]
c[1,1]="Hello"
c[2,1]=" "
c[3,1]="World!"
'TEST:
'print c[1,1] c[2,1] c[3,1]
'print len c[3,1] '6
print c[3,3] 'rld!
*/

/*
'MULTIASSIGN TO FIXED LENGTH ARRAY
'DATA
string src="Hello, ,World!," 'comma delimited
'
'LOADER USING BYTES
int e,i,j,k,m, my,mx
my=100
mx=64
redim byte ch[my,mx]       'dest array
byte *bd : @bd=@ch         'dest
byte *bs : @bs=strptr(src) 'source
byte bt
e=len(src)
while k<e
  j++ : k++
  bt=bs[k]
  m=i+j
  bd[m]=bt
  if bt=44  'comma delimiter
    bd[m]=0 'to null terminator
    i+=mx   'stride for next char string
    j=0     'begin char string
  endif
wend
my=10
redim byte ch[my,mx] 'test redim
char c at @ch[3,1]
print c
del ch
*/

/*
'MAP STRING DATA
uses console
indexbase 1
string src="Hello,~,World!" 'comma delimited
redim sys m[100]
dim sys p=strptr(src)
int i,j
byte *bt : @bt=p
'MAP
j=1 'm[j]=0
for i=1 to len(src)
  select bt
  case 0,44 'null and comma delimiter
    j++
     m[j]=i
    bt=0 'null terminate
  end select
  @bt++ 'next byte
next
'LIST
for i=1 TO j
  char c at p+m[i]
  print c cr
next
print cr cr
print j " items"
wait
del m
*/


/*
'basic dim as checks
'===================
'powerb array nnn
'dim c as char(32) 'not square brackets
'dim c(32) as char 'okay
'dim c(2)(3) as char
'dim c(2,3) as asciiz*40
dim c [12][3] as char*10
'dim c as char*5*2
'dim c (12)(3) as char*5*2
'dim as char c(12)(3)
'dim as char c[12][3]
'char c[12][3]
'print bytesof c
print dims(c)
print countof c
*/


'05/02/2025

/*
'dynamic array check
redim string dat[0]

function ff(string *dat[redim])
#show{
redim string dat[100]
}
print ubound dat
end function
ff dat
print ubound (dat)
*/


/*
USES CONSOLE
'
GOTO TESTING

MyFun:
mov eax,[esp+8]  'x
add eax,[esp+4]  'y
ret 8
' dump 8 bytes of params and then return
EndMyFun:

TESTING:
========

DIM x,y AS LONG
x=121
y=2
DECLARE FUNCTION PTR add2longs(BYVAL x AS LONG, BYVAL y AS LONG) AS LONG
@add2longs=@MyFun 'link addresses

'TEST THE FUNCTION:

PRINT "test result: " add2longs(x,y) CR CR '123 ok
'
'CAPTURE BINARY STRING
'
DIM le AS LONG = @EndMyFun-@MyFun
DIM bins AS STRING = SPACE(le)
COPY STRPTR(bins), @MyFun,le
PRINT le CR '11 bytes
PRINT CR
'
'CHECK CAPTURED OPCODES
'
INDEXBASE 1
DIM i AS LONG
DIM byte PTR bt : @bt=STRPTR(bins)
FOR i=1 TO le
  PRINT HEX(bt[i],2) " "
NEXT
PRINT CR CR
'
'SAVE THE BIN STRING TO FILE
'
PRINT "Enter FileName to Save: "
STRING s=INPUT()
s=LTRIM(RTRIM(S))
IF s
  PUTFILE(s,bins)
  PRINT "ok"
  WAIT
ENDIF
*/




/*
'ucrt
uses verrsrc.h
print "ok"
*/

'04/02/2024

/*
'USER DEFINED STACK (STRINGS)

int StackMax=1000
redim string stack[StackMax]
int stacki=1

function PushStack(string v)
if stacki>StackMax
  'overflow error or redimension
  'or
  'StackMax+=1000
  'redim string Stack(StackMax)
endif
stack[stacki]=v
stacki++
end function
'
function PopStack() as string
if stacki<1
  'empty error
endif  
stacki--
return stack(stacki)
end function
'
'TEST:
PushStack 1
PushStack 2
PushStack 3
print PopStack '3
print PopStack '2
print PopStack '1

del stack 'release memory
*/

/*
'LOCAL DYNAMIC ARRAY
function ff()
  int i=200
#show {
  redim int aa(i) 'local by default
}
  'redim int aa(i) static
  aa[50]=123
  '
  i=70
  redim int aa(i) 'elements conserved by default
  'redim int aa(i) clear
  print aa[50]
  del aa
end function
ff()
*/

'LOCAL ARRAY USING STACK


/*
'MAKING DLLS
$ dll
$ filename "t.dll"
uses rtl32 'or rtl64

print "loading dll"

function hello(int a) export as string
  return a*2 " Hello World!"
end function

sub finish() external
  print "unloading dll"
  terminate
end sub
*/
/*
'TEST THE DLL
extern lib "t.dll"
  declare hello(int a) as string
end extern
print hello(123) '246 Hello World!
*/


'03/02/2025

/*
'REDIM DYNAMIC ARRAY INSIDE AN OBJECT
'
type cc
  '
  def remapaa
    remap int aa(zz,yy,xx)
    @aa=pa
  end def
  '
  sys pa       'pointer to array content
  int zz,yy,xx 'ubounds of array dimensions
  '
  procedure constructor(int z,y,x)
    xx=x : yy=y : zz=z
    pa=getmemory zz*yy*xx*sizeof(int)
    remapaa
  end procedure
  '
  function set(int v,z,y,x)
    remapaa
    aa(z,y,x)=v
  end function
  '
  function get(int z,y,x) as int
    remapaa 
    return aa(z,y,x)
  end function
  '
  procedure destructor()
    freememory pa
    print "bye!"
  end procedure
  '
end type
'
'test
'#recordof cc
new cc c(5,5,5)
c.set(42,4,3,2)
print c.get(4,3,2)
del c
*/

/*
'REDIM REVIEW
uses console
indexbase 1

'#majorminor 'order for 'C' FreeBasic o2-default
#minormajor  'order for PowerBasic

function redims4(int*aa[redim], int d1,d2,d3,d4)
redim int aa[d1,d2,d3,d4]
end function

redim int a[0,0,0,0]
redims4(a,5,6,7,8)
'
print "attributes of Array a " cr cr
print "type: " typeof(a) cr
print "current elements: " ubound(a) cr
print "current size: " ubound(a) * sizeof(a) cr

print "dimensions: " dims(a) cr cr
print "dim n" tab "scaler" tab "strider" tab "ubound" cr cr
int i
for i=1 to dims(a)
   print i tab scaler(a,i) tab strider(a,i) tab ubound(a,i) cr
next

wait
*/


/*
'All general registers including flag
mov edi,5
o2  9c 50 51 52 53 55 56 57
inc edi
o2  5f 5e 5d 5b 5a 59 58 9d
int a=edi
print a '5
*/

'01/02/2025

/*
'FUNCTIONS INSIDE FUNCTIONS
function f1() as int
  function f2() as int
    static int i
    i++
    return i
  end function 'f2
  int j
  j=f2()
  return j
end function 'f1
print f1()
'print f2() 'not found
*/


/*
'CLASSES INSIDE FUNCTIONS
function ff()
  type tt
    float x,y,z
    method mm()
      print "mm"
    end method
  end type
  tt t
  t.mm()
end function
ff()
*/


/*
'INNER CLASSES / TYPES
'constructor
type cc
  '
  type vector
    dim as float x,y,z
  end type
  '
  dim as vector v[1000]
  method set(int n, float x,y,z)
    '#recordof vector 'visible here
    v[n]={x,y,z}
  end method
  method show(int n)
    print v[n].x ", " v[n].y ", " v[n].z
  end method
end type 'cc
'
'test
'
'#recordof vector 'not visible here
'#recordof cc 'visible
dim as cc c
c.set(10,2,4,6)
c.show(10) '2, 4, 6
*/



/*
'MODULE CONCEPT TESTS

'def module rem %1
'def module_end rem %1

==========
module 'mm
==========

interface
  dim as int ptr aa
  declare function ptr ff() as string
  'int*aa
  'string (*ff)()
end interface

inner
  int a : @aa=@a
  function f() as string, link @ff
    return "ok"
  end function 
  a=123
end inner

==============
end module 'mm
==============
'
'test
print aa
print ff()
*/


'31/01/2025

'macro recursion trapping tests

/*
macro mm()
  mm
end macro
mm
*/

/*
def dd
dd
end def
dd
'asm bytes
*/

/*
%qq 35+qq
print qq
*/

/*
type tt
  int i
end type
'operators
macro tt_"move"(a,b)
a.i=b.i
end macro
macro tt_"+"(a,b,c)
a=b+c 'dct recursive findop newrecord
end macro
'macro tt_"+"(a,b,c)
'a.i=b.i+c.i 'dct recursive findop newrecord
'end macro

'
tt a,b,c
b.i=1
c.i=2
a=b+c
print a.i
*/

/*
def dd
  '
  def dd
  end sdef
end def
dd
print 123
*/




'30/01/2025




'using link to expose an internal static function

/*
!* AccessF2(int n) as int
'
type cc
  '
  int mi
  static int ii
  '
  static function f2(int n) as int, link @AccessF2
    ii=n
    print "f2 " n
  end function
  '
  function f1() as int
    print "f1 " ii
  end function
  '
end type

AccessF2(123)
*/

'29/01/2025


/*
'#show print "hello"
*/

/*
'test new wide chars
#show {
string c="helo"
'print c 'L"helo"
string s=right(c,2)

}
print s
*/



'examples
'========

'using a wrapper proc containing a class call
/*
extern

type cc
  declare function f1() as int
  declare staic function f2() as int
end type

methods of cc
'
static int ii
'
function f1() as int
  print "f1 " ii
end function

function f2() as int
  print "f2 " ii
end function
'
end methods
'
function AccessF2() 'non OOP wrapper
  'if object instantiation not needed
  cc.f2() 'use the type/class name
  'it passes a null thispointer
end function

AccessF2()
*/

/*
'using link to expose an internal static function
'stw
extern

declare function ptr AccessF2(int n) as int
'
type cc
  dim as int mi                'property
   declare function f1() as int 'method
   declare static function f2(int n) as int
end type

methods of cc
=============

dim static ii as int
'
static function f2(int n) as int, link @AccessF2
  ii=n
  print "f2 " n
end function

function f1() as int
  print "f1 " ii
end function
'
'
end methods

AccessF2(123)
'
*/


/*
'#show {
type cc
function  ff fastcall (int a, int b, int c) as int
print b
return a+b+c
end function
end type
'}
dim cc c
#show{
print c.ff(1,10,100) '111
}
*/

/*
type int as mytype
dim as mytype x
x=4.6
print x '5
*/

/*
#macro m(a)
 print a " ok"
#endmacro
m(99)
*/

/*
type cc
  dim as int ii
  declare function ff(int n) as int
end type
'
methods of cc
  function ff(int n) as int
    print n " ok"
  end function
end methods
'
dim as cc c
c.ff 123
*/


'28/01/2025

/*
'const syntax cnst
const as long a=42
'const as char s="helo "
const as string s="helo "
#recordof s
print s a
*/


/*
'operator definition simplified
operator <-> 1 'synbol and precedence level
type tt
  int n
end type
'
'OPERATORS FOR TT
'
macro tt_"move" (acc,a)
  acc.n=a.n
end macro
macro tt_"+" (acc,a,b)
  acc.n=a.n+b.n
end macro
macro tt_"<->" (acc,a,b)
  acc.n=a.n*b.n+a.n
end macro
'
dim tt x,y,z
#show {
x=y <-> z
}
print "ok"
*/

'27/01/2025

/*
'subroutine inspect
#show {
subroutine x
  exit subroutine
end subroutine
}
*/

/*
'(30/08/2022)
'with macro prefixes
'Accessing parent vars
'
uses console
$ client ....
int x=0
print client.x '0
namespace aa
  int x=2
  print client.x '0
  namespace bb
    int x=4
    print client.x '2
    namespace cc
      int x=6
      print client.x '4
    end namespace
    print ..cc..x '6
    print 
    print client.x '2
  end namespace
end namespace
wait
*/


'26/01/2025

'test inner type class
/*
class cc1
=========
  ' 
  class cc2
  =========
    '
    function mm2()
      print "ok "
    end function
    '
  end class 'cc2
  '
  int i
  % ee1 "helo"
  '
  static sub ss1
    print "static ss"
  end sub
  '
  subroutine su
    print "subr"
  end subroutine
  '
  method mm1()
    cc2 c2
    c2.mm2
    ss1
    gosub su
  end method
  '
end class 'cc1
'
'test
'
cc1 c1
c1.mm1
'susub su 'err
'cc2 c2 'err
'ee1 'err
#recordof cc1
*/


/*
'test inner function
function f1()
function f2
print "ok"
end function
f2
end function
f1
'f2 'err
*/

/*
'test inner class nesting
'#show "t.txt" {
function ff
class cc
method mm
print "ok"
end method
end class 'cc
cc c
c.mm
end function 'ff
ff
'undef cc
'cc.mm
'}
*/

/*
'test macro
'#define m() print "ok"
'macro m() print "ok"
'macro m()
'print "ok"
'end macro
#macro m(a)
 print a " ok"
#endmacro
'macro m()
'print "ok"
'end macro
'#define m \
' print "ok" \
'
m 99
print "q"
#recordof m
*/

/*
'test type .. as ..
type int as *qw ptr
#recordof qw
*/

'23/01/2025
/*
'test methods block
#show {
class cc
% x 1
macro mm()
end macro
int a
int ff(int a)  {
mm
print "ok" x
} 'end method
end class
}
cc c
c.ff 1
*/


/*
'check methods block
'#show {
class cc
int bb
$ ee 1
internal
  macro mm(ss)
    print ss a
  end macro
end internal
method ff(int a) as int
  mm("ok ")
end method
end class
'}
#recordof cc
cc c
c.ff 8
*/

'22/01/2025

'use of declare inside type
/*
#show {
#lookahead
g()
}
type tt
  'declare function f()
  'declare f()
  ! function f()
  '
  'function f()
  '! f()
  'int f()
end type
#recordof tt
methods of tt
function f()
print "ok"
end function
end methods
'
function g()
print "g"
end function
'
tt.f
'

'goto variations
/*
def clause5 40.5
'goto 40.5
goto clause5
print "nok"
end
40.5:
405:
print "ok"
end
*/



/*
'functions without brackets
class cc
function constructor
print "ok"
end function
end class
'
cc.constructor
*/


'19/01/2025


/*
'extern cdecl 'fastcall 'fastcall 'cdecl
extern cdecl
'end extern

#show {
'class cc

'private function f (int a,b) as int, fastcall stdcall
function f cdecl fastcall (int a,b) as int
mbox " " a "," b
return 3
end function
function g thiscall cdecl (int a,b) as int {}
function h cdecl (int a,b) as int {}
function i (int a,b) as int {}
function j fastcall (int a,b) as int {}
'end class
}


'cc c
#show {
int a
a=f(10,20)
}
'#print "okc"
#recordof f
mbox "" a
print "ok" a
*/

'13/01/2025

/*
'Supposing you wanted to create a module
'to contain all the core windows calls:
======
module
======
% win windows..
namespace windows
uses corewin
end namespace
==========
end module
==========
'
'test
win.beep(432,500)
win.sleep(1000)
print "ok"
*/

/*
'symbol concatenation
int abc=7
% abm ab
print abm.c '7
*/


'15/11/2024

/*
'dynamic bstring array
sys ps
'
ps=getmemory 100*sizeof sys
bstring *s : @s=ps
s[1]="one"
s[2]="two"
int *le : @le=ps-4
print s[1] " " s[2] "  " le
int i
for i=1 to 100
  frees s[i]
next
freememory ps
ps=0
print "ok"
*/


'14/11/2024

/*
'CLASS STATICS
'=============

uses console

  class ccc
    static long aa  ' SHARED CLASS ELEMENT
    long c          ' OBJECT ELEMENT
    method tally()
      aa++
    end method
    method count() as int
      return aa
    end method
  end class
 
  dim ccc a,b
  ccc.tally()
  print "Access Class static:" cr
  print "ccc.count" tab ccc.count() cr
  print "a.count  " tab a.count() cr
  print "b.count  " tab b.count() cr
  print "ok"
wait
*/

'02/08/2024
/*
uses corewin
uses console
'uses chaos

quad seed
QueryPerformanceCounter(@seed)

  'from chaos.inc
  function irnd(int z1, z2) as int
  ================================
  '
  'returns integer between z1 and z2
  '
  mov    eax,z2
  sub    eax,z1
  inc    eax
  imul   edx,Seed,0x8088405
  inc    edx
  mov    Seed,edx 'store new seed
  mul    edx 'multiply eax by edx
  return edx+z1
  end Function

function NewPassword1(int n) as string
=====================================
string s=nuls n
byte b at strptr s
int i
int c
int a 
QueryPerformanceCounter(@seed) 'randomize seed
do
  c=irnd(0x30,0x7a)
  a=0
  select c
    case 0x30 to 0x39 : a=1 ' 0 to 9
    case 0x41 to 0x5a : a=1 ' A to Z
    case 0x61 to 0x7a : a=1 ' a to z
    case 33,46,95 : a=1     ' ! . _
  end select
  if a 'useable char
    b=c  'set char
    @b++ 'next char position
    i++  'count
    if i=n
      exit do
    endif
  endif
loop
return s
end function


function NewPassword() as string
================================
string s=nuls 6
string vc="aeiouy" '6
string cc="bcdfghjklmnpqrstvwxz" '20
string uc="BCDFGHJKLMNPQRSTVWXZ" '20
string nc="0123456789" '10
byte b at strptr s
QueryPerformanceCounter(@seed) 'randomize seed
'
'6 characters
b=asc(uc,irnd(1,20) ) 'upper consonant
@b++
b=asc(vc,irnd(1,6) ) 'vowel
@b++
b=asc(cc,irnd(1,20) ) 'consonant
@b++
b=asc(vc,irnd(1,6) ) 'vowel
@b++
b=asc(cc,irnd(1,20) ) 'consonant
@b++
b=asc(nc,irnd(1,10) ) 'number
@b++
return s
end function



print "Random passwords:" cr
print "permutations: " 20*6*20*6*20*10 cr cr
int i
for i=1 to 10
  'print NewPassword1(8) cr
  print NewPassword() cr
next
wait
*/



'30/07/2024

/*
int cm_=44
char cm=cast char cm_
print cm
'#recordof cm
#show char ch=chr(44)
'print ch
#recordof ch
*/

/*
  string cr,tab,qu,sp,cm
  cr=chr(13,10)
  tab=chr(9)
  qu=chr(34)
  sp=chr(32)
  cm=chr(44)
  print cm
*/

'26/07/2024
/*
'test 32bit 64bit
use console
 dim string cr
 dim string cr,tab,qu,sp,cm
  cr=chr(13,10)
  tab=chr(9)
  qu=chr(34)
  sp=chr(32)
  cm=chr(44)
  print "ok"
wait
*/

'24/07/2024

/*
'test built-in tab etc
print 1 tab 2 spc qu 3 qu cr
*/

/*
string tab=prior tab
'#recordof tab
print 1 tab 2
*/

'21/07/2024

/*
'testing replacewdt
type t float a,b,c=":" : int d
#recordof t
*/


'19/07/2024


/*
def listitem print "%1" + chr(9) + "%2" + chr(13,10)
'
listitem 1 shoes
listitem 2 socks
*/

/*
mbox "hello0"
mbox="hello1"
def funbox mbox
funbox="hello2"
def control funbox
control="hello3"
*/


/*
'CIRCULAR TEXT DEMO
uses consoleg
procedure main()
move 20,-15
string s="WELCOME CODERS"
int i,j
cls .2,.1,.5
scale 1.5
color .9,.8,.0
for i=1 to len(s)
  pushstate
    rotateZ -24*j
    move 4
    scale 2
    rotateZ -90-12 'clockwise
    gprint mid(s,i,1)
  popstate
  j++
next
end procedure
endscript
*/

/*
def show print "%1  --> " %1

show(10+1/4)   '10+1/4  --> 0.25
*/



'06/07/2024

/*
uses console
sys p=strptr "hello world!"
'using 32bit asm
push p
call output#string
wait

#show {
output "hello world!"
}
wait
*/

'05/07/2024

/*
''
'' VZ 200 computer 1983 (VTech Laser 200), 8 bit-homecomputer von 1983
''
'10 PRINT "HELLO BASIC!"
'' RUN
'' HELLO BASIC

'' READY

'' 20 PRINT "THANK YOU, BASIC!"

'' RUN

'' OxygenBasic on MS Windows 11. 2024

10: uses console
20: print "HELLO BASIC!" cr
30: print "THANK YOU, BASIC!" cr
40: wait
*/

'30/06/2024
/*
' inner function example
'uses console
'capth
'
class cc
========
'
function myfun(long v) as long 
  'inner
  static function f(long k) as long
  {
    function= 10+k*3 'problem with function=...
    'return 10+k*3 'problem with function=...
  } 'end function

  function= f(v)+100
end function
'function myfun2(long v) as long 
'  'inner
'  function= f(v)+100 'not found f
'end function
end class
'#recordof cc
cc c
print c.myfun(2) '116
'wait
*/

'27/06/2024

/*
#if sizeof sys = 4
 print 32
#endif
#if sizeof sys = 8
 print 64
#endif
*/


'25/06/2024

/*
'SHARED
string s
'
function f(int i) as int
shared s
s="ok"
end function
f(1)
print s
*/

/*

'NB to source code it for co264
%mode64bit
uses sysutil 'corewin
uses console
extern lib "msvcrt.dll"
'int  sprintf(char *buffer, const char *format, ...)
end extern
SetConsoleTitle "sprintf / sprintf_s Examples"
double num
char buff[64]
num = 333 * 1.5
sprintf (buff, "%.2f", (quad)  num)
print format(num,"###.00") cr
printl "333*1.5 = " buff
wait
*/

'18/04/2024

/*
putfile "t.txt","AA" 'cheating!
wstring ws
ws=(wstring) getfile("t.txt")
'ws=cast wstring getfile("t.txt")
''ws=wstring getfile("t.txt")
print ws
*/

/*
'ORDINAL DEFAULT PARAMS
'subsas
'replas
function m( string u="",s="Hello", t="world")
print u+" "+s+" "+t
end function
'm()
m(,) 'leading comma problem
'm(,"ok")
'm(,,"ok",)
'm(,"ok")
'm("moon",,"sky")
'm("good",,,)
'm("Greetings")
'm( u="x  ",t="sky" )
*/

'17/06/2024

/*
uses console

macro iif int(r,e,a,b)
========================
if e
  r=a
else
  r=b
endif
end macro
'
int a = 10, b = 20

print iif(a < b , a , b) cr
wait
*/

'04/06/2024

/*
int n=(int)(42)*4
print n
*/


'03/06/2024

/*
putfile "t.txt","AA" 'cheating!
wstring ws
ws=(wstring) getfile("t.txt")
'ws=cast wstring getfile("t.txt")
''ws=wstring getfile("t.txt")
print ws
*/

/*
int a=43
print cast byte a 'ubyte
print cast char a
*/

/*
function sf() as string
  function="ok"
  sys p=strptr(function)
  sys le at p-4
  print len(function) "  " le "  " str(strptr(function))
end function
print sf()
*/


/*
uses console
function rf(int i)
if i>0
  print i tab i*i cr
  rf(i-1) 'recurse
endif
end function
rf 20
wait
*/

/*
'ORDINAL DEFAULT PARAMS
'subsas
'replas
macro m( u="",s="Hello", t="world")
print u+" "+s+" "+t
end macro
'm()
'm(,) 'leading comma problem
'm(,"ok")
'm(,,"ok")
m(,"ok",)
'm("moon",,"sky")
'm("good",,,)
'm("Greetings")
'm( u="x  ",t="sky" )
*/


'27/05/2024

/*
sbyte sb 'signed byte
sb=32
print sb
sb=32.6
print sb 'rounds to 33
sb="-32"
print sb 'auto-convert string
sb=255
print sb 'wrap overflow -1
*/

/*
macro inlimits int(r,  a,min,max)
=================================
r=-1
if a<min then r=0
if a>max then r=0
end macro


macro setlimits (a,min,max)
=================================
if a<min then a=min
if a>max then a=max
end macro

float v=5.5
setlimits(v,2,7)
print v

macro setlimits any(r,  a,min,max)
=================================
r=a
if a<min then r=min
if a>max then r=max
end macro

float v=setlimits(5.5,2,7)
print v
*/


'26/05/2024

/*
'function table example
'======================
'
function f1(int i) as int
  return i*1
end function
function f2(int i) as int
  return i*2
end function
function f3(int i) as int
  return i*3
end function
'
sys tf={@f1#int,@f2#int,@f3#int}
!* ff(int i) as int
@ff=tf[2]
print ff(10) '20
*/

'25/05/2024

/*
'subroutine table
'================
sys tgs={@sr1,@sr2,@sr3}
'
subroutine sr1
print 10
end subroutine
subroutine sr2
print 20
end subroutine
subroutine sr3
print 30
end subroutine
'
gosub tgs[2] '20
*/

'24/05/2024

/*
int a={1,2,3,4,5}
'print countof() '5
macro iif as int(a,  b,  c,d)
if b then a=c else a=d
end macro
...
print iif(1>2,10,20) '20
*/


'07/05/2024

/*
uses console
print "Enter your name: "
string name=ltrim(rtrim(input()))
if name
  print cr
  print "Hello, " + name + "!" + cr
  wait
endif
*/
'


'28/04/2024

/*
uses console
int i=1
namespace nn
int i=2
end namespace
print i "  " nn..i
*/

'26/04/2024
/*
'def £ print
'£ "ok"
def p? print
p? "ok"
*/

'01/04/2024

/*
uses console
string s="abcdefghij"
byte b at strptr(s)
int i
for i=1 to len(s)
  print i tab b[i] tab mid(s,i,1) cr
next
wait
*/


'30/03/2024

/*
uses consoleG
'indexbase 1
uses glo2\geodesics
beginscript
procedure main()
if opening
  % count=20
  static int list=glGenLists count
  dec list 'adjust base
  glNewList List 7, GL_COMPILE
  '
  glTranslatef 0,0,0
  Spirodome2 .25, 12
  glEndList
  '
  glNewList List 12, GL_COMPILE
  RenderTetraGeo 0
  glEndList
  '
  glNewList List 13, GL_COMPILE
  RenderOctaGeo 2
  glEndList
  '
  glNewList List 14, GL_COMPILE
  'RenderIcosGeo 1
  'RenderIcos
  'Render60
  RenderBuckyBall()
  glEndList
  '
  glNewList List 15, GL_COMPILE
  RenderCube()
  glEndList
  '
  glNewList List 16, GL_COMPILE
  RenderDodec()
  glEndList
  '
endif 'opening
'
'
move 20,-15
UserMovement m1,700 'identity in steps of 100
scale 15
'glCallList List 7
'lCallList List 12
'glCallList List 13
glCallList List 14
'glCallList List 15
'glCallList List 16
if closing
  inc list 'adjust base
  glDeleteLists list,count
endif
end procedure
endscript
*/

'26/03/2024

/*
'shared mode

string s
'
function f(int i) as int
shared s
s="ok"
end function
f(1)
print s
*/


'25/04/2024

/*
float f=1
float*g=@f
print g
*/

/*
'casting pointers
=================
float n = 3.14
sys p = @n
float f2
f2 = (float*) p
print str(f2,2)
print str((float*)p,2)
print str(cast(float*)p,2)
print str(cast float*p,2)
*/


'24/03/2024

/*
'sys wb
'wb=loadlibrary "C:\Program Files (x86)\Microsoft\Edge\Application\122.0.2365.80\EBWebView\x86\EmbeddedBrowserWebView.dll"
'print wb
'freelibrary wb
extern lib "C:\Program Files (x86)\Microsoft\Edge\Application\122.0.2365.80\EBWebView\x86\EmbeddedBrowserWebView.dll"
! webview_create
! webview_set_title
! webview_set_size
! webview_set_html
! webview_run
!   webview_destroy
end extern

% WEBVIEW_HINT_NONE 0
typedef sys webview_t

  webview_t w = webview_create(0, NULL);
  webview_set_title(w, "Basic Example");
  webview_set_size(w, 480, 320, WEBVIEW_HINT_NONE);
  webview_set_html(w, "Thanks for using webview!");
  webview_run(w);
  webview_destroy(w);
*/

'20/03/2024
'
/*
'data table demo
'
-------------------
class FixedTable10k
===================
'
% TableSize  10000 'bytes
% RecordSize 100   'bytes
% FieldSize  10    'bytes
% offset    -109   '1-record-field 
'
bstring ft 'FixedTable storage
'
method constructor()
====================
  ft=space(TableSize)
end method
'
method destructor()
===================
  ft=""
end method
'
method load(string f="t.dat")
=============================
  ft=getfile(f)
end method
'
method save(string f="t.dat")
=============================
  putfile(f,ft)
end method
'
method pad(string s) as string
==============================
  int le=len(s)
  if le=10
    return s
  else
    return left(s+space(FieldSize),FieldSize)
  endif
end method
'
method get(int y,x) as string
=============================
  return mid(ft, y*RecordSize+x*FieldSize+offset,FieldSize)
end method
'
method put(int y,x, string s)
=============================
  mid(ft, y*RecordSize+x*fieldSize+offset)=pad(s)
end method
'
method show(int y=0,x=0)
========================
  if y=0
    print ""
    exit method
  endif
  if x=0
    'whole record
    print mid(ft,y*RecordSize+FieldSize+offset,RecordSize)
  else
    'field
    print get(y,x)
  endif
end method
'
end class 'FixedTable
'
'TESTS
'=====
new FixedTable10k t()
t.put(2,3,"Hello")
t.put(2,4,"world")
'print t.get(2,3)
't.show(2)
't.show(2,4)
't.show(2,3)
t.save()
del t
new FixedTable10k u
u.load()
u.show(2)
u.put(2,3, ucase(u.get(2,3)) )
u.show(2)
del u
*/


'16/03/2024

/*
uses console
%mathutilextra
uses mathutil
'
'TESTS
======
'
print "matrix 5x5 tests" cr cr
new transform4d m
m.clear                  : m.show "empty"
m.identity               : m.show "identity"
m.pushmatrix             : m.show "pushmatrix"
m.popmatrix              : m.show "popmatrix"
m.pushmatrix
m.pushmatrix
m.mulmatrix()            : m.show "mulmatrix"
m.scale(1,2,3,4)         : m.show "scale"
m.translate(10,20,30,40) : m.show "translate"
m.identity
m.rotate(30,1)           : m.show "rotate xy"
m.identity
m.rotate(30,2)           : m.show "rotate xz"
m.identity
m.rotate(30,3)           : m.show "rotate yz"
m.identity
m.rotate(30,4)           : m.show "rotate xw"
m.identity
m.rotate(30,5)           : m.show "rotate yw"
m.identity
m.rotate(30,6)           : m.show "rotate zw"
m.identity
m.rotate(-30,1)           : m.show "rotate xy"
'm.scale(1,2,3,4)         : m.show "scale"
'm.translate(10,20,30,40) : m.show "translate"
'
type vec4 float x,y,z,w
vec4 vi={1,0,0,0}
vec4 vo
m.transformVec4(vo,vi)    : m.showvec4(vi,"vector4 trans")
                          : m.showvec4(vo,"vector4 trans")
                          : m.showvec3(vo,"vector3 trans")
wait
*/
 

'16/03/2024
/*
'"hello
#case capital
uses corewin
uses imgwin
#lookahead
f 1,"Q"
function f(int*a=4,string s="x") as int callback
print( "ok " a s )
end function
*/

'12/03/2022

'identop
'Taylor series for exp and log
'lin (x+1) = x - (x^2)/2 + (x^3)/3 - (x^4)/4 ...
'e^x = 1 + (x)/1! + (x^2)/2! + (x^3)/3! ...
'sin (x) = x - (x^3)/3! + (x^5)/5! - (x^7)/7! ...
'cos (x) = 1 - (x^2)/2! + (x^4)/4! - (x^6)/6! ...


/*
print exp 6.9077552789821368 '1000
*/

/*
#lookahead
g(2)
function g(int a)
  f(1)
end function

function f(int a)
  print "ok"
end function
*/


/*
'12/03/2022
indexbase 0
const int rows=10
const int cols=10
dim table(rows-1,cols-1,1) as zstring
table(4,3)="K"
table(4,4)="L"
print table(4,3) 'K
print table(4,4) 'L
*/





'print log2 8
'print log2 .125'80'3'12
'print 0+pow(2,3)


'11/03/2022

/*
'const check
'char / byte check
const int i=10
'print i
'#recordof i
dim t(i,i) as byte 'zstring
'print ubound(t)
'print bytesof t
t[2,3]=asc "!"
t[2,4]=asc "Q"
print t[2,3]
*/

/*
Oxygen's built-in string types:

fixed length strings:

asciiz
zstring / wzstring
char  / wchar

ole/bstr strings:

bstring / wbstring

garbage collected ole/bstr strings

string / wstring
*/


/*
uses console
int row
row=input
print row
wait
*/

/*
char c[5]="abcd"
bstring s="1234567890"
'#show {
  'mid(c,1)=s 'null limit
  'c=s 'no boundary check
'}
print c
'not boundary checked
*/


/*
bstring s
'#show s= cast(bstr) getmemory(100)
'#show strptr(s)= getmemory(100)
'#show ?s = getmemory(100)
'#show freememory(strptr(s)) : ?s=0
'#show del s
*/

/*
'32bit 64bit
sys a=3,b,c
b=@a
#show c=*b
*/




/*
'static bytesof?
'zstring s
'print sizeof wstring
redim char s[100]
'print bytesof s
'print countof s
print ubound s
*/

/*
'array of fixed leng strings
type Zarray100
  char s[100]
  =
  byte b[100]
end type
'
dim zarray100 ca[64]

ca[10].s="helo"
ca[12].s=ca[10].s
print ca[12].s
print len(ca[10].s)
print countof(ca[10].s)
*/
'

/*
'10/03/2024
' jeff marshall re strings
zstring c[10]
'print len(c) '0
zstring c[10]="    " '4 spaces
'print len(c) '4
zstring c[10]=" " 
'print len(c) '1
'#recordof c
'print countof c '10
'print sizeof c '1
wzstring w[10]
print bytesof w '20
print countof c '10
*/


'05/03/2024
'
/*
'mo=18
'declare
! f(int,int,int)
#recordof f
f(1,2,3)
function f(int a,b,c)
print "ok"
end function
#recordof f
*/
'

'05/03/2024

/*
'casesy
string k
k="printar"
#show {
select
case k="printar" or k="printir" : print k
end select
}
*/

/*
'casesy
string k
k="print"
select
case k="prin" 
  print k
case k="printr" : print k
case k="printar" or k="printir" : print k
case k="printly" : print k
case k="printing" : print k
case k="print"
  print k
case else
  print "unknown"
end select
*/


/*
'linecont
string s
s = ">" '_
"hello"
print s
*/



/*
sub f(int a, optional int b=42,c)
end sub
'#recordof f
#show f(1)

'04/03/2024

'#recordof void
*/

/*
class cc
function f()
end function
end class
#recordof cc
*/

/*
'if wr="void"
#show {
function f(void)
end function
}
#recordof f
*/

/*
'w4=sigv
'#show {
function f(string s, int i,mo=0)
end function
'}
#recordof f
*/



'02/03/2024

'#show {
'dim a as float=44
'}
/*
'=astb
'dimtype
class cc
'
'function f(a=10.5) as byte
'end function
'#recordof f

function Setup(int txw=512, txh=512, typ=0)
end function
'

function f(float a[]) as word
end function
'#recordof f

function f(string a[]) as word
end function
'#recordof f

function f(a as float) as byte
end function
'#recordof f

function f(float a=0.5) as byte
end function
'#recordof f

function f(float a=0.6,b=0.7) as byte
end function
'#recordof f
'
function f(a as float=77) as byte
end function
'#recordof f 'problem
'
function f(**a=42.5 as float) as byte
end function
'#recordof f 'ok
end class
#recordof cc
*/

'29/02/2024


/*
'cases with strings
'is_cas
'end_cas
string s="abcdef"
int ans
int a=3
'#show  "..\t.txt" {
switch a
'select a
case 2 : print 2
case 3 : print 3
case 2 to 3,4,5 : print 2345
case s="abcd" : print 10
case s<"abce" : print 20
case instr("abc","b")=0 : print 300
case val("0")=0 : print 30
case s[1]="abcdef" : print 40
case 2 : print 2
case 3 : print 3
end switch
'}
'print ans
*/


'28/02/2024

/*
'casesy
'
int a=0
int b=2
#show {
select
case -a>b : print "ok"
'case a  : print "ok"
'case else  print "nok"
end select
}
*/


/*
function abc(long d=20, long e=40) as integer 'not really go
function = d*e+100
end function

print abc(4,8) '132 
print abc(4) '260
print abc() '900
*/

/*
int a=2
if a>1 : print "ok" : endif
'case a>1 : ... : endif : goto endsel
*/



'27/02/2024

/*
deff cube
  fld1
  fmul st1
  fmul st1
  fmul st1
  fxch st1 'swap
  fstp st0 'drop
end deff

deff ndiv
  fdivp
end deff

deff phi  '(sqrt(5)-1)/2
  push 5
  fild dword [rsp] '5
  pop rax          '
  fsqrt            'sqrt 5
  fld1             '1
  fsubp            'sqrt(5)-1
  fld1             '
  fadd st0         '2
  fdivp            '/2
end deff

deff hypot
  fmul st0
  fxch st1
  fmul st0
  faddp
  fsqrt
end deff

deff recip
  fld1
  fdivrp
end deff


'print cube(4)  '64
'print ndiv(3,4) '0.75
'print phi()
'print hypot(1,1)
print recip(8)
*/


/*
float a=3, b
fld dword a
fld st(0)
fld st(0)
fmulp
fmulp
fstp dword b
print a ",  " b
*/


/*
function BinaryToString(sys a,l) as string
  bstring s=nuls(l)
  sys p=strptr(s)
  copy p,a,l
  return s
end function
'
print BinaryToString(strptr("helo"),4)
'
function StringToBinary(string s, sys *a,*l)
  'a addr output
  'l length output
  l=len(s)
  sys b=strptr(s)
  a=getmemory(l)
  copy a,b,l  
end function
*/


/*
'string autoconvert
function f(string v)as string
return v
end function
'
'print f(1+1.5)
float u=f(1+1.5)
print u
*/


'26/02/2024

/*
'test %0
def mm %1 %0
mm "ok" print
*/


'24/02/2024

/*
'method alt syntax
class cc
function ff as long (int a,b,c)
return a+b+c
end function
end class
'#recordof cc
print cc.ff(1,2,3)
*/


/*
'function alt syntax
function ff as long (int a,b,c)
return a+b+c
end function
print ff(1,2,3)
*/


'23/02/2024

/*
'macro default assigns
macro mm(a=1,b=2,c=3)
print a+b+c
end macro
mm(b=12,a=101) '116
*/


/*
'macro procedures
macro procedure m (a,b,c)
print a+b+c
end macro
'
m(1,2,3)
*/

/*
'macro default values
macro function m as int (retv,a=1,b=10,c=100)
retv=a+b+c
end macro

print m(2)
*/


/*
'brackets in macro
macro m(a)
(
print "ok"
)
'end macro
#recordof m
*/

'22/02/2024

/*
'PB similar style macro functions
'109
macro function m as int (retval,a,b,c)
retval=a+b+c
end macro
'
print m(1,2,3)
*/

'20/02/2024

/*
'interpreter starter
uses sysutil
uses console
'
string src=quote !!!
a = b + c
!!!
string trp=quote !!!
+ 1 - 2 * 3 / 4 = 5 < 6 > 7 
( 20 ) 21
a 201 b 202 c 203 d 204
!!!
double acc
int i=1
int tk
int op
string wr
'instrw
do
  wr=getword(src,i)
  if wr=""
    exit do
  endif
  print wr cr
  tk=lookupindex(trp,wr)
  select tk
  case 0 : print wr " not found" cr : exit do
  case 1 to 16 : op=tk
  case 20 : '(
  case 21 : ')
  end select
loop
wait
*/



/*
'signatures
! f(byte b=10,long l=100) as float*
#recordof f
type t
  function f(byte b=10,long l=100) as float*
  end function
end type
#recordof t
*/


'14/02/2024

/*
'phi fpu calc: (sqr(5)-1)/2
double f
'
fld1
fadd st0
fadd st0
fld1
faddp
fsqrt
fld1
fsubp
fld1
fadd st0
fdivp
'
fstp qword f
print f
*/


'13/02/2024

/*
'block consistency
int i
'for i= 1 to 2
'  print i
'end for
i=2
select i
case 1
end case
case 2
  print i
end case
end select
*/

/*
'fibo on fpu
fld1
fld1
mov ecx,40
(
fldz
fadd st2
fadd st1
fxch st2
fstp st0
fxch st1
dec ecx
jg repeat
)
fdivp st1
double f
fstp qword f
print f
*/


/*
'09/02/2024
'phi convergence
uses console
int a,b,c
do
  print "enter an integer -20..20 "
  a=input
  print cr
  print "enter another integer -20..20 "
  b=input
  print cr
  if a=0 and b=0 then exit do
  while abs(a)<1e8
    print a tab b cr
    c=b
    b=a+b
    a=c
  wend
  print cr
  print "phi ratio (small): " a/b cr
  print cr cr cr
loop
*/

'06/02/2024

/*
'test redim udt
type tt
  int i
end type
'#recordof tt
'typedef int tt
'#show {
'redim tt t(8) 'static
 'tt t[8]
string t[8]
'}
int i
#if typecodeof(t[i])>0x200
print 0
#elseif typecodeof(t[i])>0xa0
print 1
#endif
*/

'31/01/2024
/*
#autodim enabled
uses console
'captsx
'buildsig
type tt
  a=2 'treated as member
  b=0.0
  s=""
  function e0(float pa=0,double **pb=4.0, string pc="") as int
  end function
  function e1(float pa=0,optional double **pb, string pc) as int
  end function
  function f(pa=0,pb=0.0,pc="") as int
  end function
  function ga00(pa as float,pb as double ptr,pc as string) as int
  end function
  function ga01(as float pa,byval as double **pb, as string pc) as int
  end function
  function ga1(pa=1 as float,*pb=2 as double,pc="Q" as string) as int
  end function
  function ga2(pa as float=1,pb as double=2,pc as string="Q") as int
  end function
  function h(as float pa ,as double pb,as string pc) as int
  end function
end type
#recordof tt
tt t={}
'print t.f() cr cr

  'function f(int pa=0,float pb=0.0,string pc="") as int
  '  return pa
  'end function
  '#recordof f
'
j=0
for i=0 to 10
  print i tab j cr
  j+=2
next
wait
*/

'28/01/2024

/*
'64bit global strings test
string s,t,tok
tok=nuls 0x10000
s=" load drop swap call ret + - * / "
t=" 1    2    3    4    5   6 7 8 9 "
print len tok
*/


/*
function instrwd(string *s,*w) as int
=====================================
'specialised instr
'check boundaries
byte bs at strptr(s)
byte bw at strptr(w)
int js=1
int jw=1
int lw=len(w)
int ls=len(s)
w=lcase(w)
do
  js=instr(js,s,w)
  if js
    if js>1
      if bs[js-1]>32
        js+=lw
        if js>ls
          exit do
        endif
        continue do 'go further
      endif
    endif
    if bs[js+lw]>32
      js+=lw
      if js>ls
        exit do
      endif
      continue do 'go further
    endif
    return js 'success
  else
    exit do
  endif
loop
end function
'
function tokens() as string
===========================
int i,j,k
string s,t
string tk
tk=nuls 0x10000 '64k
s=" load drop swap call ret + - * / "
t=" 1    2    3    4    5   6 7 8 9 "
i=instrwd(s,"call")
'print i
if i
  k=valat strptr(t)+i-1
  j++
  mid (tk,j)=chr(k)
endif
return left(tk,j)
end function
print tokens()
*/


/*
'lookup / tokenize
string s=" load drop swap call ret + - * / "
'        01234567890123456789012345678901234
'        0         1         2         3
int i,j,k
string tok=nuls 0x10000 '64k
...
k=-1
select i
case 2  : k=1 'load
case 7  : k=2 'drop
case 12 : k=3 'swap
case 17 : k=4 'call
case 22 : k=5 'ret
case 26 : k=6 '+
case 28 : k=7 '-
case 30 : k=8 '*
case 32 : k=9 '/
case else k=0 '(not listed)
end select
'token list
j++
mid tok,j,chr(k)
print "ok " k
*/

'27/01/2024

/*
'gosub by pointer variable
sys p[1024]
subroutine n
  print "ok4"
end subroutine
#show p[4]=@n
'
'more subroutines
subroutine n
  print "ok5"
end subroutine
p[5]=@n
int k token
k=4
gosub p[k]
k=5
gosub p[k]
*/


/*
'informal module and interface syntax
module
======
  external
    !* f1
    !* f2
    declare function ptr f2 'verbose syntax
  end external
  internal
    function f1i( ) link @f1
      print "ok"
    end function
  end internal
end module
f1()
'print 123
*/

'16/01/2024

/*
'whole array assignment
'"copy"
'newArray
remap int a(5)
@a=getmemory 5*sizeof int
'remap int a(5) : @a=fa(n)
'
macro ArrayAssign(typ,a,f,  n,p)
================================
int n
sys p=f(n) 'n output
remap typ a(n) : @a=p
end macro
'
print ubound(a)
del a
*/


'10/12/2024

/*
uses corewin
uses console
'
#define CTLCOLOR_MSGBOX         0
#define CTLCOLOR_EDIT           1
#define CTLCOLOR_LISTBOX        2
#define CTLCOLOR_BTN            3
#define CTLCOLOR_DLG            4
#define CTLCOLOR_SCROLLBAR      5
#define CTLCOLOR_STATIC         6
#define CTLCOLOR_MAX            7

#define COLOR_SCROLLBAR         0
#define COLOR_BACKGROUND        1
#define COLOR_ACTIVECAPTION     2
#define COLOR_INACTIVECAPTION   3
#define COLOR_MENU              4
#define COLOR_WINDOW            5
#define COLOR_WINDOWFRAME       6
#define COLOR_MENUTEXT          7
#define COLOR_WINDOWTEXT        8
#define COLOR_CAPTIONTEXT       9
#define COLOR_ACTIVEBORDER      10
#define COLOR_INACTIVEBORDER    11
#define COLOR_APPWORKSPACE      12
#define COLOR_HIGHLIGHT         13
#define COLOR_HIGHLIGHTTEXT     14
#define COLOR_BTNFACE           15
#define COLOR_BTNSHADOW         16
#define COLOR_GRAYTEXT          17
#define COLOR_BTNTEXT           18
#define COLOR_INACTIVECAPTIONTEXT 19
#define COLOR_BTNHIGHLIGHT      20

#define COLOR_3DDKSHADOW        21
#define COLOR_3DLIGHT           22
#define COLOR_INFOTEXT          23
#define COLOR_INFOBK            24

#define COLOR_HOTLIGHT          26
#define COLOR_GRADIENTACTIVECAPTION 27
#define COLOR_GRADIENTINACTIVECAPTION 28

#define COLOR_MENUHILIGHT       29
#define COLOR_MENUBAR           30

#define COLOR_DESKTOP           COLOR_BACKGROUND
#define COLOR_3DFACE            COLOR_BTNFACE
#define COLOR_3DSHADOW          COLOR_BTNSHADOW
#define COLOR_3DHIGHLIGHT       COLOR_BTNHIGHLIGHT
#define COLOR_3DHILIGHT         COLOR_BTNHIGHLIGHT
#define COLOR_BTNHILIGHT        COLOR_BTNHIGHLIGHT

print hex(GetSysColor(COLOR_3DDKSHADOW)) cr

wait
*/


'05/01/2024

/*
'static subroutine scope
'inside a type
bstring kk="global outside"
type tt
  static bstring kk 'static inside
  bstring kk       'global outside
  procedure pp
    kk="object inside obj"
    that.kk="static obj"
    gosub xx
  end procedure
  subroutine xx
    print kk
  end subroutine
end type

'gosub xx
tt t
t.pp
*/


/*
'static subroutine scope
'inside a type
bstring kk="outside"
type tt
  'static bstring kk
  bstring kk
  procedure pp
    kk="inside"
    gosub xx
  end procedure
  subroutine xx
    print kk
  end subroutine
end type

'gosub xx
tt t
t.pp
*/

/*
'https://learn.microsoft.com/en-us/windows/console/console-functions'reading characters direct from console
uses sysutil
uses console
byte c  'ascii of byte read
int n=1 'requested chars to read
int r   'chars read
cls
print cr
'read fifth character on second line
int p=1*0x10000+4
print "0123456789" 'demo input
'string s=input 'user imput
ReadConsoleOutputCharacter consout,@c,n,p,@r
'WriteConsoleOutputCharacter consout,@c,n,p,@r
print cr "ascii " c "  char: " chr(c)
wait
*/


'https://learn.microsoft.com/en-us/windows/console/console-functions
'GetConsoleScreenBufferInfo( ConsOut, csbi )
'type CONSOLE_SCREEN_BUFFER_INFO
'  COORD      dwSize;
'  COORD      dwCursorPosition;
'  word       wAttributes;
'  SMALL_RECT srWindow;
'  COORD      dwMaximumWindowSize
'end type

/*
uses console
'console location / color
def locate SetConsoleCursorPosition ConsOut,(%1)*0x10000+0 %3
cls
locate 5
color 0xe
print "y=5"
locate 5,10
color 0x1e
print "y=5,x=10"
locate 10
color 7
print "left click mouse to exit"
wait(1)
*/

/*
'test console position selection
uses console
do
  int k=inkey()
  if k=1 or k=2 'left or right click
    def mx MouseRecord.dwMousePosition.x
    def my MouseRecord.dwMousePosition.y
    print "mouse click " k tab mx tab my cr
  elseif k
    print "virtual key " k cr
  endif
  if k=27 or k=13 'esc or enter
    exit do
  endif
loop
'print "end"
'wait
*/


/*
'test new block definitions
'itr low level block captures
'
def routine procedure
def routine_end end procedure
'
routine xx
print "ok"
end routine
*/


/*
uses console

int x=10,y=5
int d,mb,mx,my
'
do
  SetConsoleCursorPosition ConsOut,0
  SetConsoleTextAttribute ConsOut,0x1a
  print str(mb) "  " str(mx) "  " str(my)
  SetConsoleCursorPosition ConsOut,(y<<16)+x
  SetConsoleTextAttribute ConsOut,0x0e
  'print "ok" cr
  'GetConsoleScreenBufferInfo( ConsOut, csbi )
  'y+=1
  'x+=2
  SetConsoleCursorPosition ConsOut,0x10000
  'd=inkey
  d=waitkey
  mx=MouseRecord.dwMousePosition.x
  my=MouseRecord.dwMousePosition.y
  'mb=MouseRecord.dwButtonState
  mb=d
loop
*/

/*
indexbase 0
redim int d[99,0]
print ubound(d,2)
*/

/*
redim int d(10000)
remap byte b(10000,4) 
@b=@d
d[7]=0x103
print b[7,1] '3
print b[7,2] '1
*/


'28/12/2023


/*
type cc
  function f(int i)
    return i*2
  end function
end type
'
dim cc c
print c.f(3) '6
*/


/*
union utype
  byte  b
  short w
  long  i
end union

utype v
v.b=42
print v.i
*/


/*
'HOW TO USE OXYGEN DLL
'22/12/2023 CP
  $ filename "..\t.exe"
  uses rtl32
  extern lib "oxygen.dll"
    declare function o2_basic(byval s as zstring*) as long
    declare function o2_exec (byval p as long) as long
    declare function o2_errno() as long
    declare function o2_error() as zstring*
    declare function o2_mode(byval m as long)
  end extern
  '
  dim qu as string
  dim cr as string
  dim src as string
  qu=chr(34)
  cr=chr(13)+chr(10)
  src="print " + qu+"Helo"+qu+cr
  '
  o2_basic(src)
  '
  if o2_errno()<>0
    print o2_error()
  else
    o2_exec(0)
  end if
  end
*/

/*
uses console

def show
  print "%1" tab %1 cr
end def
'
function f(int *rr[redim])
==========================
print "carried param dimensions" cr cr
show (ubound(rr))
show (ubound(rr,1))
show (ubound(rr,2))
show (ubound(rr,3))
print cr
redim int rr(4,3,4) 'expand array
end function
'
'
redim int r[2,3,4]
print "initial dimensions" cr cr
show (ubound(r))
show (ubound(r,1))
show (ubound(r,2))
show (ubound(r,3))
print cr
f(r)
print "altered dimensions after call" cr cr
show (ubound(r))
show (ubound(r,1))
show (ubound(r,2))
show (ubound(r,3))
print cr
'
print "ok" cr
wait
*/

/*
'20/12/2023
int a,bb,c
#show {
if (a) bb=1
}
*/

/*
'19/12/2023
dim int a[1][2][3]
int b
'print dims(a)+"  "+ubound(a)
a[1,1,2]=34
print a[1,1,2]
b=a[1][1][2]
print b
*/

/*
'18/12/2023
byte b={63,33,0}
'print cast(char) b[1] 'not lit 63
print cast(char*) strptr("helo")
*/

/*
'17/12/2023
#semicolon separator
int a,b,c,d
'
'while (a>b) c=d
'if (a>b) c=d ; print "ok"
for (a=1 ; a<4 ; a++ ) {c++}
'for (a=1 ; a<4 ; a++ ){
' c++
'}
'
print c
*/

/*
'14/12/2023
type xdouble
  double a,b
end type
#cpointer on
xdouble *d,*e
double b,c
d=&b
'#show c=*d
#show { 
 '#show d++ mbox problem
 'd++
 'd--
 'e=d
 *e.a=*e.b
e->a = e->b
}
'#recordof d
*/

/*
'09/12/2023
'supporting redim for object members
sys p=getmemory 0x100*0x4*sizeof float
int y=0x100,x=0x4
remap float d[y,x]
@d=p 'link to memory
print dims(d)
print ubound(d,1)
print ubound(d,2)
'del d
del p
*/

'08/12/2023
'
/*
type vv
  int n
  int vert[20]
end type

vv v[100]
int i=1,j=1
'#show {
 v[i].vert[j]=21
'}
print v[i].vert[j]
*/

/*
'01/12/2023
'
function instrp(int i,string s,p,int*en=0) as int
=================================================
'
'i   start position
's   string to search
'p   search string (with optional ? * wildcards
'en  boundary of found key string
'
if i<1
  i=1
endif
if not s
  return 0 'no source string
endif
if not p
  return 1 'no search string
endif
'
indexbase 1
byte bs at strptr(s) 'source string bytes
byte bp at strptr(p) 'search string bytes
int js=i      'source string position
int jp=1      'search string position
int ks=i      'next search start
int kt=i      'current search start
int kf=0      'prev key wild card position
int kg=0      'prev source wild card position
int fs=i      'possible found position
int ls=len(s) 'limit of source string
int lp=len(p) 'limit of search string
int ok=1      'vrification flag
byte ka=bp[1] 'first byte to search
do
  if jp>lp
    exit do
  endif
  if js>ls
    if jp<=lp
      ok=0
    endif
    exit do
  endif
  select bp[jp]
  case 42 '*
    ok=1
    while bp[jp]=42
      jp++
    wend
    do
      if js>ls 'end of string
        ok=1
        jp--
        exit do
      endif
      if ka=bs[js]
        ks=js
      endif
      if jp>lp 'end of pattern
        ok=1
        jp--
        exit do
      endif
      if bp[jp]=bs[js] 'possible match char
        ok=1
        jp--
        'these flags used for resuming wild card
        kf=jp
        kg=js+1
        exit do
      endif
      if bp[jp]=63 'possible match ? char
        ok=1
        jp--
        exit do
      endif
      js++
    loop
  case 63 '?
    if ka=bs[js]
      ks=js
    endif
    ok=1
    js++
  case else 'all other chars
    if bp[jp]=bs[js] 'byte match
      ok=1
      if ka=bs[js]
        ks=js
      endif
      js++
    else 'mismatch
      ok=0
      if kf
        'prev wildcard positions
        jp=kf-1
        js=kg
        kf=0
        kg=0
      else
        if ka=63
          ks=kt '?' was wildcard start
        endif
         if ks=kt
           ks++ 'nudge fwd
        endif
        kt=ks
        js=ks 'restart search
        fs=js
        jp=0
      endif
    endif
  end select
  jp++ 'next pattern byte
loop
if ok
  function=fs
else
  js=0
endif
en=js
end function
'
'test cases
===========
string s="aabcdefghijklmmnopqrstuvwxyz"
'print instrp 1,s,"ab"
'print instrp 1,s,"abz"
'print instrp 1,s,"xyz"
'print instrp 1,s,"mno"
'print instrp 1,s,"mm?o"
'print instrp 1,s,"m?o"
'print instrp 1,s,"m??"
'print instrp 1,s,"m??p"
'print instrp 1,s,"??m"
'print instrp 1,s,"*m"
'print instrp 1,s,"m*"
'print instrp 1,s,"m*z"
'print instrp 1,s,"m*k*z"
'print instrp 1,s,"m*n"
'print instrp 1,s,"a*b"
'print instrp 1,s,"a?*c"
'print instrp 1,s,"c?d"
'print instrp 1,s,"c*d"
'print instrp 1,s,"c?*e"
'print instrp 1,s,"c**f"
'print instrp 1,s,"c*??f" 'yes
'print instrp 1,s,"c*??g" 'no
'print instrp 1,s,"c??*g" 'yes
int en
'print instrp 1,s,"c??*g",en 'yes
'print en
uses console
s="abcdefghijklmmabcdefghijklmn"
int b
b=instrp(1,s,"d*lmm",en)
print b " - " en cr
print mid(s,b,en-b) cr
print instrp(1,s,"d*lmn",en) " - " en cr
print cr "ok" cr
wait
*/

/*
uses console
waitkey 27
*/

/*
int a
do
  a=inkey()
  if a
    print a cr
    exit do
  endif
loop
wait
*/


'29/11/2023

/*
asm
nop
end asm
*/

'26/11/2023

/*
redim sys t(4,5) static
sub f
end sub
flagsof(t) 3
#recordof t
print recordof t
del t
*/

'25/11/2023

/*
function da(float*a[redim],int y,x) as sys
  redim float a[y,x] static
end function
'
redim float T[0,0]
#show da(T,3,4)
int u=ubound(T)
int n=dims(T)
print u
*/

'23/11/2023

/*
type mm
float d[16]
end type
'
macro mm_"init" (a,b)
'print "init"
end macro
'
macro mm_"free" (a,b)
'print "free"
end macro
'
macro mm_"move" (a,b)
'print "move"
a.d=b.d
end macro
'
macro mm_"+" (a,b,c)
'print "+"
a.d=b.d+c.d
end macro
'
function f(mm*m) as mm
end function
==================
dim mm m1,m2,m3
#show m1=f(m2)+m3
==================
*/


/*
redim double tt [10,10]
'#recordof tt
double **t : @@t=@@tt 'coupling
'int i=3
'#show t[i]=12.5
'#show double d=t[i]
'print d
'
procedure p(double*a[redim], int i)
  print ubound(a,i)
end procedure
'
p(t,2)
*/

'21/11/2023

/*
Uses console

function f1(int *a[redim])
redim int a[10,5]
int y,x, c
for y=lbound(a,1) to ubound(a,1)
  for x=lbound(a,2) to ubound(a,2)
    c++
    a[y,x]=c
  next
next
end function

function f2(int *a[redim])
int y,x
print ubound(a,1) cr
print ubound(a,2) cr
for y=lbound(a,1) to ubound(a,1)
  for x=lbound(a,2) to ubound(a,2)
    print a[y,x] tab
  next
  print cr
next
end function

redim int g(0,0)
f1 g 'set data table
f2 g 'show data table
print ubound(g) cr
print ubound(g,1) cr
print ubound(g,2) cr
print "ok" cr
wait
*/

/*
'21/11/2023
uses console
def show
  print "%1" tab %1 cr
end def
'
function f(int *rr[redim])
=========================
show (flagsof(rr))
show (ubound(rr))
show (ubound(rr,1))
show (ubound(rr,2))
show (ubound(rr,3))
end function
'
redim int r[2,3,4]
show (flagsof(r))
show (ubound(r))
show (ubound(r,1))
show (ubound(r,2))
show (ubound(r,3))
f r
print "ok" cr
wait
*/

'19/11/2023

/*
'metalogic
% a 31
#if (a and 2)=2
print a
#endif
*/

/*
'test redim
uses console
int ix,iy,iz
int ux,uy,uz
int tx,ty,tz
tz=2
ty=3
tx=4
redim int m(tz,ty,tx)
'#show {
remap int p(tz,ty,tx)
@p=@m
'}
'@p=@m
'redim int m(2,3,4)
'redim int m(2)
int i
for i=0 to -9 step -1
print i tab p(i) cr
next
print cr "flags "flagsof m cr
wait

'#recordof m
'dim int m(2,3,4)
'
uz=ubound(m,1)
uy=ubound(m,2)
ux=ubound(m,3)
print "location " @m cr
print "elements " elements(m) cr
print 1 tab uz cr
print 2 tab uy cr
print 3 tab ux cr
print "---" cr
for iz=1 to uz
for iy=1 to uy
for ix=1 to ux
p(iz,iy,ix)=(iz-1)*(uy*ux)+(iy-1)*ux+ix
next
next
next
'
for iz=1 to uz
for iy=1 to uy
for ix=1 to ux
print p(iz,iy,ix) cr
next
next
next
print cr
print "size " ubound (m) cr
undim p
undim m
print "cleared ok"
wait
'
*/

/*
% a 14
#if a and 8
#print a
#else
#print 0
#endif
*/

'18/11/2023

/*
int a[100]
a=42
mapping int m(100)
@m=@a
'print m[1]
'redim int m[100]
#show {
del m
'undim m
}
'print a

'#recordof m
'undim m
'print flagsof m
print m
*/

/*
sys a,b
sys c at b
#recordof b
#recordof c
*/

/*
dim double x[1,2,3]
'#recordof x
print typecodeof x
*/

/*
'17/11/2023
int a
print typeof(a[32]) " " typecodeof(a(3))
*/

/*
'17/11/2023
'array macros
uses console
dim int aa[5,2]
aa[6]=33
#show aa[aa[2]+3,2]=44

function f(int a[]) as int
int d
d=a[3,2]
print d cr cr
print typeof a cr cr
print "lbound " lbound(a) cr
print "ubound " ubound(a) cr
print "elements " elements(a) cr
print "dims " dims(a) cr
print "dim order " dimorder(a) cr
'
int i
for i=1 to dims(a)
  print "scaler" tab i tab scaler(a,i) cr
  print "strider" tab i tab strider(a,i) cr
  print "lbound" tab i tab lbound(a,i) cr cr
  print "ubound" tab i tab ubound(a,i) cr cr
next
print "ok1" cr
for i=1 to 10
  print i tab str(a[i]) cr
next
print cr cr str(a(3,2)) cr
end function
f aa[]
wait
*/

/*
uses console
redim double a[5]

print "ubound of array: " ubound(a) cr cr
int i
'int m at @a '@@a for redim
'for i=0 to -3 step -1
'  print m[i] cr
'next

sub ff(double *d[])
===================
print "Test attributes of a passed dynamic array" cr cr
print "dims:" tab dims(d) cr
print "ubound:" tab ubound(d) cr
end sub
'
'TEST:
ff a
wait
del a
*/

/*
'14/11/2023
uses console
indexbase 1
'#show {
redim int a[5]
'}
int u,i
'for i=-3 to 0
'print a[i] cr
'next
u=ubound(a)
'#recordof a
print "dimensions of array " dims(a) cr
print " elements of array: " elements(a) cr
print " ubound of array: " u cr
wait
*/

/*
'2248
'2104
'12/11/2023
'bString Array
uses console
function foo() as sys
  bstring *f 'localise
  redim bstring f[110]
  int i
  for i=1 to 100
    f[i]="L"+str i
  next
  return @f
end function
'
bstring d at foo()
'equiv: bstring *d : @d=foo()
int i=1
while d[i]
  print d[i] cr
  i++
  if i>110
    exit while
  endif
wend
'disposal
int e=i-1
for i=1 to e
  freememory d[i]
next
freememory @d
@d=0
print cr "ok" cr
wait
*/


/*
'12/11/2023
'returning an array using param
uses console
procedure f(string *s[])
int i
for i=1 to 100
  s[i]= "f " str i 'global garbage
next
end procedure

procedure g()
int i=1
static string d[1000]
f d[]
while d[i]
  print d[i] cr
  i++
  if i>110
    exit while
  endif
wend
end procedure
g
wait
*/


/*
'31 oct 2023
'list of directories
uses sysutil
sys c
print GetFileList("\*.*",c,1)
*/

/*
'27/10/2023
'redim inside procedure
'instability
'redim string srd[100]
procedure p()
redim string srd[100]
int i
for i=1 to 100
srd[i]="helo"
next
print srd[100]
end procedure
p
*/

/*
'19/10/2023
'use of exec
uses sysutil
int wait=1
exec "notepad.exe ..\t.o2bas",wait
print "ok"
*/

/*
'19/10/2023
'HINSTANCE ShellExecute(
'  __in_opt  HWND hwnd,
'  __in_opt  LPCTSTR lpOperation,
'  __in      LPCTSTR lpFile,
'  __in_opt  LPCTSTR lpParameters,
'  __in_opt  LPCTSTR lpDirectory,
'  __in      INT nShowCmd
');
uses corewin
ShellExecute ( 0,"open", "..\co2.exe","", null,0 )
print "ok"
*/

/*
'09/10/2023
'# character as part of name
int #i=5
'print #i 'works
function #f(int i) as int
return i*2
end function
#show #f(3) 'not exec
print "ok"
*/

/*
'08/10/2023
'test #lookahead
#lookahead
f(1,2)
g(3)
print "ok"
'#recordof f
end
'
function f(float v,w)
end function

function g(float v)
end function
*/

/*
'07/10/2023
'MathTrig library macros
uses console
uses mathtrig
float a=1,b=2,c=3,r=0
showcalc (r=a+b+c) r "demo"
wait
*/


/*
'04/10/2023
'macro insid class test
class cc
int a
macro m()
a=i+1
end macro
function f(int i)
m()
print this.a
end function
end class
'#recordof cc
cc c
c.f 3
*/

/*
'15/09/2023
'extending macros problem
def new
incl prior new
#ifdef %2.listener
#endif
end def

#recordof new
*/




/*
'20/07/2023
'union test
'endline(
type xx
union 
byte b
word w
dword d
end union
end type
#recordof xx
*/

/*
'print version
'16/07/2023
'Array of char*
'massign
uses console
typedef char *pchar,*qchar
pchar pc[4]
pc[1]="one"
pc[2]="two"
pc[3]="three"
int n=3
int i
for i=1 to n
  print " > " pc[i] cr
next
#recordof pc'har
#show pc={"one","two","three"}
int n=3
int i
for i=1 to n
  print "g> " pc[i] cr
next
'
function f(pchar*pc, int n)
'#recordof pc
#show pc={"one","two","three"}
pc[1]="one1"
pc[2]="two2"
pc[3]="three3"
int i
for i=1 to n
  print "l> " pc[i] cr
next
end function
'
f pc,3
wait
*/


/*
'01/07/2023
'64bit direct params
type vv
  float x
end type
extern
*/
'
/*
function f(vv v1,v2,v3,float f)
end function
'
float f1,f2,f2
vv v1,v2,v3
#show f(v1,v2,v3,f1)
print "ok"
*/

/*
'01/07/2023
'extern
'callcnv callconv
function f(float x)
end function
'
float a,b,c
#show f( a*(a+b)*c )
*/

/*
'29/06/2023
'single liners
'
class cc
type color int r,g,b,a
int xx,yy,zz
type vector
  float x,y,z
end type
vector v
'
function f
print xx
color c
print c.g
#recordof color
#recordof vector
end function
end class
cc c
c.f()
#recordof cc
*/


/*
'29/06/2023
'test single liners inside procedures
function f()
type color int r,g,b,a
type vector
  float x,y,z
end type
#recordof vector
'
int x,y,z
print x
color c
print c.g
end function
f()
*/


/*
'16/06/2023
'
function ff(bstring *s,b)
  print s[1]
  print s[2]
  print b
end function
'
macro m(A,B)
ff A,countof
end macro
'
typedef bstring BSTR
m BSTR {"1","2"},33
*/

/*
'string mapping
'
'uses corewin
uses console
'
'USING LOWER 3 BYTES TO STORE WORD INDEX
'USING THE TOP BYTE TO STORE WORD LENGTH
'MUST STORE .DX FIRST
'THEN OVERLAY .LEN
'
type MapLen
===========
int idx
= 'UNION WITH
byte a,b,c,len
end type
'
procedure MapStrLenWord(sys ps,pm,int *ct)
==========================================
'WORD MAPPING FOR ANSI
'ps source string pointer
'pm map array of pointers
'ct word count
'
if ps=0 or pm=0
  exit procedure
endif
'
byte   *s = ps         'pointer to string bytes
MapLen *m = pm         'string indexes
int    iw = 0          'in-word flag
int    st = sizeof MapLen 'index stride
ct=0
'
subroutine LogIndex
  if iw=0
    ct++
    m.idx=@s-ps
    iw=1
  endif
end subroutine
'
subroutine LogLen
  if iw=1
    m.len=@s-ps-m.idx
    @m+=st 'PTR NEXT WORD
    iw=0
  endif
end subroutine
'
macro LogSymbol
  if iw=0
    gosub LogIndex
    @s++
    gosub loglen
    continue do
  endif
  gosub LogLen
  continue do
end macro
'
begin:
'
do
  select s
  case 0
    gosub LogLen
    exit do
  case 1 to 32
    gosub LogLen
    iw=0 'READY FOR NEXT WORD
  case 34
    'SKIP QUOTE
    gosub LogIndex
    do
      @s++
      if s=0
        @s--
        exit do
      endif
      if s=34
        exit do
      endif
    loop
  case 35,46,95   ' #._
    gosub logindex
  case 33  to 47, ' !$%&'()*+,-/
       58  to 64, ' :;<=>?@
       91  to 96, ' [\]^`
       123 to 126 '{|}~
    LogSymbol()
  case 48 to 255
    gosub LogIndex
  end select
  @s++
loop
end procedure
'
'
'TEST
'====
string s=` one+7, two (three) "four x" five `
sys     ps=strptr s
'sys ps=GetCommandLine
char*ch=ps
print ch cr
int     ee 'word count
MapLen  m[0x400]
MapStrLenWord ps, @m, ee
'
indexbase 1
print cr cr ee " words" cr cr
int i
for i=1 to ee
  char *ch=m[i].idx and 0xffffff
  int le=m[i].len
  @ch+=ps
  print i tab left(ch,le) cr
next
print cr "ok" cr
wait
*/

/*
'06/06/2023
'
procedure MapStrWord(sys ps,pm,int *ct)
=======================================
'WORD MAPPING FOR ANSI
'ps source string pointer
'pm map array of pointers
'ct word count
'
if ps=0 or pm=0
  exit procedure
endif
'
byte *s = ps         'string bytes
sys  *m = pm         'string pointers
int  iw = 0          'in-word flag
int  st = sizeof sys 'pointer stride
ct=0
'
subroutine LogPointer
  if iw=0
    ct++
    m=@s
    @m+=st 'PTR NEXT WORD
    iw=1
  endif
end subroutine
'
do
  select s
  case 0
    exit do
  case 1 to 32
    s=0  'SET NULL TERMINATOR
    iw=0 'READY FOR NEXT WORD
  case 34
    'SKIP QUOTE
    gosub LogPointer
    do
      @s++
      if s=0
        @s--
        exit do
      endif
      if s=34
        exit do
      endif
    loop
  case 33 to 255
    gosub LogPointer
  end select
  @s++
loop
end procedure
'
procedure MapWStrWord(sys ps,pm,int *ct)
========================================
'WORD MAPPING FOR LITTLE-ENDIAN UNICODE
'
'ps source string pointer
'pm map array of pointers
'ct word count
'
if ps=0 or pm=0
  exit procedure
endif
'
word *s = ps         'string characters
sys  *m = pm         'string pointers
int  iw = 0          'in-word flag
int  st = sizeof sys 'pointer stride
ct=0
'
subroutine LogPointer
  if iw=0
    ct++
    m=@s
    @m+=st 'PTR NEXT WORD
    iw=1
  endif
end subroutine
'
do
  select s
  case 0
    exit do
  case 1 to 32
    s=0  'SET NULL TERMINATOR
    iw=0 'READY FOR NEXT WORD 
  case 34
    'SKIP QUOTE
    gosub LogPointer
    do
      @s+=2
      if s=0
        @s-=2
        exit do
      endif
      if s=34
        exit do
      endif
    loop
  case 33 to 0xffff
    gosub LogPointer
  end select
  @s+=2 'FOR NEXT CHARACTER
loop
end procedure
'
procedure MapStrLine(sys ps,pm,int *ct)
=======================================
'LINE MAPPING
'ps source string pointer
'pm map array of pointers
'ct word count
'
if ps=0 or pm=0
  exit procedure
endif
'
byte *s = ps         'string bytes
sys  *m = pm         'string pointers
int  iw = 0          'in-word flag
int  st = sizeof sys 'pointer stride
ct=0
'
subroutine LogPointer
  if iw=0
    ct++
    m=@s
    @m+=st 'PTR NEXT WORD
    iw=1
  endif
end subroutine
'
do
  select s
  case 0
    exit do
  case 13,10 
    s=0  'SET NULL TERMINATOR
    iw=0 'READY FOR NEXT WORD
    @s++
    if s=10
      s=0
      iw=0
    endif
  case 10 to 31
    'IGNORE
  case 34
    gosub LogPointer
    'SKIP QUOTE
    do
      @s++
      if s=0
        @s--
        exit do
      endif
      if s=34
        exit do
      endif
    loop
  case 32 to 255
    gosub LogPointer
  end select
  @s++
loop
end procedure
'
'
'TEST
'====
string s=` one two three "four x" five `
int ee 'word count
sys  m[0x400]
MapStrWord strptr(s), @m, ee
'
indexbase 1
print cr cr ee " words" cr cr
int i
for i=1 to ee
  char *ch=m[i]
  print i tab ch cr
next
print cr "ok" cr
wait
*/


/*
'06/06/2023
'array of string pointers
uses console
use sysutil

'commandlinew

'from sysutil.inc
macro CreateArgv()
==================
  sys    argv[64]
  int    argc
  string args = CommandLineArgs
  'char args="one two three four" 'TEST DATA
  string arga[64]
  scope
    indexbase 0
    int i=1
    do
      arga[argc]=unquote getword args,i
      if ascb=0 then exit do
      argv[argc] = strptr arga[argc]
      argc++
    end do
  end scope
end macro

CreateArgv()

function main cdecl (int argc,char*argv[]) as int
=================================================
  printl "Arguments " argc
  printl
  printl "List:"
  int i 
  for i=1 to argc
    printl str(i) tab argv[i]
  next
end function
'
main argc, byval @argv

wait
*/

/*
'04/06/2023
'
type rect
 int x1,y1,x2,y2
end type
'
#show {
function f(int i,j, rect r,int k=0) as rect*
  'r.x1=1
  r.y1=2
  '#show r.x2=3
  'r.y2=4
static rect q
q=r
'#recordof r
'#recordof k
'print r.x1 "," r.y1 ",  " r.x2 "," r.y2
return @q
'#show function=r
'function.x2=3
end function
}
'
'#recordof f
'
rect q1,q2
q2=f(1,2,q1)
'
print q2.x1 "," q2.y1 ",  " q2.x2 "," q2.y2
'
*/

/*
'03/06/2023
'to lacate exepath
'DWORD GetFullPathNameA(
'  [in]  LPCSTR lpFileName,
'  [in]  DWORD  nBufferLength,
'  [out] LPSTR  lpBuffer,
'  [out] LPSTR  *lpFilePart
');
'grapide
uses corewin
char buf[255]
int n=255
int c
GetFullPathName "t.exe",n,@buf,@c
print buf
*/


/*
'30/05/2023
$filename "..\t.exe"
#include "$\inc\rtl64.inc"
print "hallo"
*/

/*
'27/05/2023
'test ncompar
int a,b,c
'#show {
'if (b+1)<(a)  then
'  c=0
'endif
'}
'if (a)<(b) then c=0
'if (b) then c=0
if a<=b then c=0
'if a=b then c=0
'if a==b then c=0
'if a>=b then c=0
'if a>b then c=0
'if a<>b then c=0
'if a != b then c=0
print "ok"
*/

/*
'26/05/2023
'init and free
'ncompar
type cc
int i
'
procedure constructor()
  'print "constructor"
end procedure
'
procedure destructor()
  'print "destructor"
end procedure
'
end type
'
def see "%1 "
'
macro cc_"init"(name,qty)
'print "init " see(name) qty
name.constructor()
end macro
'
macro cc_"free"(name,qty)
'print "free " see(name) qty
end macro

macro cc_"move" (a,b)
a.i=b.i
end macro

macro cc_"+" (a,b,c)
#recordof a
'print "<<"+see(a) + ">>"
a.i=b.i+c.i
end macro

macro cc_"<|>" (a,b,c)
#recordof a
a.i=b.i+c.i
end macro

operator <|>, 600, 0 'min 512, lowest prec 0
cc c,d
c.i=1
d.i=2
c=c <|> d
print c.i
'print "ok"
*/

/*
uses corewin
type tt
  int i,j,k
  function f()
  end function
end type

type tu
  tt
  int a,b,c
end type

#recordof tu
*/


/*
'see bindrec(
'19/05/2023
'demo bind block
sys bu[0x1000]
sys p=@bu
bind p
  int a
  int b
  int c
end bind
'
a=10
b=11
c=12
print a "  " b "  " c
'
sys q=@bu
bind q
  int aa
  int bb
  int cc
end bind
print aa "  " bb "  " cc
*/


/*
'19/05/2023
type RECT
  '
  int left
  int top
  int right
  int bottom
  '
  type tt
    float x,y,z
    function m1() as int
    end function
  end type
  '
  tt a1
  '
  macro RECTcalc()
    'avoid confusion with rigft() and left()
    float x=this.right-this.left
    float y=bottom-top
  end macro
  '
  function constructor(int x1,y1,x2,y2)
    with this
    .left=x1
    .top=y1
    .right=x2
    .bottom=y2
    end with
    'print "RECT created"
  end function
  '
  function destructor()
    'print "RECT destroyed"
  end function
  '
  function area() as float
    RECTcalc
    return x*y
  end function
  '
  function diagonal() as float
    RECTcalc
    return hypot(x,y)
  end function
  '
  function aspect() as float
    RECTcalc
    return x/y
  end function
  '
end type
'
#recordof rect
new RECT r(1,1,3,5)
'print r.area '8
'print r.diagonal '4.47
print r.aspect
del r
*/

/*
'18/05/2023
'test raw class
'
class cc
int x,y,z
function f1()
function f2()
'method f1()
'method f2()
'void f1()
'void f2()
'int f1()
'int f2()
end class
'
#recordof cc
'
methods cc
function f1()
  int i
end function
'
function f2()
  int i
end function
end methods
*/




'undefbuf
'/*
'17/05/2023
'
/*
  type cc
    float x,y,z
    function hypot3(float x,y,z) as float
      return sqr(x*x+y*y+z*z)
    end function
    function diagonal() as float
      return hypot3(x,y,z)
    end function
  end type
*/
 '
/*
type RECT
  intern
  type tt
    int zz
  end type
  end intern
  '
  int left
  int top
  int right
  int bottom
  '
  macro calcxy()
    'avoid confusion with rigft() and left()
    float x=this.right-this.left
    float y=bottom-top
  end macro
  '
  static int xx=42

  static function ff()
    print "ff ok"
  end function
  
  function area() as float
    calcxy
    return x*y
  end function
  '
  function diagonal() as float
    calcxy
    return hypot(x,y)
  end function
  '
  function aspect() as float
    ff()
    calcxy
    return x/y
  end function
  '
end type
'
#recordof rect
RECT r
r={1,1,3,5} '2*4
'print r.area '8
'print r.diagonal '4.47
print r.aspect
*/


/*
'17/05/2023
sub main() as int
  return 123
end sub
print main()
*/


/*
'17/05/2023
'NESTED SUBROUTINES
function main() as int
  int i=1
  subroutine sa
    int i=2
    subroutine sb
      int i=3
      subroutine sc
        int i=4
      end subroutine
      gosub sc
      print i '3
    end subroutine
    gosub sb
    print i '2
  end subroutine
  gosub sa
  print i '1
end function
main
*/


/*
'17/05/2023
'SUBROUTINE
function main(int a=1,b=2,c=3) as int
  a*=2
  b*=3
  gosub showAB
  a*=4
  b*=5
  gosub showAB

  subroutine showAB
    ...
    if a>b
      exit subroutine
    end if
    print "A=" a ",  B=" b
  end subroutine
end function
main
*/


/*
'16/05/2023
'procedure syntax
'
procedure pr() as int
  procedure=123
  exit procedure
end procedure
'
print pr()
*/



'clsi
/*
'15/05/2023
'class inside class
'but not class inside method
'
class c1
'function mm
  class c2
    function m2
      type v1
        float x=10,y=20,z=30
      end type
      v1 v={}
      print "m2 ok " v.y
    end function
  end class
  'c2 c
  'c.m2
  'end function
  function m1()
    print "m1 ok"
    c2 c
    c.m2
    'mm
  end function
end class
'#recordof c1
c1 c
c.m1
*/


/*
'15/05/2023
'class inside function
'
  function m1()
    class c2
      function m2
        print "m2 ok"
      end function
    end class
    c2 c
    c.m2
  end function
m1
*/


/*
'15/05/2023
'function inside subroutine
'
function g()
  subroutine sb
    function f()
      print "f ok"
    end function
    f
  end subroutine
  sb
end function
g
*/

/*
'15/05/2023
'subroutine inside class
class cc
  int i
  subroutine sb
    print "subroutine ok"
  end subroutine
  procedure pp
    sb
  end procedure
end class
cc c
c.pp
*/

/*

'13/05/2023
'implicit gosub
'
int i,j
subroutine displayIJ
  print "i=" i "  j=" j
end subroutine
'
'#recordof displayIJ

'goto next begin
'displayIJ:
'print "here"
'ret
'begin:

i++
j--
'gosub displayIJ
displayIJ
'
*/


/*
'12/05/2023
'inner classes
'
class c1
  int i1
  class c2
    int i2
    class c3
    end class
  end class
  method m
  '#recordof c2
   c2 c
  end method
end class
'#recordof c2
'c2 c
c1 c
print "ok"
*/


/*
'11/05/2023
'nosig polymorphism
'
type VectorXYZ
  float x,y,z
end type

type matrix4x4
  float col1[4]
  float col2[4]
  float col3[4]
  float col4[4]
end type

function f(float*v, int n) nosig
  ...
  print "f ok"
end function

float x[1000]
f(@x[31],4)

vectorXYZ v[100]
f(v[10],3)

matrix4x4 m[100]
f(m[10],16)
*/


/*
'09/05/2023
'procedures / subs
'undefbuf
class cc
  int k
  static int j
  static procedure w
    print "w ok"
  end procedure
  procedure pp(int i)
    procedure x()
    w
    print "x ok"
    end procedure
    procedure y()
    x
    print "y ok"
    end procedure
    int g
    y
    print i*10
    exit procedure
    print "not here"
  end procedure
end class
cc c
c.pp 9
#recordof cc
'pp 9
*/



/*
'09/05/2023
'misc
#show {
intern
  int i=1
end intern
inner 'scope
  int i=2
end inner
}
*/

/*
'09/05/2023
'when / until syntax
int i=1
end
do 
  i++
  'exit when i=2
#show {
  'continue if i=2
  'continue when i=2
  'continue until i=2
  'repeat if i=2
  'redo if i=2
'loop until i=2
'loop when i=2
loop
}
print i
*/


/*
'08/06/2023
'rem syntax
rem ok

rem {
ok
}
*/


/*
'
'08/05/2023
'inner function formats
'
function ff
as void
  function f()
  {
    print "ok"
  }
  function g(int i,j)=i+j
  'int f() {
  '  print "ok1"
  '}
  f
  print g(1,2)
end function
ff
*/



/*
'08/05/2023
'proto ' syntax
'
int a
'
function volbox
( float width=1,height=1, float depth=10 )
as float,link a
'
return width*height*depth
function= width*height*depth
exit function
end function
'
dim float v
v=volbox (height=2)
'print a
print v
v=volbox (1.5, 2.0, 4.0)
print v
*/


/*
'08/05/2023
'exit when ...
int i
do
  i++
  print i
  exit when i=3
loop
*/


/*
'09/05/2023
'inner subroutines, scoped
function ff
  int i=10
  subroutine s1
    print i '10
    int i=1
    subroutine s2
      int i=2
      print i + prior i '3
    end subroutine
    gosub s2
  end subroutine
  gosub s1
end function
ff
*/

/*
'07/05/2023
'testing 'subroutine'
'testing 'when'
int i=-1
gosub x
'
subroutine x
  print "i"
  exit subroutine when i<1 'not i>0
  print i
end subroutine
*/



/*
'07/05/2023
'testing 'subroutine
gosub x
print "ends"
'
subroutine x
  print "ok"
  exit subroutine
end subroutine
*/


/*
'07/05/2023
'inline low level code in expressions
' "o2" "asm"
int i=10
i+=o2(40 40)
print i
i+= asm(add eax,3 : sub eax,6)*4 
print i
*/


/*
'06/05/2023
'test class inside function
'captbody
function ff()
  function f
    print "f"
  end function
  f
  type tt
    float x,y
  end type
  class cc
    int a
    method m(int i) as int
      a=i
      return i*2
    end method
  end class
  new cc c() local
  print c.m(3) "  " c.a
  del c
end function
ff
*/

/*
'05/05/2023
'test for supprting inner functions
'defpro
function f()
  function g()
    function h()
      function i()
        print "i"
      end function
      i
    end function
    h
  end function
  g
end function
f
*/


/*
'03/05/2023
'test intern
'lookupr
'setnamespace
'#unique on
'int ac
'scope
'int ac
'int ac
'int ac
'end scope
'int ac
  class cc
    float a
    type zz
      int r,g,b
    end type
    intern
      % ac 42
      % ac 43
      % aa 44
      float aa
      int ab
      float aa
      int a
      float hp=0.5*pi()+0 'only visible to functions of the class
    end intern
    function m() as float
print ac
zz z
z.g=1
      return a*hp
    end function
  end class
#recordof cc
cc c
c.a=2
print str c.m(),5
'#recordof hp
*/

/*
'03/05/2023
' class" containing type etc. Scope test
' capturedefs()
  class s1
    float x,y,z
    function g
      print "g"
    end function
  end class

class cc
  '
  % max 16
  '
  class tt
    int u,v
    sub h
      print "h"
    end sub
  end class
  '
  def min 
{ 
8 }
  '
  int a
  has s1 s
  has tt t
  function m() as sys
    print max
    t.g
    return @t
  end function
  '
end class
'
#recordof  cc
cc c
'c.s.g
'c.t.h
'c.m
'print c.m
'#recordof tt
#recordof max
*/


/*
'03/05/2023
'local/static overlay / redim checks
'narray
int a,x,y,m
'dim int q(1,1,1,1) '68 16/20/24
redim int q(1,1,1,1) '68 16/20/24
'overlay int q(1,1,1,1) '68 16/20/24
'
'overlay int q(y) '4 68
'overlay int q(y,x) '68 68
'overlay int q(y,x,m) '140/4
'overlay int q(y,x,m,m) '144/4
int n
#recordof m
#recordof q
#recordof n

function f(int*a,y,x)
int m
'overlay int q(1,1,1)
'overlay int q(y) '68/4
'overlay int q(y,x) '136/4
'overlay int q(y,x,m) '140/4
'overlay int q(y,x,m,m) '144/4
'@q=@a
int n
'#recordof m
'#recordof q
'#recordof n
end function
*/

/*
'02/05/2023
'merge type and class
'
class cc
int r=1
int g=2
int b=3
sub f()
end sub
end class

#recordof cc

type cc
int r=1
int g=2
int b=3
sub f()
end sub
end type

#recordof cc
*/




/*
'01/05/2023
'prior

function print(string s)
'use previous definition of print
prior print("<"+s+">")
end function
'
prior print "helo"
print "helo"
*/


/*
'01/05/2023
'casting for hiword loword signed values
int i
i=loword(0xfffff1)
'print hex i
'i= cast short loword(0xfffff1)
'i= convert int loword(0xfffff1)
'short i= loword(0xfffff1)
'short i=0xfffff1
' loword(i)
'short j=i
'i=j
int i=0xfffaf1
mov eax,i
'movsx ax,al
'movsx eax,al
'movsx eax,ax
'mov i,eax
'
macro losword int(a, b)
mov eax,b
movsx eax,ax
mov a,eax
end macro
'
macro hisword int(a, b)
mov eax,b
shr eax,16
movsx eax,ax
mov a,eax
end macro
'
int i,j
i=losword(0xfbf2faf1)
j=hisword(0xfbf2faf1)
print hex(i) "  " hex(j)
*/

/*
'30/04/2023
'64bit cdecl import and export
'asm check on mode64bit
$filename  "t.exe"
uses rtl64
extern export cdecl
!* f (float a,b,c)

#show {
function g cdecl ()
float a,b,c
  f a,b,c
end function
}

end extern
*/


/*
'29/04/2023
'typecodeof
'new .. local
'new .. static
extern
========
class cc
========
int a,b
sbyte c
function constructor(int i)
  print "c " i
end function
function  destructor()
  print "d"
end function
function f()
  print "f " a
end function
function g()
  print "g " b
end function
end class
def m 6
extern
! * f()
end extern
cc c
char s
'print hex typecodeof (f)

function cf()
#show {
'new cc c(123)
new cc c(123) local
'new cc c(123) static
}
end function
*/

/*
'29/04/2023
$dll
$filename "cc_classes.dll"
uses rtl32
extern export
'
========
class cc
========
int a,b
function constructor(int i)
  print "c " i
end function
function  destructor()
  print "d"
end function
function f()
  print "f " a
end function
function g()
  print "g " b
end function
end class

function cc_table() as sys
return @ prior cc_table
end function
'
end extern
*/

/*
'new 18
extern virtual lib "cc_classes.dll"
class cc
int a,b
function constructor(int i)
function destructor()
function f()
function g()
end class
! cc_table() as sys
end extern
'
'#show {
new cc c(123)
'}
'#show c.constructor 456
c.a=1
c.b=20
c.f
c.g
del c
*/

/*
'28/04/2023
'new virtual objects
'using function table instead of class factory
'supports access to the object properties
'extern virtual lib "cc_classes.dll"
'declare cc_table() as sys
'
extern virtual
class cc
int a,b
function f()
function g()
end class

function cc_table() as sys
return 123
end function

'sys cc_table[20]
end extern
#recordof cc
'#recordof cc_table

int a
#show {
new cc c
}
int b
print c.___
'
*/

/*
'28/04/2023
'optional params / export
extern
declare function * f(int a=3,b=4)

function g(int a,b) link @f
print a "  " b
end function
'
'@f=@g 
f
'g
end extern
*/

/*
'18/04/2023
'compund ascii
'cased as an int
'
string s="abcd"
int p at strptr s
select p
case "a"
case "ab"
case "abc"
case "abcd"
  print s
case else
end select
*/

/*
'12/04/2023
'E conversions

print 1.00003e-25
*/

/*
'11/04/2023
'$ functions
function f$(int a) as int
return a*10
end function

'def f$ f
'
print f$(3)
*/



/*
'09/04/2023
'CLASS MACROS
class cc
  int i
  macro ma
    mbox "ok"
  end macro
  function f()
    ma
  end function
end class

cc c
c.f
'ma
*/


/*
double a= 485.32+
485.83+
486.03+
485.83+
486.03+
486.03+
485.83+
485.83+
486.03+
486.03+
485.83+
486.03

print a '5830.65
*/

/*
double d= 562.72+
153.90+
323.86+
120.00+
64.80+
8.82
print d '1234.10
*/

/*
'13/01/2023
'$
'function dollar$()
'end function
int dollar$() {}
'int a$
print "ok"
*/


/*
function binstring(any*p, int nb=4) as string
=============================================
indexbase 0
string s=nuls nb*8
byte bs at @p       'byte overlay input
byte bt at strptr s 'byte overlay output
int i,j,k,m
nb--
for i=nb to 0 step -1
  byte b=bs[i]
  for j=7 to 0 step -1
    m=k+j
    bt[m]=48+(b and 1) 'ascii 0 or 1
    shr b              'bit shift right
  next
  k+=8
next
return s
end function

int v=0xcc33aaaa
print binstring(v,4) 'pass numeric variable and its byte count
*/

/*
'12/01/2023
'universal stack fix: stdcall/cdecl/ms64
sys pstk 'variable to hold stack pointer
...
pstk=rsp 'save stack pointer
'call functions ...
rsp=pstk 'restore stack pointer

print "ok"
*/

/*
'11/01/2023
'binary strings
string s=nuls 256
sys p=strptr s
'map values into the string
int bi at p+4
float bf at p+8
bi=42
bf=21.5
'
'check with numbers on a string copy
string t=s
p=strptr t
@bi=p+4
@bf=p+8
print bi "  " bf
*/

/*
'29/12/2022
'testing -m co2 option
function DlgProc( sys hDlg, uint uMsg, sys wParam, lParam ) as Typo CALLBACK
end fuction
*/


/*
'28/12/2022
% WM_SIZE 4
int a=6
select a
  case WM_SIZE+1 : ' a, b
    print 5
  case WM_SIZE+2 : REM a, b
    print 6
  case WM_SIZE+3 : // a, b
    print 7
end select
*/

/*
'08/12/2022
'PASSING WHOLE REDIMMED ARRAYS
'
uses console
redim double a(5,10,20,4)
'
sub ff(double *d[])
===================
print "Test attributes of a passed dynamic array" cr cr
int i
print "dims: " tab dims(d) cr
print cr
print "n" tab "lbound" tab "ubound" tab "scaler" tab "strider" cr
for i=1 to dims(d)
  print i tab lbound(d,1) tab ubound(d,i) tab scaler(d,i) tab strider(d,i) cr
next
end sub
'
'#show ff a
ff a
wait
del a
*/


/*
'09/12/2022
'REINDEX TESTS
uses console
'indexbase 0
'int d={9,8,7,6,5,4,3,2,1,0}
'int d={8,9,6,7,4,5,2,3,0,1}
redim int d(100)
d={8,9,6,7,4,5,2,3,0,1}
redim int d(10)
int m=10
'
macro filter(r,i)
=================
if d[i]>=5
  r=1
endif
end macro
'
macro compare(r,i,j)
====================
'if d[i]>d[j] 'ascending
if d[i]<d[j] 'descending
  r=1
endif
end macro
'
reindex idx,m,n,filter,compare
'
'  idx     index to be created
'  m       count of data elements
'  n       count of resulting index
'  filter  filter macro
'  compare comparison macro
'
'PARTIAL USE OF REINDEX
'reindex idx,m,n,filter
'reindex idx,m,n,,compare
'reindex idx,m,n
'reindex idx,m : int n=m
'
'RESULTS
'=======
print "total " n cr cr
print "#"  tab "INDEX" tab "DATA" cr
int i,j
for i=indexbase to n+indexbase-1
  j=idx[i]
  print i tab j tab d[j] cr
next
print cr cr
del idx
wait
*/


/*
'15/10/2022
'test init and free
uses corewin
class cc
  method m1() as RECT
    rect s
    method={100,200,10,20}
  end method
  method m2(rect*r)
    print r.right
  end method
end class

macro cc_"init"(a,n)
  print "init " n
end macro

macro cc_"free"(a,n)
  print "free " n
end macro

cc c
*/


/*
'17:16 15/10/2022
'objects passed and returned byval
'regparam parambl regspill
'newtmpvar
uses corewin
'uses console
'extern
class cc
  method m1() as RECT
    rect s
    method={100,200,10,20}
  end method
  method m2(rect r)
    print r.right
  end method
end class

'cc c
'RECT R=c.m1()
'print r.bottom
'#show c.m2(r)
'#show c.m2(c.m1())
'dprm aprm
rect r={1,2,3,4}
'#show {
  function m3(rect r,r) as int
    return r.right
  end function
'}
'#show {
  print m3 r,r
'}

*/


/*
'11/10/2022
'array traversal
'test strider
uses console
redim int x(1,3,4)
x={1,2,3,4,5,6,7,8,9,10,11,12}
int i
int k
int*j
@j=@x 'element pointer j
for i=1 to dims(x)
  print "scaler and strider "+str(i)+tab+scaler(x,i)+tab+strider(x,i)+cr
next
printl
k=strider(x,2)
printl "test strider 2: " k
printl
for i=1 to ubound(x,2)
   print "val " i ":" tab j cr
   @j+=k 'stride
next
wait
*/

/*
'23:10 06/10/2022
'check consts
'%= x str(2+6.5)+"ok"+4
'#recordof x
const as float w=99+2.5, x=67, y=68
'#recordof w
print x
*/


/*
'01/10/2022
uses console
printl "redimensioning objects"
printl
indexbase 1
int c
class obc
  int id
  method constructor()
    c++
    id=c
    printl "ob constructor " c
  end method
  method destructor
    printl "ob destructor "  id  
  end method
end class
'
printl "minimal array"
redim obc ob(1,1,1)
printl
printl "increase array"
redim obc ob(2,2,2)
printl
printl "reduce array"
c=0
redim obc ob(1,2,2)
wait
*/


/*
'30/09/2022
'test cr crlf

  sub removelf(string*s)
  ======================
  indexbase 1
  if not s
    exit sub
  endif
  int le=len s
  string t=s
  int i=0
  int j=0
  byte a
  byte bs at strptr(s)
  byte bt at strptr(t)
  do
    i++
    if i>le
      exit do
    endif
    a=bs[i]
    if a=10
      continue do 'omit    endif
    endif
    j++
    bt[j]=a
  loop
  s=left(t,j)
  end sub


  sub insertlf(string*s)
  ======================
  indexbase 1
  if not s
    exit sub
  endif
  int le=len s
  string t=s+s
  int i=0
  int j=0
  byte a
  byte bs at strptr(s)
  byte bt at strptr(t)
  do
    i++
    if i>le
      exit do
    endif
    a=bs[i]
    if a=13
      j++
      bt[j]=a
      a=10
    endif
    j++
    bt[j]=a
  loop
  s=left(t,j)
  end sub

uses console

string s= "12345" cr "67890" cr
printl s
printl len s
printl
removelf s
printl s
printl len s
printl
insertlf s
printl s
printl len s
wait
*/


/*
'28/09/2022
'check redim 18
indexbase 0
bstring t[100]
redim int s(1000)
int*p
'
'print p[-1]
'bstring b
'?b=@s
'print len b
'#show p=@s
'#show p=@s(10)
'#show p=strptr s(10)
s(10)={"1","2"}
'#show t(10)="10"
'#show s[10]="10"
'print s[10]
t=s[10]+s[11]
print "ok " t
*/


/*
'13:11 27/09/2022
'indirect inheritance
'
extern virtual

class vb
method k()
method m()
end class


extern

class bb
  int a,b
  method k()
    print "bb k"
  end method
  method m()
    print "bb m"
  end method
end class


'#recordof bb_table
'
class cc
  int a
  bb*b
  method m
    if @b=0
      @b=getmemory sizeof bb
      ?b=@bb_table 'extern only
    endif
    b.m()
  end method
end class

'#recordof vb

dim vb v
?v=@bb_table
#show v.m
'
'dim cc c
'c.m
*/


/*
'26/09/2022
'float anomaly / dtf?
'in juliaRings.o2bas / julia
'int a
'#show a=(a+a)*.33
function f()
indexbase 0
int tmp,red,grn,blu
#show tmp = (red+grn+blu) * 0.33
end function
*/

/*
'24/09/2022
'INTENTIONAL TYPES
typedef int iter,logi,bound,idxr
'creating unique symbols
'safe iteration
**/

/*
'24/09/2022
'multidim read/write check
uses console
indexbase 1
#minormajor 'default is majorminor
'dim int yx(4,5) 'static
int ym=4,xm=5
'redim int yx(ym,xm) 'dynamic
redim int yx[ym,xm] 'dynamic
dim int y,x,i
for y=1 to 4
  for x=1 to 5
    i++
    yx(y,x)=i
    print yx(y,x) tab
  next
  printl
next
printl
if #minormajor
  printl "column major order"
else
  printl "row major order"
endif
'test storage order for
'minrmajor and major minor
dim int nn at @yx
printl nn(1) tab nn(2) tab nn(3) tab nn[4]
wait
*/

/*
'21/09/2022
'check printl
uses console
printl
wait
*/

/*
'17/09/2022
'multidim check
uses console
'#minormajor
'dim int d(1,2,3,4,5)
'redim int d(1,2,3,4,5)
redim int d(5,4,3,2,1)
redim int d(10,10,10,10,10)
d(1,2,1,4,5)=123
print d(1,2,1,4,5) cr
'redim int d(1,2,3,4,5)
'redim int d(60,2)
int i
for i=1 to dims(d)
  print ubound(d,i) tab scaler(d,i) cr
next
print cr

int *dd=@d
'for i=1 to ubound(d)
'print i tab dd(i) cr 
'pos 80 == 0*120+1*60+0*20+3*5+1*4+indexbase
'next
wait
*/

/*
'16/10/2022
'elements, dims
'ubound, lbound
'arwd
int cc,ee
'#show "t.txt"{
dim int d(1,2,3,4,5)
'cc=elements(d)
'ee= dims(d)
'void_ hah,hah
'indexbase 0
cc=lbound(d)
ee=ubound(d)
'}
'
'#recordof swap
'#recordof scaler
'print cc "   " ee
int i=1
'print dims(d)
'print elements(d)
'
for i=1 to dims(d)
  print " " scaler(d,i)
  'print " " lbound(d,i)
  'print " " ubound(d,i)
next
print ubound(d) " ok"
*/

/*
'14/02/2022
'
'defining block macros

$ mac (
$ mac_end )
$ mac_exit exit
$ mac_redo repeat

int i
mac
  i++
  print i 'twice
  if i>1
    exit mac
  endif
  print i*100 'once
  redo mac
end mac
'1 100 2
*/

/*
'14/02/2022
'sub / function polymorphism
'using an underscore _
'
sub ff_()
  print "called sub"
end sub
function ff() as int
  print "called function"
  return 1
end sub
'
int i=ff() 'called function
ff() 'called sub
*/

/*
'14/09/2022
'indirect jump
sys j1=@ends
goto j1
msg:
print "msg ok"
ends:
print "ends ok"
*/

/*
'14/09/2022
'prev and next
'
int i=10
reps:
i--
goto reps when i>0
'goto prev reps when i>0
'goto next reps when i>0

reps:
print i
*/


/*
'14:32 13/09/2022
'flexi redim overlay
indexbase 1
dim int p(640*480)
int rgba=4
overlay byte c (480,640,rgba)
'#recordof array_map
@c=@p
c(201,601,2)=0xac
'p[200*640+600+1]=0x12345678
byte b=c(201,601,2)
'byte b=c(200*2560+600*4+2)
print hex b
'
'
'sys *d : @d=@@c
'd[0]=640*4 '2560
'd[-1]=4
'd[-2]=1
'print d[1] ">>> " d[0] "  " d[-1]  "  " d[-2] "  " d[-3]

*/

/*
'18:30 12/09/2022
'inner arrays
dim int a(100)
dim int b(100)
dim int c(10,50)
indexbase 0
int d,i
#show {
d=a[ b[ c[i+5,10] ] ]
}
print "ok"
*/


/*
'20:24 12/09/2022
'end for / endfor
int i
for i=1 to 100
endfor
print "ok"
*/


/*
'00:37 08/09/2022
'multidimensional redim
'redim int x (4,5)
'% a=1
'% b=2
'% c=3
int a=1,b=2,c=3
'#minormajor
indexbase 0
redim int x(a,b,c)
int xx
#show {
x(a,b,c)=123
}
'#show {
xx=x(a,b,c)
'}
sys p at @x  'testing dim
sys p at @@x 'testing redim
string cr=chr(13,10)
print p[-1] cr p[-2] cr p[-3]
print "ok "  xx
*/


/*
'12:48 07/09/2022
int a
a=#replace (1,2,3)
,    'find comma
)*(  'replace with these
print a '24
*/

/*
'22:28 06/09/2022
'arrays inside arrays
indexbase 0
int i=1,j=1
int a[1000]
'
#show a[a[j]+110]=a
*/

/*
'17:48 06/09/2022
'multidimensional arrays
indexbase 0
int i,j
dim int a[99,9]
'#recordof a
'#show a=a[i+99,j]
'#show a=a[3,4]
'
'#show a=a[4]
'#show a=a[i]
'#show a=a[i+4]
*/

/*
'05/09/2022
'custom operators for udt
'idop:
type hint int v
operator maxv 1000 6
operator !<a>! 1000 6
'
macro hint_"move"(a,b)
  a.v=b.v
end macro
macro hint_"+"(acc,a,b)
  acc.v=a.v+b.v
end macro
int x,y
macro hint_"maxv" (acc, a, b)
  if b.v>a.v
    acc.v=b.v
  else
    acc.v=a.v
  endif
end macro

macro hint_"!<a>!" (acc, a, b)
  if b.v>a.v
    acc.v=b.v
  else
    acc.v=a.v
  endif
end macro

hint aa,bb,cc
'#recordof hint_"maxv"
'#show cc=aa maxv bb maxv cc
#show cc=aa !<a>! bb maxv cc
'#show x=y maxv y
*/


/*
'03:28 05/09/2022
'iup debug
*/


/*
'13:54 04/09/2022
'32bit vs 64bit
$filename "t.exe"
uses rtl64
mov rcx,0xffffffffffffffff '-1
'and ecx,0xff 'changes rcx to 0xff
'and cx,0xff  'no effect on rcx
'and cl,0xff  'no effect on rcx
sys c
mov c,rcx
print hex c
*/

/*
'00:25 04/09/2022
'array dims using udt
'with mixed elements
type sy
  char c[16]
  int x[100]
end type
'
sy y[1000]
string t
int a
int i=10
int j=20
y[i].c="Hello"
y[i].x[j]=123
a=y[i].x[j]
'
'Hello  123
print y[i].c "  " y[i].x[j]
print y[10].c "  " y[10].x[20]
*/

/*
'00:25 04/09/2022
'array dims using udt
type yy int x[100]
yy y[1000]
int a
int i=10
int j=20
y[i].x[j]=123
a=y[i].x[j]
print a
print y[10].x[20]
*/




/*
'10:06 03/09/2022
'class calls
'
'#show{
class cc
  int v
  method m1(int a)
    print "ok1"
  end method
  method m2(int a)
    print "ok2 this: " @this
  end method
end class
'}
'#recordof cc_table
cc c
#show {
cc.m2(12)
}
*/


/*
'15:46 31/08/2022
'macro blocks
$ bb (     'def bb scope
$ bb_end ) 'def bb end scope
int a=1
bb
  int a=2
end bb
print a
*/


/*
'30/08/2022
'precalc equates / not with deff
%  mol pi
%= hmol mol*0.5
#recordof mol
*/

/*
'30/08/2022
'with macro prefixes
'Accessing parent vars
'
$ client ...
int x=0
print client.x '0
namespace aa
  int x=2
  print client.x '0
  namespace bb
    int x=4
    print client.x '2
    namespace cc
      int x=6
      print client.x '4
    end namespace
    print ..cc..x '6
  end namespace
end namespace
*/

/*
'30/08/2022
'with macro prefixes
'
==============
module console
==============
  namespace cn
  uses console
  end namespace
  '
  $ cns ..cn..
  '
end module
'
cns.output 12345 cns.tab "okay" cns.cr
cns.getkey
*/


/*
'29/08/2022
'
==============
module console
==============
  namespace cn
  uses console
  end namespace
  '
  interface
  ---------
  'relative namespaces with prefixed ..
  $ cprint  ..cn..output 
  $ cwait   ..cn..getkey
  $ tab     ..cn..tab
  $ cr      ..cn..cr
end module
'
cprint 12345 tab "okay" cr
cwait
*/


/*
'28/08/2022
int a=7
module console
  namespace cn
    uses console
    'mbox "q" 'q
    '..mbox "q" 'q
    '...mbox "q" 'messagebox q
    'print ...a '7
    'print ..a 'error
  end namespace
  '
  interface:
  $ cprint  ..cn..output 
  $ cwait   ..cn..getkey
  $ tab     ..cn..tab
  $ cr      ..cn..cr
end module
cprint "ok" cr 'ok'
'..mbox "q" 'q
'...mbox "q" 'q
cwait
*/

/*
'28/08/2022
'namespaces with dotted notation
int a=0
namespace xx
  int a=24
  namespace yy
    int a=25
    'print xx..a  '24 
    'print ...a   '24
  end namespace
  'print ..yy..a  '25
  'print a        '24
  'print ..a      '24
  'print ...a     '0
end namespace
'root:
'print a          '0
'print ..a        '0
'print ...a       '0
'print xx..a      '24
'print xx..yy..a  '25
*/

/*
'27/08/2022
'namespaces with dotted notation
a..b..c.x
..b..c.x
...d 'd in parental namespace

'notation for symbol coupling

module cn
  namespace cn
    uses console
    ...print <=> output
  end namespace
  '
  interface
  cn..output<=>print
  print <=> cn..output
  '
end module
*/

/*
'26/08/2022
'nested relative namespaces
namespace motherX
  namespace childA
    'init
    int a=100
    '
    sub destructor()
      print "destr A"
    end sub
    '
  end namespace
  '
  namespace childB
    'init
    int a=200
    '
    sub destructor()
      a=0
      print "destr B"
    end sub
    '
  end namespace
  '
  'init
  int a=1000
  '#recordof motherx::childB::a
  '#recordof ::childB::a
  '#recordof motherx::childB::destructor
  '#recordof ::childB::destructor
  int d
  d= 0 + ::childb::a
  '#show motherx::childB::destructor()
  '#show ::childB::destructor()
  print d
  '
  ...
  '
  sub destructor()
    a=0
    '::childA::destructor
    '::childA::destructor
    'namespace childA
    'destructor()
    'end namespace
    'namespace childB
    'destructor()
    'end namespace
    print "destr m"
  end sub
  'destructor()
end namespace

'print motherX::childb::a

'#show motherX::destructor()
'#show motherX::childA::destructor()
'#show motherX::childB::destructor()

'#recordof motherX::
'#recordof motherX::childA::
'#recordof motherX::childB::
*/


/*
'modules and namespaces
module console
  namespace cn
  uses console
  end namespace
end module

'reopen the console namespace
'no need for namespace prefixes
namespace cn
print "ok1"
end namespace

'use namesoace prefixes
cn::print "ok2"
cn::getkey
*/


/*
'24/08/2022
'nestable namespaces
dim int x=1
namespace a
  namespace b
    namespace c
      dim int x=56
    end namespace
  end namespace
end namespace
'
namespace a::b::c
  print x '56
end namespace
'
print a::b::c::x '56
print x '1
*/

/*
'23/08/2022
'modules and namespaces
namespace cn
uses console
end namespace

namespace cn
print "ok"
namespace
'print "ok"

cn::print "ook" 'lookup override issue
'cn::printl "ok"
'cn::output "ok" cn::cr
'cn::wait 'macro issue
cn::getkey
*/

/*
'18/08/2022
'share model with cpih
uses console
int i,j
float bal=125000
float pcown
float share=1250
float cost=0
float abal
float aval
float cpihb=121.2 'july 2022
float cpih=cpihb
int year=2022
'25 years x 4 quarters
  print tab "CPIH" +
    tab "Each" tab "AccCost" +
    tab "Value" tab "%Owned" cr
for i=1 to 100
  pcown+=1
  cost+=share
  bal-=1250
  abal=bal*(cpih/cpihb) 'with indexation
  aval=125000*(cpih/cpihb) 'with indexation
  share=1250*(cpih/cpihb) 'with indexation
  j++
  j and=3
  if j=1
    print str(year) cr
    year ++
  endif
  print tab str(cpih,2) +
    tab str(share,0) tab str(cost,0) +
    tab str(aval,0) tab str(pcown) "%" cr
  cpih+=1.21 'linear 1% increase
next
pause
*/


/*
'12/08/2022
'MODULES
'
module
  sys p1,p2,p3,p4
  inner
    ============
    uses console
    ============
    p1=@input
    p2=@output
    p3=@cls
    p4=@getkey
  end inner
  ! input() as string at p1
  ! output(string s)  at p2
  ! cls  ()           at p3
  ! pause() as int    at p4 
end module

========
module X
========

 interface
 '
 !* fi(int a) as int
 '
 inner
  '
  function ff(int a) as int
    print "ok " a
  end function
  '
  'links
  @fi=@ff
  '
 end inner
 '
end module
'
fi(3)
pause
*/



/*
typedef void vv
vv*v
'#recordof vv
#recordof v
*/

/*
'21:28 06/08/2022
'indexing code
type CadPoint
  string lbl
  string typ
  float x,y,z
end type
CadPoint p[100]
int i=1
p[i].x=0 'offset 8180
p[i].y=0 '       8184
p[i].z=0 '       8188

'>>>>

''_16
'fldz
'mov esi,[ebx+10192]
'imul esi,esi,20
'fstp dword [ebx+esi*1+8180]
''_17
'fldz
'mov esi,[ebx+10192]
'imul esi,esi,20
'fstp dword [ebx+esi*1+8184]
''_18
'fldz
'mov esi,[ebx+10192]
'imul esi,esi,20
'fstp dword [ebx+esi*1+8188]
*/



/*
'13:09 04/08/2022
'test forward call
!ok() as string
print ok()


function ok() as string
return "okay"
end function
*/


/*
'29/07/2022
'defm tests
defm mm
$2
print "$1: " + "$2 -- " + $1
end defm
'
mm version ok
*/

/*
'29/07/2022
'error trapping
string s=" "
int i
int a
  a=instr(i,/???sis,"k")
*/

/*
'20:03 26/07/2022
'restructure defs
'print "ok"

typedef struct xx {
int a,b,c
} yy,*zz,**uu
uu*u

typedef void vv,*pvv
pvv pv
typedef struct qqq qq

typedef void*ptr (nerk *jot)
(
int type, int bb)

#case capital
long x1
typedef long long,lon,LONG
LONG x2

'#recordof long
'#recordof x1
'#recordof x2
'#recordof jot
'#recordof type

'#recordof qqq
'#recordof qq
'#recordof pvv
'#recordof pv
'#recordof xx
'#recordof zz
'#recordof uu
'#recordof u

class cc
int a,b,c
method m1() as float {}
method m2() as float {}
end class
'#recordof cc

def dd
print "hello"
int a
end def
#recordof dd
*/

/*
'23/07/2022
'NEW VOID
'void a
'#recordof void
'#recordof a
'
typedef void aa,bb,cc,*dd
'#recordof cc
'#recordof dd
'cc c
'dd c
'#recordof c
void ff(void){print 123}
*/

/*
'23/07/2022
'VOID
typedef void z1,*z2
'#recordof z1
'z1 a
z1 *a
#recordof a
'#recordof z2
'typedef struct void (*fn)(void*k);
'#recordof fn
*/


/*
'22/07/2022
'array member and sizeof
'64k overflow on length field
  type WaveOut
  =============

  sys       err
  sys       hwavo
  sys       buf
  sys       bufmask
  'WAVEHDR   whdr
  'MMTIME    mmPosData
  short das[0x10000]
'  sys xx[0x10]
'  sys yy
end type
#recordof waveout
print sizeof waveout
*/


/*
'22/07/2022
typedef struct Ihandle_ Ihandle;
typedef int (*Icallback)(Ihandle*);
int       IupOpen          (int *argc, char ***argv);

void iupopen(void);
print "ok"
*/


/*
'20/07/2022
typedef struct Ihandle_ Ihandle;
typedef int (*Icallback)(Ihandle*);

'#recordof ihandle
#recordof Icallback
'print version
*/

/*
'21/07/2022
'self reference
typedef struct st {
st* ss
}
#recordof st
*/

