'GENERICS.INC


  def literal "%1"


  def bufptr strptr


  sub Clear(sys p, int n)
  =======================
  sys v at (p)
  while n>=sizeof(sys)
    v=0 : @v+=sizeof(sys): n-=sizeof(sys)
  wend
  byte b at (p)
  while n>0
    b=0 : @b++ : n--
  wend
  end sub


  macro Swap(a,b,    c)
  =====================
  typeof(a) c
  c=a
  a=b
  b=c
  end macro

  def show
  ========
  print  " %1: " + %1
  end def


  macro LimitMin(a,m)
  ===================
  if a<m then a=m
  end macro


  macro LimitMax(a,m)
  ===================
  if a>m then a=m
  end macro


  macro LimitMinMax(a,n,m)
  ========================
  if a<n then
    a=n
  elseif a>m then
    a=m
  end if
  end macro
 

  def Stride
  ==========
  @%1+=sizeof %1
  end def

  def ByteSize
  ============
  sys _p_=@%1
  if _p_>0
    #if ptrlevelof %1==0
      int _l_=bytesof %1
    #else
      int*_l_
      @_l_=_p_ -4 'length of mem
    #endif
  endif
  end def

  macro CountOfEach int(r,a,  s)
  ===============================
  if @a>0    
    #if ptrlevelof a==0
     r=countof a
    #else
      bstring s
      ?s=@a
      r=len(s)/sizeof(a)
    #endif
  endif
  end macro


  def ForEach
  ===========
  scope
    sys _p_=@%1
    int _i_
    int _e_
    _e_=CountOfEach(%1)
    if _p_>0
      typeof(%1) * %1 'new pointered version
      @%1=_p_
      for _i_=1 to _e_
        %2
        stride %1
      next
    endif
  end scope
  end def




'bottom-up Merge-sort procedure
===============================
macro mergeSort(
  index,count,compare, 'params
  i,src,dest,stp,sw,kk,bi,bj,ej,ed,ni,nj,sx,dj,sd 'encapsulated
  )
'
' index      index array name
' count      element count
' compare    comparator callback/macro
'
sys src  = 0      ' index offset for elements to be compared
sys dest = 0      ' index offset for merged ordered elements
sys stp  = 0      ' merge group size X sizeof idx element
sys sw   = 0      ' flag to select from second group instead of first
sys kk   = 0      ' element counter
sys bi   = 0      ' base for first group
sys bj   = 0      ' base for second group
sys ej   = 0      ' boundary for second group
sys ed   = 0      ' source data boundary
int sx   = 4      ' element sizeof int
int * ni          ' position for first compare element
int * nj          ' position for second compare element
int * dj          ' destination for element
sys sd=count*sx   ' size of index data (bytes)
'
#ifndef index
  int *index 'create the index file
  if @index then freememory @index                        'clear counter
  @index=getMemory 2*(count)*sx
  scope
  indexbase 1
  int i
  for i=1 to count
    index[i]=i 'initial value
  next
  end scope
#endif
'
src=@index
dest=sd+@index
stp=sx 'INITIAL STRIDE IS SIZE OF IDX ELEMENT
do 'MERGING LOOP
  if stp>=sd
    if src<>@index then 'COPY INDEX VALUES BACK TO BASE
      copy @index, @index+sd, sd
    endif
    exit do 'DONE
  end if
  kk=0
  bi=src : bj=bi+stp : ej=bj+stp
  @ni=bi : @nj=bj
  ed=src+sd 'DATA BOUNDARY
  LimitMax ej,ed
  @dj=dest
  stp+=stp 'DOUBLE STRIDE FOR EACH MERGE 8,16,32 ...
  do 'NEXT MERGING PASS
    kk++      'TALLY ELEMENTS
    if kk>count
      exit do 'ALL ELEMENTS PROCESSED
    endif
    retest:
    if @ni>=bj
      if @nj>=ej 'MOVE TO NEXT GROUP PAIR
        bi+=stp
        bj+=stp
        ej+=stp
        @ni=bi
        @nj=bj
        LimitMax ej,ed 'LIMIT EJ TO BOUNDARY ed
        goto retest
      else '@nj<ej
        dj=nj
        stride nj
        'PICK FROM SECOND GROUP
      endif
    elseif @nj>=ej
      dj=ni
      stride ni
      'PICK FROM FIRST GROUP
    else 'ni<eej and nj<ed
      '
      'OTHERWISE COMPARE BEFORE PICKING
      sw=0
      compare sw, ni, nj 'COMPARE PROCEDURE
      if sw 
        dj=nj
        stride nj
      else
        dj=ni
        stride ni
      endif
    endif
    stride dj 'NEXT DESTINATION POSITION
  loop
  swap src,dest 'SWAP SOURCE/DESTINATION BASES FOR NEXT PASS
