=========
'TESTLOG2
=========


/*
'13:56 19/07/2022
'
% noconsole
uses console
print 0 "a" 1 "b" 2 "c" 3 cr
pause
*/

/*
'15:26 16/07/2022
'low level macro
'1 read param spec
'2 capture params into array
'3 make substitutions
 '
*/


/*
'03:31 14/07/2022
'macine script extensions
'o2 macros
%mov
 8b 205 %1..%9
%
-mov f4
*/



/*
'21:49 13/07/2022
'opcode sets in octal
'mov
o2 210 105 00
o2 211 105 fc
o2 212 105 f4
o2 213 105 f0
o2 260 01
o2 270 hl40302010
o2 240 hl00002000
o2 306 105 ec 10
o2 307 105 e0 hl40302010
'lea
o2 215 175 f4
'add
o2 004 19
o2 005 hl40302010
o2 200  105 f4 10
'sub
o2 284 10
o2 285 hl2000
o2 283 105 f4 
'imul
o2 366 155 e0
o2 017 257 105 dc
'idiv
o2 366 175 e0
*/



/*
'18:26 11/07/2022
'immed to variable
int a
'o2 c6 83 00 20 00 00 42
'o2 c6 83 nl8192 42
o2 c6 203 hl2000 nb42
'o2 b0 45 88 83 00 20 00 00
print hex a
*/

/*
'12:28 11/07/2022
'test +val
'print valat strptr("+32")
'
'test neg long
o2 b8 nl-123
int a
mov a,eax
print a
*/


/*
'14:34 10/07/2022
'
'lea edi,[ebx+...]
'o2 8d 2,7,3 00 00 00 00
'      1010 1011 ab
'mov edi,[edi]
'o2 8b 1;7;7 00
'      01111111=7f 00
*/


/*
'23:46 09/07/2022
'machine code check /octer
int a=42
mov eax,999
'mod reg r/m
o2 8b 83 00 20 00 00
inc eax
mov a,eax
print a  '43
*/


/*
'08/07/2022
'segment register overrides
'
$filename "t.exe"
uses rtl64
'o2 64, 8B, 04, 25, 18, 00, 00, 00
'end
int i
'mov fs:[0x18],eax
mov ecx, fs:[0x18]
mov i,ecx
 print i " ok"
*/

/*
'05/07/2022
'MAKEINTRESOURCE for resource management
uses corewin
def  MAKEINTRESOURCE "#%1"
wstring s=MAKEINTRESOURCE(31)
'print s
messageboxw 0, s, L"title",0
*/

/*
'05/07/2022
'test subarrays
type ap
  byte i
  byte j
end type
'
type aa
  word k
  ap m[0]
end type
'#recordof aa
'
indexbase 0
string s="abcdefghijklmnop"
aa a at strptr s
int i=2
int j=1
int v
v=a[j].m[i].i
print hex v '63
v=a[j].m[i].j
print hex v '64
*/

  
/*
'04/07/2022
'size check
type aa
int a
int b
int c[1]
end type
#recordof aa
print sizeof aa
*/

/*
'04/07/2022
'check word type in mid
string s="qwerty"
int le=0x10006
word*q
@q=@le
print q
string t
#show t=mid(s,1,q)
*/

/*
'03/07/2022'
'short lengths
int a,b
a=0x10003
'xor ecx,ecx
'mov ecx,0x10000
mov cx,a
mov b,cx
print b
*/

/*
'02/07/2022
'new order
function f(int a,b,c) as float
end function
float g[100]
#recordof g
print typeof g
*/


/*
'01/07/2022
'struc array access
type records
  '16 members
  int a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p
end type
'
int d[16000]
records r at @d
int i,j
'#show i=r[j].f
#show i=r[j].g
'#show i=r[j].a
'4 access instructions
macro mrcio int*(r,x,y)
  #noprec @r=x<<4+y+4<<2+@d
end macro
'10 access instructions
#show i=mrcio(j,6)
*/


/*
'30/06/2022
'o2 storage test
type qq float a,b,c
'#recordof qq
#recordof instr
*/

/*
'STRUCTUREOF
'ENCODINGOF
'RECORDOF
type vt long v,double d
dim as vt v
string rv=recordof v

string rt=recordof vt
'
string s=encodingof vt
'same
string t=structureof vt
print "
" rv"
" rt"
" s "
" t
*/

/*
'23/06/2022
'module concept
'
=========
'MODULE X
=========

int a,b,c

function f(int a) as int
end function

undef a,b,f 'hide symbols

'=============
'END MODULE 'X
==============

print f

*/

/*
'23/06/2022
'undef
function f(int a) as int
end function
undef f
f:
'#recordof f
undef f
'#recordof f
'print f
end
#show goto f
*/


/*
'21/06/2022
'consts
'supporting compound types
const int a=42,b=999, c=56
'#recordof a
'#recordof c
'print typeof a
'print a
'a=43
'a *=4
'a++
'a={4}
 : ++c
' : c++
print c
'print "ok"
*/


/*
'21/06/2022
'consts re: type conversion: cnst
'could use encodeequate
const int a=10*2.55
%= a = 10*2.55
'#recordof a
'print typeof 25'.5
print typeof L"25'.5"
'need derived typeof
*/


/*
'20/06/2022
function f() as char*
return "abcd"
end function

#show string s=f
print s
*/

/*
'12:03 18/06/2022
'findex trial
print "hello"
*/

/*
'17:58 17/06/2022
macro m(a)
  print "ok " a
end macro
'
m(99)
print 123
*/


/*
'13:19 17/06/2022
'
int A
  #if typecodeof A > 0
    #print "A type: " + typeof(A) ' int
  #endif
*/

/*
'10:39 16/06/2022
'const assignment trap needed
% m = 10
'int=32
'dim=32
'++m
'm++
#show m+=1
'm-=1
'm=m+1
'm=62
'#show {
 '"q"="w"
 '4+4=4
 '4=4
 ''4*=4
 '4-+=4
 '4 and=4
 '4+=4
'}
print m
*/

/*
'10:32 16/06/2022
'stringutil dependency
'ReadSpecificLine.o2bas
uses parseutil
new Textarray t
t.load "t.txt"
print t.line 7
print t.lineCount
del t
*/

/*
'07:31 04/06/2022
'unprototyped float / double literals
#fpnprecision single 'double
extern
! ff
end
float f
#show ff 2,1.0
*/


/*
'20:19 30/05/2022
SetWindowTheme(
    _In_ HWND hwnd,
    _In_opt_ LPCWSTR pszSubAppName,
    _In_opt_ LPCWSTR pszSubIdList
    );
'returns hTheme
OpenThemeData(
    _In_opt_ HWND hwnd,
    _In_ LPCWSTR pszClassList
    )
CloseThemeData(
    _In_ HTHEME hTheme
    );
DrawThemeBackground(
    _In_ HTHEME hTheme,
    _In_ HDC hdc,
    _In_ int iPartId,
    _In_ int iStateId,
    _In_ LPCRECT pRect,
    _In_opt_ LPCRECT pClipRect
    );
DrawThemeText(
    _In_ HTHEME hTheme,
    _In_ HDC hdc,
    _In_ int iPartId,
    _In_ int iStateId,
    _In_reads_(cchText) LPCWSTR pszText,
    _In_ int cchText,
    _In_ DWORD dwTextFlags,
    _In_ DWORD dwTextFlags2,
    _In_ LPCRECT pRect
    );

*/
/*
extern lib "UxTheme.dll"
! SetWindowTheme
! OpenThemeData
! CloseThemeData
! DrawThemeBackground
! DrawThemeText

end extern

sys  hwndList
...
SetWindowTheme(hwndList, L"Explorer", NULL)
*/



/*
'22:17 23/05/2022
'Pass byval
type vector float x,y,z
class cc
vector v
method m(vector w) as vector
'print w.y
returnvar={10,20,30}
end method
end class
'
vector v={1,2,3}
cc c
vector x=c.m v
print x.y
*/



/*
'10:44 23/05/2022
'call with indirectfloats
uses glo2/materials
'#recordof redshiny
float*ma
@ma=@redshiny
function material(float*ma)
end function
function matd(float ma)
end function
'material ma
class cc
float*ma
method m() as float
  '@ma=@redshiny
print "@ma " @ma
  '#show material ma
print "ok1"
  return ma
end method
end class
cc c
float f
'#show f=c.ma
#show material redshiny
print "ok"
*/
 

/*
'18:48 16/05/2022
'constrained array address
'addr rax,x[i]
mov rax,i
dec rax 'indexbase
imul rax,sizeof x 'not a lit number
'shl rax,2 'float or int
push rax
lea rax,x
add rax,[esp]
add rsp,4
*/

/*
'23:07 15/05/2022
addr use of esi register

type rgb byte r,g,b
rgb a[100]

int i=1
#show {
addr eax,a[i]
}
*/

/*
'15:26 14/05/2022
'branchless inrange
'
macro inrangeb int(r,m1,m2,a)
============================
'check m1 & m2
sub rsp,8         'reserve stack
mov eax,m1
mov ecx,m2
mov [rsp+4],eax
mov [rsp  ],ecx
fld dword [rsp+4] 'm1
fld dword [rsp  ] 'm2
fcomi            'm2-m1
'                 'swap m1 and m2 if m2<m1
cmovb [rsp  ],eax
fcomip
cmovb [rsp+4],ecx
fstp st0          'dump m1
'
mov eax,-1        'inrange true
mov ecx,0         'to falsify
fld dword a
fld dword [rsp+4] 'm1 as min
fcomip            'm1-a
cmova eax,ecx     'm1>a
fld dword [rsp]   'm2 as max
fcomip            'm2-a
cmovb eax,ecx     'm2<a
mov r,eax
fstp st0          'dump a
add rsp,8         'release stack
'
end macro
'
macro inrange int(r,m1,m2,a,  k)
================================
'check m1 & m2
fld dword a
fld dword m1
fld dword m2  'onstack m2 m1 a
fcomi         'm2-m1
jae fwd k     'swap if (jb) m2<m1
fxch st1      'm1 m2 a
k:
mov eax,-1    'true
mov ecx,0     'to falsify
              'max min a
fxch st2      'a min max
fxch st1      'min a max
fcomip        'min-a
cmova eax,ecx 'falsify if min>a
fxch st1      'max a
fcomip        'max-a
cmovb eax,ecx 'falsify if max<a
fstp st0      'dump a
mov r,eax
end macro
'
float a=1.0,b=2.0,c=1.5
print inrange(a,b,c)
print inrange(b,a,c)
float a=1.0,b=2.0,c=2.5
'print inrange(a,b,c)
print inrange(b,a,c)
float a=1.0,b=2.0,c=0.5
print inrange(a,b,c)
print inrange(b,a,c)
*/

/*
fld dword a
fld dword b
fcomip 'b-a
fstp st0
mov eax,1
mov ecx,999
cmovb eax,ecx 'b<a
int i
mov i,eax
print i
*/



/*
'23:01 13/05/2022
'macro typing
type point float x,y

point b
print cos(b.x)
*/

/*
'16:50 13/05/2022
'branchless coding
byte c
'
macro lcasebyte(b)
==================
mov al,b
mov cl,0x20
mov dl,0
cmp al,0x40
cmovle cl,dl
cmp al,0x5a
cmovg cl,dl
add al,cl
mov b,al
end macro

macro ucasebyte(b)
==================
mov al,b
mov cl,0x20
mov dl,0
cmp al,0x60
cmovle cl,dl
cmp al,0x7a
cmovg cl,dl
sub al,cl
mov b,al
end macro
'
macro limitint int(r,a,min,max)
===============================
mov eax,a
mov ecx,min
mov edx,max
cmp eax,min
cmovl eax,ecx
cmp eax,max
cmovg eax,edx
mov r,eax
end macro
'
macro limitfloat float(r,a,min,max)
===================================
fld dword a
mov ecx,min
fld dword min
mov edx,max
mov eax,a
fcomip
cmova eax,ecx
fld dword max
fcomip
cmovb eax,edx
mov r,eax
fstp st0
end macro
'
macro inrangefloat int(r,a,m1,m2)
===================================
sub rsp,8
mov [rsp+4],m1
mov [rsp  ],m2
fld dword m1
fld dword m2
fcomip 'm2-m1
fstp st0
'swap if m2<m1
cmovb [rsp+4],m2
cmovb [rsp],m1
fld dword a
fld dword [rsp+4] 'm1
mov eax,-1        'true
mov ecx,0         'false
fcomip            'm1-a
cmova eax,ecx     'm1>a
fld dword [rsp]
fcomip            'm2-a
cmovb eax,ecx     'm2<a
mov r,eax
fstp st0
end macro
'
macro insiderangefloat int(r,a,min,max)
=======================================
fld dword a
mov eax,-1
fld dword min
mov ecx,0
fcomip
cmovae eax,ecx
fld dword max
fcomip
cmovbe eax,ecx
mov r,eax
fstp st0
end macro
'
'c=48
'c=64
c=65
'c=90
'lcasebyte c
'print c
float a,b,c
a=3.450
b=2.5
c=3.5
'print limitfloat a,b,c
'print inrangefloat a,b,c
print insiderangefloat a,b,c
*/


/*
'07:05 13/05/2022
'cmov instructions
'branchless
int a=1,b=2,c
'#show {
a-b
mov ecx,99
mov edx,100
cmovl eax,ecx
cmovge eax,edx
c=eax
'}
'print c
float a=1,b=2, c
#show {
a-b
fcomi
}
*/


/*
'18:42 03/05/2022
'atan 360

float a
'y,x
a= deg atan 0,-1
if a<0
  a+=360
endif
print a
*/

/*
'10:22 02/05/2022
'bytes of a string
'pointer with byte type ...
string s1="Aurel", s2= "_microA"
string s3=s1+s2

byte b[] at strptr s3 'array of ascii bytes
print b[3]
bstring bs
strptr(bs)=@b
print bs
*/


/*

'12:52 30/04/2022
'precision test for float
float a=1.00001
print a
*/

/*
'13:10 26/04/2022
'read lisp notation

% show  print "%1"


%  read  readi %1
%  opi   %opq %1
%* ops   opq %1 

def readi
  opi %1
  int x= %2 ops %3 %4 %5 %6 %7 %8 %9
end def

#show expand read ( * 1 2 3 4)
print "result  " x
*/


/*
'04:34 26/04/2022
'scope tests
{
 int a
}
'[
'  int b
']
'print b
(
 int c
)
print c
*/


/*
'11:51 25/04/2022
'passing items in brackets
% show print "%1"
macro m(a)
show (a)
'int d=a
end macro

int d[100]
m {1,2,3}
m ((1,2,3))
'print d[2]
*/



/*
'08:45 25/04/2022
'macro local labels 
'macro recursion breaking

macro M(ct,pa,pb,pc,pd,   lb1,lb2,lb3)
======================================

'RECURSION
%= counter = ct-1 '%=' EARLY CALCULATION OF EQUATE
#print counter
'
#if counter>0
  m(counter,100,200)
#endif

'CHECKING PRESENCE OF PARAMETERS
#ifndef pc
  goto lb3
#endif
'
#ifndef pd
  ...
#endif

'LOCAL LABELS
lb1:
  ...
lb2:
  ...
lb3:

end macro

M(3,10,20,30) 'omitting 5th param
*/

/*
deff coos fcos
print coos(pi())
/*
'19:35 24/04/2022
'check for defined members
class cc
int x
char*z
end class
'#recordof cc
cc*c=getmemory 12
'cc c
#ifdef c.z
  'print "c.z exists"
  print ptrlevelof c.z
  #show sys a=strptr c.z
#endif
*/

/*
'18:48 24/04/2022
'strptr
use generics
bstring b
'#show strptr(b)=getmemory(100)
redim float x(100)
print @x
'redim float y(40)
'#recordof y
*/

/*

'09:14 24/04/2022
'ForEach iteration
'

def ForEach
===========
  scope
    int _i_
    sys _p_=@%1
    if _p_>0
      #if ptrlevelof %1==0
        int _e_=countof %1
      #else
        int*_e_
         @_e_=_p_ -4 'length of mem
        _e_/=sizeof(%1)
      #endif
      typeof(%1) * %1 'new pointered version
      @%1=_p_
      for _i_=1 to _e_
        %2
        @%1+=sizeof(%1)
      next
    endif
  end scope
end def
*/
/*
uses generics
' 
'dim float b[100]   'static array
redim float b(100) 'dynamic array
'dim float b at getmemory 100*sizeof float 'custimised dynamic
int n
'ForEach b {
'  n+=2
'  b=n
'}
'single liner
ForEach b { n+=2 : b=n }

show(b[10])
del b
*/  


/*
'23:30 23/04/2022
'%0 token substitution / low level macro function
int v
def show
  quote !!! %1 =>>  !!! + %1
end def
def inr  %0=%1*%2
'  {%1}
'print inr v 3 4 " ok"
'print show (inr v 3 4 " ok")
sys p
%*  each @%1,
%* eachaddress "%1 "+str(@%1)+chr(13,10)
def assig sys %1={each %2}
def showaddresses print eachaddress %1 
def addresses eachaddress %1
aa:
nop
bb:
nop
cc:
nop
'assig d {aa,bb,cc}
'print countof d
'sys p=@aa
'print str(d[1]) " : " p
'showaddresses {aa,bb,cc}
print addresses(aa,bb,cc)
*/

/*
'10:59 21/04/2022
'recursion checks
% burst burst burst
'burst 'word recursion
% busted1 busted2
% busted2 busted3
% busted3 busted1
'busted1 'word recursion

def bloater
  int i=123 'too many definitions
  bloater
end def
'bloater
def bloater
  nop 'macro recursion suspected (280meg)
  bloater
end def
bloater
*/




'type tree
'  tree
'end type
'tree t 'type must not be a member of itself

'type tree
'  bush 'unidentified element type
'end type

'type bush
'  tree
'end type
'bush b 


/*
'13:07 20/04/2022
'check language extensions
'more.inc
string v=ff 1000
print v
*/

/*
'12:18 19/04/2022
'block labels check
int i,j
#show {
if i
  if j
  endif
endif
if i
endif
}
*/

/*
'12:17 19/04/2022
indexbase 0
redim int i(400)
int j=10
#show {
if i(100)

  sys v=i(j)
endif
}
print "ok"
*/

/*
'19:39 16/04/2022
'2280
redim string r[20]
dim string s[20]
int a
int i=4
#show {
 if r(i) then a=2
}
'#recordof s
print "ok"
*/

/*
'14:40 15/04/2022
'analytics /stats
int final
print offsetof final
*/

/*
'array assign
dim int a(100)
a=> 2,4,6,8
'print a[3]

class Array

method redim() as int
  return 1
end method
end class

method ubound() as int
  return 100
end method

method lbound() as int
  return 1
end method

method assign() as int
  return 1
end method
end class

method insert() as int
  return 1
end method

method delete() as int
  return 1
end method

method sscan() as int
  return 1
end method
end class

method sort() as int
  return 1
end method
end class

Array c
'notation
def ubound %1.ubound
def lbound %1.lbound
'print c.ubound
print ubound(c)
*/



/*
'08:50 14/04/2022
'overloading sub/function for methods
class cc
  method act() as int
    print "act function"
  end method

  method act_()
    print "act sub"
  end method
end class

cc c
c.act
int x=c.act
*/

/*
'00:05 14/04/2022
'pseudocommands
string s="qwerty"
'chr(s,2)="A"
'print s

function f(string *s, int i, string w) as string
return "as function"
end function

function f_(string *s, int i, string w) 'command counterpart
print "as command"
end function

print f (s,2,"A") 'as function
f(s,2,"A")        'as command
*/


/*
'POINT INSIDE POLY

function inrange(float p,a,b) as int
====================================
if b<=p and p<a
  return -1
elseif a<=p and p<b
  return -1
endif
end function


function interpolate (float y,x1,x2,y1,y2) as float
===================================================
if y1=y2 'horizontal line
  y2=y1*+1.00001 'heuristic to avoid infinity issues
endif
return x1 + (x2 - x1) * (y - y1) / (y2 - y1)
end function


function pnpoly(int npol, float *xp,*yp, x, y) as int
=====================================================
indexbase 0
int i, j,c=0
for i=1 to i<npol
  j=i-1
  if inrange(y,yp[i],yp[j])
    if x < interpolate( y, xp[i], xp[j], yp[i], yp[j] )
      c= not c 'toggle
    endif
  endif
next
return c
end function

'TEST
uses console
float px={0,1,1,0}
float py={0,0,1,1}
float x,y
int n=4
def printi print "%1:   " cr : %1
def printd print "%1:   " %1 cr
printi ( float x=0.5, y=0.5)
printd ( pnpoly(n,px,py,x,y)     )
printd ( pnpoly(n,px,py,x+0.4,y) )
printd ( pnpoly(n,px,py,x,y+0.4) )
printd ( pnpoly(n,px,py,x+0.6,y) )
printd ( pnpoly(n,px,py,x,y+0.6) )
pause
*/



/*
'21:12 01/04/2022
'rightmatch anymatch

'#if rightmatch "qwerty","rty"
'print "ok"
#if anymatch ("qwerty","wer")
print "ok"
#endif
*/

/*
'14:27 01/04/2022
'#print metatypeof sub
#alert "ook"
#alert "ook"
'#error "ook"
#if leftmatch "cor1e1", "Core"
  #print "ok"
#else
  #print "not ok"
#endif
print 123
*/

/*

'05:55 28/03/2022
'while implem
int i
#show {
while i<10
  i++
wend
}
*/


/*
'19:57 19/03/2022
'new generic iif
uses generics
type vector{float x,y,z}
vector v[4]={0,0,0, 1,2,3, 4,5,6, 7,8,9}
int a=1
'v=v[3]
#show v=iif(a=1,v[2],v[3])
print v.x "," v.y "," v.z
'#recordof iif
*/


/*
'23:52 17/03/2022
'ptrlevelof

int a
#if ptrlevelof a<1
print ptrlevelof a
int **a
print ptrlevelof a
#endif
int*a
#show {
del a
}


'def d print " %1 %2 %3 "
'd 1,2
*/


/*
'13:47 14/03/2022
string s="abc"
'#recordof _asc
'#show asc(s,2,66)
'_mid(s,2)="?"
'chr(s,2,"?")
'chr(s,2)="?"
asc(s,2)=66
print s
wstring s="abc"
unic(s,2)=66
print s
int l=*(strptr(s)-4) '6
print l
*/

/*
'21:46 12/03/2022
'DEFAULT VALUES
class vv
  int a=1
  int b=2
  int c=3
end class
new vv v()
'v{}
vv v{ .b=20 ,.a=10 }
print v.a " " v.b " " v.c
vv v{ 10,20,300}
print v.a " " v.b " " v.c
'#recordof vv
*/

/*
'19:11 10/03/2022
'PROTOTYPES / METATYPES
type vector {float x,y,z}
function f(vector*v,int n){}
class C
  function f(vector*v,int n,p) as vector {}
end class
'#recordof vector
#recordof C'f


'function f
'prototype vector (vector v, int n)

'function f
'==========
'#input   vector v, int n
'#output  vector
'{}

'macro m
'==========
'#terms   w,v,n
'#rtype   any*
'{}


'class C
'==========
'has vector *v, *w
'has int count
'...
'end class
*/




/*
'15:57 25/02/2022
'abstract programming
type vt void a,b,c
vt v
v.a=v.b+v.c
'a=b+c
*/

/*
type position {void x,y,z}
type velocity {}
type size {}
type shape {}

class particle
  position p
  velocity v
  size     s
  shape    *f
  void constructor(){}
  void destructor(){}
  void reset(){}
  void act(){}
end class

#recordof position
#recordof particle
*/

/*
type abstract
void x,y,z
void* abstract
end type

abstract v
int i
'
#recordof abstract
print @v " " @v.y " " @i
*/


/*
'12:33 24/02/2022
'
type vector
  float x,y,z
end type
'
function f1() as vector
vector v={1,2,3}
return @v
end function

function f2() as vector
returnvar={1,2,3}
end function

'#recordof f2

vector *v
int i
#show let v=f2()
print v.y
*/


/*
'21:04 28/07/2021
'passing fun param returning pointer
type x int y,z
function f() as float*
static float a[100]
return @a
end function

function g(float*b, int a)
end function
'#recordof f
#show g f,1
#show g byval f,1
float s
'#show g byval @s,1
'#show g byval s,1
'#show g s,1
*/


/*
'11:11 09/06/2021
'check 'static dim'
function f()
static dim int a
#recordof a
end function
f()
*/

/*
'11:55 07/06/2021
'redim test static with constructor

uses generics
class cc
  method constructor()
  print "constr"
  end method
  '
  method destructor
  print "destr"
  end method
end class

redim cc c(0)

function f()
  redim cc c(2)
  'redim cc c(3) clear
  redim cc c(0) 'destructors
end function
f()
*/

/*
'11:44 07/06/2021
'check dim static
function f()
  dim int a
  #recordof a
  dim static int a
  #recordof a
end function
*/

/*
'18:17 05/06/2021
'safe stride

double *a
int x
type tt int i,double *a
tt t
#show x=sizeof(t.a)
*/

/*
'15:12 05/06/2021
'redim scope check
class cc
  bstring s
  bstring s
  method constructor()
    s=""
  end method
  method destructor
    s=""
    frees s
  end method
end class

redim cc c(0)
int i
function testr()
  redim cc c(80)
  for i=1 to 80
    c[i].s=str(i*100)
  next
end function
testr()

for i= 31 to 32
  print c[i].s
next

redim cc c[80] clear

print c[i].s
print "ok"
*/


/*
    $filename "exceldemo.exe"                                    
    uses  COM/COMutil                                    
    
    string filename
    int i, j
    idispatch *oExcelApp
    idispatch *oWorkBook
    idispatch *oExcelWorkBook
    idispatch *oExcelSheet
    idispatch *oRange
    filename = "exceldemo.xls"
    Coinitialize null
    CreateInterfaceByName "Excel.Application" oExcelApp

    ObjectByName(oExcelApp,GET, "Workbooks", null, 0, oWorkBook)
    ObjectByName(oWorkBook, GET, "Add",null ,0, oExcelWorkbook)
    ObjectByName(oExcelWorkbook,GET, "ActiveSheet", null,0, oExcelSheet)
'print hex @oExcelSheet
    ObjectByName(oExcelSheet, GET, "Range", BSTR {"G3"},1, oRange)
'print hex err
'print hex @oRange
    LetByName(oRange, "Value", BSTR {"123"})
'print hex err
    oRange.Release 
'print hex @oRange
    ObjectByName(oExcelSheet, GET, "Range", BSTR {"B1:B5"}, 1,oRange)
'print hex @oRange
    CallByName(oRange, "BorderAround", BSTR {1, -4138, 3},null)
    ObjectByName(oRange, GET, "Interior", null,0, oInterior)
'print hex @oInterior
    LetByName(oInterior, "ColorIndex", L"38")
    'LetByName(oInterior, "Pattern", "xlPatternCrissCross")
'print hex err
    'LetByName(oInterior, "Pattern", "xlPatternSolid")
    oRange.Release
    oInterior.Release
    'for i = 1 to 10
    '  for j = 1 to 10
        ObjectByName(oExcelSheet,GET, "Cells", BSTR{"2", "3"},0, oCell)
print hex @ocell
'        LetByName(oCell, "Value", BSTR {"test-" + i + "-" + j})
if @ocell
oCell.Release
endif
    '  next j   
    'next i
    LetByName(oExcelWorkbook, "SaveAs", filename)
    CmdByName(oExcelWorkbook, "Close")
    CmdByName(oExcelApp, "Quit")
    oExcelSheet.Release
    oExcelWorkbook.Release
    oWorkBook.Release
    oExcelApp.Release
     
    'print "Speadsheet Created."
    Couninitialize
     
*/

/*
'07:01 23/03/2021
$filename "exceldemo.exe"
'uses RTL32                                    
uses  COM/COMutil                                    
 
function main()
string filename
int i, j
string cr=chr(13,10)
filename = "C:\OxygenBasic\demos\COM\exceldemo.xls"
CoInitialize null
CreateInterfaceByName "Excel.Application" oExcelApp
int i
indexbase 1
VARIANT vr
CallByNameV(oExcelApp, 2, "Workbooks", null,0,vr)
Idispatch*oWorkBook=@vr.pdispVal


VARIANT vr
VARIANT va[8]
iDispatch*dd
va[1].vt=VT_DISPATCH : va[1].lVal=null
CallByNameV(oWorkBook, 1, "ExcelWorkBook", va,1,vr)
Idispatch*oExcelWorkBook=@vr.pdispVal
print hex err
print @oExcelWorkbook

/*
ObjectByName(oExcelWorkbook, "Worksheets", BSTR {1}, oExcelSheet)
print @oExcelSheet
print hex err
/*
ObjectByName(oExcelSheet, "Range", BSTR {"G3"}, oRange)
print @oRange

LetByName(oRange, "Value", 123)
oRange.Release 
ObjectByName(oExcelSheet, "Range", BSTR {"B1:B5"}, oRange)
CallByName(oRange, "BorderAround", BSTR {1, -4138, 3})
ObjectByName(oRange, "Interior", BSTR {1}, oInterior)
LetByName(oInterior, "ColorIndex", 38)
LetByName(oInterior, "Pattern", "xlSolid")
oRange.Release
oInterior.Release
for i = 1 to 10
  for j = 0 to 10
    ObjectByName(oExcelSheet, "Cells", BSTR {i, j}, oCell)
    LetByName(oCell, "Value", "test-" + str(i) + "-" + str(j))
    oCell.Release
  next j   
next i    
CallByName(oExcelWorkbook, "SaveAs", BSTR {filename})
CmdByName(oExcelWorkbook, "Close")
CmdByName(oExcelApp, "Quit")
oExcelSheet.Release
oExcelWorkbook.Release
oWorkBook.Release
oExcelApp.Release
 
print "Speadsheet Created."
*/
'oExcelApp.Release
'CoUninitialize
'end function
'main


/*
'20:52 24/03/2021
function f(int*a,c)
print c
end function

f (int {},countof)
f (int {1,3},countof)
*/