loop
end macro


  macro NewSortIndex(idx,ct,cf,filt,comp,  i,f,x)
  ===============================================
  'idx            index name
  'ct             count of items
  'cf             resulting count of filtered items
  'filt  optional filter procedure for selecting items
  'comp  optional comparison procedure for sorting items
  '
  int *idx 'create the index file
  int cf   'filtered data counter
  cf=0
  if @idx then freememory @idx                        'clear counter
  @idx=getMemory 2*(ct)*sizeof int
  scope
    int x at @idx  'idx strider
    int i          'iterator
    int f          'filter flag
    for i=0 to ct-1
      f=0
      #ifdef filt
        filt f,i
      #else
        f=1
      #endif
      if f
        x=i+indexbase
        stride x : cf++
      endif
    next
  end scope
  #ifdef comp
    mergeSort idx,cf,comp
  #endif
  end macro


  macro NewSortedData(a,b,idx,ct,  i,j)
  =====================================
  'a   new array for sorted data output
  'b   data array
  'idx sorted index to data array
  'ct  count of array elements
  '
  typeof(b) *a
  if @a then freememory @a                        'clear counter
  @a=getMemory ct*sizeof b
  scope
    indexbase 1
    int i,j
    for i=1 to ct
      j=idx[i]
      a[i]=b[j]
    next
  end scope
  end macro


  def DelDynamicArray if @%1 then freememory @%1 : @%1=0
  def DelSortIndex  DelDynamicArray %1
  def DelSortedData DelDynamicArray %1


  macro Encounters(v,ct,act,  a,b,e)
  ==================================
  '
  'permutations of pairs of elements in an array
  'v    array of elements
  'ct   count of elements
  'act  action to be performed with the selected pair
  '
  typeof(v) *a,*b
  sys e
  e=(ct-1) * sizeof v + @v
  @a=@v
  while @a<e
    @b=@a
    while @b<e
      @b+=sizeof b
      act a,b
    wend
    @a+=sizeof a
  wend
  end macro


  macro Touch(xd,yd,r1,r2,act,    xx,yy,rr,dd)
  ============================================
  '
  '2 objects may come into contact on an xy 2d plane
  'xd   difference in x coordinates
  'yd   difference in y coordinates
  'r1   touch radius of object 1
  'r2   touch radius of object 2
  'act  action to perform when contact is made
  '
  float rr=r1+r2
  float xx = abs(xd)
  if xx<=rr then
    float yy = abs(yd)
    if yy<=rr then
      float dd=xx*xx+yy*yy 'distance squared
      rr*=rr
      if dd<=rr then
        act
      end if
    end if
  end if
  end macro




'MACRO FUNCTIONS
'===============


  macro iif any(r, c, a ,b)
  =========================
  'any' becomes the accummulator type
  if c
    r=a
  else
    r=b
  endif
  end macro

  macro Limited any(r,v,min,max)
  ==============================
  if v<min
    r=min
  elseif v>max
    r=max
  else
    r=v
  endif
  end macro