/*
    ' O2 Sage BOI
     
    $filename "o.exe"
    uses RTL64                                 
    uses  COM/COMutil                                    
     
    CoInitialize null
     
    CreateInterfaceByName "ProvideX.Script" oscript
    CallByName(oscript, "Init", BSTR {"C:\Sage\Sage 100 Standard\MAS90\Home"})
     
    ObjectByName(oscript, "NewObject", BSTR {"SY_Session"},osession)
    CallByName(osession, "nSetUser", BSTR {"js", "northstar"})
    CallByName(osession, "nsetcompany", BSTR {"ABC"})
    CallByName(osession, "nSetDate", BSTR {"A/R", "20210322"})
    CallByName(osession, "nSetModule", BSTR {"A/R"})


    'Need to use variants directly for Idispatch osession    
    'ObjectByName(oscript, "NewObject", BSTR {"AR_Customer_svc"}, osession, ocust)
    indexbase 1
    VARIANT va[2], vr
    va[1].vt=VT_BSTR : va[1].bstrVal="AR_Customer_svc"
    va[2].vt=VT_DISPATCH
    (sys) va[2].lVal=@@osession
    vr.vt=0 : vr.llVal=0 'return
    CallByNameV(oscript, METHOD, "NewObject", va,2,vr)
    Idispatch *ocust
    @ocust= (sys*) vr.lVal
    frees va[1].bstrVal

    BSTR customerno,customername,city,state,telephoneno
     
    CmdByName(ocust, "nMoveFirst")
    GetByName(ocust, "sCustomerNo", customerno)
    GetByName(ocust, "sCustomerName", customername)
    GetByName(ocust, "sCity", city)
    GetByName(ocust, "sState", state)
    GetByName(ocust, "sTelephoneNo", telephoneno)
    CmdByName(ocust, "DropObject")
    CmdByName(osession, "DropObject")
     
    ' print @osession 'check pointer
     
    print "Customer:  " customerno "  " customername "  " city+ "  " state "  " telephoneno
     
    oscript.Release                                       
    CoUninitialize
*/
     



/*
'09:33 21/03/2021
' O2 Sage BOI
 
$filename "t.exe"                                    
uses  COM/COMutil

function CallByNameSV(IDispatch *vi, word flag, BSTR name, BSTR *sa=null, int c=0, VARIANT *vr=null) as int
===========================================================================================================
  int i
  VARIANT va[8] 'up to 8 params
  indexbase 1
  '
  for i=1 to c
   va[i].vt=VT_BSTR
   ?va[i].bstrVal=?sa[i] 'direct coupling
  next
  '
  err=CallByNameV(vi, flag, name, va, c, vr) 'VARIANT morph
  '
  for i=1 to c
    frees sa[i]
  next
  return err
end function

macro ObjectByName(vi,fl,nf,sa,sr,   rv)
========================================
  idispatch *sr
  VARIANT rv
  CallByNameSV(vi, fl, nf, sa, countof, rv)
  @sr=@rv.ppdispVal
end macro


CoInitialize null
 
CreateInterfaceByName "ProvideX.Script" oscript
CallByName(oscript, "Init", BSTR {"C:\Sage\Sage 100 Standard\MAS90\Home"})

'SB>>
'osession = COM::CBN(oscript, "NewObject", :SET, "SY_Session")

'longhand:
'idispatch *osession
'VARIANT rv
'CallByNameSV(oscript, SET, "NewObject", BSTR {"SY_Session"}, countof, rv)
'@osession=@rv.ppdispVal

ObjectByName(oscript, SET, "NewObject", BSTR {"SY_Session"},osession)

print @osession 'check pointer
 
oscript.Release                                        
CoUninitialize 
*/


/*
'08:29 21/03/2021
    ' Sage BOI (Business Object Interface)- first customer - selected columns
     
    IMPORT COM.sbi
     
    oscript = COM::CREATE(:SET, "ProvideX.Script")
    COM::CBN oScript, "Init", :CALL, "C:\\Sage\\Sage 100 Standard\\MAS90\\Home"
idispatch *osession
VARIANT rv
CallByNameSV(osession, SET, "NewObject", BSTR {"SY_Session"}, 1, rv)
@osession=@rv.ppdispVal
    osession = COM::CBN(oscript, "NewObject", :SET, "SY_Session")
    COM::CBN osession, "nSetUser", :CALL, "js", "MY_PASSWORD"
    COM::CBN osession, "nsetcompany", :CALL, "ABC"
    COM::CBN osession, "nSetDate", :CALL, "A/R", "20171218"
    COM::CBN osession, "nSetModule", :CALL, "A/R"

    ocust = COM::CBN(oscript, "NewObject", :SET, "AR_Customer_svc", osession)
    COM::CBN ocust, "nMoveFirst"
    CustomerNo$ = COM::CBN(ocust, "sCustomerNo", :GET)
    CustomerName$ = COM::CBN(ocust, "sCustomerName", :GET)
    City$ = COM::CBN(ocust, "sCity", :GET)
    State$ = COM::CBN(ocust, "sState", :GET)
    TelephoneNo$ = COM::CBN(ocust, "sTelephoneNo", :GET)

    COM::CBN ocust, "DropObject"
    COM::CBN osession, "DropObject"
    COM::RELEASE oscript
     
    PRINT "Customer:  ", CustomerNo$, "  ", CustomerName$, "  ", City$, "  ", State$, "  ", TelephoneNo$, "\n"
*/     

/*
'08:11 21/03/2021
uses com/comutil
idispatch *x
VARIANT *v
end
#recordof v
#show @x=@v.ppdispval
*/

/*
'20:27 22/02/2021
'USES OF '&'
'
'print &h101 '257
'print &o101 '65
'print &b101 '5
'print "ok" & "ay" 'okay 'string concatenator
int a=15
'print a & 19 'bitwise and: 3
'print a && 19 'logical and: -1
'print (&a) 'address eg: 5844992
'int a& = 67 'name char suffix
'print a&    '
'int a&b = 67 'name embedded character
'print a&b    ''

'print &h101 '257
'print 0o101 '65
'print 0b101 '5
'print "ok" + "ay" 'okay 'string concatenator
int a=15
'print a and 19 'bitwise and: 3
'print a && 19 'logical and: -1
print @a 'address eg: 5844992
*/



/*
  '19:16 22/02/2021

  dim as float t(100)
  ...
  'to clear array t using pointer pt
  int i
  float*pt
  @pt=@t 'set base address
  for i=1 to countof(t)
    pt=0
    @pt+=sizeof(pt) 'stride for next element
  next
  print "ok" & "ay"
*/


/*
'16:13 22/02/2021
'quad byval check 64bit
$filename "o.exe"
uses rtl64
function f(quad q) as quad 'external
q+=q
print q '90
return q+q
end function
'
quad a=0, r=45
#show a=f(r)
print a '180
*/


/*
'21:25 21/02/2021
'float t
float *t
float ptr t
dim as float byref t
dim t as float ptr
dim t as float *
'#recordof t
*/

/*
'11:37 21/02/2021
'
function SineGen(int n,single**t) as int
'generates 360 degree sinewave table in n steps
  sys m=getmemory(n*4)
  int i
  @t=m
  double ni=pi()*2/n
  double pi2=2*pi()
  for i=0 to n-1
    t=sin(i*ni)
    @t+=4 'stride
  next
  @t=m 'reset t base
end function
'
single *SineTable 'MUST be a pointer
SineGen(720,SineTable) 'half degree steps
indexbase 0
print SineTable(60) '.5
...
freememory @SineTable
*/

/*
'10:05 21/02/2021
uses console

dim as SINGLE x

FUNCTION F() AS SINGLE
  FUNCTION=4.5
END FUNCTION

DIM AS SINGLE A=F()

PRINT A CR
WAIT
*/


/*
'21:53 19/02/2021
function f(float*v) as int
end function
function g(int*v) as int
end function

'float x
'#show f x
int x
'#show g x
#show g ((@x)) '+0
*/

/*
'14:22 17/02/2021
'16:25 19/02/2021
'provide extra referencing
type vv float x,y,z
'typedef float vv
function f(vv**v) as sys
static vv w
w.y=45
'@v=@w
v.y=23
return 0
end function

vv *a
vv a
#show f a
print a.y
*/


/*
'11:25 18/02/2021
sys a
sys x
float y
function f(float*v)
end function
lbl:
'
'#show a=@12  'creates temp var to hold 12
'#show a=@ lbl 'address of label
'#show a=@@ lbl 'address of label
'#show a=@x     'address of variable
'#show a=@@x
'#show f x
'#show f @x
'#show f @@x
#show f y
*/


/*
  '11:23 18/02/2021
  uses  COM/COMutil
  CoInitialize null
  #show {
  ConnectByName "SAPI.SpVoice", voice
  }
  sys v=@voice
  print v
*/


/*
function f(any*a)
float b at @a
print b
end function


float c= 9.6
f c+55
*/




/*
function f(int *a,b) as int
end function

macro mf(ma,mb)
#if ma=null
  print "null"
  f(null,mb)
#endif
end macro

'mf 0,5
'mf 0.0,5
'mf null,5
'mf "X",5
'mf null,5
'print typecodeof x
'print typecodeof "x"
'print typecodeof strptr(" ")
'print typecodeof val(" ")
'print typecodeof round(4.5)

macro mf(p)
#if not match((p),(null))
   print "not null"
#else
   print "null"
#endif
end macro

mf null
mf 0
mf 1/4
*/

/*
'09:39 09/02/2021
'index optimisations
indexbase 0
int v[100]
int a,b,c
#show "t.txt" {
v[]
v[2]
v[b]
v[b+2]
v[b+c]
v[v[b+2]]
v[v[b]+2]
v[v[b]+cs]
}
*/

/*
function f(bstring**s)
print s
end function

#show {
char c="WQ"
f c
}
*/


/*
'10:18 06/02/2021
function f(float*v) as sys
===========================
static float b={1,2,3,4.2,5,6,7,8,9}
v[4]=b[4]
return @b
end function

float b
#show f b
print b[4]
*/


/*
'18:38 05/02/2021
function f(float**v) as sys
===========================
static float b={1,2,3,4.2,5,6,7,8,9}
@v=@b
return @b
end function

float *b
#show f b
print b[4]
*/


/*
function f(char**s)
mbox @@s
s="£"
end function

'#show
'f "Q" "R"
char *t="W"
#show f t
print t
*/


/*
string cr=chr(13,10)
string ss = "Hello World"
        byte ptr bb = strptr(ss)
        long ii = 1
       
        print bb[ii+1] cr     ' Correctly prints 101
        print bb[(ii+1)]    ' IMO, should print 101, but prints 72.
        print bb[(ii)+1] cr   ' Correctly prints 101
*/

' PRINT ((1+1))
/*
string s=space(128)
byte *a=strptr s
int i
for i=1 to 128
  a[i]=i+i
next
int ii=2
'#show byte j=a[(ii+3)]
'#show byte j=a[ii+3]
#show byte j=a[a[6]]
print j
*/


/*
float a={1,2,3,4,5}
int ii=2
#show int j=a[(ii)+3]
print j
*/

/*
'20:52 02/02/2021
'
function f(sys p)
sys q at p
char c at q[2]
print c
end function
'
bstring s[]={"a","b","c"}

#show f @s
print s
*/


/*
'16:22 02/02/2021
'passing pchar arrays
typedef char*pchar
''
function f(sys a)
pchar *c
@@c=a
print c[1]
end function
'

sys c[100]
c[1]= strptr "ok1"
c[2]= strptr "ok2"

f @c
*/

'10:45 02/02/2021
'passing bstring arrays
/*
function  f(bstring *s) as string
'function  f(bstring s[]) as string
print s[1]
s[2]="x"
end function
'
bstring s[]={"a","b","c"}
f "Q"
print s[2] "," s[3]
*/
/*
function  f(bstring *s) as string
'function  f(bstring s[]) as string
print s[1]
end function
'
f "k" "x"
*/


/*
'10:43 31/01/2021
'passing string arrays
function  f(bstring **s) as string
'function  f(string s[]) as string
print s[1]
s[1]="r"
end function

string s[]={"a","b","c"}
'#show s[1]=s[2]+s[3]
'f s[1]
'#show f s[1]+s[2]
'#show f "Q"'+"S"
'f left("qwerty",2)
'f(string{"q"})
'f(string{44})
'f(lcase("Q"))
'f 46
'*/
'
/*
function  f(bstring s[])
print s[2]
end function

bstring s[]={"a","b","c"}
'print s[1]
#show f s
'print s[1]
'f(string{"q"})
'f(string{44})
'#show f(lcase("Q"))
*/
'
/*
function  f(string s)
print s
end function

'#show f "ok"
int i=66
'#show f ( chr(i) )
'#show f ( left("x",1) )
'#show f ( mid("x",1,1) )
'#show f ( ltrim("x") )
'#show f ( lcase("A") )
'#show f ( lcase(chr(65)) )

function  f(int *s)
print s
end function

#show f  1 2 3.5 asc("Q")
*/



/*
'13:50 27/01/2021
'embedder
string memBuff1 = getfile ("o.exe")
string memBuff2 = getfile ("t.txt")
string outBuff = memBuff1 + memBuff2
putfile ("ot.exe",memBuff1 + memBuff2)
'putfile ("ot.exe",outBuff)
putfile ("ot.cfg",str(len(membuff1)) ) 'save length of t.exe
...
'recover embedded data from ot.exe
string s=getfile("ot.exe")
int lo=val(getfile("ot.cfg"))
string d=mid(s,lo+1,200)
print d
*/


/*
'09:58 27/01/2021
'embedfile
$filename "o.exe"
uses rtl32
bstring dat 'must be global
embedfile "t.txt",dat 'must be global
...
print left(dat,100)
print len(dat)
*/

/*
'13:45 20/01/2021
'test ops / save

type xxx
========
  float x,y,z
end type

macro xxx_op()
=================

 macro .move (a,b)
 print "move "
 'copy @a,@b,sizeof xxx
 end macro

 macro .save (a,b)
 print "save "
 end macro

 macro .+ (a,b,c)
 fadd dword a.y
 print "+ "
 end macro

 macro .* (a,b,c)
 print "* "
 end macro

end macro

dim xxx i,j,k,m
#show {
  i=j+k*m
}
*/


/*
'20:25 19/01/2021

type simd
float w,x,y,z
end type

simd a,b
a={1,2,3,4}
'#show{
movups xmm0,a
addps xmm0,xmm0
movups b,xmm0
'}

function str (simd*a) as string
  return a.w ", " a.x ", " a.y ", " a.z
end function
'
#show a=b
print str(b)
*/

/*
'16:11 18/01/2021
revoke integer?
#recordof integer
'typedef short integer
alias short as integer
#recordof integer
*/

/*
'20:26 17/01/2021
'
float f=1.2
int a
'#show a=convert int (f/2)
#show a=cast int f'(f/2)
print a
*/


/*
'19:45 17/01/2021
'override int type as short variable
typedef short shint,int
#recordof int
int a=0x8001
print a
*/


/*
'16:29 17/01/2021
'override int type as float macro
def int round(%1)

#recordof int
#show print int(1.2)
*/


/*
'16:29 17/01/2021
'override int type as function
function int(long i) as long {return i}

#recordof int
#show print int(1.2)
*/



/*
'16:29 17/01/2021
if int(1) = 0 then
    print "i think 1 = 0"
end if
print int(1.7)
*/

/*
'08:55 15/01/2021
'local alias
extern
function f alias "ff" ()
end function
end extern

#recordof f
*/

/*
'12:19 14/01/2021
'new primitives
int i
#recordof i
*/


/*
'17:19 12/01/2021
' _join_ operator
def id %1
int a
#show {
a = id 1 _join_ id 2
}
*/

/*
'13:17 09/01/2021
'lpart rpart
int a=4
'print lpartof a
'print lpartof(a.q)
'print rpartof(a.n)
'print rpartof(n.a)
class cc
  method m(){print "ok"}
end class
cc c
#show vtypeof(c).m
*/


/*
extern
#define apientry

void apientry x (int a)
end extern
*/

/*
'11:51 01/12/2020
extern virtual
class c
  !m
end class

extern
! function ptr f(int v) as int
end extern


end

int a
'#show a=f[2]'(3)
c *x
int i=2
#show x.m[i](11)
*/

/*
'12:24 29/11/2020
'def/macros word combine

$ m "%1"

'#show {
'  int a_b=5
'print m{a}_b
print m(a) m(b) m(c)
*/

/*
'12:07 29/11/2020
'macro word combine
macro m(a)
a
end macro

'print m(3).3
int a_b=5
print m(a_b)
*/

/*
'02:50 10/11/2020
'fix macro function /no return val
macro m int(a,b)
a=b+1
a++
end macro

#show m 42
*/

/*
'14:15 02/11/2020
function fs(string**s) as string
print @s
return s
end function

string t="ok"
print @t 'same as @s inside function fs
print fs(t)
*/


/*
  '16:33 09/11/2020
  'com low-level generic
  'CALLBYINDEX
  '$filename "o.exe"
  'uses rtl64
  uses  COM/COMutil
  CoInitialize null
  CreateGuid clsid "96749377-3391-11D2-9EE3-00C04F797396" 'SAPI
  CreateGuid iid   "6C44DF74-72B9-4992-A1EC-EF996E0422D4" 'IspVoice
  VirtualInterface *voice
  err=CoCreateInstance clsid, null, context, iid, @voice
  CallByIndex voice[20] (l"Hello World",1,0) 'speak
  print "ok" 'pause required before ending
  CallByIndex voice[2] () 'release
  CoUninitialize

*/

/*
  '13:21 17/11/2020
  'com low-level generic
  'CALLBYOFFSET
  '$filename "o.exe"
  'uses rtl64
  uses  COM/COMutil
  CoInitialize null
  CreateGuid clsid "96749377-3391-11D2-9EE3-00C04F797396" 'SAPI
  CreateGuid iid   "6C44DF74-72B9-4992-A1EC-EF996E0422D4" 'IspVoice
  VirtualInterface *voice
  err=CoCreateInstance clsid, null, context, iid, @voice
  CallByOffset voice(80) (L"Hello World",1,0) 'speak async
  print "ok" 'pause required before ending
  CallByOffset voice(8) () 'release
  CoUninitialize
*/

/*
  '16:33 09/11/2020
  'com automation
  '
  $filename "o.exe"
  uses rtl64
  uses  COM/COMutil
  CoInitialize null

  CreateInterfaceByName "SAPI.SpVoice" voice
  '
  BSTR r
  GetByName(voice,"volume",r) : print "vol " r
  GetByName(voice,"rate",r) : print "rate " r
  CallByName( voice,"speak", BSTR {"Hello World"} )
  LetByName(voice,"volume",7)
  LetByName(voice,"rate",3)
  CallByName( voice,"speak", BSTR {"Hello World","1"} )
  '
  indexbase 1
  VARIANT va[2]
  va.vt[1]=VT_BSTR : va[1].bstrval="Hello Sky"
  va.vt[2]=VT_BSTR : va[2].bstrval="1"
  CallByNameV( voice, METHOD,"speak", va,2 )
  del va.bstrval
  print err

  'CallByNameS( voice,1, "speak", BSTR {"Hello World"},countof )
  ...
  voice.Release
  CoUninitialize
*/

/*
  '09:53 10/11/2020
  'low-level COM
  uses  COM/Voice
  CoInitialize null
  ISpVoice *voice
  ConnectVoice(voice)
  '
  voice.speak("Hello World")
  '
  voice.Release
  CoUninitialize
*/





'https://www.oxygenbasic.org/forum/index.php?topic=1743.0
/*
  '13:57 02/11/2020
  'com automation
  $filename "o.exe"
  'uses rtl64
  uses console
  uses  COM/Voice
  '
  CoInitialize null
  IDispatch*v
  wstring cr=chr(13,10)
  int er
  er=ConnectByName("SAPI.SpVoice",v)
 'print str(er) ",  " hex(@v) "," hex(?v) cr
'#show wstring aa={"1","2","3"}

  if not er
    indexbase 1
    VARIANT va[4],vr
    'pass variants va in reverse order
    va[1].vt=VT_BSTR
    va[1].bstrVal=l"Hello world"
    'va[1].vt=VT_R4
    'va[1].fltval=1.234
    'er=CallByNameRV(v,"speak",1,va,vr)
    '
    BSTR sr
    '#show er=CallByNameS(v,"speak",BSTR{"Hello World"},countof,sr)
    '#show er=CallByNameS(v,"speak",BSTR{},countof,sr)
    '#show er=CallByName(v,"speak",{"Hello World"},sr)
    er=CallByName(v,"speak",{"Hello World"},sr)
print er
    frees sr
    '
    'print vr.vt
    frees va[1].bstrVal
    v.Release
    @v=0
  endif
  CoUninitialize
  wait
*/

/*
  '14:02 19/10/2020
  'dispatch
  '
  string s1="Speak"
  sys  s1p[32]=strptr s1
  int vid
  int a=voice.GetIDsOfNames(null, byval @s1p,1,0,byval @vid)
  mbox hex a
  '
*/

/*
'10:56 13/10/2020
class vec
float x,y,z
method destructor(){}
end class

macro vec_op()
  macro .+(a,b,c)
    a.x=b.x+c.x
    a.y=b.y+c.y
    a.z=b.z+c.z
  end macro
  macro .move(a,b)
    a.x=b.x
    a.y=b.y
    a.z=b.z
  end macro
  macro .free(a,b)
    a.destructor()
  end macro
end macro

function f() as vec
function={1,2,3}
end function

#show "t.txt" {
function ff()
vec a,b
a=f()'+b
PRINT A.Y
end function
}
FF
*/

/*
'11:41 23/09/2020
'color dialog
'
$filename "t.exe"
uses rtl64
uses corewin
'
Type tCHOOSECOLOR
  lStructSize As Long
  hwndOwner As sys
  hInstance As sys
  rgbResult As Long
  lpCustColors As sys
  flags As Long
  lCustData As sys
  lpfnHook As sys
  lpTemplateName As sys
End Type
'
dim as int c            'returned color
dim as tCHOOSECOLOR cc  'color structure
cc.lStructSize=sizeof cc
cc.hwndOwner=0 'hwnd
cc.hInstance=GetModuleHandle 0
cc.flags=2 'fullopen
'custom colors
dim as long cu(16)={
  0x0000ff,0x8080,0x00ff00,0x808000,0xff0000
}
cc.lpCustColors=@cu
'
c=ChooseColor @cc
print hex(cc.rgbResult,6)
*/


/*
'16:49 21/09/2020
'FIX FLOAT BOOLEANS
double a
a=5.01
#show {if frac(a)'<>0
endif
}
if frac(a)'>0
  print "frac"
else
  print "no frac"
endif
*/

/*
'14:41 20/09/2020
'any
macro Limited any(r,v,min,max)
==============================
  if v<min
    r=min
  elseif v>max
    r=max
  else
    r=v
  endif
end macro

'default int
print limited(1.5,0.7,5.7)   '1.5 '2
print limited(0.5,0.7,5.7) : '0.7 '1
print limited(9.5,0.7,5.7) : '5.7 '6
float v
v=limited(1.5,0.7,5.7) : print str(v,5)  '1.5
v=limited(0.5,0.7,5.7) : print str(v,5)  '0.7
v=limited(9.5,0.7,5.7) : print str(v,5)  '5.7
string s
s=limited("m","j","q") : print s  'm
s=limited("c","j","q") : print s  'j
s=limited("u","j","q") : print s  'q
*/

'print byte 257

'print round(-1.55)
/*
'11:01 15/09/2020
'http://www.cplusplus.com/reference/cstdio/printf/

uses corewin
uses console
char buf[100]
double d=pi()

'sprintf_s(buf,100,"floats: %4.2f %+.0e %E " cr, d, d, d)
'sprintf(buf, "floats: %4.2f %+.0e %E " cr, d, d, d)

   sprintf (buf, "Characters: %c %c ", asc("a"), 65)
   print buf cr
   sprintf (buf, "Decimals: %d %ld", 1977, 650000L)
   print buf cr
   sprintf (buf, "Preceding with blanks: %10d ", 1977)
   print buf cr
   sprintf (buf, "Preceding with zeros: %010d ", 1977)
   print buf cr
   sprintf (buf, "Some different radices: %d %x %o %#x %#o ", 100, 100, 100, 100, 100)
   print buf cr
   sprintf (buf, "floats: %4.2f %+.0e %E", double 3.1416, double 3.1416, double 3.1416)
   print buf cr
   sprintf (buf, "Width trick: %*d", 5, 10)
   print buf cr
   sprintf (buf, "%s", "A string")
   print buf cr
   print cr
wait
*/

/*
'00:19 15/09/2020
function dp_str(string num="", int wid=20, dpp=10) as string
===========================================================
  'num  number string
  'wid  column width
  'dpp  decimal point position in column
  '
  string buf 'column buffer
  int ln     'length of num
  int dp     'offset of num decimal point
  '
  buf=space(wid) ' column string
  ln=len(num)
  dp=instr(num,".")
  if dp=0 'integers
    dp=ln+1
  endif
  '
  int n=dpp-dp 'left spaces
  'check if too long
  if n<0 then n=0 'remove left space
  if ln>wid
    mid buf,1,"!!"+num 'error
  else
    mid(buf,1+n,num) 'copy number into position
  endif
  return buf
end function

'TESTS
uses console
print dp_str(pi(),30)      "|" cr
print dp_str(pi(),30,4)    "|" cr
print dp_str(str(pi(),5))  "|" cr
print dp_str(12345678)     "|" cr
print dp_str(123)          "|" cr
print dp_str(-123)         "|" cr
print dp_str(-123.45)      "|" cr
wait
*/


/*
float g=3.5
if convert int(g)=g 
'if g=convert int g 
  print g
endif
*/

/*
'04:28 13/09/2020
'float f,g
'#show {if f=string(g,"q"){} }
'#show {
uses console
double f
double g=5/3
print "g ="     tab g cr
print "cast"    tab str((int) g) cr
print "cast"    tab str(cast int g) cr
print "convert" tab str(convert int g) cr
#show {
'if (convert int g )<= g then
if g>= (convert int g) then
  print "rounded down" cr
'else
'  print "rounded up" cr
endif
}
wait
'}
*/

/*
$filename "o.exe"
uses rtl32
uses console
 */     

/*
'14:36 07/09/2020
'nesting check
#show {
int i,j
do until i>3
  i++
  j=0
  if i>1
    do 
      j++
      ...
    loop until j>3
  endif
loop
}
*/


/*
'12:38 06/09/2020
'do until
int i
do until i>10
  i++
loop until i=5
print i
*/

/*
'08:27 04/09/2020
'support numeric condition
'
#show {
int i
do 'while i<10
 i++
 'exit when 1<2
 continue while i<5
 exit when i>2
loop 'while i<10
}
print i
*/


/*
'13:40 03/09/2020
'fix precedence
int a[100]
int b[100]
#show {
 if a[1]=10 and b[1]=20 and b[2]=30
 endif
}
*/

/*
'05:28 19/08/2020
function iif(int c,a,b) as int
  if c
    return a
  else
    return b
  endif
end function

print iif(1==2, 11, 10)
*/


/*
'11:25 30/08/2020

macro iif int(a,b,c,d)
if b
  a=c
else
  a=d
endif
end macro

#show "t.txt" {
int a,b,c,d
a=iif(a==b,c,d)
}
*/

/*
'10:20 29/08/2020
#show "t.txt" {
function f(int i)
int a,b
a=b
end function
}
f 1
*/

/*
'10:20 29/08/2020

  Function SetText(sys hwnd, string s)
  ====================================
  SendMessage hwnd,WM_SETTEXT,len(s),strptr(s)
  End Function


  Function GetText(sys hwnd) as string
  ====================================
  int le
  bstring s
  le=SendMessage hwnd,WM_GETTEXTLENGTH
  s=nuls le
  SendMessage hwnd,WM_GETTEXT,le+1,strptr(s)
  return s
  end function
*/


/*
includepath "c:\cevp\code\OxygenBasic\inc\"
'includepath "..\inc\"
uses corewin
*/



/*
'10:22 26/08/2020
class ca
  int i
end class

class cb

  function x()
  end function

  private int ii 'indicative
  protected
  public
  ca
  int b
end class

#recordof cb
*/


/*
byte s=33,t=0
mov ch,s
mov t,ch
print t
*/

/*
'18:19 22/08/2020
'sys assignment using stack instead of register
int a, b=1
push b
pop a
print a
*/

/*
'==
function f(int a) as int
return a
end function

int c=1
int d=2
print f(f(1)==d)
*/


/*
'11:54 18/08/2020
int a
a=(1>2 ? 10 : 20)
print a
'#show print str((1>2 ? 10 : 20))

*/

/*
'02:55 18/08/2020
function drawcube(int color=0,int size=1)
print color " " size
end function

drawcube( size=2, color=0xff) '255 2
*/

/*
'02:53 18/08/2020
function testbyte (int v) as int
return v
end function

print testbyte( ( lcase("A") = "a") )
*/


/*
sbyte b
b=255
print b
*/

/*
'function mystrlen(byval char *x) as integer
function mystrlen(char *c) as integer
 byte*x = @c
 byte *y = @x
 while x
  @x++
 wend
 return @x-@y
end function

char c="12345"
print mystrlen(c)
*/


/*
'12:39 29/07/2020
'test valid exe
$filename "o.exe"
uses rtl64
uses corewin
uses console
print 123
wait
*/


/*
'08:40 19/03/2020
if 1
  while 0
    exit if 1
  wend
endif
end
*/

/*
'22:48 16/03/2020
$filename "o.exe"
uses rtl64
uses console

def str$ str
def incr inc
def p? printl

function format$(string n, optional string f) as string
if f
  int i=instr(f,".")
  if i 'count places to right
    int j=len(f)
    int k=j-i
    if k>0 'decimal places
      n=round(val(n)*(10^k))
      i=len(n)
      if i<k+1
        n+=string(k-i+1,"0") 'pad right
        i+=k
      endif
      n=left(n,i-k)+"."+mid(n,i-k+1,k) 'insert decimal pt
    endif
  endif
endif
int i=instr(f,",")
if i 'comma thousands
  int j=instr(n,".")
  if j=0 then j=len(n)+1
  if j>3
    for i=j-3 to 2 step -3
      n=left(n,i-1)+","+mid(n,i) 'insert commas
    next
  endif
endif
return n
end function


macro iif$ string(R,X,A,B)
if X
  R=A
else
  R=B
endif
end macro


FUNCTION PBMAIN () AS LONG

    local vsing as single = 3.141519
    local vdoub as double = 3.141519
    static vint  as long       
    local vquad as quad = 4989895
   
    local ws as wstring = "0"   
    local s as string = "$ 0,.00"

    'printl iif$(1<0, "ok","nok")


    int c1=1000000, c2=1000000
    double t2n12=1.2345
    int i
    for i=1 to 8
      PRINTl IIF$((c1=1000000) AND (c2=1000003), "*OK!* ", "ERROR ") &
      " " & RTRIM(FORMAT$(t2n12, "0.00") )
      c2++
    next

    'vint += 1  ' i need to fix this.
   
    LOCAL y AS long   = 3.7 
    local z AS double = 12345.12321

    incr vint   

    p? FORMAT$(0, ws)
    p? FORMAT$(2323332.15, s)

    p? FORMAT$(0, "0.000")
    p? FORMAT$(2323332.15, "0.000")




    p? str$(2323332.123)
    p? str$(2323332)
    p? str$(vint)
    p? FORMAT$(0)
    p? FORMAT$(1)
    p? FORMAT$(vsing)
    p? FORMAT$(vdoub)
    p? FORMAT$(vint)
    p? FORMAT$(vquad)

END FUNCTION

pbmain
wait
*/


/*
'print typecodeof double
typedef double dd
'print typecodeof dd
typedef dd ee
#recordof ee
*/

/*
MACRO ¤EXAMPLE string(r, dd, d2)
    #if typecodeof(dd) = 0x68
        r = str(dd)
    #endif
END MACRO

double* f(float h){}
quad f(){}
'#recordof f
print typeof(f(1))
print hex typecodeof(f(1))
typeof f(1) g
#recordof g
*/


/*
'15:17 29/02/2020
$filename "o.exe"
uses RTL64
double p = pow(-2.5,2)
print 0 + pow(-2.5,2)
print "" + pow(-2.5,2)
print (pow(-2.5,2))
print -2.5 pow 2
print -2.5 ^ 2
*/

/*
'11:28 24/02/2020
$filename "o.exe"
'uses RTL64
int i
'#show i=(str(7)+str(3)=str(8))
'#show i=(pow(1,1)=2)
'#show if ((str(7)=str(8))) {} 
'#show if ((("7"<>"8"))) {}
int iif(int x,int a,b) {
if x
  return a
else
  return b
endif
}

i=iif((pow(2,2)==2),10,20)
print i
*/


/*
'int i=("AA">ucase("A"))
'int i=(ucase("A")<"AA")
'int i=(sin(1)>0)
int i=(pow(1,1)=1)
'int i=(asc("Q",1)>70)
'int i
'#show i= ("71">"70") {}
'#show if str(71)>str(70) {}
print i
'int i
'if str(71)>"70"
'print "y"
'endif
*/

/*
$filename "o.exe"
uses RTL64
#show print sqr 3
'print (pow (2,3))
*/

/*
'19:29 22/02/2020
int iif(int a,b,c){}
string s
'iif ((sin(s) == 0), 10, 20)
'int i=(sin(1) == 1)
'int i=(sin(1) == 1)
int i
#show i=(sin(i) == 1 ? 10 : 20 )
print i
*/


/*
int a,b,c,d,e
#show e=(a>b ? c : d)
int iif(int a,b,c) {
  if a
   return b
  else
   return c
  endif
}

print iif((a=b),10,20)
*/


/*
'13:46 22/02/2020
#show atan(-2,3)
#show sin(1)
*/

/*
'13:45 22/02/2020
'$filename "o.exe"
'uses RTL64
'print ( pow(-2,3))
'print str pow(-2,3)
float f(double d){return d}
print f pow(-2,3)
print (f pow(-2,3))
*/

/*
'11:13 22/02/2020
$filename "o.exe"
uses RTL64
DOUBLE d = -2.5654885563273315
'print d
'print pow(1, 2)
'print d^2.0
'print d pow 2
'print atan(1,2)
#show double e=pow(d,2)
print e
#show double e=d pow 2
print e
*/

/*
'19:30 20/02/2020
macro iif int(R,X,A,B)
  if X
    R=A
  else
    R=B
  endif
end macro

string s="qq"
int result

result = iif (ucase(s) = "QQ", 100, -2)
print result
*/

/*
' http://largeint.sourceforge.net/Ackerman.htm

uses console

int c,s,d
sub init_counts()
   c=0 : s=0 : d=1
end sub

' Naive implementation with three recursive calls:
function A (int m, n) as int
   c = c + 1
   s = s + 1
   if s > d then d = s

   if m = 0 then
      function = n + 1
   elseif n = 0 then
      function = A(m - 1, 1)
   else
      function = A(m - 1, A(m, n - 1))
   end if
   s = s - 1
end function

init_counts() : printl "Ackermann function A(m,n) - three recursive calls"
init_counts() : printl "A(3, 7) = " : print A(3,7)  tab " calls: " c " depth: " d '1021
init_counts() : printl "A(3,12) = " : print A(3,12) tab " calls: " c " depth: " d '32765; A(3,13) -> stack overflow
init_counts() : printl "A(4, 0) = " : print A(4,0)  tab " calls: " c " depth: " d '13; A(4,1) -> stack overflow

' Cheat - direct computation for m < 4
function A (int m, n) as quad
   c++
   s++
   if s > d then d = s
      select case m
      case 0
         function = n + 1
      case 1
         function = n + 2
      case 2
         function = 2 * n + 3
      case 3
         function = 2 ^ (n + 3) - 3
      case else
         if n = 0 then
            function = A(m - 1, 1)
         else
            function = A(m - 1, A(m, n - 1))
         end if
      end select
   s--
end function

printl
init_counts() : printl "Ackermann function A(m,n) - direct computation for m < 4 "
init_counts() : printl "A(3, 7) = " : print A(3,7)  tab " calls: " c " depth: " d '1021
init_counts() : printl "A(3,12) = " : print A(3,12) tab " calls: " c " depth: " d '32765; A(3,13) -> stack overflow
init_counts() : printl "A(4, 0) = " : print A(4,0)  tab " calls: " c " depth: " d '13; A(4,1) -> stack overflow
printl
init_counts() : printl "A(3,20) = " : print A(3,20) tab " calls: " c " depth: " d '8388605
init_counts() : printl "A(3,30) = " : print A(3,30) tab " calls: " c " depth: " d '858934589
init_counts() : printl "A(4, 1) = " : print A(4, 1) tab tab " calls: " c " depth: " d '65533; A(4,2) too much -> 19729 digits
init_counts() : printl "A(5, 0) = " : print A(4, 1) tab tab " calls: " c " depth: " d '65533; A(5,1) wrong result


printl "Enter ..."
wait
*/



/*
int a=2
sys p=@a
*(p+0+0) |= 4
print a
*/


/*
#cpointer on
indexbase 0
type node
{
    struct node *prev;
    int n;
    struct node *next;
} *h,*temp,*temp1,*temp2,*temp4;
'#recordof node
'#recordof temp2
node n[16] at getmemory(1024)
'#show n[10].n=42
'#show n[0]->next=n[1]
'#show n->n=42
#show n=22
'#cpointer off
'#show @n=22
*/



/*

'12:01 26/12/2019
'#include "inc\msvcrt.inc"
uses msvcrt

extern

  #define effVendorName 1


  type AEffect
    sys pDispatcher
  end type

  function dispatcher(AEffect*effect,int index, int opcode, int *value, sys pt, float opt) as int*
    switch (opcode)
      case effVendorName:
        copy (pt, "Alexey Longard", 20)
    end switch
    ...
  end function

  function VSTPluginMain() as AEffect*, export
    AEffect *effect
    @effect = malloc(sizeof(AEffect))
    memset(@effect, 0, sizeof(AEffect))
    effect.pdispatcher = @dispatcher
    return @effect
  end function
*/


/*
'.cfg

int sttw
int endw
int ascw

function skipspace(string s, int*i)
===================================
byte b at strptr s
do
  ascw=b[i]
  select ascw
  case 0              : exit do
  case 33 to 255 :    : exit do
  end select
  i++
end do
end function


function skipword(string s, int*i)
===================================
skipspace(s,i)
sttw=i
byte b at strptr s
select b[i]
  case 40,41 : i++ : jmp fwd done
end select
do
  select b[i]
  case 0 to 32 : exit do
  case 40,41 : exit do
  end select
  i++
end do
done:
endw=i
end function

string cbuf 'prog buffer
string dbuf 'data buffer

'for calls
type def_data
=============
  int offset
end type

type eval_data
==============
  sys proc
  int baseparam
  string name
  string result
end type

type param_data
===============
  string express
  string value
end type
end type






function BlockData(string*s, int*i) as string
=============================================
skipspace(s,i)
byte b at i-1+strptr(s)
int lb,rb,d,e,k
def setb k=i+1 : d++
do
  select b
  case 0 : e=i : exit do
  case 1 to 31 : if not lb then e=i : exit do
  case "("  : if not lb then lb=40  : rb=41  : setb
  case "<"  : if not lb then lb=60  : rb=62  : setb
  case "["  : if not lb then lb=91  : rb=93  : setb
  case "{"  : if not lb then lb=123 : rb=125 : setb
  case lb   : d++ 'nesting
  case rb   : d-- : if d<=0 then e=i : i++ : exit do
  case else : if not k then k=i : lb=-1
  end select
  @b++
  i++
end do
skipspace(s,i)
if k then return mid(s,k,e-k)
end function


function ExtractData(string s,w, int i=1) as string
===================================================
  'format: $keyword lbracket data rbracket
  i=instr(i,s,w)
  if i then return BlockData(s,i+len(w))
end function
*/


/*
string s
s=getfile o2dir+"\Oxide.cfg"
    if s
      dir=ExtractData s,  "$dir "
      fi=ExtractData s,   "$file "
      ps=ExtractData s,   "$pos "
      sx=ExtractData s,   "$sizeX "
      sy=ExtractData s,   "$sizeY "
      fnt=ExtractData s,  "$font "
      fnz=ExtractData s,  "$fontsize "
    else
      sx=800
      sy=600
      fnt="Lucida Console" ' Courier
      fnz=12
      dir=o2dir
    end if
...
    s="$dir ["+buf+"]"+cr+
      "$file ["+fo+"]"+cr+
      "$pos [" a "]"+cr+
      "$sizeX [" sx "]" +cr+
      "$sizeY [" sy "]" +cr+
      "$font [" fnt "]"  +cr+
      "$fontsize [" fnz "]"  +cr
    putfile o2dir+"\oxide.cfg",s
*/


/*
'10:12 12/12/2019
'float variadic params are passed in cpu in 64bit mode
$filename "o.exe"
uses rtl64
uses corewin
char c[64] 'string buffer
double v1=123
extern
 'create an overlay of sprintf with variadic prototype
! sprintf (char *s,*f,...) at @sprintf
#show sprintf (c,"%4.2f",v1) '123.00
print c
*/


/*
$filename "o.exe"
uses rtl32

#show {
function f(int a,b) as int
  return f(a,b)
end function
}
*/

/*
$filename "o.exe"
uses rtl64
'uses corewin
'typedef sys quad
quad r,v
end

'#show r = sleep v
#show {
function f(quad q) as quad
#show return q
end function
}
#show r = f v
*/



/*
'12:07 07/12/2019
#define xx(a,b) ( a > b )
#show if xx(2,1) && 1
print "ok"
endif
*/


/*
'19:16 14/11/2019
'jumping back to main
'
$filename "o.exe"
'uses rtl64
sys buf[3]

macro setjmp(label,buf)
=======================
addr rsi,buf
mov [rsi],rbp
mov [rsi+8],rsp
addr rcx,label
mov [rsi+16],rcx
end macro

macro longjmp(buf,value)
========================
addr rsi,buf
mov rbp,[rsi]
mov rsp,[rsi+8]
mov rax,value
jmp [rsi+16]
end macro


function xx()
=============
longjmp(buf,0x42)
print "not ok 1"
end function

function main()
===============
int a=0x12
setjmp(here,buf)
xx()
print "not ok 2"
'
here:
mov a,rax
print hex a '42
end function
'
main()
*/

/*
'13:37 09/11/2019
'macro precedence brackets insertion
macro m(a)
if a=0 and a=0 then
endif
end macro
#recordof m
*/

/*
'12:44 09/11/2019
'sheme and basic compare
'(define fibo*
'   (lambda (a b x)
'     (if (= x 0) a
'        (fibo* b (+ a b) (- x 1)))))
'
function fibo(int a,b,x) as int
  if x=0 then return a else return fibo(b,a+b,x-1)
end function
'
function fiboloop(int a,b,x) as int
do
  function=a
  if x<=0 then exit do
  a=b
  b+=function
  x--
loop
end function
'
print fibo(1,1,5) '1 2 3 5 8 ...
*/


/*
'04:18 06/11/2019
int a,b,c
a=b=c
'print a '-1
a= b=c and c=b
print a '-1
*/

/*
'04:18 06/11/2019
double i
if i !=1 and i !=0
  print "ok"
endif
*/

/*
'04:18 23/10/2019
' at address
function f(sys p)
double d at p
#show d=0
end function

function f(double*d)
#show d=0
end function
*/


/*
'15:34 06/10/2019
void**x
#recordof x
*/


/*
'
$filename "o.exe"
uses rtl64
uses corewin
xx:
int *a
@a=@xx
'a=42
print "ok"
exitprocess 0
*/


/*
uses tt.asc
*/


/*
'14:15 25/09/2019
'print 2.0000^-2
'print 1/0
'print 0/0
'print ( (1/0) / (1/0) )
'print 0\0

float inf=1/0       'create infinity variable
'print inf + inf     '#inf
'print inf - inf     '#qnan
'print inf * inf     '#inf
'print inf / inf     '#qnan
'print 1/inf         '0
'print 0/inf         '0
'print inf/0         '#inf
'print inf/2         '#inf
'print deg(atn(inf)) '90
print inf==inf  '-1
print inf==0    '0
print inf==1    '0
print inf<>inf  '0
print inf<>-inf '-1
print inf<inf   '0

*/



/*
'16:56 20/09/2019
$filename "o.exe"
uses RTL64
uses corewin

  function HelloA(string s) as string
    return "HelloA "+s
  end function

  function HelloW(wstring s) as wstring
    'messageboxw 0,s,"Q",0
    function="HelloW "+s
  end function

  print HelloW "World!"
print "ok"
  'messageboxw 0, HelloW("World!"),"q",0
*/


/*
'19:31 19/09/2019

int a

sub print( string s)
  a=prior print(">>: "+s)
end sub

a=print "Hello" '>>: Hello
a=prior print "Hello" 'Hello

*/



/*
'19:47 17/09/2019
'bind block
sys p
bind p
 int a
 int b
end bind
*/

/*
'19:32 17/09/2019
'shared memory between 32/64 bit processes
'http://msdn.microsoft.com/en-us/library/aa366551(VS.85).aspx
$filename "o.exe"
uses rtl32
uses corewin
sys hMapFile,pBuf
'configure for read/write 0x1000 mem space
hMapFile=CreateFileMapping(sys -1,0,4,0,0x1000,"OurVars01")
pBuf=MapViewOfFile(hMapFile,7,0,0,0x1000)
if pBuf
  bind pBuf {
    int a
    int b
    int c
    float f
    char s[0x100]
  }
  a=1
  b=2
  c=3
  f=1.5
  s="hello"
  print "Server ready (press 'OK' to close)"   
  UnmapViewOfFile(pBuf)
  CloseHandle(hMapFile)
endif
*/
----
/*
uses corewin
sys hMapFile,pBuf
hMapFile = OpenFileMapping(7,0,"OurVars01")
if hMapFile
  pBuf = MapViewOfFile(hMapFile,7,0,0,0x1000)
  bind pBuf {
    int a
    int b
    int c
    float f
    char s[0x100]
  }
  string cr=chr(13,10)
  print a cr b cr c cr f cr s cr
  UnmapViewOfFile(pBuf)
  CloseHandle(hMapFile)
endif
*/



/*
'10:44 14/09/2019
$filename "o.dll"
$dll
uses rtl32
'sharable globals
int a=1
int b=2
int c=3
float f=1.5
string s="hello"

function shareGlobals() as sys export
=====================================
return @a
end function
----
*/

/*
'10:52 14/09/2019
extern lib "o.dll"
! shareGlobals
end extern
sys sg=shareGlobals()
bind sg {
 int a
 int b
 int c
 float f
 string s
}
'#recordof f
string cr=chr(13,10)
print a cr b cr c cr f cr s cr
sys aa=@b
'#show int bb at (aa)
int bb at aa
#show print bb
*/

/*
'00:46 13/09/2019
'qword 32/64
$filename "o.exe"
uses rtl64
qword a=0xaaaaaaaa
print hex(a) chr(13,10) hex(a+2)
*/

/*
'11:31 10/09/2019
'test quad bitwise logic
'itr
$filename "o.exe"
uses rtl64
quad q,r
q=-1
r=quad 0x123456789
'#show q = q and r
#show if r
  print hex r
endif
*/

/*
sub clear(sys p, int n)
=======================
mov ecx,n
mov rsi,p
(
 dec ecx : jl exit
 mov byte [rsi],0
 inc rsi
 repeat
)
end sub

int a=-1
clear @a,4
print a
*/

 
/*
'14:57 26/08/2019
macro mm (a,#rest)
  int a={#rest}
end macro

mm(aa,10,20,30,40,50)
print aa[3] "  " countof 
*/

/*
'14:56 26/08/2019
function f(char*s)
  print s
end function
'
f ("hello1")
f (("hello2"))
f (bycopy "hello3")
f (bycopy ("hello4")) 'fails
*/

/*
'11:14 23/08/2019

uses console
indexbase 0
'
'multiassin tests
function f(float*v,int n)
indexbase 1
int i
for i=1 to n
print i "  " v[i] cr
next
end function
'
f (float{10,20,30,40},countof)
wait
*/



/*
'10:38 22/08/2019
'address error
int a
@a=4
*/


/*
'14:18 22/08/2019
'member numeric names
type rec
  int 0,1,2,3,4,5
end type
'#recordof rec
rec r[100]
r[2].2=22
r[2].3=45
print r[2].3 " " r[2].2
*/

/*
'11:13 22/08/2019
int vidx={1,2,3}
string vx[100]
int i
for i=1 to 100 : vx[i]="" : next
vx[2]="ok"
def support_strptr   
    function %1s(byval int n) as sys {return strptr(v%1[vidx[n]])}           
end def
#recordof support_strptr
support_strptr x
print xs(2) " " (string) xs(2)

/*
'o2 typecodes hexadecimal
'
  sbyte 1,
  short 2,
  long 4,
  byte 21,
  ubyte 21,
  word 22,
  dword 24,
  quad 48,
  qword 58,
  single 64,
  double 68,
  extended 6A,
  char A1,
  wchar A2,
  zstring A1,
  wzstring A2,
  bstring C1,
  wbstring C2,
  string E1,
  wstring E2,

  'ranges for primitives:

  signed ints   01..1f
  unsigned ints 21..3f
  floats        61..7f
  char          A1..BF
  bstrings      C1..DF
  strings       E1..FF

  classes and UDTs:

  0x200 ...
*/
/*
'04:52 21/08/2019
'                  suf dtt num
'------------------------------
def generateModule '%1_%2_%3   
    function %1_%2_%3(%2 p1) as %2
          #if typecodeof(%2) >= 0x200
               ' udt code
          #elseif typecodeof(%2) > 0xa0
               ' string code...
          #elseif typecodeof(%2) > 0x60
               ' float code...
          #elseif typecodeof(%2) >  0
               ' int code...
               return p1*3
          #else
               ' unidentified
          #endif
     end function
end def 

generateModule x int 3
print x_int_3(7) '21
*/

/*
'12:07 20/08/2019
'variadic chr
function chrs(int n,...) as string
if n>0
  function=nuls n
  byte b at @param 'param base on stack
  byte c at strptr function
  while n
    @b+=sizeof sys 'next param on stack
    c=b
    @c++
    n--
  wend
endif
end function
'
byte a=0x41 'A
byte b=0x42
byte c=0x43
print chrs(5,a,b,c,0x44,0x45) 'ABCDE'
*/

/*
'08:45 20/08/2019
'address assignment error
string s1 = "A"
    string s2 = "B"
    string s3 = "C"

    byte ptr p1
    byte ptr p2, ptr p3  ' use ptr or '*' for each variable
     
    @p1 = StrPtr(s1)
    @p2 = StrPtr(s2)
    @p3 = StrPtr(s3)

byte p4
#show @p4 = StrPtr(s3) 'itr address resolution

   
    print chr(p1) chr(13, 10)
    print chr(p2) chr(13, 10)
    print chr(p3) chr(13, 10)
   
    'print chr(p1, 13, 10) ' Compilation time error.
'itr mixing chr variables and nums
*/


/*
'12:24 19/08/2019
declare f (int,string) as string
print f(1,"Q")
function f (byval int a, byval string b) as string {return a+b}
*/

/*
'03:13 20/08/2019
'unprototyped function with float params
function f(double v) nosig
end function
'
'#show f 5.0
'#show f double 5.0
'#show f convert double 5.0
'#show f cast double 5.0
#show f 5.0 / 1
*/

/*
'12:24 19/08/2019
declare f (byval int, byval string) as string
print f(1,"Q")
function f (byval int a, byval string b) as string {return a+b}
*/


/*
'12:24 19/08/2019
declare f (byval int a, byval string b) as string
print f(1,"Q")
function f (byval int a, byval string b) as string {return a+b}
*/


/*
'12:34 17/08/2019
'int a[100]
'a[1]=>1,2,3,4,5
class aa
  int a,b,c,d,e
  string s
  int g
  method m1(){}
  method m2(){}
end class
#recordof aa

function f(aa*a)
'a[1]=>1,2,3,4,5,"X"
'a[1]<=1,2,3,4,5,"X"
'a[1]<=(1,2,3,4,5,"X")
'a[1]<={1,2,3,4,5,"X"}
'a[1]={1,2,3,4,5,"X",7}
a={1,2,3,4,5,"X",7}
print a.b a.s a.g
end function
aa a
f a
*/


/*
'12:34 17/08/2019
type color
  byte r=0x10
  byte g=0x20
  byte b=0x30
  byte a=0x40
  char cls[200]="Q"
  byte w=0x50
end type
'#recordof color
color c
'#show typeof c d
'c={10,20,30,40,"Q",50}
#show c={.w=7}
print c.g " " c.cls " " c.w
*/

/*
$filename "o.exe"
uses rtl64
string s
print ltrim(rtrim(s))
print "ok"
*/

/*
'12:26 15/08/2019
'forb iteration expression
int i
int bg(){i=1}         'begin
int en(){return i<=3} 'limit
int st(){i++}         'step
int it(){print i}     'action
'for bg();en();st(){it()}
for ;en();st(){it()}
*/

/*
'11:37 10/08/2019
'sructured assembler
'
'
'addr
'(
'  exit
'  repeat
')

'do loop

mov ecx,10
(
  dec ecx
  jl exit
  ...
  repeat
)

'if
(
  cmp eax,10
  jge exit
  ...
)

'if elseif
'case
mov eax,15
(
  (
    cmp eax,10
    jge exit
    ...
    exit 2
  )
  (
    cmp eax,20
    jge exit
    ...
    exit 2
  )
  mov eax,-1
)

'while
mov ecx,10
(
  cmp ecx, 0
  jle exit
  ...
  dec ecx
  repeat
)

int i
mov i,ecx
print i
*/


/*
'14:22 07/08/2019
string s="abcdef"
print mid(s,-2) 'ef
*/

/*
$filename "o.exe"
uses rtl64
function f() as dword
end function
#show sys v=f
*/


/*
string c$&$="abc"
print c$&$
*/

/*
$filename "o.exe"
uses rtl64
type vv
int i
char c[20]
end type
vv f
'char
bstring k="qwerty"

#show int i=asc(k)
*/


/*
$filename "o.exe"
uses rtl64
type vv
int i
char c[20]
end type
vv f
byte b at @f.c
'#show byte b=asc(f.c)
#show if b<>46 {}
'#show if asc(f.c)<>46 {}
*/


/*
$filename "o.exe"
uses rtl64
sys v[2]
addr r8,v
mov rax,0x12345678
'inc r8
mov al,ah
mov [r8],ax
print hex v
*/

/*
$filename "o.exe"
uses rtl64
type vv
int i
char cfilename[20]
end type
vv f
#show if (f.cFileName <> ".") and (f.cFileName <> "..") {}
'char f[20]
'string f=" "
'char d1="."
'char d2=".."
'#show if (f <> d1) and (f <> d2) {}
print "ok"
*/

/*
'22:46 02/08/2019
'variadics all passed in cpu
$filename "o.exe"
uses rtl64
uses corewin
char c[64]
double v1=123, v2
extern
! sprintf (char *s,*f,...) at @sprintf
'movsd xmm0,v1
'movsd xmm1,v1
'movsd xmm2,v1
'movsd xmm3,v1
'movsd v2,xmm0
'mov r8,v1
'mov r9,v1
#show sprintf (c,"%4.2f %4.2f",v1,v1)
print c " ok " v1
*/

/*
$filename "o.exe"
uses rtl64
'uses corewin
#ifdef mode64bit
  extern lib "msvcrt.dll"
#else
  extern lib "msvcrt.dll" cdecl
#endif
! sprintf (char *s,*f,...)
end extern
'
type vv double x,y,z, char c[32]
vv v at getmemory(sizeof(vv)*10)
v={10,20,30}
char s[256]
'! sprintf cdecl (char *s,*f,...) at @sprintf
'sprintf s,"%s %4.2f", "Q", double v.y
'#show sprintf s,"%s %4.2f %4.2f", "Q", 200.0+1,v.y
char s1="Q"
print "ok"
#show sprintf s,"%s ", s1
print s "   " v.y
print "ok"
freememory @v
*/


/*
'10:34 01/08/2019
'fix indirect floats / noprototype
'$filename "o.exe"
'uses rtl32
type vv float x,y,z, string s
vv v at getmemory(sizeof(vv)*10)
int f(vv*v){}
!*g
@g=@f#vv
int h(int n,...){}
end
#show g(1,double v.y)
*/

/*
'23:40 31/07/2019
int f(int a,b[],n){print b[2] : return 5}
print(f(20,INT {11,22,33,44},30))
*/

/*
'17:55 29/07/2019
int a,b,c
'#show if not a>b {}
'#show if not a {}
'#show if (a>b)&(a=b){}
'#show if (a>b)and(a=b)or(a=b) {}
'#show c=a>b and b<a and 33
#show if a>b and b<a and 33{}
*/

/*
'14:32 29/07/2019
$filename "o.exe"
uses rtl64
int a,b,c
#show c=(a>b)&&(a=b)
print c
*/

/*
'11:57 29/07/2019
function abc(int i=0,j=2,) as long
print i "  " j
end function
int i=32
INT a = abc(i = 32,)
'print "ok"
#recordof abc
*/

/*
$filename "o.exe"
uses rtl64
int a,b,c
#show c=not((a<=b)and(a>=b))
print c
*/

/*
'15:11 28/07/2019
'compound assignment
int a,b,c,d =5
a := b := c := d
print a " " b " " c " " d
*/

/*
byte c=4
c=(c=4)
print c
*/

/*
'10:07 27/07/2019
'local / global string allocation
type vv string x,y,z
function f(vv*s)
#show s.x="A"
end function
*/

/*
10:08 27/07/2019
'conversion / comparison
word w=0xffff
int i=w
'print  w "   " i

short a=0xffff
int i=a
'print a "   " i


'left side determines type
'literal numbers are treated as 32bit int or 64bit float
print typeof(1)
print typeof(1.5)

if w=-1
  'print "ok1"
endif

if (cast word -1)=w
  print "ok2"
endif

if (convert word -1)=w
  'print "ok2"
endif

if 1=-w
  'print "ok3"
endif
*/

/*
'13:28 26/07/2019
uses addresources
print "okay"
*/

/*
'09:53 26/07/2019
int f(byref int*a){}
#recordof f
*/


/*
'09:52 26/07/2019
class THECLASS
    method constructor(int a)
    end method
end class

FUNCTION THESUB(THECLASS *v) AS INT
    ' nothing
END FUNCTION

' This works fine.
NEW THECLASS a(1)
THESUB(a)
...
DEL a

static THECLASS a2
#recordof a2
a2.constructor(2)
THESUB(a2)

'' This raises compile-time error.
'NEW STATIC THECLASS a2(2)
'THESUB(a2)
*/

/*
char*c,*d
@c=strptr "okay"
@d=@c
print d
*/


/*
'15:14 23/07/2019
'https://docs.microsoft.com/en-gb/windows/win32/multimedia/playing-wave-resources
'  // TEST
'  uWAV0001 WAVE c:executing.wav
$filename "t.exe"
uses rtl32
% SND_SYNC   = 0
% SND_RESOURCE = 262148 '0x40004

DECLARE FUNCTION PLAYSOUND LIB "WINMM.DLL" ALIAS "PlaySoundA" (azsSound AS ASCIIZ, BYVAL hModule as SYS, BYVAL  Opts AS DWORD) AS INT
DECLARE FUNCTION PBMAIN() AS INT

FUNCTION PBMAIN() AS INT
   sys h=GetModuleHandle(0)
   IF PLAYSOUND("WAV0001", h, SND_RESOURCE OR SND_SYNC) THEN
      print "Sound played"
   ELSE
      print "Could not play sound"
   END IF
END FUNCTION

PBMAIN() ' invoke entry point
*/



/*
'09:04 24/07/2019
'pseudopointer
function f(char*s){}
int i
#show f( (char*) i )
*/


/*
'19:13 23/07/2019
'LinkList_1.o2bas
'Singly linked List

uses console

type record
===========
  int num
  bstring name 'not string
  record *nextptr 'pointer to next record
end type

class LinkedList
================

  record startRecord
  int start

  sub constructor(int n)
  start=n
  end sub

  sub destructor()
    record *List
    @list = @startRecord.nextptr
    while @List
      frees list.name
      sys p=@list
      @List = @List.nextptr
      freememory p 'free prior record
    wend       
  end sub

  function newRecord() as record*
    sys address = getmemory sizeof(record)
    if address = 0 then printl "Cannot allocate memory for record"
    return address
  end function

  sub createRecords(int n)
    record *List
    int num = 100
    int i
    '
    @List=@StartRecord
    for i = 1 to n
      @List.nextptr = newRecord()
      @List = @List.nextptr
      List.num = num
      List.name = "Name" + str(num)
      printl "Input data for node " + i + " = " + List.num + " " + List.name  + ", nextptr = " + @List
      num += 1
    next i               
  end sub

  sub displayList()
    record *List
    @list = @startRecord.nextptr
    int ix = 0
    while @List
      ix += 1     
      printl "Data Node " + ix + " = " + List.num + " " + List.name  + ", nextptr = " + @List
      sys *tmp : @tmp = @List
      @List = @List.nextptr
      if @List = 0 then
         printl
         printl "nextptr " + @tmp + ": Empty List, nextptr = " + @List
         exit while
      end if   
    wend       
  end sub

end class 'LinkedList


sub main()
   new linkedList li(1)
   int n = 5
   
   print  "Create and display Singly Linked List"
   printl "-------------------------------------" + cr

   li.createRecords(n)
   printl
   li.displayList()
   
   printl
   printl "Enter ..."
   del li
   waitkey
end sub

main()
*/

/*
macro cc_op()
  macro .free(a,b)
    a.destructor()
    print b "  "
  end macro
end macro

class cc
 sub destructor()
 print "d"
 end sub
end class

cc c
'del c
*/

/*
'18:04 22/07/2019
int i,j,k=-1
for i=3 to 1 step k
j++
next
print j
*/

/*
'18:03 22/07/2019
int i
#show{
for (,i<3,i++)
  print "ok"
  'exit for
next
}
*/

/*
'15:25 22/07/2019
int i,j,k=1
#show{
for i=1 to j 'step k
next
}
*/


/*
'11:25 22/07/2019
'syntax: support ",)"
print mid(
  "abcdefgh",
  3,
  4, 'allow comma
)

int f
(
  int x,
  int y,
  int z,
)
{
 print x y z
}
f(1,2,4)
f(1,2,4,)
*/

/*
'LinkList_1.o2bas
'Singly linked List

uses console

type record
   int num
   bstring name
   record *nextptr 'pointer to next record
end type

class LinkedList
================

  record startRecord
  int start

  sub constructor(int n)
  start=n
  end sub

  sub destructor()
    record *List
    @list = @startRecord.nextptr
    while @List
      frees list.name
      sys p=@list
      @List = @List.nextptr
      freememory p 'free prior record
    wend       
  end sub

  function newRecord() as record*
    return getmemory sizeof(record)
  end function

  sub createRecords(int n)
    record *List
    int num = start
    int i
    '
    'CREATE RECORDS
    @List=@StartRecord       
    for i = 1 to n
      @List.nextptr = newRecord()
      @List = @List.nextptr
      List.num = num
      List.name = "Name " + chr(num-32)
      printl "Input data for node " + i + " = " + List.num + " " + List.name
      num += 1
    next i               
  end sub

  sub displayList()
    record *List
    @list = @startRecord.nextptr
    int ix = 0
    while @List
      ix += 1     
      printl "Data Node " + ix + " = " + List.num + " " + List.name
      @List = @List.nextptr
    wend       
  end sub

end class 'LinkedList


sub main()
   new linkedList li(100)
   int n = 3
   
   print  "Create and display Singly Linked List"
   printl "-------------------------------------" + cr

   li.createRecords(9)
   printl
   li.displayList()
   
   printl
   printl "Enter ..."
   del li
   waitkey
end sub

main()
*/


/*
'11:24 21/07/2019
int i
'for i=1,i<10,i+=3 {print i}
'for i=1,i<10,i+=3 { 
'print i '1 4 7
'}
'
'for i=1,i<100,i*=3 {print i} ' 1 3 9 27 81
'
'for i=1,i<100,i*=3
'  print i ' 1 3 9 27 81
'next
'
string i
int c=65
#show{
for i="A", len(i)<10, i+=chr(c)
  c++
next
}
print i 'ABCDEFGHIJ
*/


/*
string i,b="A",j="AAAAAA",k="AA"
int c
'#show {
for i=b to  <j step k
c++
next
'}
print i " " c 'AAAAAAA 3
*/

/*
'11:01 21/07/2019
int i,j=10,k=3
#show {
for i=1 to  <j step k
print i
next
}
print "ok"
*/

/*
for i=b to e step s 
  ...
next

----->

i=b
._for
  if s>0
    if i>e
      jmp fwd ._end_for
    end if
  else 's<=0
    if i<e
      jmp fwd _end_for
    endif
  endif
  '
  ...
  '
  ._next
  i+=s
  jmp _for
._end_for
*/

/*
int i = 0
int f(){return 2}

for i = 9 to 5 Step -f()
   print i       
next i

print "done." '9 7 5 done
*/


/*
'12:59 16/07/2019
'stepper functions
int i,j
int f(int i){print i : return 10}
for i=1 to 100 step f(i) 'i=1
  j+=10
next
print j
*/

/*
'16:19 18/07/2019
end
int m,i,a,l
#show {
select a
case 1
    m=i
    do
      i++
      if i>l
        exit do
      endif
      'a=bb(i)
      if a<48
        exit do
      endif
    loop
end select
}
print "ok"
*/

/*
'16:16 18/07/2019
int i,j
#show {
while i>1
i--
exit while
continue while
wend
}
print "ok"
*/

/*
'13:22 18/07/2019
#show {
do {
  do {
    exit do
  }
  exit do
}
}
print "ok"
*/

/*
'13:06 18/07/2019
#show {
function f()
  exit function
end function
}
print "ok"
*/

/*
'12:08 18/07/2019
int i,j
#show {
do
select i
case 1
case 2
  select j
  case 1
  case 2,3,4 to 10
    exit do
  end select
end select
exit do
loop
}
print "ok"
*/


/*
'12:00 18/07/2019
int i,j
#show {
do
for i=1 to 2
  for j=1 to 2
    exit do
  next
next
exit do
loop
}
print "ok"
*/

/*
'11:36 18/07/2019
int i,j
#show {
do
if i
  if j
    exit do
  endif
endif
exit do
loop
}
print "ok"
*/


/*
'#unique on
#show {
do
  exit do
  continue do
  do
    exit do
    continue do
  enddo
enddo
}
print "ok"
*/

/*
$filename "o.exe"
uses rtl64
int line(int i,string s){}
int linei(int i,int s){}
int i=1,a=1,b=3
string s="qwerty"
'! g at @line#int#string
'#show linei(i,instr s,s)
'#show linei(i,line i,s)
#show linei(i,linei i,a)
*/


/*
'15:11 16/07/2019
$filename "o.exe"
uses rtl64
extern
class cc
int f(string s, int i){print s+i}
end class
'
'#show f "ok",7
'#show string s=mid("abcd",2,2)
'print s
cc c
#show c.f("ok ", 7)
*/



/*
int i,j
i=5
jmp fwd .aa 'limit precalc
for i=1 to 10
  ..aa
  j+=16
next
print j
*/

/*
'12:13 16/07/2019
int i,j
'#show {
for j=1 to 0
..x07
..x06
..x05
(
)
'if i>0
'endif
..x08
goto .x07
next
'}
print "ok"
*/


/*
'12:13 16/07/2019
   int ite0007
   gosub .FNini0007
   goto .FNind0007
    ..FNini0007
       int iti0007 = 1
       RET
    ..FNind0007
   'select case 1
   'case 1
   'do
   '  exit do
   'if 0
   '(
   for ite0007 = 0 TO 2 step 1
   'while 0
   '
   ..FNst0007

   ..BBCmiddles
      print "Hello world"
           
      if iti0007 = 0 then
         gosub .FNini0007
      end if
      goto .FNst0007
   NEXT
   ite0007++
   'wend
   ')
   'endif
   'loop
   'end select
*/

/*
'09:48 15/07/2019
type vector float a,b,c

type vector
  double x,y,z
end type

function f(vector v, int n)
  print v.x ", " v.y ", " v.z ",   " n
end function

vector v{ 1.5, 2.5,3.5 }
'
f v,10
'
f byval v, 20

! g at @f#vector#int
g byval v, 30
print "ok"
*/




/*
'04:27 03/07/2019
'09:55 15/07/2019
'
'restricted proc labels
'
'goto .inside1 'error

function f1()
  'goto .inside1 'ok
  if 0
    ..inside1
    print "inside1"
    exit function
  endif
  'goto .inside1 'ok
  'goto .inside2 'error
end function

function f2()
  'goto .inside2 'ok
  if 0
    ..inside2
    print "inside2"
    exit function
  endif
  'goto .inside2 'ok
  'goto .inside1 'error
end function

'goto .inside1 'error
'goto .inside2 'error

f1
f2
'print "ok"
*/



/*
extern virtual
class cc
! aa
! bb
! cc
end class
#recordof cc
*/

/*
'type rgba   byte r,g,b,a
'#recordof rgba

'type rgba
'byte r,g,b,a
'#define xx print "ok"
'end type
'xx
def colo
  byte r,g,b,a
  =
  int c
end def

type rgba
 colo
end type
#recordof rgba
*/


/*
'05:32 10/07/2019
extern
class bb
  int b1,b2
  float s1,s2
end class
class cc
bb bf
int a,b,c
double d,f
int f1(
  int v,
  int w,
){}

int f2(int v, int w,){}

end class
#recordof cc
int f(int v, int w,){}
'print "ok" f(1,2)
'#recordof f
*/

/*
'05:27 10/07/2019
class cc
int m(int a,int b
){}
end class
'#recordof cc
print "ok"
*/

/*
'05:21 10/07/2019
'uses com\variantutil
'print "ok"
type tt
  tt*s
  t as tt *
end type
'print "ok1"
#recordof tt
*/

/*
'11:56 09/07/2019
'structure stress tests
typedef void *pvoid
type qq
  void *p
end type

type tt
qq *q
end type
print "ok1"
*/

/*
21:12 08/07/2019
'variant returns

int hResult

macro retbstr bstring (retv, comcall,   pvarval,cc)
===================================================
VARIANT pvarval
def cc %1(pvarcall,%2)
hResult=cc comcall
retv=varval.pbstrVal
end macro

bstring s=retbstr(oServerXMLHTTPRequest.responseBody() )


macro retv VARIANT* (retv, comcall,   cc)
=========================================
def cc %1(retv,%2)
hResult=cc comcall
end macro

VARIANT v=retv(oServerXMLHTTPRequest.responseBody() )
print v.pbstrval
*/

/*
type t
int a
bstring*b
end type
#recordof t
bstring s
t v
#show s=v.b
*/

/*
'17:33 06/07/2019
'
$filename "o.exe"
uses rtl64
uses com\variantutil
'#recordof VARIANT
function f (double d,VARIANT v,w, double d) as int, export
#recordof v
#recordof w
#recordof d
end function
'#recordof f
VARIANT p,q
double d
#show f(d,p,q,d)
print "ok"
*/


/*
'15:30 05/07/2019

uses console


'PACK FORMAT: PSEUDO-BSTRINGS: LENGTH DATA NULLS...


sub AppendLen(string*s, int*k, string*wt)
=========================================
  'base 0 index
  sys p=strptr(wt)
  int lw at p-4 'length field
  int ls=len s
  int le=lw+6 'include 2 null bytes
  if ls<k+le
    s+=nuls(le+4096) 'stretch buffer
  endif
  copy strptr(s)+k,p-4,le
  k+=le
end sub


function PackCount(string*s) as int
===================================
  int ls=len(s)
  sys ps=strptr(s)
  int i,j
  int *lw
  'count elements
  while i<ls
    @lw=ps+i
    i+=6+lw      
    j++
  wend
  return j
end function


macro PackStr(s,d,n,  i,j,dp)
=============================
'for strings and pointered primitives
' s  pack-buffer string (in/out)
' d  name of array (in)
' n  count of array elements (in)
  int i,j
  j=len(s)
  typeof d *dp
  @dp=@d
  for i=1 to n
    AppendLen(s,j,dp)
    @dp+=sizeof(d)
  next
  s=left(s,j)
end macro


macro UnpackStr(s,t,d,n,  i,le,dp)
==================================
'unpack(s,t,d,n)
'for strings and pointered primitives
' s  pack-buffer string (in)
' t  type of array (in)
' d  name of dynamic array (in)
' n  count of elements (out)
  int i,*le
  #ifndef n
    int n
  #endif
  n=PackCount(s)
  redim t d(n)
  t dp at @d
  sys sp=strptr s
  'fill array
  bstring b
  for i=1 to n
    @le=sp 'length field
    sp+=4  'string data
    (sys) b=sp
    dp=b
    sp+=le+2 'skip null bytes terminator
    @dp+=sizeof(t)
  next
end macro


macro DisplayArray(s,n)
=======================
scope
  indexbase 1
  int i
  for i=1 to n
    print s[i]
    if i<n
      print ", "
    endif
  next
  printl
end scope
end macro


redim string s1(4)
s1={"The", "quick", "brown", "fox"}
redim string s2(5)
s2={"jumped", "over", "the", "lazy", "dog"}

string buf
int bi
int n1=4,n2=5
packstr(buf,s1,n1)
packstr(buf,s2,n2)
unpackstr(buf,string,s3,n3)
DisplayArray(s3,n3)
'
'OTHER PRIMITIVES
'
float f={10,20,30,40}
'bi=0 'to clear buf
'
packstr(buf,f,countof f) 'append float array
unpackstr(buf,string,s3,n3)
DisplayArray(s3,n3)
'
unpackstr(buf,int,v,n3) 'unpack into integer array
DisplayArray(v,n3)
'
waitkey

*/


/*
'15:07 01/07/2019
#compact
indexbase 0
uses oxsc\lexa
uses oxsc\lexi
uses console

function WordSpacer(string s="") as string
==========================================
int a,b,i,j,ns,op,qp,ap
string t,W
i=1
j=0
do
  w=wrd(s,i)
  if lenw=0 then exit do
  a=0
  ns=0
  if ascw=64 '@
    a=ascw
  elseif ascw=58 ' :=
    if ascn=61
      if i=swd+1
        lenw++
        i++
        a=ascw
      endif
    endif
  else
    op=identop(s,swd,i)
    if op
      a=ascw
    endif
  endif
  if a
    b=asc(s,i)
    lenw=i-swd
    select ascw
    case 38,42,64 '&& *** && @@ ...
      do
        b=asc(s,i)
        exit when b<>ascw
        i++
        lenw++
      loop
    end select
    '
    if b=61
      '+= *=
      i++
      lenw++
    endif
    w=mid(s,swd,lenw)      
    '
    if qp=0
      ns=1
    endif
    '
    op=1 'catch all
    '
  endif
  qp=0
  if op=0
    select ascw
    case 40,44,58,59,91,123: '(,:;[{
       qp=0 'expect no binary operator next
    case else
      qp=1 'expect a binary operator next
    end select
  endif
  appe(t,j,w)
  '
  skiplspace(s,i) 'ascn
  ap=0
  select ascn 'next start char
  case 10,13
    endline(s,i)
    appe(t,j,cr)
    qp=0 'expect no binary operator next
  case 40,44,58,59,91,123: '(,:;[{
    if ascn=58
      if asc(s,i+1)=61 ' :=
        ap=1
      endif
    elseif qp=0
      ap=1
    endif
  case else
    if ns=0
      ap=1
    endif
  end select
  if ap
    appe(t,j," ") 'right space
  endif
loop
return left t,j
end function

'TEST:
======
print WordSpacer("
-42 + -42
-a + -a
-a / -a
-a/+a
-a / a
+e, +e, -e
a+=b
a+=(b)
a={{1,2,3}}
a:=b
if     a:=b[-9] and c=d[7*3]+4
  &a=&f(++b,c+@d,-e/**g /*g++--  )
  a shl=&h4
endif
")
waitkey
*/


/*
'10:39 30/06/2019
'test unicode conversions
indexbase 0
uses minwin
uses oxsc\lexa
uses oxsc\lexi
uses oxsc\utfs
string ff="o2testsunicode.o2bas"
string s=getfile ff
'messageboxW 0,s,L"ok",0
ConvertUTF s,1
ConvertToUnicode s
string bom
bom=chr(0xff,0xfe)
putfile "o.txt",bom+s
'print 123
*/


/*
'14:53 01/07/2019
'location test
uses oxsc\lexa
print "ok"
*/


/*
'14:49 01/07/2019
'Array concatenation

uses console

redim string s1(4)
s1={"The", "quick", "brown", "fox"}
redim string s2(5)
s2={"jumped", "over", "the", "lazy", "dog"}
'
'FAST CONCATENATION BUT STRINGS REMAIN LINKED
redim string s3(0)
s3_buf = s1_buf + s2_buf
@s3 = strptr s3_buf
'
int i
for i=1 to 9
  print s3[i] " "
next
printl
s1[4]="bear" 'ALSO AFFECTS S3
for i=1 to 9
  print s3[i] " "
next
printl
printl "Enter ..." : waitkey()
*/




/*
'03:07 30/06/2019
'rsp alignments
$filename "t.exe"
uses rtl64
uses minwin

jmp fwd begin

msg:
====

sub rsp,40
' sub rsp,8  'to realign rsp after stacking return address
' sub rsp,32 'to provide spill zone
call messagebox
' add rsp,32
' add rsp,8
add rsp,40
ret

 
begin:
======
mov rcx,0
"Hello"
mov rdx,rax
"Test Message"
mov r8,rax
mov r9,0
call msg
*/


/*
'02:50 30/06/2019
'support backward globel labels
function f()
{
  'goto .b
  {
    {
     ..b
    }
  }
  goto .b
}
print "ok"
*/


/*
'22:02 29/06/2019
'global labels
int a=0
'goto .inside
if a
  if a
    ..inside
    print "here inside"
    goto done
  endif
endif
goto .inside
.done
*/


/*
'11:15 28/06/2019
'extended support
$filename "o.exe"
uses rtl32
extended f(extended v)
{}
'
extended a,b
#show a=f(b)
*/

/*
'11:10 28/06/2019
'exit code test
uses sysutil
print exec("o.exe",1)
*/

/*
$filename "o.exe"
uses rtl32
return 123
*/

/*
'04:01 27/06/2019
'+numbers
print val("+15") ", " val("-12")
*/


/*
'17:56 25/06/2019
#compact
indexbase 0
uses lexa
uses lexi
uses console
int i=1
print precedence("a>b and a<c",1,0) cr
print precedence("b+c*d and a>b or b>c",1,0) cr
wait
*/
 
/*
'17:57 25/06/2019
uses console
sub print(string s)
prior print ">>" s
end sub

sub print()
print "<>"
end sub

print
print "ok"
'undef print
'print "ok"
wait
*/

/*
'12:59 22/06/2019
'decouple lexa and lexi
indexbase 0
uses lexa
uses lexi
uses utfs
string s="yy"
print dic(" x 1, yy 21, z 3, ",s)
*/

/*
'09:49 21/06/2019
print " " o2version
print " " version
*/

/*
'17:59 19/06/2019
'test returns byval members
class cc
int k
method mm() as cc
  'method.k=3
  method={4}
end method
end class

cc c,d
d=c.mm
print d.k
*/


/*
'17:54 19/06/2019
'test function return expressions
int f(){
  function=(function shl 1)+1
  function=(function shl 1)+1
}
print f
*/

/*
'04:35 18/06/2019
'test address of function
! f() at [ebx+512]
'int f(){}
! g() at @f
#recordof g
#show sys a=@f
*/


/*
'04:33 18/06/2019
$ filename "s.exe"
uses rtl64
'#show [rbx+512]=[rbx+512]
print "ok"
*/

/*
'23:07 17/06/2019
'SET FUNCTION VECTOR DIRECTLY
! f() at [ebx+512]
#recordof f
*/


/*
'10:47 16/06/2019
'Test repeated CreateProcess
uses corewin


'  type STARTUPINFO
'  dword  cb
'  char*  lpReserved
'  char*  lpDesktop
'  char*  lpTitle
'  dword  dwX
'  dword  dwY
'  dword  dwXSize
'  dword  dwYSize
'  dword  dwXCountChars
'  dword  dwYCountChars
'  dword  dwFillAttribute
'  dword  dwFlags
'  word   wShowWindow
'  word   cbReserved2
'  byte*  lpReserved2
'  sys    hStdInput
'  sys    hStdOutput
'  sys    hStdError
'  end type


  function Exec(string c, sys wait=0)
  ===================================
  STARTUPINFO infs
  PROCESS_INFORMATION infp
  CreateProcess 0,c,0,0,0,0,0,0,@infs,@infp
  if wait
    WaitForMultipleObjects 1,@infp.hthread,1,-1
  end if
  CloseHandle infp.hProcess
  CloseHandle infp.hThread
  end function

  int i
  int wait=1
  for i=1 to 8
    Exec "t.exe" ',wait
  next
  print "done"
*/


/*
'03:31 16/06/2019
'check dlls
$dll
$filename "t.dll"
uses rtl64

extern
FUNCTION DLLFUNC() AS string, export

    RETURN "Hello world, from an exported DLL function."

END FUNCTION
end extern
*/

/*
'03:32 16/06/2019
$filename "t.exe"
uses rtl64

DECLARE FUNCTION DLLFUNC LIB "t.dll" ALIAS "DLLFUNC" () AS STRING

FUNCTION PBMAIN() AS INT
   print DLLFUNC()
END FUNCTION

PBMAIN() ' invoke entry point
*/




/*
'13:18 14/06/2019
'accessing scoped function
'scoped linkage
declare * g()
scope
  function f() link @g
    print "here"
  end function
end scope
g()
*/

/*
'02:01 14/06/2019
'indexbase arithmetic
indexbase -5
int a=5-indexbase
print a
*/

/*
'16:40 13/06/2019
'return byvalue
type vector float x,y,z
vector f() {function={1,2,3} }
vector v
v=f()
string str(vector*v) {return v.x ", " v.y ", " v.z}
'
print str v
*/


/*
'16:13 13/06/2019
'c style case check 'not supported in utf-16
int a=43,b=0
#show {
select a
case '+'
  b=a
end select
}
print b
*/


/*
'check overloading
char c="1234"
print mid("1234",2)
print mid("1234",2,2)
print mid(c,2)
print mid(c,2,2)
*/


/*
'15:38 12/06/2019
'implement 'prior'
int f(){return 1}
int f(int v){return 2}
print f(1) '2
print prior f() '1
int a=1
int a=2
print prior a
*/


/*
'08:53 11/06/2019
'c style iteration / omitted expressions
uses console
int i,j
'for i=1;i<=4;i++ {printl i}
'for i=1;j<=4;i++ {j=i : printl i}
'for i=1;j<=4;i=i+1 {j=i : printl i}
'for i=1;j<=4;i+=1 {j=i : printl i}
'for ;i<=4;i++ {printl i}
'for ;i<=4; {printl i++}
'for ;; {printl i++ : exit for}
'for ;; {printl i++ }
'for (;++i and 7;) {printl i }
'for (i=1 to 5 step 2) {printl i }
waitkey
*/

/*
'11:54 10/06/2019
'read indexbase in an expression
print indexbase
*/


/*
'00:57 10/06/2019
'improve ++
indexbase 0
int a[9],i
#show a[++i]
#show a[i++]
*/



/*
'08:57 09/06/2019
'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/imp-operator
'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/eqv-operator
*/


/*
uses console
numberformat 17,1,0,0,1,0
printl ">" + 0 "<"
printl ">" + .1 "<"
printl ">" -.1 "<"
printl ">" 1 "<"
printl ">" 0-1 "<"
printl ">" + -1 + "<"
waitkey
*/

/*
'16:13 08/06/2019
'new operators shl shr rol ror pow
'print 4 shl 2
'print 4 ror 3
'print 2 pow 3
print mod(8,3)
print 8 mod 3
*/


/*
'10:58 08/06/2019
'BITWISE OPERATIONS ON FLOAT EXPRESSION
'print 4 OR 3 CHR(13, 10) '7
'print floor(31 / 7) CHR(13, 10) '4
print str(floor(31 / 7) OR 3) CHR(13, 10) '
print str(31 / 7 OR 3) chr(13, 10)
*/

/*
'print str(31 / 7 OR 3) chr(13, 10)
'print 7.0 or 3
'int a= 7.0 or 3
'float a=7.0 or 3
'print str(31 \ 7 OR 3) chr(13, 10)
*/


/*
FUNCTION ¤NOT(byval QUAD v1) AS QUAD
  'asm
  addr rcx,v1
  not dword [rcx]
  not dword [rcx+4]
  return v1  
END FUNCTION

FUNCTION ¤AND(byval QUAD v1, v2) AS QUAD
  'asm
  addr rcx,v1
  addr rdx,v2
  mov eax,[rcx]
  and eax,[rdx]
  mov [rcx],eax
  mov eax,[rcx+4]
  and eax,[rdx+4]
  mov [rcx+4],eax
  return v1  
end function

FUNCTION ¤OR(byval QUAD v1, v2) AS QUAD
  'asm
  addr rcx,v1
  addr rdx,v2
  mov eax,[rcx]
  or eax,[rdx]
  mov [rcx],eax
  mov eax,[rcx+4]
  or eax,[rdx+4]
  mov [rcx+4],eax
  return v1  
end function
*/

/*
class qint
==========
  int i
  int lowest,highest
  '
  function check() as int
  if i<lowest
    'report
    'clamp
    'roll over
  elseif i>highest
  endif
  end function
end class


macro qint_op()
  '
  macro .move(a,b)
    #if typecodeof(a)=typecodeof(qint)
      #if typecodeof(b)=typecodeof(qint)
        a.i=b.i
      #else
        a.i=b
      #endif 
      a.check
    #else
      a=b.i
    #endif
  end macro
  '
  macro .neg(a,b)
    a.i=-b.i
    a.check
  end macro
  '
  macro .not(a,b)
    a.i=not(b.i)
    a.check
  end macro
  '
  macro .+ (a,b,c)
    a.i=b.i
  end macro
  '
  macro .+ (a,b,c)
    a.i=b.i+c.i
  end macro
  '
  macro .- (a,b,c)
    a.i=b.i-c.i
  end macro
  '
  macro .* (a,b,c)
    a.i=b.i*c.i
  end macro
  '
  macro ./ (a,b,c)
    a.i=b.i/c.i
  end macro
  '
  macro .\ (a,b,c)
    a.i=b.i\c.i
  end macro
  '
end macro
*/


/*
#show byte a=0+386+0
*/

/*
function getsubresult(string *s) as string
    s += ". Thanks!"  ' this seems to think i passed a literal
    return s
    'function=s+". Thanks!"  ' this seems to think i passed a literal
end function

function getresult(int v, string s) as string
    string ss = s
    ss = "Hello " + s + " you owe me " + str(v)   
    return getsubresult(bycopy ss) ' bycopy has no effect.

end function

print getresult(123, "Brian")
*/

/*
'11:10 04/06/2019
'fix numberformat
$filename "o.exe"
uses rtl64
print str(20)
numberformat(6,1,0,1,1,0)
    print str(20)
    numberformat()
    print str(20)
*/


/*
'11:07 03/06/2019
'fix byte overflow trap
byte grr
'#show grr=325+1
'mov al,325
'print grr
function f(byte a)
#show print a
end function
#show f 325

/*
'04:25 02/06/2019
uses mathcomplex
function f() as complex
complex c[8],d[8]
int i=1
c[i]=d[i] / d[i]
function=c[i]
end function
print "ok"
*/


/*
  ' ******************************************************************
  ' FreeBasic Complex number library
  ' ------------------------------------------------------------------
  ' Based on ComplexMath Delphi library by E. F. Glynn
  ' http://www.efg2.com/Lab/Mathematics/Complex/index.html
  ' ******************************************************************
  ' Port to OxygenBasic
  ' ------------------------------------------------------------------
  ' Mathematical constants
  ' ------------------------------------------------------------------

  % MaxNum    1.797693134862315E+308  ' Max. floating point number: 2^1024
  % MaxLog  709.782712893384          ' Max. argument for Exp
  % MinLog -708.3964185322641         ' Min. argument for Exp
  % TwoPi     6.283185307179586       ' 2*Pi
  % PiDiv2    1.570796326794897       ' Pi/2
  % Ln2PiDiv2 0.9189385332046728      ' Ln(2*Pi)/2
  % Sqrt2     1.414213562373095#      ' Sqrt(2)

  ' ------------------------------------------------------------------
  ' Error codes for function evaluations
  ' ------------------------------------------------------------------

  % FOk         0  ' No error
  % FDomain    -1  ' Argument domain error
  % FSing      -2  ' Singularity
  % FOverflow  -3  ' Overflow range error
  % FUnderflow -4  ' Underflow range error

  ' ------------------------------------------------------------------
  ' Boolean constants
  ' ------------------------------------------------------------------

  % True -1
  % False 0

  ' ------------------------------------------------------------------
  ' Type definition
  ' ------------------------------------------------------------------

  type Complex double x,y

  ' ------------------------------------------------------------------
  ' Global variables
  ' ------------------------------------------------------------------

  sys ErrCode 
  ' Error code from the latest function evaluation

  Complex C_zero   = {0, 0}
  Complex C_one    = {1, 0}
  Complex C_i      = {0, 1}
  Complex C_MaxNum = {MaxNum, MaxNum}


  ErrCode = FOk


  'OPERATORS
  ==========
  '
  macro Complex_op(a,b,c)
    '
    macro .move (a,b)
      #if typecodeof(b)=typecodeof(complex)
        a.x=b.x
        a.y=b.y
      #else
        a.x=b
        a.y=b
      #endif
    end macro
    '
    macro .neg (a,b)
      a.x=-b.x
      a.y=-b.y
    end macro
    '
    macro .+ (a,b,c)
      #if typecodeof(c)=typecodeof(complex)
        a.x=b.x+c.x
        a.y=b.y+c.y
      #else
        a.x=b.x+c
        a.y=b.y+c
      #endif
    end macro
    '
    macro .- (a,b,c)
      #if typecodeof(c)=typecodeof(complex)
        a.x=b.x-c.x
        a.y=b.y-c.y
      #else
        a.x=b.x-c
        a.y=b.y-c
      #endif
    end macro
    '
    macro .* (a,b,c)
      #if typecodeof(c)=typecodeof(complex)
        ErrCode = FOk
        a.x = b.x * c.x - b.y * c.y
        a.y = b.x * c.y + b.y * c.x
      #else
        a.x=b.x*c
        a.y=b.y*c
      #endif
    end macro
    '
    macro ./ (a,b,c)
      #if typecodeof(b)=typecodeof(complex)
        #if typecodeof(c)=typecodeof(complex)
          if (b.x = 0) and (b.y = 0)
            ErrCode = FOverflow
            a = C_MaxNum
          else
            double dvs = 1 / (c.x * c.x + c.y * c.y)
            ErrCode = FOk
            a.x=(b.x * c.x + b.y * c.y) * dvs
            a.y=(b.y * c.x - b.x * c.y) * dvs
          endif
        #else 'c is scalar
          if c = 0 then
            ErrCode = FOverflow
            a=C_MaxNum
          else
            ErrCode = FOk
            a.x=b.x/c
            a.y=b.y/c
          endif
        #endif
      #else 'b is scalar, assume c is complex
        if (c.x = 0) and (c.y = 0) then
          ErrCode = FOverflow
          a=C_MaxNum
        else
          double Temp = b / ( (c.x * c.x) + (c.y * c.y) )
          ErrCode = FOk
          a={c.x * Temp, - c.y * Temp}
        endif
      #endif
    end macro
    '
    macro .= (a,b,c)
    a=(b.x=c.x)and(b.y=c.y)
    end macro
    '
    macro .<> (a,b,c)
    'a=1-((b.x=c.x)and(b.y=c.y))
    if (b.x=c.x)and(b.y=c.y)
      a=0
    else
      a=1
    endif
    end macro
    '
  end macro 'complex_op


function str(complex*c) as string
return "" c.x ", " c.y
end function


complex a,b,c,d
a={1,2}
b={2,3}

'c=a*b
'print str(c)
'd=c/b
'd=(complex) 1/b
d=1/b
'#show "o2.txt"{
'if c<>d and c<>d
if c<>d
  print "ok"
else
  print "nok"
endif
'}
'd=1/d
print str((complex) 1/d)

*/

/*
'21:58 30/05/2019
'redim without static
'localised strings
redim string s(0)
function f() as string
int i=1
redim string s(100)
#show s(i)=s(5)
end function
*/

/*
'05:38 31/05/2019
'check redim oop
*/

'uses MathComplex


/*
'09:51 28/05/2019
'assignments vs logical expressions
int a,b,c,d
c=2
d=2
#show a=(c = d)
#show b=(c==d)
print a "  " b
*/


/*
FUNCTION CMPR(STRING ğa, STRING ğb) AS INT
   STRING a = ğa
   STRING b = ğb
   IF (a=b) THEN
      print "equal 1"
   ELSE
      print "different 1"
   END IF
int c=(a==b)
print c
   return (a == b)
   'function = (a == b)
END FUNCTION

   STRING su
   STRING sa
   su = "compare3"
   sa = "compare3"
   IF CMPR(su, sa) THEN
      print "equal 2"
   ELSE
      print "different 2"
   END IF
*/

/*
'07:24 28/05/2019
'string matching for comparison
'
string  s="abc"
wstring t="abc"
char    u="abc"
wchar   v="abc"

typeof(t) rs 'dim a matching type
'rs=s
rs=u
'rs=v
if t=rs
  print "ok"
else
  print "nok"
endif
*/

/*
'07:17 28/05/2019
'fix convert  .. then
string s="abc"
wstring t="abc"
char u="abc"

if s=convert string t
  print "ok"
else
  print "nok"
endif 


if t=convert wstring s
  print "ok"
else
  print "nok"
endif 

#show {
if t=convert wstring u then
  print "ok"
else
  print "nok"
endif 
}
*/

/*
'12:45 27/05/2019
'test byte logic
string s="123456"
byte bs at strptr s
bs[1]=0xff
bs[2]=0xfe
'#show{
if (bs[1]=0xf0) and (bs[2]=0xfe)
elseif (bs[1]=0xff) and (bs[2]=0xfe)
  print "ok"
endif
'}
*/


/*
'display bom
'11:26 27/05/2019
'UTF16
string s=getfile "o2tests1.o2bas"
string t=""
int i
for i=1 to len(s)
  t+=hex(asc(s,i),2)+" "
next
print t
*/

/*
'03:41 27/05/2019
type complex double x,y
complex a,b,c
#show b={cos(pi),sin(pi)}
string str(complex*b) { return str(b.x,6) ", " str(b.y,6) }
#recordof str
print b.x ", " b.y
print str(b)
*/

/*
'03:38 27/05/2019
def dat { 1,2,3,4,5 }
#recordof dat
int a[16]
a={dat}
print a[3]

/*
'11:18 26/05/2019
MACRO fill_zstring(v, c)
  'v direct zstring, asciiz or char
  'c dynamic string source of any length
  v=left(c,spanof(v)-1)
END MACRO

zstring v[6]
print spanof(v)
fill_zstring(v,"BB")
print v
fill_zstring(v,"BBBBBBBBBB") 'fills with 5 chars
print v
*/

/*
wstring s="123",t="123"
#show "o22.txt"{
if (s+L""=L"12"+L"3")
  print s
else
  print "nok"
endif
}
*/

/*
sub testwstr(byref p1 as wstring)
 
   IF (p1 = l"orig") THEN   ' crashes if you bracket the condition.
   'IF p1 = l"orig" THEN   ' works fine if you dont use brackets.
      print("+Success")
   ELSE
      print("-Failure" & "")  ' crashes with bracketed condition + an extra string concatenated here...
   END IF
   
end sub
   
testwstr("orig")
*/

/*
single a
#if typecodeof(a)=typecodeof(float)
  #print "ok"
#else
  #print "nok"
#endif
*/

/*
float a
#if match(typeof(a),"float")
  #print "ok"
#else
  #print "nok"
#endif
*/

/*
'13:21 25/05/2019
'hyperbolic functions
print cosh(2)
print acosh(3.7621956910836315)
*/

/*
'14:20 24/05/2019

type string32
  string buf
end type

macro string32_op (a,b,c)
  '
  macro .move (a,b)
   a.buf = b.buf
  end macro
  '
  macro .+ (a,b,c)
    a.buf = b.buf + c.buf
  end macro
  '
  macro .& (a,b,c)
    a.buf = b.buf + c.buf
  end macro
  '
end macro

function len( string32*ss ) as int
  return len(ss.buf)/4
end function

function str32( string s ) as string32
  int le=len(s)
  function.buf=nuls(le*4)
  byte a at strptr(function.buf) 
  byte b at strptr(s)
  int i 
  for i=1 to le
     a=b : @a+=4 : @b++
  next
end function

'#recordof str32

function AnsiStr( string32*s ) as string
  int le=len(s.buf)/4
  string t=nuls(le)
  byte a at strptr(t) 
  byte b at strptr(s.buf)
  int i 
  for i=1 to le
     a=b : @a++ : @b+=4
  next
  return t
end function

function left( string32*ss, int n ) as string32
  function.buf=left(ss.buf,n*4)
end function

function mid( string32*ss, int i,n ) as string32
  function.buf=mid(ss.buf,i*4-3,n*4)
end function

'TESTS
string q="abc"
string r
string32 s,t,u
s=str32(q)
'print len(s)
t=s+s
'print ansistr(t+s)
print ansistr(mid(t+s,4,5))
u=mid(t+s,2,3)
print ansistr u
r=ansistr(left(t,4))
print r
*/

/*
'05:43 24/05/2019
'not
'print hex not(1+2)
'int f(){return 1}
'#show if not f(){}
int a,b,c
#show c=not(a>=b) 'bitwise not
*/

/*
int a
#show a=1+2+3\4
*/

/*
'07:56 23/05/2019
'64bit mode quad literals
$filename "o.exe"
uses rtl64
quad a
'#show a=0x123456789
'o2 48 b8 hq 123456789
o2 48 b8 nq -10000000000 '10e9
'mov a,rax
'print hex a
quad a,b,c,d
#show a=0x123456789\16
print hex a
#show a=16*0x123456789
'#show a=10/2
'#show a=100+200
print hex a
*/

/*
'extern lib "MSVCRT.dll" cdecl
'sys  sprintf_s(char *buf, sys size, char *format, ...)
'end extern
*/

/*
'04:44 23/05/2019
'quad number literals
'http://www.cplusplus.com/reference/cstdio/scanf/
'http://www.cplusplus.com/reference/cstdio/sscanf/
uses corewin
quad q
char c[256]
c="3434234233"
sscanf(strptr(c), "%dll", @q)
print c chr(13,10) q
*/

/*
'04:10 23/05/2019
'32bit limitation extend
quad a
#show a= 0x123456789
print hex a
*/

/*
'06:08 22/05/2019
'assignment conditionals syntax
int a,b
b=0
function f(int v) as int
  return v
end function

if ((a:=f(b))!=0) 'yes
'if (a:=f(b)!=0) 'no
'if a:=f(b)!=0   'no
'if a:= f(b) 'yes
  print a
else
  print "nok"
endif
*/

'Boffins All-purpose Symbolic Instruction Code

/*
'00:30 22/05/2019
'getting integer modulus from rdx after integer division
'not floats
'not quads in 32bit mode
int a,b,r
b=7
a=b\3 'cpu integer division
r=rdx 'modulus
print a ", " r '2, 1
*/


/*
'08:41 21/05/2019
'numberformat test jit mode
print str([ebx+368])
numberformat 6,1,0,0,0,0
print 1.2345
*/

/*
'08:15 21/05/2019
'wide string instr
wstring s="abcdef"
wstring k="d"
int a=instr(s,k)
print a '4 ok
*/

/*
'06:06 21/05/2019
'fix quad with float-macros
QUAD J, A
'float j,a
'int j,a

#show J = (J + 2 - A + floor(0.25 * A))
'#show J = (J + 2 - A + (0.25 * A))
'#show J = (sin(0.25 * A)+j)
'#show J = J + sin(0.25 * A)
#recordof a
*/


/*
'23:21 20/05/2019
'power operator
print 2^3
float a,b
a=2
b=3
print a^b
print 2^0.5
*/

/*
'23:07 20/05/2019
'test any
'function f(v as any)
function f(byref v as any)
char c at @v
print c
end function

string s="ok"
#show f byval strptr s
*/
/*
'11:00 20/05/2019
'wstring conversion fixed
includepath "..\"
uses corewin
wstring ti="title"
messageboxw 0, wstring "ok", ti,0
*/

/*
'04:04 20/05/2019
'fix string concat
wstring s=  0 "1" "2" "3" 4
print s+s+"Q"
*/


/*
'15:45 16/05/2019
'jumping into inner block
'..gl
goto next .gl
'jmp fwd .gl
(
  print "!"
  ..gl
)
print "ok " @.gl
*/


/*
'15:18 15/05/2019
'checking bstr null terminators
use corewin
uses chaos
indexbase 1
byte *b
int i,t,l
'@b=sysallocstringbytelen 0,l
for i=1 to 10000
  l=irnd(10,10000)
  @b=getmemory l
  l+=2
  if b[l]<>0
    t++
  endif
  'sysfreestring @b
next
print t
*/


/*
'12:35 15/05/2019
'fix 64bit sys/quad switch
'fix print typeof ...
$filename "o2tests.exe"
'uses rtl64
'quad a,b,c
'#show a=b+c
type qq
quad a
=
dword x,y
end type

qq a,b,c
sys v
'#show a.a=b.a+b.a+v+1
'mbox typeof a.a
'typeof a.a ta
'#show string s=typeof a
'print s
print typeof a.x
*/

/*
function range(float v,min,max) as int
======================================
if (v>=min)and(v<=max)
  return 1
endif
end function
*/


/*
'13:33 14/05/2019
'infinity
print atn(1/0)*2 chr(13) pi()
*/

/*
'12:27 14/05/2019
function approx(float a,b,e) as int
===================================
'a first number
'b second number to compare with
'e error factor
e+=1
if (a<=b*e)and(a>=b/e)
  return 1
endif
end function

print approx( 1.2, 1.21, 0.01) '1
print approx( 1.2, 1.22, 0.01) '0
*/

/*
double r=2.3
select r
case <2.3   : 
case <2.31 : print "approx 2.3 " r
end select
print "ok"
*/

/*
'15:06 13/05/2019
'sigfig
double b=pi()
print b
string s
int ls
int n=3
s=round(b*pow(10,n))
ls=len(s)
print left(s,ls-n)+"."+mid(s,ls-n+1)
*/

/*
uses corewin
char c[32]
sprintf( c,"%0.3f", convert double pi() )
print c
*/

/*
uses console
'macro print(s)
'  mbox "" s
'end macro
print (1*2)+3 " q"
printl (1*2)+3 " q"
wait
*/

/*
'06:33 12/05/2019
'
'uses console
'print (((1*2+3) "ok"))
'print (5) ("ok")
'print (`7`)
'print `q`
'print "p"+`q`
'string s=``+""
'string s=chr 164
's+=chr 172
string s=""+``
print s
'putfile "t.txt",s
'waitkey
*/

/*
'11:21 11/05/2019
'fix mixed int and float function
'
declare function rand  lib "msvcrt.dll" alias "rand" () as int
declare function srand lib "msvcrt.dll" alias "srand" (int seed)
uses console

FUNCTION rnd(byval int l1, l2) AS double
    if l1 > l2 then
        int l3 = l1
        l1 = l2
        l2 = l3
    end if
    double rv = (rand() / 32767)
    return floor(l1 + (rv * (l2 - l1)))
END FUNCTION

srand 12345
int v
int i
double d=1.5
for i=1 to 10
  #show v = 2000 + rnd(1, 20) 'this fails. always returns a number smaller than 21     
  '#show v = 2000 + pi()
  '#show v = 2000 + d
  print v cr
next
waitkey
*/

/*
'09:40 10/05/2019
'Thread Demo
uses corewin
uses console
extern
'
class ThreadDemo
================
int counter
int running
sys thread
'
function constructor()
  counter=0
  running=1
  thread=CreateThread(0,0,@threadcall,@this,0,0)
end function
'
function destructor()
  CloseHandle(thread)
end function
'
function threadcall()
  while running
    act()
  wend
end function
'
function act()
  counter++
  sleep 20
end function
'
function stop()
  running=0
end function
'
end class
'
'TEST:
new ThreadDemo td()
int k
printl "Press [space] to show count, [enter] to close"
do
  k=waitkey
  select k
  case 3,13 : td.stop() : exit do
  case 32 : printl td.counter
  end select
loop
printl "Final count " td.counter
waitkey
del td
*/


/*
goto NOLabel
select case 1
    case 2
        NOLabel:       
end select
print "ok"
*/

/*
$filename "o2tests.exe"
'uses rtl32
def tab chr(9)
print str 5.11,15
'numberformat(16,0,0,0,0,0)
'    print str(100.5) tab str(100.5, 0)   
'    numberformat
*/

/*
'member spanof
'16:53 06/05/2019
type tt
wchar c[23]
end type
tt t
print spanof t.c "  " bytesof t.c
print spanof tt.c "  " bytesof tt.c
*/

/*
function j$#int(int a)
print a
end function

#recordof j'$#int

j$#int 5
*/

/*
int a
'a=a&a
#show a$=a
*/

/*
'03:40 03/05/2019
int a$=4
int a=2
print a$
*/

/*
def ucase$ ucase
def lcase$ lcase
def left$  left
def mid$   mid

#lookahead

print Proper$("tRaNsLaToR")

Function Proper$(A$ as string) as string
   Local T$ as string
   T$ = Ucase$(Left$(A$,1)) & Lcase$(Mid$(A$,2,256))
   Function = T$
End Function
*/

/*
print 42###
*/

/*
int a%=2
float a=1.5
function f(float a)
print a
end function

#show if f &f {}
*/

/*
int a
print size of a

'.he print 123
*/

/*
uses console
#show {
print "ok":cls:print "ok"
}
waitkey
*/


/*
type ii
int a,b,c
end type

type aa
int a,b,c
ii*i
end type

aa a
ii*i
#show @i=@a.i
*/  

/*
'11:32 27/04/2019
'rtclass *runtime = (rtclass*)(basicstruct->instance);
rtclass *runtime : @runtime=basicstruct.instance

'basicstruct *b = (basicstruct*) malloc(sizeof(basicstruct));
'memset(&b, 0, sizeof(basicstruct));
basicstruct *b : @b=getmemory(sizeof(basicstruct))

'int** arrayptr;
int** arrayptr
*/

/*
'12:14 23/04/2019
'fix 'here'
$ filename "Here.exe"
'uses rtl32
'uses rtl64

uses console

dim a$ as string

a$="abcdefg"

jmp fwd here              'here will crash?
a$ = "1234567890"       'this does not get executed

here:
a$ = right$(a$,5)
print a$
wait
*/

/*
wstring s
int a=0x3b1
#show s=wchr(0x3b1)
print s
*/

/*
int a=0x1ffff
int b
mov eax,0x20000
mov ax,a
print hex(eax)
*/

/*
'MapFileAndCheckSumA
'https://docs.microsoft.com/en-us/windows/desktop/api/imagehlp/nf-imagehlp-mapfileandchecksuma
'http://www.sunshine2k.de/reversing/tuts/tut_pe.htm
'https://www.codeproject.com/Articles/19326/An-Analysis-of-the-Windows-PE-Checksum-Algorithm
'https://bytepointer.com/resources/microsoft_pe_checksum_algo_distilled.htm
'
! MapFileAndCheckSumA lib "Imagehlp.dll"
'
string fi
string s
fi="oxygen.dll"
getfile fi,s
'
int *ck 'checksum
dword b at strptr(s)+60 'PE header offset
@ck=strptr(s)+b+0x58 'checksum location
'
'CLEAR CHECKSUM
ck=0
'
'CALCULATE CHECKSUM
uint uw  'upper word
uint ls  'byte length of data
uint ca  'checksum accumulator
word *pd 'input
int j    'iterator
ls=len(s)
@pd=strptr(s)
for j=1 to ls step 2 'each word
  ca+=pd
  uw=ca>>16
  ca and=0xffff
  ca+=uw
  @pd+=2
next
'final
uw=ca>>16
ca=uw+ca
ca and= 0xffff
ca+=ls 'add in byte length of data
'print hex(ca)
'
'SET CHECKSUM
'ck=ca
'putfile fi,s 'testing


'VERIFY
=======

dword e ' error
dword i ' previous checksum
dword o ' new checksum
'
e=MapFileAndCheckSumA("oxygen.dll",@i,@o)
select e
  case 2 : print "Could not map the file"
  case 3 : print "Could not map a view of the file"
  case 1 : print "Could not open the file"
  case 4 : print "Could not convert the file name to Unicode"
  case else : print hex(i) "   " hex(o) "    " e  '"   " hex(crc32(strptr s, len s))
end select
*/



/*
'01:47 31/01/2019
uses chaos
dword d
int i
string s=getfile("o2tests.o2bas")
d=crc32(strptr s, len s)

dword d
d=-1
print d
*/


/*
'01:47 31/01/2019
$ filename "Checksums.exe" 

'uses rtl32
'uses rtl64
uses chaos

uses console

'RtlComputeCrc32 (DWORD dwInitial, const BYTE *pData, INT iLen)  result dword
'RtlCrc32 ( void const* Buffer, size_t Size, DWORD InitialCrc )  result dword
'RtlCrc64 ( void const* Buffer, size_t Size, ULONGLONG InitialCrc ) result ulonglong

'string fname="Checksums.o2bas"
string fname="o2tests.o2bas"
string s
'getfile fname, s
s="a"
'print s

https://github.com/Mattiwatti/BSOD10/blob/master/src/ntdll.h'RtlComputeCrc32(
'	_In_ ULONG32 PartialCrc,
'	_In_ PVOID Buffer,
'	_In_ ULONG Length
'	);
'NTAPI
'RtlCrc32(
'    _In_reads_bytes_(Size) const void *Buffer,
'    _In_ size_t Size,
'    _In_ DWORD InitialCrc
'    );
extern lib "ntdll.dll"
! RtlComputeCrc32
! RtlCrc32
! RtlCrc64
end extern

'printl hex (RtlComputeCrc32 0, s, len s)
'printl right(hex (RtlComputeCrc32 0, s, len(s), 8))

int p=0x04c11db7 'polynomial
int i = Crc32(strptr "", 0)
int a = Crc32(strptr s, len s)
int b = RtlComputeCrc32(0, s, len s)
int c = RtlCrc32(s, len(s),i)
printl right(hex(a),8) " Chaos crc32"
printl right(hex(b),8) " ntdll RtlComputeCrc32"
printl right(hex(c),8) " ntdll RtlCrc32"

'printl hex(RtlCrc32(s, len(s),0)) ": Incorrect."

printl "Enter..."
waitkey
*/

/*
'03:16 28/01/2019
'itr char* deref
uses corewin

FUNCTION MSGBOX(wstring wText, dword mOptions=0) AS LONG
   wString wCaption = "PluriBASIC w"
   FUNCTION = MessageBoxw(0, wText, wCaption, mOptions)   
END FUNCTION

char c="ok char*"
wchar w[100]
w=c
'print w

#show msgbox w,1
*/

/*
function f(sys p, int le) as string
string s=space(le)
copy strptr(s),p,le
#show return s
end function

print f(strptr("12345"),4)
'1234
*/


/*
'14:04 23/01/2019
$filename "t.exe"
uses ..\rtl64
type tt
'a as void*
'b as void*
'void  *a,*b
'void*a
'void *b
'void *c
end type
#recordof tt
*/

/*
'12:48 15/01/2019
'oleaut
'https://docs.microsoft.com/en-us/windows/desktop/api/oleauto/nf-oleauto-variantinit
uses corewin
uses variantutil

def sh print "%1  %2,%3"

macro variant_op
================
  '
  macro .init(a,b)
    'sh init a b
    VariantInit(a)
  end macro
  '
  macro .free(a,b)
    'sh free a b
    VariantClear(a)
  end macro
  '
  macro .move(a,b)
    sh move a b
    VariantCopy(a,b)
  end macro
  '
  macro .+ (a,b,c)
    sh + b c
    VariantClear(a)
    VarAdd(b,c,a)
  end macro
  '
  macro .conv(a,b,t)
    sh conv a b
    VariantClear(a)
    a.vt=VT_R8
    a.dblval=b
  end macro
  '
  macro .neg(a,b)
    sh conv a b
    VariantClear(a)
    VarNeg(b,a)
  end macro
  '
  macro .not(a,b)
    sh conv a b
    VariantClear(a)
    VarNot(b,a)
  end macro
  '
end macro

'#RECORDOF VARIANT
variant x,y,z
'x.vt=VT_R8 : x.dblval=2.5
'x=y
'x=y+z
x=2.5
y=x+x
'variantcopy y,x
print y.vt "  " y.dblval
'print "ok"
*/

/*
void VariantInit(
  VARIANTARG *pvarg
);
HRESULT VarR8FromI4(
  LONG   lIn,
  DOUBLE *pdblOut
);
HRESULT VariantChangeType(
  VARIANTARG       *pvargDest,
  const VARIANTARG *pvarSrc,
  USHORT           wFlags,
  VARTYPE          vt
);
HRESULT VarMul(
  LPVARIANT pvarLeft,
  LPVARIANT pvarRight,
  LPVARIANT pvarResult
);
HRESULT VarSub(
  LPVARIANT pvarLeft,
  LPVARIANT pvarRight,
  LPVARIANT pvarResult
);
HRESULT VarNeg(
  LPVARIANT pvarIn,
  LPVARIANT pvarResult
);
HRESULT VarUI8FromR4(
  FLOAT   fltIn,
  ULONG64 *pi64Out
);
HRESULT VariantClear(
  VARIANTARG *pvarg
);
HRESULT VariantCopy(
  VARIANTARG       *pvargDest,
  const VARIANTARG *pvargSrc
);
HRESULT VarNeg(
  LPVARIANT pvarIn,
  LPVARIANT pvarResult
);
HRESULT VarNot(
  LPVARIANT pvarIn,
  LPVARIANT pvarResult
);
HRESULT VariantChangeType(
  VARIANTARG       *pvargDest,
  const VARIANTARG *pvarSrc,
  USHORT           wFlags,
  VARTYPE          vt
);
HRESULT VarR4FromStr(
  LPCOLESTR strIn,
  LCID      lcid,
  ULONG     dwFlags,
  FLOAT     *pfltOut
);
HRESULT VarCat(
  LPVARIANT pvarLeft,
  LPVARIANT pvarRight,
  LPVARIANT pvarResult
);
*/


/*
'11:52 20/01/2019
'default copying
type asmint
int i
end type

asmint a,b,c,d
#show a=b
*/

/*
'06:02 20/01/2019
' operations
type asmint
int i
end type

macro asmint_op()
  macro .move (a,b)
    a.i=b.i
  end macro
  macro .+ (a,b,c)
    a.i=b.i+c.i
  end macro
  macro .* (a,b,c)
    a.i=b.i*c.i
  end macro
end macro

asmint a,b,c,d
'#show a=b
'#show a=b+c
'#show a=b+c+d
'#show a=(b+c)*d
'#show a=b+(c*d)
'#show a=b+(c*d)+(c*d)
#show a=b+c*d+c*d
*/


/*
'05:36 20/01/2019
'save' accumulator-based operations
type asmint
int i
end type

macro asmint_op()
  macro .save (a)
    mov a.i,eax
  end macro
  macro .move (a)
    mov eax,a.i
  end macro
  macro .+ (a)
    add eax,a.i
  end macro
  macro .* (a)
    mul a.i
  end macro
  macro .conv (a,b,t)
    mov ecx,b
    mov a,ecx
  end macro
  macro .neg (a,b)
    mov ecx,b
    neg ecx
    mov a,ecx
  end macro
  macro .not (a,b)
    mov ecx,b
    not ecx
    mov a,ecx
  end macro
  macro .>= (a,b)
    cmp b.i,eax
    mov eax,0
    setg al
    mov a,eax
  end macro
end macro

asmint a,b,c,d
int i,j

'#show {
'if i+0>=j+0
'if a>=b
'if (a>=b)+(c>=d)
'endif
'while a>=b
'  exit while
'wend
'}
'#show a=b
'#show a=b+c
'#show a=b+c+d
'#show a=b+(c*d)
'#show a=b+(c*d)+(c*d)
'#show a=42
'#show a=b+42

function f(asmint*a) as asmint
return.i=a.i
end function

'#show a=f(b)
'#show a=b+f(c)
'#show a=f(42)
'#show a=-b
'#show a=b+-c
'#show a=-f(b)
'#show a=b+ -f(c)
'#show a=not(b)
'#show a=b+ not(f(c))
'int i,j
'#show i=i+-j
*/



/*
'18:10 18/01/2019
'NULL VARIADICS / FIXED
$filename "t.exe"
uses rtl64
typedef void*msys
extern
function f(msys a,...) as msys
end function

#show f null
*/



/*
'12:45 15/01/2019
uses corewin
'extern
quad gtc64() at @GetTickCount64
'end extern

#show quad a=gtc64()
print hex a
*/


/*
macro hquad quad(a,b,c)
a=b*0x10000*0x10000+c
end macro
*/

/*
uses corewin
quad a
GetTickCount64
addr ecx,a
mov [ecx],eax
mov [ecx+4],edx
print hex a
*/

/*
$filename "t.exe"
uses rtl64
mov eax,0x7bcd0000
movsxd rax,eax
quad q=0x1000
#show imul [q]
print hex rax
*/

/*
'QUAD INPUT
$filename "t.exe"
uses rtl64

quad qs=0x10000 : qs*=0x10000
#show quad a= qs*0x12345678+0x9abcdef0
#show quad a= 0x12345678*qs+0x9abcdef0
'quad b=qs*0x1D4A9EB+0xC4E94E60
print hex a
*/

/*
$filename "t.exe"
'uses rtl64

type tquad
 dword lo
 int hi
end type

macro mquad quad (q,h,l,   pq)
  tquad pq at @q
  pq.hi=h
  pq.lo=l
end macro
'
quad a=mquad(0x12345678,0x9abcdef0)
print hex a
print a
*/

/*
  '13:55 07/01/2019
  '
  'ARRAY SYSTEM

  class ArrayObject 'supporting 1D 2D 3D
  ======================================
    sys bu 'member buffer
    sys pd 'member destructor
    int sn,sx,sy,sz 'sizes
    '
    function pack() as string
      function=nuls(64)+(bstring) bu
      sys a at strptr(function)
      a={pd,sx,sy,sz}
    end function
    '
    function unpack(string s)
      destructor()
      indexbase 1
      sys a at strptr(s)
      pd=a[1] : sx=a[2] : sy=a[3] : sz=a[4]
      (bstring) bu=mid(s,65)
    end function
    '
    function constructor(sys p, int n=4,x=1,y=1,z=1)
    pd=p : sn=n : sx=x*n : sy=y*sx : sz=z*sy
    bu=getmemory n*x*y*z
    end function
    '
    function destructor()
    if bu
      if pd
        int i
        sys d=pd
        sys p=bu
        sys n=sn
        for i=1 to sx*sy*sz
          call d(p) 'destructor for each member
          p+=n
        next
      endif
      freememory bu : bu=0
    endif
    end function
    '
    function resize(int x) as sys
    sys bo=bu
    bu=getmemory(x*sn)
    if sx>x
      sx=x
    endif
    copy bu,bo,sx*sn
    end function
    '
    function io(int x) as sys
    return bu+(x*sn)
    end function
    '
    function io(int x,y) as sys
    return bu+(x*sn)+(y*sx)
    end function
    '
    function io(int x,y,z) as sys
    'print "io " x "," y "," z
    return bu+(x*sn)+(y*sx)+(z*sy)
    end function
    '
  end class
  '
  '
  def CreateArray
  ===============
    '%1 type
    '%2 var name
    '%3 array dimensions
    '
    ArrayObject %2_object 'supporting 1D 2D 3D arrays
    sys %2_dstr
    #ifdef %1.destructor
      %2_dstr=@%1.destructor()
    #endif
    %2_object.constructor(%2_dstr,sizeof(%1),%3)
    macro %2 %1* (a,%3) { @a=%2_object.io(%3) }
    #ending {%2_obj.destructor()}
  end def
  '
  'ArrayObject v_obj
  'v_object.constructor(sizeof(vector),x,y,z)
  'macro v vector* (a,x,y,z) { @a=v_object.io(x,y,z) }

  'TESTS
  '=====
  '
  type vector float x,y,z
  CreateArray vector v(2,4,6)
  v(1,2,3).y=2.5
  v(1,2,3).z=4.5
  'v(1,2,3)={10,20,30}
  print v(1,2,3).y
  v(2,3,4)=v(1,2,3)
  print v(2,3,4).y
*/


/*
'14:52 29/12/2018
'indirect member in udt array
type tt
  int a
  int *b
end type

indexbase 1
tt t[100]
int v=21
@t.b=@v
int i=1
#show int a=t[i].b
#show int @a=t[i].b
print *a
*/




/*
'14:15 29/12/2018
'udt size alignment
'packed 
type tt
int v
byte b
end type
'
print sizeof tt
tt t[10]
print bytesof t
*/

/*
'09:47 28/12/2018
#COMPILE EXE
#COMPILER OXYGEN
#OPTIONS X64
#DIM ALL

GLOBAL RK() as STRING

FUNCTION PBMAIN() AS LONG

DIM RK(10)

RK(1) = "22"

PRINTBR RK(1)

END FUNCTION
*/

/*
'06:10 17/12/2018
'fix macro ## substitution
type tt
  int a
end type

macro mm(v)
tt v
print "x"#v#""
v.a=1
end macro
'
mm
*/

/*
'concatenation operations
'13:07 14/12/2018
'
class cat
=========
  string s
  sys ls,i
  '
  function str() as string
    return left s,i
  end function
  function add(sys p,le)
    if le+i>ls
      s+=nuls le+0x1000
      ls+=le+0x1000
    endif
    copy i+strptr s,p,le
    i+=le
  end function
end class

def sh ` %1 `
macro cat_op(a,b)
=================
  '
  macro .load(a,b)
    print "load " sh a sh b
    b.i=0  
    #if match "cat",typeof a
      b.add(strptr(a.s),a.i))
    #else
      b.add(strptr(a),len(a))
    #endif
  end macro
  '
  macro .+ (a,b)
    print "+ "  sh a sh b " " typeof a
    #if match typeof a,"cat"
      print "another cat"
      b.add(strptr(a.s),a.i)
    #else
      b.add(strptr(a),len(a))
    #endif
  end macro
  '
  macro .destructor(a,n, p,i)
    print "destructor "#a#""
    int i
    cat p at @a
    for i=1 to n
      p.s=""
      @p+=sizeof a
    next
  end macro
  '
  macro .+= ()
  end macro
  '
end macro 'cat

cat c
cat d
'c="A"
'c+="A"  "B"
c+=d
print "ok"
*/

/*
'04:49 17/12/2018
'wide string support
#show wstring s=l"ok"
print s
*/


/*
'13:05 14/12/2018
'scope / undefined var itr
'int f(int a){}
'f
int a,b
scope
int b=4
end scope
print b
*/


/*
'11:01 12/12/2018
'BIT
function bit(sys v,b) as int
return (v>>b) and 1
end function

int a
a=128
print bit(a,7) '1
a=127
print bit(a,7) '0
a=1
print bit(a,0) '1
*/

/*
'10:45 10/12/2018
'OPERATIONS USING CPU REGISTERS
'save
type azm
int v
end type

macro azm_op(a,b,c)
===================
  '
  macro .load(b,a)
  mov eax,b.v
  end macro
  '
  macro .+ (b,a)
  add eax,b.v
  end macro
  macro .* (b,a)
  imul eax,b.v
  end macro
  '
  macro ./ (b,a)
  idiv eax,b.v
  end macro
  '
  macro .save(b,a)
  mov a.v,eax
  end macro
  '
end macro

'#recordof azm
'#recordof azm_op

function f() as azm
===================
function.v=99
end function

'TESTS
function tt()
azm a,b,c,d
'#show a=b+(c/d)
'#show a=f()
#show a=b+c*(f()+d)
end function

'print 123
*/


/*
'11:38 11/12/2018
'implement bycopy
$filename "c.exe"
'uses ..\rtl64
sub f(string *s){s+=s+s}
string s="ok"
'f s
f bycopy s
print s
*/

/*
'11:37 11/12/2018
'check literals passed byref
$filename "c.exe"
uses ..\rtl64
string f(string *s){s+=s+s : return s}
#show print f "ok"
*/

/*
'09:07 10/12/2018
$filename "c.exe"
uses ..\rtl64
long var=2
print string(var,"0")
*/



/*
' 22:16 10/12/2018
' Od_Combbox.o2bas
' Owner drawn Combobox
'  Thanxx to my boss Paul who is an inspiration in this work

$ filename "Od_Combbox.exe"
use rtl64
#lookahead
arrayc
' %review

uses O2Common
uses dialogs



' identifiers
%  IDC_Combobox = 101

'  The program logo icon  is obtained from the resource file
'  the 400 must corespondence to the 400 in the rc file
   %  IDI_LOGO     400


sys  hDlg   , hCombobox





'  Will need this Array dimensioning macro
'  otherwise results would be garbage
   Dim_zstring  ArrayCB , 20, 30
   int i
   string ArrayCB(20) : for i=1 to 20 : ArrayCB="" : next



'=======================
FUNCTION  O2Main
 
Dialog( 150, 70, 160,  75, "Ownerdrawn ComboBox ",  WS_CAPTION OR   WS_SYSMENU )
   
 
  ' Add in the combo box
    sys CBBStyle =   WS_CHILD or WS_VSCROLL  or  WS_TABSTOP OR  CBS_DROPDOWNLIST  OR  _
                          CBS_HASSTRINGS  or CBS_OWNERDRAWFIXED
   COMBOBOX( "" ,IDC_Combobox, 10, 10, 60, 50, CBBStyle, WS_EX_CLIENTEDGE  or WS_EX_ACCEPTFILES , 0 )


   sys  ebStyle = WS_CHILDWINDOW or WS_VISIBLE    or  BS_DEFPUSHBUTTON   or WS_DLGFRAME
     CONTROL "Exit", IDCANCEL,"Button", ebStyle , 85, 35, 30, 14


    hDlg = CreateModalDialog( 0, @DlgProc, 0 )

END FUNCTION



'============================
'   Main callback function
    Function DlgProc( hDlg, uint uMsg, sys wParam, lParam ) as sys callback

     zstring  SelString , wAnswer 
     Long jj , CBIndex     

    hCombobox = GetDlgItem(hDlg,  IDC_Combobox)

 

 SELECT CASE  uMsg

CASE   WM_INITDIALOG
       '     display the program icon
            sys  hInstance = GetModuleHandle(NULL)
             sys hIcon = LoadIcon(hInstance, IDI_Logo)
            'Set Icon to Main Window
             SendMessage(hDlg, WM_SETICON, ICON_BIG, hIcon)
 
  '        Setup the combobox elements
           BuildArrayCB
           For jj = 1 to  20
                   SendMessage(hCombobox, CB_ADDSTRING, 0, ArrayCB[jj] )
           Next jj
           '  set cursor to the first element of the combobox
            SendMessage(hCombobox,  CB_SETCURSEL, 0, 0)
       

     CASE WM_ERASEBKGND   
 '            added to display background color for the main window
            '  for a Light Yellow background
               MainWindBGColor = 6
               hBGDC = wParam
  '          Pass the DC of the region to be repaint
             DrawGradient hBGDC           
             FUNCTION = 1
             EXIT FUNCTION


 CASE  WM_COMMAND
          SELECT CASE LOword(wParam)
            CASE   IDCANCEL
                       EndDialog( hDlg, null )

       CASE  IDC_Combobox
         IF HIWORD(WPARAM) = CBN_SELENDOK THEN
            ' user selected something
              CBindex = SendMessage(hComboBox, CB_GETCURSEL, 0, 0)
              SendMessage(hComboBox, CB_GETLBTEXT, CBindex, @SelString)
             wAnswer = TRIM(SelString)
             Mbox   " Selected : " + wAnswer , 0
         END IF
     END SELECT               
 

   CASE  WM_DRAWITEM
      '    for owner drawn combo box
           IF  LOword(wParam) =  IDC_Combobox THEN
                    OwnerDrwCombo hCombobox, WPARAM, LPARAM
             END IF

 END SELECT

END FUNCTION


'===================================
' Owner drawn procedure for the combo box
FUNCTION   OwnerDrwCombo(sys BYVAL hWnd ,  sys BYVAL wParam , sys BYVAL lParam ) AS LONG
         Zstring  zTxt
          RECT  rct
         DRAWITEMSTRUCT lpdis at lParam

  IF   lpdis.itemID = &HFFFFFFFF& THEN
      'When it is an empty list -- just exit
      EXIT FUNCTION
  END IF

  SELECT CASE  lpdis.itemAction
     CASE  ODA_DRAWENTIRE,  ODA_SELECT
   
        'CLEAR BACKGROUND
        IF ( lpdis.itemState AND  ODS_SELECTED) = 0 OR _     
              ( lpdis.itemState AND  ODS_COMBOBOXEDIT) THEN 
              'When not selected
              'text background
              SetBkColor  lpdis.hDC,   O2c_AZURE
              'text color
              SetTextColor  lpdis.hDC, GetSysColor( COLOR_WINDOWTEXT)
             'clear background
              FillRect  lpdis.hDC,  lpdis.rcItem,GetSysColorBrush( COLOR_WINDOW)
        ELSE
          '  When the item is selected
              ' set the text background
               SetBkColor  lpdis.hDC,   O2c_Light_Yellow         
              'set the text color
               SetTextColor  lpdis.hDC,  O2c_MAGENTA
         END IF

        'Get the item text
        SendMessage hWnd,  CB_GETLBTEXT,  lpdis.itemID, VARPTR(zTxt)
        DrawText  lpdis.hDC, zTxt, LEN(zTxt),  lpdis.rcItem, _
                  DT_SINGLELINE OR  DT_LEFT OR  DT_VCENTER

   
   '   Focus rectangle and bullet must be drawn after the text
 '    otherwise these will overlap by the text
      IF ( lpdis.itemState AND  ODS_SELECTED) THEN
        '        when selected , set cordinates of bullet
               ' Draw the bullet pointer at the right end
              '  Note that you need to adjust these parameters to suit the
             '  size of  each combobox and do some tests to fine tune
               rct.Left   =  +106
               rct.Right =   lpdis.rcItem.Right + 25
               rct.top    =   lpdis.rcItem.top +6
               rct.bottom =   lpdis.rcItem.bottom - 6
                'Draw a round focus rectangle -- make it look like a bullet
                RoundRect(  lpdis.hDC, rct.Left, rct.top, rct.Right, rct.bottom, 48, 48)
                'draw a focus rectangle around all
               CALL DrawFocusRect( lpdis.hDC,  lpdis.rcItem)
        END IF
        FUNCTION =  TRUE

  END SELECT

END FUNCTION   





'====================================
Sub BuildArrayCB
        ' Setup the Combobox elements
       '   using ArrayCB
            ArrayCB[1] = "One"
            ArrayCB[2] = "Two"
            ArrayCB[3] = "Three"
            ArrayCB[4] = "Four"
           ArrayCB[5] = "Five"
            ArrayCB[6] = "Six"
            ArrayCB[7] = "Seven"
            ArrayCB[8] = "Eight"
            ArrayCB[9] = "Nine"
            ArrayCB[10] = "Ten"

            ArrayCB[11] = "Eleven"
            ArrayCB[12] = "Twelve"
            ArrayCB[13] = "Thirteen"
            ArrayCB[14] = "Fourteen"
            ArrayCB[15] = "Fifteen"
            ArrayCB[16] = "Sixteen"
            ArrayCB[17] = "Seventeen"
            ArrayCB[18] = "Eighteen"
             ArrayCB[19] = "Nineteen"
              ArrayCB[20] = "Twenty"
End Sub



'----------------------------------
'  Program starts
 init_common_controls()
 O2Main
*/


/*
'10:29 09/12/2018
'fix creating class in child macro
macro myclasses(a,b,c,d)
  macro .create(a,b,c,d)
    class a
      sys bu
      int n
      int e
      '
      function constructor(b*c,int d)
      e=d*sizeof b
      bu=getmemory e
      copy bu,@c,e
      n=d
      end function
      '
      function destructor()
      freememory bu
      end function
    end class
  end macro
end macro
#recordof myclasses
myclasses.create(cfloat,float,f,nf)
#recordof cfloat
*/

/*
Class StringBuf
===============
  sys bu
  int mx
  int le
  int qu
  int wi
  '
  function constructor(string*s)
  ==============================
    int ls=len s
    wstring ws=s
    qu=512
    mx=qu+(ls*2)
    le=ls
    wi=2
    bu=getmemory mx*2
    copy bu,strptr(ws),ls*2
  end function
  '
  function constructor(wstring*s)
  ===============================
    int ls=len s
    qu=512
    mx=qu+(ls*2)
    le=ls
    wi=2
    bu=getmemory mx*2
    copy bu,strptr(s),ls*2
  end function
  '
  function constructor(stringbuf*b)
  =================================
    le=b.le
    mx=b.mx
    wi=b.wi
    qu=b.qu
    bu=getmemory mx*2
    copy bu,b.bu,le*2
  end function
  '
  function destructor()
  =====================
    freememory bu
    bu=0 : mx=0
  end function
  '
  function primitive() as wstring
  ===============================
    return left( cast(wbstring) bu, le)
  end function
  '
  operator load(wstring*s)
  ========================
    s=left( cast(wbstring) bu, le)
  end function
  '
  operator load(stringbuf*a)
  ==========================
    sys abu=a.bu
    int amx=a.mx
    if le>amx
      amx=a.qu+(le*2)
      abu=getmemory amx*2
      copy abu,bu,le*2
      freememory a.bu
      a.bu=abu
      a.mx=amx
    else
      copy a.bu,bu,le*2
    end if
    a.le=le
  end operator
  '
  operator + (stringbuf*a)
  ========================
    sys abu=a.bu
    int amx=a.mx
    if le+a.le>amx
      amx+=a.qu+(le*2)
      sys abu=getmemory amx*2
      copy abu,a.bu,a.le*2
      copy abu+(a.le*2),bu,le*2
      freememory a.bu
      a.bu=abu
      a.mx=amx
    else
      copy abu+a.le*2,bu,le*2
    end if
    a.le+=le
  end operator
end class
*/


/*
'07:01 05/12/2018
'TEST REDIM DESTRUCTORS
int d

class cc
  void destructor() {d++}
  float x,y,z
end class

redim cc c[100]
c[13].y=39
redim cc c[13]
print c[13].y
redim cc c[20] clear
print c[13].y
print "destructor calls " d
*/

/*
'17:54 04/12/2018
'SAFER REDIM RESET FOR STRINGS ETC
'
redim string s(100)
s(13)="ok"
redim string s(100)
print s(13)
redim string s(20) clear
print s(13)
print len s_buf
*/

/*
'02:08 04/12/2018
def redimreset
redim %1 %2 (0)
redim %1 %2 (%3)
end def

redim single s(100)
s(13)=39.5
redimreset single s(100)
print s(13) " ok"
*/



/*
'18:09 03/12/2018
'readint internal
$filename "c.exe"
uses ..\rtl64
print "ok"
*/

/*
'13:56 03/12/2018
'64bit xor literal test
$filename "c.exe"
'uses ..\rtl64
sys a
mov a,1
'mov cl,60
rol a,60
xor a,3
print hex a
*/

/*
'13:00 03/12/2018
'FILING DYNAMIC DATA
'
redim float s(100)
redim float u(0)
s(13)=39.5
'
'SAVING DYNAMIC SINGLES
putfile "t.txt",s_buf
'
'LOADING DYNAMIC SINGLES
u_buf=getfile "t.txt"
@u=strptr(u_buf)
print u(13)
*/


/*
'11:38 03/12/2018
'UDT SELF REFERENCE TEST
type tt
  int a,b,c
  tt* t
end type

tt t
@t.t=@t
t={1,2,3}
print t.b
print t.t.b
print t.t.t.b
*/


/*
'11:31 03/12/2018
'ARRAY UDT
type tt
  int a,b,c
end type
'
class cc
  '
  sys buf
  int lb
  '
  function resize(int n)
  int nlb=n*sizeof tt
  sys nbuf=getmemory nlb
  int e=lb
  if nlb<e then e=nlb
  if lb
    copy nbuf,buf,e
    freememory buf
  endif
  lb=nlb
  buf=nbuf 
  end function
  '
  function constructor(int n)
  resize n
  end function
  '
  function destructor()
  freememory buf
  end function
  '
  function pv(int i) as tt*
  i*=sizeof tt
  if i<lb
    return buf+i
  endif
  end function
  '
end class
*/


/*
'11:54 02/12/2018
'numeric names
type tt
  int 1,2
end type

tt t
#show t.1=t.2
*/

/*
'17:59 30/11/2018
int a
#show if a
endif
*/

/*
'12:10 30/11/2018
'lookahead
#lookahead
f 21
dim v(32) as long
function f(int a){print a}
print v(8)
*/

/*
'11:43 30/11/2018
'boolean not
int a=1,b=1)
if not(a<>b) then
  print "ok"
else
  print "nok"
endif
*/

/*
'11:26 30/11/2018
'pointer members
type tt
  pf as float ptr
end type

dim t as tt
dim f as float=pi()
@t.pf=@f
print t.pf
*/

/*

'N DIMENSIONAL

type vector
===========
  int x,y,z
end type


def UseMultidim
===============

  class Multidim%1
  ================
    '
    'order minor to major
    indexbase 0
    '
    int dms[63] 'up to 64 dimensions
    int dn 'number of dimensions
    int sz 'number of bytes
    sys bu 'dynamic buffer
    '
    function constructor(int*dm, n)
    ===============================
    int i
    dms[0]=dm[0]+1
    for i=1 to n-1
      dms[i]=dm[i]+1
      dms[i]*=dms[i-1]
    next
    dn=n
    sz=dms[n-1]*sizeof %1
    bu=getmemory sz
    end function
    '
    function destructor()
    =====================
    'del all members
    #if typecodeof(%1)>0xa0 'string types and above
      %1 *v
      int i
      for i=0 to sz-1 step sizeof(%1)
        @v=bu+i
        del v 
      next
    #endif
    freememory bu
    dn=0 : sz=0 : bu=0
    end function
    '
    function locator(int*d) as %1*
    ==============================
    int i
    int j=d[0]
    for i=1 to dn-1
      j+=dms[i-1]*d[i]
    next
    return j*sizeof(%1)+bu
    end function
    '
    function vf(int*d) as %1
    ========================
    %1 v at locator(d)
    function=v
    end function
    '
    function vf(int*d, %1 *a)
    =========================
    %1 v at locator(d)
    v=a
    end function
    '
  end class

end def

'TESTS:
=======
UseMultiDim float

'new Multidim m(int{7,3,1},countof)
'print m.sz '256
'print m.locate(int{0,0,0})
'print m.locate(int{0,0,1})
'print m.locate(int{0,1,0})
'print m.locate(int{1,0,0})
'print m.locate(int{2,1,1})
'm.vf(int{2,2,1})=12.5
'print m.vf(int{2,2,1})
'def mvf m.vf(int{%1}) 'syntax compaction
'mvf(2,2,1)=42
'float f=200+mvf(2,2,1)+100 '+mvf(2,2,1)
'del m
'

def NewMultidim
===============
  new Multidim%1 %2(int{%3},countof)
  def %2vf
    %2.vf(int{%%1})
  end def
end def
'
def Multidim
===============
  Multidim%1 %2
  %2.constructor(int{%3},countof)
  def %2vf
    %2.vf(int{%%1})
  end def
end def
'

NewMultidim float m(7,3,1)
Multidim float m(7,3,1)
mvf(2,2,1)=10
mvf(1,2,1)=1
float f=1000+mvf(2,2,1)+mvf(1,2,1)+100
'print f '1111
del m

UseMultidim float
Multidim float m(7,3,1)
mvf(2,2,1)=10
mvf(1,2,1)=1
'float f=1000+mvf(2,2,1)+mvf(1,2,1)+100
'print f '1111

UseMultidim vector
#recordof MultidimVector
Multidim vector v(7,3,1)
'#show sys p=v.locator(int{2,2,1})

''v.locator(int{2,2,1}).y=23
''print 1+v.locator(int{2,2,1}).y+4

'MyClassObject.functionthatreturnsaUDT
'(dimension1, dimension2, dimension3).
'UdtMemberOfTypeLong = 12345
*/


/*
'VISUAL STYLES    
'https://docs.microsoft.com/en-us/windows/desktop/controls/cookbook-overview
'https://www.oxygenbasic.org/forum/index.php?topic=1753.msg19735;topicseen#msg19735  
*/



/*
a=b+c*fun()
--->
a=b+(c*fun()) 'precedence
--->
tmp1=fun()   
--->
tmp2=c*tmp1
--->
a=b+tmp2
*/

/*
$filename "t.exe"
uses ..\rtl64

Declare Function PluriBASICMessageBox  Lib "user32.dll" Alias "MessageBoxA"

FUNCTION MSGBOX(string sText, sys mOptions = 0, string sCaption = "PluriBASIC") AS LONG
   FUNCTION = PluriBASICMessageBox(null, sText, sCaption, mOptions)
END FUNCTION

#def __dim1 (d1-bnd[1])
#def __dim2 (d2-bnd[3])
#def __dim3 (d3-bnd[5])

#def __class_nam_def class _arr_%1

macro __declare_array_type(dtype)
__class_nam_def(dtype)

    int dims      ' Number of dimensions
    int elems     ' Number of elements.
    int slength   ' length of strings.
    int ispointer ' is pointer flag.
    sys hBuffer   ' Address of the buffer
    sys hCustAddr ' Address provided by the inline code.
    int BuffLen   ' length of the buffer in bytes
    int bnd[10]   ' bounds.   
 
    function redim(int p, int * d, n)
        int i
        elems = 0
        for i = 1 to n step 2
            bnd[i+0] = d[i+0]
            bnd[i+1] = d[i+1]
            elems   += (d[i+1]-d[i+0])
        next
        int nBufLen = (elems * sizeof(sys)) + 32
        sys nBuffer = getmemory(nBufLen)
        int eBfCopy = BuffLen
        if BuffLen
          if BuffLen>nBufLen then
              eBfCopy = nBufLen
          end if
          copy nBuffer, hBuffer, eBfCopy
          freememory hBuffer
        endif
        hBuffer = nBuffer
        BuffLen = nBufLen       
    end function 
 
    method constructor(int * d, n, isptr, slen, sys hAddr)
        ispointer = isptr
        slength   = slen
        hCustAddr = hAddr
        dims = n / 2
        this.redim(0, d, n)
    end method
   
    function destructor()
        freememory(hBuffer)
        hBuffer = 0
        BuffLen = 0
    end function
   
    '======================================================================
    function c(int d1, d2, d3, dtype v)
        dtype dt at (hBuffer + 32)
        dt(__dim1 * __dim2 + __dim3) = v
    end function

     function c(int d1, d2, d3) as dtype
        dtype dt at (hBuffer + 32)
        return dt(__dim1 * __dim2 + __dim3)
    end function
    '======================================================================
    function p(int d1, d2, d3) as dtype*
        dtype dt at (hBuffer + 32)
        return @dt(__dim1 * __dim2 + __dim3)
    end function
 
end class

end macro

__declare_array_type(bstring)

SUB BYREFPAR(BYREF ss AS STRING, BYVAL _ByValue_s2 AS STRING)
   STRING s2 = _ByValue_s2
   ss = "Changed in the SUB"
   s2 = "Changed in the SUB"
END SUB

FUNCTION PBMAIN() AS INT
   new _arr_bstring sss(int{-10, 100, 0, 100, 0, 100}, countof, 0, 0, 0)
   sss.c(5,5,5) = "Original contents 1"
   sss.c(5,5,6) = "Original contents 2"
   BYREFPAR(sss.p(5,5,5), sss.c(5,5,6))
   MSGBOX(sss.c(5,5,5), 0, sss.c(5,5,6)) ' should display one modified and one unmodified.
END FUNCTION

PBMAIN() ' invoke entry point
*/

/*
class glitchy
  int glt[10]
  method constructor()
     glt[5] = -5
  end method
  function func(int d) as int
    print "i am returning: " & str(glt[d])
    return glt[d]
  end function 
end class

new glitchy sss()

print "but i am receiving: " & str(sss.func(5))

int f = sss.func(5)

print "no, it is correct: " & str(f)
*/


/*
'03:29 25/11/2018
'STRINGS AS GENERIC
'FIXED STRING MULTIASSIGN
'print val(3.5)+val("4.5")

function f(string s[],int n) as string
print s[3]
end function

#show string s={1,2,3.5,4,5}
'f s,countof s
'print s[3]
string t=f (string{1,2,3.5,4,5},countof)
*/

/*
'13:26 24/11/2018
'PASSING WHOLE ARRAY OF STRINGS BYREF

string s={"A","B","C","D"}
'
'function f(s[] as string) '[]' indicates whole array passed byref
'X
'function f(s as string []) '[]' indicates whole array passed byref
'function f(byref s as string [])
'function f(byref s as string ptr)
'function f(s as string ptr)
'function f(s as string [])
'function f(string s[]) '[]
function f(string **s) '[]'
======================
print s[1] s[2] s[3] s[4]
s[3]="c"
end function

f(s)
print s[1] s[2] s[3] s[4]
*/


/*
'06:48 24/11/2018
'MODIFIED EXPRESSIONS WITH FUNCTIONS
'
int f(int a){return a*2}
'#show int v=10+f(2)+100
int b[1000]
b[f(2)]=5
print b[f(2)]
'print v '114
*/


/*
'05:28 24/11/2018
'PROPERTIES BY PSEUDOASSIGNMENT
class cc
  '
  int a[1000]
  '
  function prop(int i,j,k, v) 'SET
  int d=i+j*10+k*100
  a[d]=v
  end function

  function prop(int i,j,k) as int 'GET
  int d=i+j*10+k*100
  return a[d]
  end function
  '
end class

cc c
c.prop(1,2,3)=21
int x=c.prop(1,2,3)
print x
*/


/*
'05:18 24/11/2018
'complexity in array indexes
int a[10]
function f(int n) as int
  return n*2
end function

print a[f(2)]
*/


/*
'16:28 22/11/2018
uses ..\console

type rect
  long left
  long top
  long right
  long bottom
end type


function f(rect*rc) as rect*
   'rect rc at prc
   printl "in function f: " rc.left ", " rc.top ", "rc.right ", "rc.bottom
   return &rc
end function


'works in oxsc
'RECT Rect1 = {10,15,100,200}
'RECT Rect2
'Rect2 = f(Rect1)
'Rect2 = f(rect{10,15,100,200}) 'anon rect
'printl "Rect = " Rect2.left ", " Rect2.top ", "Rect2.right ", "Rect2.bottom


RECT Rect1 = {10,15,100,200}
RECT Rect2
RECT *ptRect2=getmemory sizeof rect
'#recordof ptrect2
#show {
 'Rect2 = f(Rect1)
 ptRect2 = f(Rect1)
 '&ptRect2 = f(Rect1)
 'sys a = f(Rect1)
}
'&ptRect2 = f(rect{10,15,100,200}) 'anon rect
printl "ptRect = " ptRect2.left ", " ptRect2.top ", "ptRect2.right ", "ptRect2.bottom

printl "Enter: " : waitkey
*/



/*
'macro function inside fun problem
'uses console

type rect
  int left,top,right,bottom
end type

macro showrect string(s,r)
s=" "+str(r.left) ", "+r.top+", "+r.right+", "+r.bottom
end macro

function frect(rect*prc) as rect ptr
   print "in function frect: " prc.left ", " prc.top ", " prc.right ", " prc.bottom
   '#show print showrect(prc)
   return @prc
end function

RECT ptRect1 = {10,15,100,200}
RECT *ptRect2

&ptRect2 = frect(ptRect1)
'&ptRect2 = frect(rect{10,15,100,200})
'print "ptRect = " showrect(ptrect1)
print "ptRect = " showrect(ptrect2)
*/

/*
'---------------
'MACRO OPERATORS
'===============

'PARTIAL DEMO

type vector3f
  float x,y,z
end type

macro vector3f_op
=================
  ;
  macro .save (acc,a)
  ------------===----
    a.x = acc.x
    a.y = acc.y
    a.z = acc.z
  end macro
  macro .load (a,acc)
  -------------------
    acc.x = a.x
    acc.y = a.y
    acc.z = a.z
  end macro
  macro .neg (a,acc)
  ------------------
    acc.x = -a.x
    acc.y = -a.y
    acc.z = -a.z
  end macro
  macro .+ (a,acc)
  ----------------
    acc.x += a.x
    acc.y += a.y
    acc.z += a.z
  end macro
  macro .- (a,acc)
  ----------------
    acc.x -= a.x
    acc.y -= a.y
    acc.z -= a.z
  end macro
  macro .* (a,acc)
  ----------------
    acc.x *= a.x
    acc.y *= a.y
    acc.z *= a.z
  end macro
  macro ./ (a,acc)
  ----------------
    acc.x /= a.x
    acc.y /= a.y
    acc.z /= a.z
  end macro
  '
end macro

function str(vector3f*a) as string
==================================
    return str(a.x)+","+str(a.y)+","+str(a.z)
  end function
  '

'TESTS
'=====
'#recordof vector3f_op
'#recordof str
dim vector3f A = {1,2,3}
dim vector3f B = {10,20,30}
dim vector3f C = {10,100,1000}
'A=B+C
'print a.y
'print str(A)
'print str(A+B)
print str(C*(A+B))
'print "ok"
*/



/*
'00:27 21/11/2018
'PASSING ANONYMOUS ARRAYS

function f(int *a,n)
print n
int i
for i=1 to n
  a[i]*=2
next
end function

f( int{1,2,3,4,5}, countof )
*/

/*
'00:10 21/11/2018
'DEFAULT MEMBER VALUES
type color
  byte r=0x10
  byte g=0x20
  'g as byte =0x20
  byte b=0x30
  byte a=0x40
end type

color c    'sets all to null
color d
d={} 'sets all to default values
print hex(d.r) ", " hex(d.g) ", " hex(d.b) ", " hex(d.a)

d={g=0x25,b=0x35} 'default values with overrides
print hex(d.r) ", " hex(d.g) ", " hex(d.b) ", " hex(d.a)
*/

/*
'12:29 20/11/2018
'
function hiint(quad*q) as int
=============================
int i at @q+4
return i
end function

'macro hiint int* (i,q)
'======================
'@i=@q+4
'end macro

quad a=0x12345678*0x100
print hex hiint a '12
*/


/*
'12:29 20/11/2018
'
$filename "c.exe"
uses ..\rtl64
def hiint((%1)>>32)
quad a,b
a=0x12345678*0x100
b=hiint(a)
print hex b '12
*/

/*
string a(){return "A"}
string b(){return "B"}
'
if a()<b()
  print a()
else
  print b()
end if
#show a()
*/

/*
'12:21 18/11/2018
'dword float division
dword a,b,c
#show a=b/c
*/

/*
'11:33 18/11/2018
'small type shifts
word a,b=6
byte c=2
#show a=b<<c
print a
*/

/*
'08:33 18/11/2018
'new cats
string s="1234"
print "A"+"B"+"C"+s
*/

/*
'06:12 16/11/2018
$filename "c.exe"
uses ..\rtl64
def trim ltrim(rtrim(%1))
*/

/*
'05:31 16/11/2018

$filename "c.exe"
'uses ..\rtl64

function trim(string s) as string
=================================
int i,j
int ls=len s
if ls=0 then return ""
byte bb at strptr(s)
indexbase 1
for i=1 to ls
   if bb[i]>32 then exit for
next
if i>ls then return ""
for j=ls to 1 step -1
   if bb[j]>32 then exit for
next
return mid(s,i,j-i+1)
end function

string s,t
t=trim(s)
print ">" t "<"
s=""
t=trim(s)
print ">" t "<"
s=" "
t=trim(s)
print ">" t "<"
s="  ABCDEF   "
t=trim(s)
print ">" t "<"
*/

/*
function makword(byte lower,upper) as word
  return upper*0x100+lower
end function

function makdword(word lower,upper) as dword
  return upper*0x10000+lower
end function

'masking tests
int a,b
a=0x30101
b=0x30202
print hex makword a,b '201
print hex makdword a,b '2020101
*/


/*
'MessageBoxIndirect_64.o2bas
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms645402(v=vs.85).aspx
$ filename "MessageBoxIndirect_64.exe"
uses rtl64
uses corewin
'
typedef dword DWORD, UINT
typedef sys   HWND,HINSTANCE,DWORD_PTR,MSGBOXCALLBACK
typedef char *LPCTSTR
'
typedef struct {
  UINT           cbSize;
  HWND           hwndOwner;
  HINSTANCE      hInstance;
  LPCTSTR        lpszText;
  LPCTSTR        lpszCaption;
  DWORD          dwStyle;
  sys         lpszIcon;
  DWORD_PTR      dwContextHelpId;
  MSGBOXCALLBACK lpfnMsgBoxCallback;
  DWORD          dwLanguageId;
} MSGBOXPARAMS, *PMSGBOXPARAMS;




'=======================
' main

MSGBOXPARAMS mbp

with mbp
  .cbSize=sizeof MSGBOXPARAMS
  .hwndOwner=null 'hWnd
  .hInstance=GetModuleHandle(null)
  .lpszText="Good message"
  .lpszCaption="Message"
  .dwStyle=MB_OK OR MB_USERICON OR MB_TASKMODAL   '3 'Yes/No/Concel
  .lpszIcon=   200
  .dwContextHelpId=null
  .lpfnMsgBoxCallback=null
  .dwLanguageId=0 'LANG_NEUTRAL
end with     '

int a
a=MessageBoxIndirect mbp
print a
'6 yes
'7 no
'2 cancel
*/

/*
'03:43 11/08/2018
'msvcrt val/str/format$ equivalent
'http://www.cplusplus.com/reference/cstdio/printf/
'nb: msvcrt downgrades extended precision to double.

  uses ..\msvcrt 'or corewin
  char odata[64]
  sprintf(odata,"%g", double 1/3)
  print odata '0.333333 
  sprintf(odata,"%lli", quad 9/5)
  print odata '2
*/


/*
'powerbasic format
'http://www.manmrk.net/tutorials/basic/PowerBASIC/PBWINH/FORMAT_function.html
'c printf / sprintf
'http://www.cplusplus.com/reference/cstdio/printf/
*/


'12:56 13/11/2018
'core function override

/*
function str(extended*ne, int dplaces=16) as string
===================================================
addr rax,ne
fldt [rax]
'using vector 200 to call float_to_ascii
return (bstring) call [rbx+200] dplaces
end function

print str 1/3, 5
*/

/*
function str(double d, string fmt="") as string
===============================================
'return d
return fmt+d
end function

'print " " 1.23
'print str 1.23
'print str 1.23,"XYZ"
*/




/*
11:02 13/11/2018
$ filename "c.exe"
uses ..\rtl64
num.sns=1

print "!" str(67) chr(13,10) "!" str(-67)
print val(" 67")
*/

/*
'10:15 13/11/2018
  '
  type numformat
    int dp   ' DECIMAL PLACES
    int trz  ' STRIP TRAILING ZEROS
    int sn   ' SCIENTIFIC NOTATION BY DEFAULT
    int sdp  ' INHIBIT ZERO BEFORE DECIMAL POINT
    int sns  ' LEADING SPACE FOR NON NEGATIVE NUMBERS
    int lps  ' LEAD PADDING SPACES
  end type

  'default settins in the RTLs:

  '---------------------
  'NUMBER FORMAT CONTROL
  '=====================
  '
  num.dp =16 ' DECIMAL PLACES
  num.trz= 1 ' STRIP TRAILING ZEROS
  num.sn = 0 ' SCIENTIFIC NOTATION BY DEFAULT
  num.sdp= 0 ' INHIBIT ZERO BEFORE DECIMAL POINT


  'implementation in rtl float_to_ascii:
  '
  'PADDING FOR NON-NEGATIVE NUMBERS
  '
  cmp num.sns,0
  jz fwd nex
  mov byte ptr [rdx],32
  inc rdx
  '
*/

/*
'11:02 13/11/2018
'Generated with PluriBASIC 6.0.74371.0

$ filename "c.exe"
uses ..\rtl64



' STARTS STR$.BIN

' Enter the stock code and functions here.


' END OF STR$.BIN
' STARTS PLURIBASIC_INIT.BIN

' Enter the stock code and functions here.

' END OF PLURIBASIC_INIT.BIN
' STARTS CALLBACKDATA.BIN

' CALLBACK data

' END OF CALLBACKDATA.BIN
' STARTS ENTRY_POINT.BIN

' Enttry point code
' END OF ENTRY_POINT.BIN

' Initializes various things in the script.
FUNCTION PluriBASIC_Initialize() AS LONG

END FUNCTION


finit
function formt(double d, string f="") as string
return str(d)
end function

FUNCTION PBMAIN() AS LONG
   DOUBLE d
   STRING s
   d = 1.6
   s = STR(d)
   
           print formt(1.4+1.1)
           short b= -1
           print formt(b)
           string b=130.5
           print formt(b)

END FUNCTION

PBMAIN() ' invoke entry point
*/

/*
'11:02 13/11/2018
$filename "c.exe"
include ..\rtl32
'#recordof midstr
#show string s=midstr ("1234567",2,3)
print s
*/

/*
'16:37 12/11/2018
int r1,r2,r3,r4,r5,r6
int a=60, b=13
 
r1 = (a and b)    'bitwise and
r2 = (a & b)      'bitwise and

r3 = (60 && 13)   'Logical and

r4 = (a&b)        'addition?

r5 = (a& b)    'bitwise and
r6 = (a &b)    'address?

print r1 ", " r2 ", " r3 ", " r4 ", " r5 ", " r6
*/

/*
function midstr(string s, int i,n) as sys
=========================================
int le=len s
int j=i+n-1
if j>le
  j=le
endif
function=strptr(s)+i-1
edx=j
end function

char*c=midstr("123456789",3,2)
print edx
*/



/*
'17:24 23/10/2018
'08:30 27/10/2018
'objects in expressions

$filename "c.exe"
include ..\rtl32

class cc
  bstring b
  method constructor(cc*v) {b=v.b : print "cc in " b}
  method constructor(int v) {b=v : print "cc int " b}
  method constructor(float v) {b=v : print "cc float " b}
  method constructor(string v) {b=v : print "cc string " b}
  method destructor(){"cc destructor" : frees b}
  method primitive() as string {print "cc prim " b : return b }
  'OPERATORS:
  operator load (string*s){print "cc string load " b : s=b} 'requires perfect match
  operator load (cc*a){print "cc cc load " b  : a.b=b}
  operator + (cc*a) {print "cc + " a.b b : a.b+=b }
  operator < (cc*a) as int {print "cc < " : if b<a.b {return 1} }
  operator > (cc*a) as int {print "cc > " : if b>a.b {return 1} }
end class
#recordof cc

function foo(string a) as cc {print "foo cc" : return.b=a}
function bar(cc* a) as cc {print "bar cc" : return.b=a.b}

'TESTS:
=======
'#recordof cc

cc a,b,c,d
'#recordof c
a.b="A"
b="B"
c="C"
d.b="D"
'a=b+c
string s=A+B+C
print s
if b<a
  print "b<a"
else
  print "a<=b"
end if
'a=foo("helo ")+foo("world")
'a=b+(c+d)
'a=b+("hello "+"world")
'a=("hello "+"world")+b
'a=(c+d)+b
'a=bar("Hello World")
'print a.b
'a=foo("Hello World")
'print "down convert:"
'string s
's=a 'down-convert
'print a.b
*/



/*
type vector
  float x,y
end type
#recordof vector
#cpointer on
vector v

print v.y
print v->y
*/


/*
'dim b as single=4.5
dim as single b=4.5
'single a=4.5
print b
*/

/*
'22:20 06/11/2018
'address coupling
dim a as long
dim b as long ptr : @b = @a
a = &h1234
print hex(b)
*/

/*
'21:48 06/11/2018
'POINTER VARIABLES
dim byref a, byref b as single
#recordof b
dim as single byref a,byref b
single ptr a
single*a

#recordof b
*/

/*
'14:59 06/11/2018
'qwords
'print hex [rbx+712]
quad q,r
qword q,r
'double q,r
#show q=-3
int v at@q
r=q
print hex v[1]
quad u at @q
print u
'string s=str q
'print s
'print hex q
'#show quad q=r
*/


/*
'09:49 05/11/2018
'UNSIGNED QUAD
finit
var float a1 at @[ebx+712]
int b'=0x40000000
'fild dword b
'fimul dword b
'b=8
fimul dword b
'fstp dword a1
print hex cast(dword) a1

b=-2
fild dword b
fldz : fld st1 : fcomip : fstp st0 : jae fwd _nq
fadd dword [ebx+712] : fadd dword [ebx+712]
._nq

'to remove msb for storage bit
'jmp fwd _nqh

fld dword [ebx+712] : fld st1 : fcomip : fstp st0 : jb fwd _nqh
fsub dword [ebx+712] : fsub dword [ebx+712]
._nqh
 
extended e
quad q
fld st0
fistp qword q
fstpt e
string cr=chr(13,10)
var int i at @e
print hex(i[3],8) cr hex(i[2],8) cr hex(i[1],8)
string s=hex (q,16)
print s
print q
*/


/*
'05:02 05/11/2018
'REFERENCING POINTERED STRUCTURES
type aa
  float x,y,z
end type

type bb
  sys h
  'pos as aa ptr
  aa ptr pos
end type

sys p
bb v at (p)
end
#show float f=v.pos.y 
*/

/*
PB----->>

CASE %HDM_LAYOUT
         '  Fill the WINDOWPOS structure with
         '  the appropriate size and position of the
         '  header control and change the top position
         '  of the rectangle that the header
         '  control will occupy.
         LOCAL phdl AS HDLAYOUT PTR
         phdl = lParam
         @phdl.@pwpos.hwnd = hwnd
         @phdl.@pwpos.flags = %SWP_FRAMECHANGED
         @phdl.@pwpos.x = @phdl.@prc.nLeft
         @phdl.@pwpos.y = 0
         @phdl.@pwpos.cx = @phdl.@prc.nRight - @phdl.@prc.nLeft
         @phdl.@pwpos.cy = 40   ' --> change me
         @phdl.@prc.nTop = 40   ' --> change me
         FUNCTION = -1
         EXIT FUNCTION

O2------->>

CASE %HDM_LAYOUT
         '  Fill the WINDOWPOS structure with
         '  the appropriate size and position of the
         '  header control and change the top position
         '  of the rectangle that the header
         '  control will occupy.
         'LOCAL phdl AS HDLAYOUT PTR
         '@phdl = lParam
         HDLAYOUT phdl at lparam
         phdl.pwpos.hwnd = hwnd
         phdl.pwpos.flags = %SWP_FRAMECHANGED
         phdl.pwpos.x = phdl.prc.nLeft
         phdl.pwpos.y = 0
         phdl.pwpos.cx = phdl.prc.nRight - phdl.prc.nLeft
         phdl.pwpos.cy = 40   ' --> change me
         phdl.prc.nTop = 40   ' --> change me
         FUNCTION = -1
         EXIT FUNCTION
*/

/*
'11:13 04/11/2018
'QWORDS 'UNSIGNED QUADS
'======================
'SET UP QWORD COMPLEMENT
mov dword [rbx+720],0x40000000
fild dword [rbx+720]
fmul st0 'square of 0x40000000
mov dword [rbx+720],0x10
fild dword [rbx+720]
fmulp st1 
fstp dword [rbx+720] '1<<64
print cast float [rbx+720]

deff qwordun
============
fldz
fld st1
fcomip
fstp st0
jae fwd _nq
fld dword [rbx+720] '1<<64
faddp st1 'add complement to negative value
._nq
end deff

print hex qwordun((4))
*/





/*
'11:31 30/10/2018
'case systax
int a=42
'int a=0
'string a=chr(42)
select a
case '*' 'no colon
  print 42
case 0 'no colon
  print 0
case else : print "nok"
end select
*/


/*
'08:29 27/10/2018
'shorter string logic
string s
#show if not s
end if

#show if len(s)=0
end if
*/


/*
'15:45 23/10/2018
'using object params to accept different types
uses ..\rtlobjects
class cc
  bstring b
  method constructor(int v) {b=v : print "int " b}
  method constructor(float v) {b=v : print "float " b}
  method constructor(string v) {b=v : print "string " b}
  method destructor(){print "cc destructor" : frees b}
end class
'
function f(cc*c){print "f receives " c.b}
'f 42
'f 21.5
f "84"
print "ok"
*/

/*
'11:12 23/10/2018
'function name in quotes
'
'function "f" (int v) as int {print "ok"}
'call "f"(1)

class cc
  method constructor(){}
  method destructor(){}
  method "+" () as cc {}
  method "-" () as cc {}
end class
'
#recordof cc
*/


/*
'11:38 22/10/2018
uses ..\rtlobjects
class cc
  sub constructor()
  end sub
  function create() as cc
    return.constructor()
  end function
end class
*/

/*
'16:06 21/10/2018
'return direct UDT
$filename "t.exe"
'uses ..\rtl64
uses ..\rtlobjects
'extern
print "starts"
int a
'end
class vector 
  float x,y,z
  sub destructor(){print "vector.destroy"}
end class

'end
'#show {
vector f(int a) {
 'exit function
 'returnvar.y=2.5
 'f.y=2.5
 'print a
 function.y=2.5
 print a
 'print returnvar.y
}
'}
'#recordof f
vector v
#show v=f(99)
print "v.y " v.y
print "ok"
'
*/



/*
'10:30 21/10/2018
'properties
uses ..\rtlobjects

class cc
========
  int vp
  function vf(int va) {vp=va}
  function vf() as int {function=vp}
  function destructor() as int {print "cc destructor"}
end class

'#recordof cc

dim as cc c
c.vf()=42
int m=2
print c.vf()*2
*/


/*
string wr="calls"
if wr="call"
print wr
else
print "x"
end if
*/

/*
int a,b
#show copy @a,@b,4
*/

/*
word f(){}
int a,b
'#show if f()>a
#show if 0>a
end if

int a
'#show if a>b
'end if
*


/*
'16:39 19/10/2018
'#recordof chr
print chr(13,10)
*/

/*
'constants
const as float a="5/3", b=72
'#recordof a
'#recordof b
*/

/*
'13:34 16/10/2018
'print overloading

type vector
===========
  float x,y,z
end type

function print(vector*v)
========================
  print v.x ", " v.y ", " v.z
end function

vector a={1.5, 2.5, 3.5}
print a
print "ok"
*/

/*
'13:29 16/10/2018
'print overloading
uses console

function print(float a,b)
=========================
  #ifdef output
    output str(a,b) 'using console
  #else
    print str(a,b) 'relay to core print function
  #endif
end function

#recordof print
print pi(),5
print "ok"
wait
*/


/*
'with namespace
namespace ns::lengthy::deep
int a=2
'#recordof a
end namespace
'
#recordof ns::lengthy::deep::a

with ns::lengthy::deep::
  print ns::lengthy::deep::a '2
  ..a = 4 'in assignment
  print ..a + ..a 'in expression
  int b[10]
  b[..a]=5 'syntax testing as indexer
end with
print b[4] '5
*/

/*
'08:57 16/10/2018
'global namespace
'itr global::a
*/

/*
'06:11 16/10/2018
'enumerations with dot members / unique
#unique off
enum bit ee
 a,b,c,d
end enum

'print c
print ee.c '4
'print c '4
*/

/*
'04:03 16/10/2018
'https://en.cppreference.com/w/cpp/language/namespace
*/


/*
'22:25 15/10/2018
int i = 12345

namespace aa
   int i = 10
   int x = 22
   namespace bb
      int i = 11
      int x = 33
   end namespace
   print global::i   ' access the global i variable
end namespace
print "ok"
*/


/*
'14:49 15/10/2018
namespace nn
int a=4
end namespace
'print nn::a

namespace aa
   type t
      int x
      int y
   end type
   t.x=9 'trapped
end namespace

#recordof aa::t
dim aa::t v
v.x = 11
print v.x
*/

/*
'12:56 15/10/2018
'https://www.oxygenbasic.org/forum/index.php?topic=1787.msg19428;topicseen#msg19428
'quirks
'enum
'  anonymous enum
'  dot member enum
'namespaces

*/

/*
$filename "t.exe"
uses ..\rtl64
uses ..\rtlsupp
end
type vector float x,y,z
#show {
vector foo(float v){
  '#recordof _retvar
  '#show _retvar.x=5
}
}
'#recordof foo
'#show vector v=foo
'#show vector *v = foo
'#show vector v at foo()
'#show dim as vector v=foo 1.0
'#show copy 1,2,3
*/

/*
'00:25 14/10/2018
'stack frame calling

sub rsp,64
'var int a at @[rsp]
'#recordof a
'#show a=1
'#show int a at ([rsp])
*/


/*
#unique on
uses ..\oleaut
'
function Foo1 () as string2
   dim b as bstr 
   (sys) b = SysAllocString("Test string")
   function=b
   SysFreeString b
end function

function Foo2 () as string2
   function = (bstring) SysAllocString("Test string")
end function

function Foo () as string2
   return (bstring) SysAllocString("Test string")
end function

'dim as string2  s = Foo
dim as string2 s = (bstr) SysAllocString("Test string")
print s
*/


/*
type yy{} 'dummy type

type xx
  yy*a
end type

type yy
  xx*b
end type
*/




/*
'11:10 13/10/2018
'deferred destructors
uses ..\RTLsupp
class cc
  float x,y,z
  sub destructor()
    print "destructor " x
  end sub
end class

sub f()
cc c[2]
c[2].x=5
cc d
d.x=7
end sub
f
'cc e
*/


/*
'14:39 12/10/2018
'nested string compare bug
'wchar buffer[260] = "1234567890"
wstring buffer = "1234567890"
wstring s4="4",s5="5"
wstring ww
'print mid(buffer,4)
'print right(buffer,4)
'print mid(buffer,-4)
dim i as long
dim pr as string
for i =  len(buffer) to 1 step -1
   'if mid(buffer, i, 1) = wstring("5") 'or mid(buffer, i, 1) = wstring("4")
   'if mid(buffer, i, 1) = "5" or mid(buffer, i, 1) = "4"
   'if mid(buffer, i, 1) = s5 or mid(buffer, i, 1) = s4
   'if (mid(buffer, i, 1) = s5) or (mid(buffer, i, 1) = s4)
   'ww=mid(buffer,i,1)
   'ww=5
  if (ww = s5) or (ww = s4)
   'if mid(buffer, i, 1) = s5 'or (mid(buffer, i, 1) = s4)
     'print i ': exit for
   end if
   'pr+=mid(buffer,i,1)
next
'print pr
print "ok"
*/

/*
'14:32 12/10/2018
'arrays in types
typedef int tt[10]
tt t[5]
#recordof tt
#recordof t
*/


/*
'14:09 12/10/2018
function f(bugly b) 'as bugly
function f(bugly b=43) 'as bugly
'function f(b as bugly) 'as bugly
end function
*/

/*
'14:10 12/10/2018
'unicode script reading
include "u.o2bas"
*/

/*
'14:35 12/10/2018
'unicode string literals
wstring s=l"ok"
print s
*/

/*
'default sys issue
function f(ugli u){print typeof u}
#recordof f
'f 1
'print typeof u
print "ok"
*/

/*
'test unicode literals
wstring s
lax:
s="1234567"
'print mid(s,-3)
print right(s,3)
*/

/*
'fix mid negative offsets for mid
'RTLs
'12:41 10/10/2018
$filename "t.exe"
'uses ..\rtl64
wstring s
lax:
s="1234567"
'print mid(s,-3)
print right(s,3)
*/


/*
'https://docs.microsoft.com/en-us/windows/desktop/controls/subclassing-overview
SUBCLASSING2
$ filename "test4.exe"
'uses rtl64
uses MinWin
uses User
uses Comctl
#lookahead

%GWLP_WNDPROC = -4

function WinMain() as sys

   WndClass wc
   MSG      wm
   sys inst = GetModuleHandle 0

   sys hwnd, wwd, wht, wtx, wty, tax

   wc.style = CS_HREDRAW or CS_VREDRAW
   wc.lpfnWndProc = &WndProc
   wc.cbClsExtra = 0
   wc.cbWndExtra = 0   
   wc.hInstance = GetModuleHandle 0
   wc.hIcon=LoadIcon 0, IDI_APPLICATION
   wc.hCursor=LoadCursor 0,IDC_ARROW
   wc.hbrBackground = GetStockObject WHITE_BRUSH
   wc.lpszMenuName =0
   wc.lpszClassName =@"Demo"

   RegisterClass (&wc)

   Wwd = 320 : Wht = 200
   Tax = GetSystemMetrics SM_CXSCREEN
   Wtx = (Tax - Wwd) /2
   Tax = GetSystemMetrics SM_CYSCREEN
   Wty = (Tax - Wht) /2

   hwnd = CreateWindowEx(0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0)

   sys hEdit = CreateWindowEx(WS_EX_CLIENTEDGE, _
                              "Edit", _
                              "", _
                              WS_CHILD OR WS_VISIBLE OR WS_TABSTOP, _
                              20, 30, _
                              250, 25, _
                              hWnd, 102, _
                              inst, 0)
   SetWindowSubclass hEdit, &EditSubclassProc, 102, 0
   SetFocus hEdit

   ShowWindow hwnd,SW_SHOW
   UpdateWindow hwnd

   WHILE GetMessage(&wm, 0, 0, 0) > 0
      IF IsDialogMessage(hWnd, &wm) = 0 THEN
         TranslateMessage(&wm)
         DispatchMessage(&wm)
      END IF
   WEND

End Function

function WndProc (sys hWnd, uint wMsg, sys wParam, sys lparam) as sys callback
'==================================================================

    SELECT wMsg
       
      CASE WM_CREATE
         EXIT FUNCTION


      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If the Escape key has been pressed...
               IF HIWORD(wParam) = BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_DESTROY
         PostQuitMessage 0

    END SELECT

   function = DefWindowProc hWnd,wMsg,wParam,lParam

end function ' WndProc

FUNCTION EditSubclassProc (sys hWnd, uint wMsg, sys wParam, sys lparam, uIdSubclass, dwRefData) as sys callback

   SELECT CASE wMsg
      CASE WM_DESTROY
         ' // REQUIRED: Remove control subclassing
         RemoveWindowSubclass hwnd, &EditSubclassProc, uIdSubclass

      CASE WM_KEYDOWN
         SetWindowText GetParent(hwnd), "ASCII " & STR(wParam)

   END SELECT

   FUNCTION = DefSubclassProc(hwnd, wMsg, wParam, lParam)

END FUNCTION


WinMain
*/


/*
$ filename "t.exe"
uses rtl64
uses corewin
'uses MinWin
'uses User
'#lookahead

%GWLP_WNDPROC = -4

function WinMain() as sys

   WndClass wc
   MSG      wm
   sys inst = GetModuleHandle 0

   sys hwnd, wwd, wht, wtx, wty, tax

   wc.style = CS_HREDRAW or CS_VREDRAW
   wc.lpfnWndProc = &WndProc
   wc.cbClsExtra = 0
   wc.cbWndExtra = 0   
   wc.hInstance = GetModuleHandle 0
   wc.hIcon=LoadIcon 0, IDI_APPLICATION
   wc.hCursor=LoadCursor 0,IDC_ARROW
   wc.hbrBackground = GetStockObject WHITE_BRUSH
   wc.lpszMenuName =0
   wc.lpszClassName =strptr "Demo"

   RegisterClass (&wc)

   Wwd = 320 : Wht = 200
   Tax = GetSystemMetrics SM_CXSCREEN
   Wtx = (Tax - Wwd) /2
   Tax = GetSystemMetrics SM_CYSCREEN
   Wty = (Tax - Wht) /2

   hwnd = CreateWindowEx(0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0)

   sys hEdit = CreateWindowEx(WS_EX_CLIENTEDGE, _
                              "Edit", _
                              "", _
                              WS_CHILD OR WS_VISIBLE OR WS_TABSTOP, _
                              20, 30, _
                              250, 25, _
                              hWnd, 102, _
                              inst, 0)
   SetProp(hedit, "OLDWNDPROC", SetWindowLongPtr(hEdit, GWLP_WNDPROC, &EditSubclassProc))
   SetFocus hEdit

   ShowWindow hwnd,SW_SHOW
   UpdateWindow hwnd

   WHILE GetMessage(&wm, 0, 0, 0) > 0
      IF IsDialogMessage(hWnd, &wm) = 0 THEN
         TranslateMessage(&wm)
         DispatchMessage(&wm)
      END IF
   WEND

End Function


function WndProc (sys hWnd, wMsg, wParam, lparam) as sys callback
'==================================================================

    SELECT wMsg
       
      CASE WM_CREATE
         EXIT FUNCTION


      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If the Escape key has been pressed...
               IF HIWORD(wParam) = BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_DESTROY
         PostQuitMessage 0

    END SELECT

   function = DefWindowProc hWnd,wMsg,wParam,lParam

end function ' WndProc

FUNCTION EditSubclassProc (sys hWnd, wMsg, wParam, lparam) as sys callback

   SELECT CASE wMsg
      CASE WM_DESTROY
         ' // REQUIRED: Remove control subclassing
         SetWindowLongPtr hwnd, GWLP_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")

      CASE WM_KEYDOWN
         SetWindowText GetParent(hwnd), "ASCII " & STR(wParam)

   END SELECT

   FUNCTION = CallWindowProc(GetProp(hwnd, "OLDWNDPROC"), hwnd, wMsg, wParam, lParam)

END FUNCTION


WinMain
*/

/*
$filename "t.exe"
uses rtl64
uses console
cls
printl "Do wish to see the answer? (Y/N)"
string ans=input()

ans=ltrim rtrim ans     'Enter in Win64 does not work
printl ">" ans
if lcase(ans) = "y" then
  printl "Your answer is Yes"
else
  printl "Your answer is not Yes"
end if

printl "Enter ... " : waitkey     
*/

/*
'64bit precision
quad a
a=-1.0-1.0
print hex a
'
int cw
fstcw cw
print hex cw
and cw,0xfffcff
or cw,0x200
print hex cw
fldcw cw
'
a=-1.0-1.0
print hex a
finit
*/


/*
extern lib "t.dll"
! hello()
end extern

hello()
*/

/*
$dll
$filename "t.dll"
uses rtl32

print "loading"

sub hello() export
  print "Hello World!"
end sub


sub finish() external
  print "unloading"
  ...
  terminate
end sub
*/



/*
'Generated with PluriBASIC 6.0.74371.0

$ filename "t.exe"

uses rtl64



' STARTS STR$.BIN

' Enter the stock code and functions here.


' END OF STR$.BIN
' STARTS PLURIBASIC_INIT.BIN

' Enter the stock code and functions here.

' END OF PLURIBASIC_INIT.BIN
' STARTS CALLBACKDATA.BIN

' CALLBACK data

' END OF CALLBACKDATA.BIN
' STARTS ENTRY_POINT.BIN

' Enttry point code
' END OF ENTRY_POINT.BIN

' Initializes various things in the script.
FUNCTION PluriBASIC_Initialize() AS LONG

END FUNCTION


function formt(double d, string f="") as string
return str(d)
end function

FUNCTION PBMAIN() AS LONG
   DOUBLE d
   STRING s
   d = 1.6
   s = STR(d)
   
           print formt(1.4+1.1)
           short b= -1
           print formt(b)
           string b=130.5
           print formt(b)

END FUNCTION

PBMAIN() ' invoke entry point
*/

/*
$filename "t.exe"
uses rtl64

function format(double d, string f="") as string
return str(d)
end function

print format(1.4+1.1) '2.5
short b=-1
print format(b)
string b=130.5
print format(b)
*/


/*
macro midset(cw)
================
  sys ps=strptr s
  sys pw=strptr w
  int ls=cw*len s
  int lw=cw*len w
  i*=cw
  n*=cw
  if i<0 then i=ls+i+cw 'index from right
  i-=cw 'base 0
  if n>lw then n=lw
  if n+i>ls
    n=ls-i
    if n<0 then return
  end if
  copy ps+i,pw,n
end macro

function amid(char*s,int i, int n,char* w)
==========================================
midset(1)
end function

function amid(string s,int i, int n,string w)
=============================================
midset(1)
end function

function wmid(wchar*s,int i, int n,wchar* w)
============================================
midset(2)
end function

function wmid(wstring s,int i, int n,wstring w)
===============================================
midset(2)
end function


string s="1234567890"
amid (s,-4,3)="abcd"
print s
'
wstring s="1234567890"
wstring w="abcd"
wmid (s,2,3)=w
print s
'
char s="1234567890"
amid (s,2,3)="abcd"
print s
'
wchar s="1234567890"
wstring w="abcd"
wmid (s,2,3)=w
print s
*/



/*
  function fmt(string sf,...) as string
  '====================================
  sys     p=@param+sizeof sys
  int     nv at p 'integers
  bstring sv at p 'string
  single  fv at p 'single
  double  dv at p 'double
  sys i
  int le=len sf
  string sp="  "
  do
    i++ : if i>le then exit do
    select asc sf,i
    case "s" : function+= sv sp : p+=sizeof sys
    case "n" : function+= nv sp : p+=sizeof sys
    case "f" : function+= fv sp : p+=sizeof sys
    case "d" : function+= dv sp : p+=sizeof double
    end select
  end do
  end function


  'TEST
  '====

  'literal floating points are Double
  
  string s

  's=fmt "" 'tolerates empty ellipsis
  'print len s
   s=fmt ("sndd","Result:", 42, 1.25, pi)
  print s
*/



/*
wstring s="1234567890"
#show mid (s,3)="ABC"
print s
*/


/*
print 3.5^-1
*/

/*
string s="1234567890"
mid (s,2)="abcd"
print s
wstring s="1234567890"
wstring w="abcd"
mid (s,2,3)=w
print s
*/

/*
'cmov logic
mov ecx,4
mov eax,3
cmp eax,ecx
cmovl eax,ecx 'greater
print eax
*/



/*
'pseudoassign
function f(string s,t,u)
print s+t+u
end function

string s
'f("C ")="A ","B "
f()="C ","A ","B "
'f="C ","A ","B "
*/

/*
DIM s as string = "1234567890"
mid(s, 2) = "xxx"
print s
mid(s, 2,"xxx")
print s
*/

/*
  sys kernel32=LoadLibrary `kernel32.dll`
  sys user32=LoadLibrary `user32.dll`
  sys GDI32=LoadLibrary `GDI32.dll`

  bind kernel32
  (
    GetCommandLine  GetCommandLineA   ; @0
    GetModuleHandle GetModuleHandleA  ; @4
    ExitProcess     ExitProcess       ; @4
  )

  bind user32
  (
    LoadIcon         LoadIconA         ; @8
    LoadCursor       LoadCursorA       ; @8
    RegisterClass    RegisterClassA    ; @4
    MessageBox       MessageBoxA       ; @4
    CreateWindowEx   CreateWindowExA   ; @48
    ShowWindow       ShowWindow        ; @8
    UpdateWindow     UpdateWindow      ; @4
    GetMessage       GetMessageA       ; @16
    TranslateMessage TranslateMessage  ; @4
    DispatchMessage  DispatchMessageA  ; @4
    PostQuitMessage  PostQuitMessage   ; @4
    BeginPaint       BeginPaint        ; @8
    EndPaint         EndPaint          ; @8
    GetClientRect    GetClientRect     ; @8  
    DrawText         DrawTextA         ; @20
    PostMessage      PostMessageA      ; @16
    DefWindowProc    DefWindowProcA    ; @16
  )


  bind GDI32
  (
    GetStockObject   GetStockObject    ; @4
  )

declare MessageBox(sys hWnd, char* lpText, char* lpCaption,   
   dword uType) as int at @MessageBox

MessageBox 0,"Hello World", "binding",0
*/

/*
function format(double d, string f="") as string
return str(d)
end function

'short b=-1
print format 1.5+1.1
string b=130
'#recordof b
print b
print str "123.5"
*/


/*
extended f=123.45
int i at @f
string fmt(int v){ return right(hex(v,8),8) }
print fmt(i[3]and 0xffff) "  " fmt(i[2]) "  " fmt(i[1])
*/

/*
'ptrlevelof
int***i
'#recordof i
#show int b=ptrlevelof i
'#show int b=typecodeof(i)
*/

/*
'^^ symbols
int a=1,b=2
'print 2^3 'power
'print a^^(b-2)
b ^^=0
print b
*/

/*
typedef double *pDouble
dim as double num = 123456.78
dim as pDouble pNum
@pNum = @num 'address coupling
print pNum
*/

/*
print wchr(65,66)
*/

/*
'Get String from  Pointer
! lstrlenA 			Lib "kernel32.dll" (ByVal lpString As Long) As Long
! PutMem4  			Lib "msvbvm60.dll" (ByVal Addr As Long, ByVal NewVal As Long) As Long
! SysAllocString  	Lib "oleaut32.dll" (Optional ByVal pszStrPtr As Long) As Long
! SysAllocStringByteLen Lib "oleaut32.dll"(Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As String
! SysReAllocString 	Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

declare function GetStrFromPtrA(ByVal aPtr As Long) As String
 
'test
'Returns a copy of a null-terminated ANSI string (LPSTR/LPCSTR) from the given pointer
Function GetStrFromPtrA(ByVal aPtr As Long) As String
     Function = SysAllocStringByteLen( aPtr, lstrlenA(aPtr))
End Function
*/

/*

class tt
========
  '
  double x,y
  '
  'operations are identified as methods with the name in quotes
  '
  'they use 'this' as the accumulator
  '
  'the accum is auomatically created before the operator is called
  '
  'its destructor is invoked when the expression is complete
  '
  'operations return a pointer to 'this' accumulator
  '
  method destructor()
    ...
  end method
  '
  method constructor()
  x=0 : y=0
  end method
  '
  method constructor(tt*a)
  x=a.x : y=a.y
  end method
  '
  method constructor(double ax,ay)
  x=ax : y=ay
  end method
  '
  method construcor(string ax,ay)
  x=val(ax) : y=val(ay)
  end method
  '
  method "save" (tt*a)
  a.destructor
  copy @tt,@this,sizeof this
  end method
  '
  method "save" (abc*a) 'another type
  a.destructor 'if destructor exists
  copy @tt,@this,sizeof this
  end method
  '
  method "+" (tt*a)
  x+=a.x
  y+=a.y
  end method
  '
end class

internal logistics:
===================
'op     operator
'typ    class of operation
'acc    accumulator
'v      operand expression
'saved  flag
if typ has constructors
  if op=0 'load
    typ acc
    if not clear then acc.destructor : clear
    acc.constructor()
    clear saved flag
  elseif op=2 'save
    acc."save"(v) 'using polymorphic saves
    set saved flag
    goto done
  end if
  if typeof(v)<>typeof(acc)
    typ b
    clear b
    b.constructor(v) 'using polymorphic constructors 
    acc.op(b)
    if destructor exists then b.destructor
  else
    acc.op(v)
  end if
  '
  done:
  '
  if not saved then
    if destructor exists then acc.destructor : clear
  else
    if destructor exists then log v to local/global destructors
    if typeof(v)<>typeof(acc)
      if destructor exists then acc.destructor : clear
  end if
elseif typ is general udt
  use macro system
elseif typ is primitive
  use primite expression evaluation
end if

============
dimensioning
============

sparsely populated arrays

dynamic arrays

check for empty obects before using destructor

lazy contructors and destructors

nesting level

type destructorr
sys base,deref,count,nesting,destructor
end type

function isnul

function nullify

function destructora

predicaments:
=============

scope
  class myclass
    bstring buffer
    '
    method constructor(string s)
      buffer=s
    end method4
    '
    method destructor()
      del buffer
    end method
    '
  end class
  for i=1 to 1000
    n=random(1,10000)
    redim myclass v(n)
  next
end scope


using constructors
==================

dim myobject v : v.constructor(a,b,c)

array objects
=============

dim myobject v[100]
redim myobject v[n]
dyn myobject v[n]


*/


/*
type MyUdt
  double x,y
end type

macro MyUdt_op
  macro ."load" (acc,a) 'mandatory
    acc.x=a.x
    acc.y=a.y
  end macro
  '
  macro ."+" (acc,a)
    acc.x+=a.x
    acc.y+=a.y
  end macro
  '
  macro ."save" (a,acc) 'mandatory
    a.x=acc.x
    a.y=acc.y
  end macro
  '
  macro ."foo" (z)
    z.x = 123
    z.y = 34
  end macro
  '
  macro ."import" (z,a,b)
    z.x = a
    z.y = b
  end macro
  '
  macro ."str" string (s,z)
    s=str(z.x)+", "+str(z.y)
  end macro
  '
end macro


'myudt v=foo()
'dim myudt v=foo()
dim as myudt v=foo()
'dim v as myudt = foo() 'not working
print v.y
'
myudt va,vb,vc
va=foo()
vb=va+va
print vb.y '68
'
vc=foo()+foo()+va
print vc.y '102
'
vc=va+import(1000,100)
print vc.y '134
'
#show string s="result: "+str(vc) '1123,134
print s
*/


/*
type tt float a,b,c

tt f(){}
'#recordof f
'#show sys a=f
'#show tt*t=f
'#show tt t=f
int e(tt*t){}
tt s
'#show e(s)
#show e(f())
*/

/*
'16 byte stack pointer alignment
'64bit mode
int f(){print hex(rsp)}
f
*/


/*
'16 byte stack pointer alignment
'64bit mode
#show int f(){}
*/

/*
'16 byte stack pointer alignment
mov rax,0
or rax,-1
and rax,-16
print hex rax
*/

/*
int a,b
gosub g until a=1
end
g:
print "ok"
ret
*/


/*
dim ws as wstring*260
#recordof ws
#recordof 260
*/

/*
class cwstr

end class


FUNCTION Foo () AS CWSTR
   'DIM cws AS CWSTR = "Test string"
   'FUNCTION = cws
   NEW CWSTR cws("Test String")
   FUNCTION=@cws
END FUNCTION

FUNCTION Foo () AS CWSTR
   'DIM cws AS CWSTR = "Test string"
   'RETURN cws
   NEW CWSTR cws("Test String")
   RETURN @cws
END FUNCTION


SUB Bar (CWSTR*c)
...
END SUB


'#recordof foo
'#show bar( byval foo())
'CWSTR cws1 at foo()
DIM cws1 as CWSTR PTR : @cws1=foo()
...
DEL cws1
*/

/*
wchar w[50]
print sizeof w
print countof w
print bytesof w
*/

/*
'Embedded quote marks:
'$s `"Hello World"`
string s=quote !! "Hello World" !!
#recordof s
print s
'prints ">" "Hello World" "<"
*/

/*
%n 123.45
print n
single nn=n
print nn
print str(nn,2)
*/

/*
'STRPTR ASSIGN
sys p
'bstring s
'int i : zstring* s
string*s
#show strptr s=p
*/

/*
#unique on
enum Bit x
a=1,b,c
end enum
scope
  enum BIT y
  a=10,b,c
  end enum
  print b '11
end scope
print b '2
*/


/*
  includepath "..\"
  uses corewin
  '
  'wchar* cmdline = GetCommandLineW
  '
  'dim wchar*cmdline : @cmdline=GetCommandLineW
  
  'wchar ptr cmdline = GetCommandLineW
  '
  dim cmdline as wchar ptr
  @cmdline=GetCommandLineW
  '
  print cmdline
*/


/*
'$ FileName  "test.exe"
DIM s AS ASCIIZ*260
'DIM s(260) AS ASCIIZ
'char s[260]
s = "Test string"
DIM p AS ASCIIZ PTR : @p = STRPTR s
'char*p=strptr s
'ASCIIZ p AT STRPTR s
print p
*/

/*
uint a=-1
print a
*/


/*
'error messages
'uses console
uses abc
'=gler
*/

/*
'ALIGNMENTS
type tt
int i
word w
end type
type tu
tt
word wu
int  wi
byte b
end type
tu v,w[2]
'#recordof tu
'#recordof v
'#recordof w
#show w[1].i=42
#show w[2].i=84
*/

/*
#show sub f(){}
*/

/*
macro mm int(r)
mov eax,1
#snip
r=1
end macro
'#recordof mm
#show{
'if mm then {}
int a=mm
'int a=12
}
*/

/*
int a
a++
print "ok"
*/

/*
'string s="ok"
'int s
'print s
*/

/*
'$filename "t.exe"
'print filename
int a,b,c,d
macro isqa int (r,a) {r=1}
#show {if (isqa(b)<>0)or(c>1)or(d<>0){} }
*/


/*
int a
int i=10
short b=-1
#show a=i+b
#show b=b+0
print a
*/


/*

oaidl.h

'typedef [string] wchar_t* LPOLESTR;
'typedef GUID IID;
'typedef IID* REFIID;
'typedef GUID* REFGUID;
'

HRESULT GetIDsOfNames(
  REFIID   riid,
  LPOLESTR *rgszNames,
  UINT     cNames,
  LCID     lcid,
  DISPID   *rgDispId
);

HRESULT GetTypeInfo(
  UINT      iTInfo,
  LCID      lcid,
  ITypeInfo **ppTInfo
);

HRESULT GetTypeInfoCount(
  UINT *pctinfo
);

HRESULT Invoke(
  DISPID     dispIdMember,
  REFIID     riid,
  LCID       lcid,
  WORD       wFlags,
  DISPPARAMS *pDispParams,
  VARIANT    *pVarResult,
  EXCEPINFO  *pExcepInfo,
  UINT       *puArgErr
);
*/

/*
'accessing string arrays byref
wstring w[100]

int f1(sys*p){
  w[]={"a","b","c"}
  p=@w
}
int f2(wstring**s){
  w[]={"a","b","c"}
  @s=@w
}
'
wstring*t
f1 @@t
print t[2]
f2 t
print t[2]
*/


/*
wstring w[100]
int f(wstring**s){print s[2]}
w[2]="ok"
#show f w
*/


/*
byte a,b,c,d
'#show { if (a<>0)and(b<>0)and(c<>0) then {} }
'#show { if (a)and(b) then {} }
'#show { if a>0 then {} }
sys f
'#show { if c then {a=b} }
string wr=" "
#show {if val(wr)<>0 {a=b} }
*/

/*
sys p=0x123456789
print hex p
*/

/*
#show mov rax,0x123456789
print hex rax
*/

/*
mov edx,0xa0000000
mov esi,0
shld esi,edx,4
print hex esi
*/

/*
int f(dword a){}
int i
#show f i+i
*/

/*
end
int i
sys p
#show call xx p or i
#show call xx 123 or 456
xx:
*/


/*
type tt
  byte b[100]
end type

tt a[200]
int i=1, j=1

8/
#show a[i].b[j]

/*
'print "helo"
'print version
int v[1000]
indexbase -2
int i=-2
v[-1]=42
v[-2]=24
#show v[i]
#show v[1+i]
print v[i+1]
*/

/*
05:12 25/08/2018
'NEW CONDITIONALS:
int a,b,c,d,e,f
int f1(){}
'#show { if f1(){} }
'#show { if f1() and f1() {} }
'#show { if ((a>b)and(c<d))or(e<>f)or(a<>b){} }
*/

/*
'NEW CONDITIONALS:

int a,b,c,d
int f(){}
int f1(int a){}

'#show {if (a>b)and(c<d) {} }
'#show {if (a>f())and(c<d){} }
'#show {if (a>b)and(f()<d) {} }
'#show {if a>b {} }
'#show {if not a>b {} }
'#show {if not a>b {} }
'#show { if f(){} }
'#show { if not f(){} }
'#show { if not f1(7){} }
'#show {if f()>b {} }
'#show {if f()>f() {} }
'#show { if a>b+1 {} }
'#show { if a+1>b {} }
'#show {if (a>b) {} }
'#show { if a and b {} }
'#show { if(a)and(b) {} }
'#show { if(a+8)and(b) {} }
'#show { if(f())and(b) {} }
'#show { if(f())and(f()) {} }
'lazy
'FLOATS ok
'STRINGS
*/

/*
$filename "o2dt.exe"
'uses rtl64
includepath "..\"
uses corewin
includepath ""
uses console

'int t=9
% t 9999
def t 999
int t=99
'#show string s= str t
print ">>" t cr
wait
*/

/*
'% t 9
'def t 99
'macro t(){999}
'int t=9999
'#show int a=t
*/

/*
'includepath "..\"
'uses corewin
'includepath ""
'#recordof messagebox
'#recordof rect
'#recordof wndclassex
'int f(){
'#show string s= str t
'mbox s
'}
'f
*/

/*
includepath "..\"
uses corewin
includepath ""
uses console
print pi tab pi/2 cr
'MessageBox 0,str (pi),"sdk",1
wait
*/

/*
int v
mov eax,5
(
 dec eax
 jl exit
 inc v
 repeat
)
print v
wait
*/


/*
#show int v=-4+5
'#show mov v,-45
'#show v=-v
print  hex v
*/

/*
extended v
v=1e12
quad q=v
print v chr(13,10) q
*/

/*
includepath "..\"
uses corewin
includepath ""
uses console
int a
do
  a=GetAsyncKeyState VK_CONTROL
  print a cr
loop
*/

/*
  'dynamic compiling
  extern lib "oxygen.dll"
  ! o2_abst      (string s) as string
  ! o2_basic     (string s) as sys
  ! o2_exec      (sys p=0)  as sys
  ! o2_buf       (sys n)    as sys
  ! o2_errno     ()         as sys
  ! o2_error     ()         as string
  ! o2_len       ()         as int
  ! o2_lib       ()         as sys
  ! o2_link      (string s) as sys
  ! o2_mode      (int m)
  ! o2_pathcall  (sys m)
  ! o2_prep      (string s) as string
  ! o2_varcall   (sys m)
  ! o2_version   () as string
  ! o2_view      (string s) as string
  end extern
  o2_basic quote """
  extern
    function f1(int a)
    print "helo 1  " a
    end function
    '
    function f2(int a)
    print "helo 2  " a
    end function
    '
    function finish()
    terminate
    end function
    '
    sys ft{@f1,@f2,@finish}
    addr ft
  end extern
  """ ' end quote
  '
  if o2_errno
    print "dynamic " o2_error
    end
  end if
  '
  indexbase 1
  sys pex=o2_exec 0
  sys ft at (pex)
  extern
    ! f1(int a) at ft[1]
    ! f2(int a) at ft[2]
    ! finish()  at ft[3]
  end extern
  f1(10)
  f2(20)
  finish()
  print "ok main"
*/

/*
int a=loadlibrary "oxygen.dll"
int pb=getprocaddress(a,"o2_basic")
print pb
*/

/*
indexbase 0
float a,b,c,d
int i,j
#show {
  'if a>0 {}
  'if a>0 {}
  'if a>b[i]{}
  'if a>b[i+i]{}
  'if a[i+i]>b{}
  'if a[i]>b[j+j]{}
  'if a[i+i]>b[j+j]{}
  if a[i+i]>42{}
  'a[i+i]=b[j+j]
}
*/


/*
  'EXE
  $ filename "o2testsg1.exe"
  uses rtl32

  includepath "..\"
  uses corewin
  includepath ""
  print "ok 32bit"
*/


/*
  'TEST EXIT 2 OR
  int a,b,c,d
  (
  (
   cmp a,0 : jz exit
   cmp b,0 : jz exit
   exit 2
  )
  print "ok or exit 2 "
  )
*/
  

/*
  'TEST EXIT EQUIV OR
  int a,b,c,d
  (
   cmp a,0 : jz exit
   cmp b,0 : jz exit
   jmp fwd ndone
  )
  print "ok or "
  .ndone
*/
  
/*
  'TEST EXIT EQUIV AND
  int a,b,c,d
  cmp a,0 : jnz fwd ndone
  cmp b,0 : jnz fwd ndone
  print "ok and "
  .ndone
*/
  
    


/*
'PROPOSED CONDITIONAL
{ if (a>b)or(c<d) {}
int tc
int a,b,c,d
mov tc,-1
mov eax,a
cmp eax,b
jgt cond 'or lazy jump true
mov eax,c
cmp eax,d
jlt cond
mov tc,0
.cond
or tc,0
jz ncond  '12 instructions
...
.ncond
*/


/*
'CURRENT CONDITIONAL
int a,b,c,d
#show { if (a>b)or(c<d) {} '21 instructions
}
print "ok t"
*/

/*
  'FUNCTIONOVERLOADS
  int f(int a){print "ok " 1}
  int f(int a){print "ok " 2}
  F 0
*/
  


/*
  'FUNCTION POINTERS
  int f(int a){print "ok " a}
  !* g(int a)
  @g=@f
  g 123
*/

/*
  print "ok"
*/

/*
  'LOGICAL STATEMENTS
  int a,b,c,d
  a=(b==0)and(c==0)
  print a
*/

/*
  'MULTIASSIGN PARAMS
  function f(int*a,n)
  print n  
  int i
  for i=3 to 4
    print a[i]
  next
  end function
  int a{10,20,30,40,50}
  'f a,countof a
  f int{1,2,3,4,5},countof
*/

/*
'---------------
'MACRO OPERATORS
'===============

'PARTIAL DEMO

type vector3f
  float x,y,z
end type

macro vector3f_op
  macro ."save"(a,acc)
    a.x = acc.x
    a.y = acc.y
    a.z = acc.z
  end macro
  macro ."load"(acc,a)
    acc.x = a.x
    acc.y = a.y
    acc.z = a.z
  end macro
  macro ."neg"(acc,a)
    acc.x = -a.x
    acc.y = -a.y
    acc.z = -a.z
  end macro
  macro ."+"(acc,a)
    acc.x += a.x
    acc.y += a.y
    acc.z += a.z
  end macro
  macro ."-"(acc,a)
    acc.x -= a.x
    acc.y -= a.y
    acc.z -= a.z
  end macro
  macro ."*"(acc,a)
    acc.x *= a.x
    acc.y *= a.y
    acc.z *= a.z
  end macro
  macro ."/"(acc,a)
    acc.x /= a.x
    acc.y /= a.y
    acc.z /= a.z
  end macro
  '
  macro ."str" string (out,a) 'CORE FUNCTIONS
    out=str(a.x)+","+str(a.y)+","+str(a.z)
  end macro
  '
end macro

'TESTS
'=====
'#recordof "r.txt" vector3f_op

dim vector3f A = {1,2,3}
dim vector3f B = {10,20,30}
dim vector3f C = {10,100,1000}

'vector3f a
'#show A=A
'#show a=b+c
'#show a=(b+c)
'#show a=a*(b+c)
print str(A)
print str(A+B)
print str(C*(A+B))
*/



/*
  'FUNCTION DEFAULTS
  int m(int a=10,b=20){
  print a ", " b
  }
  m()
  m(1)
  m(1,2)
  m(b=2)
*/  

/*
  'MACRO DEFAULTS
  macro m(a=10,b=20)
  print a ", " b
  end macro
  '#recordof m
  m()
  m(1)
  m(1,2)
  m(b=2)
*/


/*
  'LEGACY GLOBAL
  global as sys p
  #recordof p
*/


/*
  'POW
  #show float a=pow(2,3)
  print a
  print log10 a
*/


/*
  'NEGATIVE FLOAT PARAM
  sub f(float a) label {}
  sys g
  g=@f
  float c,d
  #show call g -d+d
  '#show f float -d+1.
*/


/*
  int a
  #show a=0xaffffffb
  print hex a
*/


/*
  'CONVERSION BUG
  finit
  double d
  "fffffffe"
  dec eax
  mov ecx,eax
  call fwd hexaval
  fstp qword d
  print d
  print hex d
  #SHOW int a=d
  print hex a
  end
  '-------
  hexaval:
  '=======
  '
  'ECX POINTS TO LEFT BOUNDARY OF TEXT NUMBER
  '
  push esi
  xor edx,edx
  xor esi,esi
  '
  ( 'rhexconv:
    inc ecx
    mov al,[ecx]
    cmp al,48 '0
    jb exit 'boundary reached
    '
    'CONVERT TO UPPERCASE
    '
    (
      cmp al,96
      jbe exit
      cmp al,122
      ja exit
      sub al,32
    )
    '
    cmp al,70 'F
    ja exit
    cmp al,57 '9
    jbe nadjal
      cmp al,65
      jb exit 'boundary character
      sub al,7
    nadjal:
    sub al,48 'ascii to hex number
    shld esi,edx,4 'shift nybble
    'o2 0f a4 d6 04 
    shl edx,4
    add dl,al
    '
    'itr overflow
    '
    repeat 'jmp rhexconv
  '
  ) 'nhexconv: 'done conversion 'result in edx
  '
  mov eax,edx 'return lower dword
  mov edx,esi 'possible upper dword
  pop esi
  '
  push edx
  push eax
  fild qword ptr [esp]
  add esp,8
  ret
*/

/*
  'HEX TO VAL BUG  
  double d=-1'0xffffffff
  'int d=0xffffffff
  'd=-2
  'shr d,4
  print d
  print hex d
*/

/*
'USING MACRO FUNCTIONS
'2D ARRAY WITH BOUNDARY CLIPPING
indexbase 0
dword pix[800*600]
'
'SINGLE-LINE MACRO FUNCTION
'macro pix2d(x,y) pix(y*800+x)
'
'MULTI-LINE MACRO RETURNING A UNIQUE VARIABLE
'
macro pix2d int* (v,x,y,  vv)
=============================
  'v  pixel pointer supporting read/write
  'x  horizontal coordinate
  'y  vertical coodinate
  'vv sink pixel
  if x>=0 and x<800 and y>=0 and y<600
    @v=@pix(y*800+x)
  else
    'int vv=0xffffffff 'value when out of bounds
    dword vv=0xffffffff
    vv=-1
    @v=@vv
  end if
end macro
'
'TEST
pix2d(1,20)=0x77aabbcc
'print hex pix2d(1,20)
print pix2d(800,10)
print hex pix2d(800,10)
*/


/*
  'META-EXPRESSIONS
  int pix[800*600]
  print spanof pix
*/

/*
  'MACRO FUNCTION
  macro mm any* ( r,  b,c)
  typeof r a
  #recordof a 
  a=b+c
  @r=@a
  end macro
  '
  macro md any ( a,  b,c)
  #recordof a 
  a=b+c
  end macro
  '
  float aa=md(1,2.5)
  print aa
*/

/*
  'ASSIGNMENT WITHIN CONDITIONAL EXPRESSION
  int f(int a){return a*2}
  int v
  if v := f(2)
    print v
  end if
*/


/*
  #case capital
  int aA=2
  int AA=4
  print aa
  print AA
*/


/*
  'META
  $a
  #ifndef a
    print "a"
  #else
    print "b"
  #endif
*/


/*
  'META NEW
  class cc
    float a,b,c,d
    int m(){print "ok"}
  end class
  new cc c
  c.m
  del c
  #recordof c
*/ 


/*
  const float f=1.5/2
  #recordof f
  '#show f=7.5
  print f
*/


/*
  'AUTODIM OFF
  a=1
  print a
*/


/*
  'CONCAT LITERALS
  string s
  s="1" "2"
  '#show string t="1"+"2" 'needs '+'
  print s
*/


/*
  'MULTILINE STRING
  string s=
  "
  a
  b
  c
  "
  print s
*/


/*
  'CHANGING STRING BYREF
  string s
  int f(string*s){s="ok"}
  int g(string*s){f(s) : s="g "+s}
  g(s)
  print s
*/

/*
  'LITERAL BYREF
  function f(int*a){print a}
  int va=4
  va+=3
  'print va
  'f(va)
  '
  function f(string *a){print a }
  '#show f("")
  string s="3 "
  s+="okk"
  f(left("qwerty",5))
  f(s+s) 
*/

/*
  goto nn
  print "nok"
  'nn:
  .nn
  print "ok"
*/

/*
  'ASM
  int a
  a=4
  mov eax,a
  shl eax
  add eax,4
  print eax
*/


/*
  'OOP
  class cc
    method m1(int a){print "ok1" a}
    method m2(int a){print "ok2"}
    method m3(int a){print "ok3"}
    '
  end class

  cc c
  '#recordof cc
  '#recordof c
  c.m1 23 'object call
  'cc.m2 'class call
*/


/*
  'FUNCTIONS
  function f(string s) as string
  return s
  end function
  '
  string s="hello"
  print f(s)
*/

/*
  'INCLUDES
  MessageBox 0,"msg","title",1
*/


/*
  'MACROS
  macro m(a)
  print a
  end macro
  '
  m "Hello"
*/


/*
  'TYPES
  #recordof wndclassex
*/


/*
  'EXPRESSIONS
  sys i=42
  string s="helo"
  print "ok " i " " s
*/
