#case capital
uses generics

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

type SYSTEMTIME
  word wYear,wMonth,wDayOfWeek,wDay
  word wHour,wMinute,wSecond,wMilliseconds
end type

extern lib "kernel32.dll"
! Sleep (sys msec)
! GetSystemTime (SYSTEMTIME*lpSystemTime)
! GetLocalTime (SYSTEMTIME*lpSystemTime)
! GetTickCount() as sys


/*
macro longlongstore(t) addr ecx,t : mov [ecx],eax : mov [ecx+4],edx
macro f(v) mid( "0"+v , -2)
macro m(v) mid("00"+v, -3)

macro timestr(t)
t.wYear "." f(t.wMonth) "." f(t.wDay) " " +
f(t.wHour) ":" f(t.wMinute) ":" f(t.wSecond) +
"." m(t.wMilliseconds)
end macro
*/
end extern


extern
 
================
Class TableClass
================

indexbase 1

string bufi      ' INPUT BUFFER
string bufo      ' FLAT TABLE BUFFER
string bufr      ' ROW BUFFER
string bufc      ' OUTPUT BUFFR FOR COLUMN DATA
string pr        ' GENERAL OUTPUT BUFFER
string jus       ' JUSTIFICATION AND COLUMN WIDTHS CODING
string dlm       ' COLUMN (FIELD) DELIMITER STRING
string ColPad    ' COLUMN PADDING 
sys    Cols      ' NUMBER OF COLUMNS
sys    Rows      ' NUMBER OF ROWS
sys    TotWidth  ' TOTAL CHARACTER WIDTH
sys    seln      '
sys    ld        '
sys    lc        '
sys    lp        '
sys    dq        '
sys    rws       ' SELECTED ROW COUNT
sys    ColWidth  [0x100] ' COLUMN WIDTHS
sys    ColIndex  [0x100] ' COLUMN PRESENTATION INDEX
sys    ColFormat [0x100] ' COLUMN DATA FORMAT
string ColFormats[0x100] ' COLUMN DATA FORMAT CODINGS
sys    *idx,*ido

method NewQuery()
=================
seln=0 : rws=0
bufr="" : bufc=""
if @idx then
  freememory @idx
  freememory @ido
end if
end method

method Init()
=============
bufi="" : bufo="" : pr="" : cr="" : jus="" : dlm="" : colpad=""
TotWidth=0 : rows=0 : cols=0 : lc=0 : ld=0 : lp=0 : dq=0
lc=2
dlm=","
ld=1
jus=string 0x100,"L" 'DEFAULT TO LEFT ALIGNED DATA IN ALL COLUMNS
NewQuery()
end method


'CREATE PACKED TEXT SET OF NUMBERS FROM ARRAY OF DOUBLE FLOAT
'
method SetNum(double*d,sys x,y)
===============================
bufi=nuls x*y*32 'max 32 digits per number+delims
string w
sys i,j,k,n
k=1
for i=1 to y 'ROWS
  for j=1 to x
    n++
    w=d[n] : lw=len w
    mid bufi,k,w : k+=lw
    if j<x then
      mid bufi,k,dlm : k+=ld 'DATA DELIMITER
    else
      mid bufi,k,cr  : k+=lc 'END OF ROW
    end if
  next
next
bufi=left bufi,k-1 'TRIM BUFFER
measure
end method

method colprintf(sys cc, double e) as string
============================================
'cc  column number
'e   number
'b   buffer for formatted number text
static char b[64]
sprintf_s b,64,colformats[cc],e 'C NUMBER TO TEXT FORMATTER
method=b
end method

'PARSE FORMAT STRING AND EXTRACT WIDTH DATA ETC
'
method ParseFormat()
====================
byte   b at strptr jus
byte   c
sys    a
sys    cc          'COLUMN COUNTER
sys    i=1, j      'CHAR INDEXES
string jj=nuls 256 'OUTPUT FORMAT BUFFER
do
  select b
  case 0        : exit do
  case 34,39,96 'OPENING QUOTE MARKS
    @b++ : i++
    c=b
    j=i
    do
      select b
      case 0 : exit do
      case 34,39,96 ' CLOSING QUOTE MARKS
        colformats[cc]=mid(jus,j,i-j)
        select asc jus,j
        case 37   : colformat[cc]=1 ' %
        case else : colformat[cc]=2 ' DATE FORMAT D T
        end select
        exit do
      end select
      @b++ : i++
    end do
  case 48 to 57 : v=val mid jus,i,4 'DECIMAL NUMBERS
    colwidth[cc]=v 'OVERRIDE COLUMN WIDTH
    do 'FLUSH NUMBER
      @b++
      i++
      select b
      case 48 to 57 : 'FLUSH NUMBER DIGITS
      case else     : @b-- : i-- : exit do
      end select
    end do
  case 65 to 90, 97 to 122    'C L R etc
    if cc>=0x100 then exit do
    cc++
    mid jj,cc,chr(b)
    colwidth [cc]=0
    colformat[cc]=0
  end select
  @b++
  i++
end do
jus=left jj,cc 'OVERWRITE RAW FORMAT STRING
end method


'IS ASCII DELIMITED FORMAT
'
method iscsv() as sys
=====================
if ld=3 then
  if dlm=`","` then return 1
end if
end method


'LOCATE END OF RECORD
'
method endofrecordcsv(sys bb) as sys
====================================
byte *b
@b=strptr(bufi)+bb-1
sys i=bb
do
  select b
  case 0     : return 0
  case 10,13 : return i

  case 34
     @b++ : i++
     do
       select b
       case 0 : return 0
       case 34
         if b[2]<>34 then  exit do ' OTHERWISE CONTINUE ""
         @b++ : i++ 'skip
       end select
       @b++ : i++
     end do

  end select
  @b++ : i++
end do
end method


'LOCATE END OF FIELD
'
method endoffieldcsv(sys bb) as sys
===================================
byte *b 
@b=strptr(bufi)+bb-1
sys i=bb
dq=0
do
  select b
  case 0     : return 0
  case 44    : return i
  case 10,13 : return i 'end of record
  case 34
     @b++ : i++ : dq++
     do
       select b
       case 0 : return 0
       case 34
         dq++ 
         if b[2]<>34 then exit do
         @b++ : i++ 'SKIP EXTRA QUOTE MARK AND CONTINUE
       end select
       @b++ : i++
     end do
  end select
  @b++ : i++
end do
end method


'COUNT ROWS AND MAX COLUMN WIDTHS, INCLUDING COLUMN SPACING
'
method measurecsv()
===================
sys a, b, i, wa, wb, cm, c, cw
a=1 : b=1
for i=1 to cols
  colwidth[i]=0  'CLEAR PREVIOUS COLUMN WIDTHS
  colformat[i]=0 'CLEAR FORMAT FLAGS
next
Cols=0 : Rows=0
ld=len dlm
'if not ld then dlm=`","` : ld=3
ParseFormat 'GET SPECIFIED WIDTHS AND FORMATS
do
  wb=b
  a=endofrecordcsv(b)
  if a=0 then exit do
  cm=0
  c++ 'row counter
  do
    if ld then wa=endoffieldcsv(wb)
    cm++ 'column counter
    if cm>cols then cols=cm 'COLUMNS MAX COUNT
    cw=wa-wb-dq
    if cw > ColWidth[cm] then ColWidth[cm]=cw 'COLUMN MAX WIDTH
    if wa=a then
      exit do
    else
      wb=wa+1
    end if
  end do
  b=a+lc
end do
rows=c
'
c=0
for i=1 to cols
  colIndex[ i ]=c+1
  c+=ColWidth[ i ]+lp
next
TotWidth=c+lc-lp '-lp: no padding before cr
end method


'COUNT ROWS AND MAX COLUMN WIDTHS, INCLUDING COLUMN SPACING
'
method measure()
================
if iscsv then measurecsv : return
sys a, b, wa, wb, cm, c, cw
a=1 : b=1
ParseFormat 'GET SPECIFIED WIDTHS AND FORMATS
do
  wb=b
  a=instr b,bufi,cr
  if a=0 then exit do
  cm=0
  c++ 'row counter
  do
    if ld then wa=instr wb,bufi,dlm
    if wa=0 or wa>a then wa=instr wb,bufi,cr
    cm++ 'column counter
    if cm>cols then cols=cm 'COLUMNS MAX COUNT
    cw=wa-wb
    if cw > ColWidth[cm] then ColWidth[cm]=cw 'COLUMN MAX WIDTH
    if wa=a then
      exit do
    else
      wb=wa+ld
    end if
  end do
  b=a+lc
end do
rows=c
'
c=0
for i=1 to cols
  colIndex[ i ]=c+1
  c+=ColWidth[ i ]+lp
next
TotWidth=c+lc-lp '-lp: no padding before cr
end method

method dedoublequote(string s) as string
========================================
string w=space len s
byte b at strptr s
byte c at strptr w
sys i
do
  c=b
  select b
  case 0  : exit do
  case 34 : @b++ 'SKIP ADJACENT QUOTE CHAR
  end select
  @b++ : @c++ : i++
end do
return left w,i
end method

'CONVERT FROM CSV TO ALIGNED LAYOUT
'
method buildcsv()
==================
sys    a, b, wa, wb, wl, cm, lpos, cpos
string w1
'
bufo=space Rows*TotWidth
a=1 : b=1
do
  wb=b
  a=endofrecordcsv(b)
  if a=0 then exit do
  cm=0
  cpos=1
  do
    wa=endoffieldcsv(wb)
    '
    cm++ 'COLUMN COUNTER
    wl=wa-wb-dq
    if dq then wb++ 'FIELD DATA IS WITHIN QUOTES
    if dq>2 then
      w1=dedoublequote mid(bufi,wb,wl+dq-2)
    else
      w1=mid(bufi,wb,wl)
    end if
    if colformat[cm]=1 then
      w1=colprintf cm, val w1
    end if
'itr date time formats
    wl=len w1
    '
    p=lpos+cpos 'default "L" LEFT ALIGN
    if wl>colwidth[cm] then wl=colwidth[cm] 'RIGHT CLIP DATA
    '
    select asc(jus,cm)
      case "R" : p=lpos+cpos+ColWidth[cm]-wl
      case "C" : p=lpos+cpos+( ColWidth[cm]-wl )*.5
    end select
    '
    mid bufo,p,w1
    cpos+=colwidth[cm]
    if a=wa then
      exit do
    else
      mid bufo, lpos+cpos, colpad
      cpos+=lp
      wb=wa+1
    end if
  end do
  b=a+lc 'NEXT DATA
  lpos+=TotWidth
  mid bufo,lpos-lc+1,cr
end do
end method


method build()
===============
if iscsv then buildcsv : return
sys    a, b, wa, wb, wl, cm, lpos, cpos
string w1
bufo=space Rows*TotWidth
a=1 : b=1
do
  wb=b
  a=instr(b,bufi,cr)
  if a=0 then exit do
  cm=0
  cpos=1
  do
    if ld then wa=instr(wb,bufi,dlm)
    if wa=0 or wa>a then wa=instr wb,bufi,cr
    '
    cm++ 'COLUMN COUNTER
    wl=wa-wb-dq
    if dq then wb++ 'FIELD DATA IS WITHIN QUOTES
    if dq>2 then
      w1=dedoublequote mid(bufi,wb,wl+dq-2)
    else
      w1=mid(bufi,wb,wl)
    end if
    if colformat[cm]=1 then
      w1=colprintf cm, val w1
    end if
'itr date time formats
    wl=len w1
    '
    p=lpos+cpos 'default "L" LEFT ALIGN
    if wl>colwidth[cm] then wl=colwidth[cm] 'RIGHT CLIP DATA
    '
    select asc(jus,cm)
      case "R" : p=lpos+cpos+ColWidth[cm]-wl
      case "C" : p=lpos+cpos+( ColWidth[cm]-wl )*.5
    end select
    '
    mid bufo,p,w1
    cpos+=colwidth[cm]
    if a=wa then
      exit do
    else
      mid bufo, lpos+cpos, colpad
      cpos+=lp
      wb=wa+ld
    end if
  end do
  b=a+lc 'NEXT DATA
  lpos+=TotWidth
  mid bufo,lpos-lc+1,cr
end do
end method


method doublequote(string*f)
============================
string qu=chr(34)
if not instr(f,qu) then return
sys a,b=1
do
  a=instr(b,f,qu)
  if a=0 then exit do
  f=left(f,a)+qu+mid(f,a+1)
  b=a+2
end do
end method


method packcsv() as char*
=========================
bufi=space 3*rows*cols+2*len(bufo)
sys i,j,k,m
k=1
string qu=chr(34), cm=chr(44)
string f
for i=1 to rows
  for j=1 to cols
    f = ltrim rtrim mid(bufo,m+colindex[j], colwidth[j])
    doublequote(f)
    mid bufi,k, qu+f+qu
    k+=2+len f
    if j<cols then
      mid bufi,k,cm : k++
    else
      mid bufi,k,cr : k+=lc
    end if
  next
  m+=totwidth
next
mid bufi,k,chr 0
return bufi
end method

method pack() as char*
======================
if iscsv then return packcsv
bufi=space ld*rows*cols+lc*rows+len bufo
sys i,j,k,m
k=1
string f
for i=1 to rows
  for j=1 to cols
    f = ltrim rtrim mid(bufo,m+colindex[j], colwidth[j])
    mid bufi,k, f
    k+=len f
    if j<cols then
      mid bufi,k,dlm : k+=ld
    else
      mid bufi,k,cr : k+=lc
    end if
  next
  m+=totwidth
next
mid bufi,k,chr 0
return bufi
end method

method RowColPos(sys row,col) as sys
====================================
if not row then exit method
if not col then exit method
if row>rows then exit method
if col>cols then exit method
return totwidth*(row-1)+colindex[col]
end method

method RowColData(sys row,col) as char*
=======================================
static string w
sys n=RowColPos(row,col)
if n then
  w=mid bufo,n,colwidth[col]
else
  w=""
end if
return w
end method

method RowData(sys row) as char*
================================
static string w
sys n=RowColPos(row,1)
sys i
if n then
  n--
  for i=1 to cols
    w+=ltrim(rtrim(mid(bufo,n+ColIndex[i],colwidth[i])))+cr
  next
else
  w=""
end if
return w
end method

method SelByCol(optional sys col,slm,char*kew, double ken,kem)
==============================================================
if not col then
  if not slm then seln=0
  exit method
end if
if col>cols then exit method
'
byte   a,*b,c
sys    d,i,j,k,m,le
static double v
static string wi,ke
ke = lcase kew         'KEYWORD LOWERCASE
le = colwidth[col]     'LENGTH OF COLUMN STRINGS
k  = colindex[col]     'POSITION OF COLUMN IN ROW
if not bufr then bufr=nuls rows
@b=strptr bufr
d=slm and 0x70 'INSTR OR RANGE SELECTORS
m=slm and 0x07
for i=1 to rows
  a=0
  select d
  case 0    : wi=lcase mid bufo,k,le
              if instr(wi,ke) then a=1
  case 0x50 : wi=lcase mid bufo,k,le
              if instr(wi,ke)=1 then a=1
  case else : v=val mid bufo,k,le
    'RANGE SELECTORS
    select d          
    case 0x0x10 : if v>=ken and v<=kem then a=1
    case 0x0x20 : if v>=ken and v<kem  then a=1
    case 0x0x30 : if v>ken  and v<=kem then a=1
    case 0x0x40 : if v>ken  and v<kem  then a=1
    end select
  end select
  c=1-b
  select m
  case 0x00 :           'ALWAYS
  case 0x01 : a and = b 'AND
  case 0x02 : a or  = b 'OR
  case 0x03 : a xor = b 'XOR
  case 0x04 : a and = c 'NOT AND
  case 0x05 : a or  = c 'NOT OR
  case 0x06 : a xor = c 'NOT XOR
  case 0x07 : a=c       'NOT
  end select
  if a
    b=1 : j++
  else
    b=0
  end if
  stride b
  k+=totwidth
next
seln=j
end method


method OrderByCol(sys col,optional descend)
===========================================
'
if not col then exit method
if col>cols then exit method
'
sys           i,j,k,m,le
static string w,wi
static string *ss
static double *sd
static sys    desc,fc
byte          *b
if seln then
  rws=seln
  @b=strptr bufr
else 
  rws=rows
end if
fc   = colformat[col]                  '0 STRING 1 NUMBER FORMATS
w    = space rws*totwidth              'BUFFER FOR SORTED TABLE
if @idx then
  freememory @idx
  freememory @ido
end if
@idx = getmemory 2 * rws * sizeof sys  'INDEX BUFFER
@ido = getmemory 1 * rws * sizeof sys  'ORIGINAL INDEX BUFFER
select fc
case 0,2
  @ss  = getmemory rws * sizeof sys    'KEY COLUMN STRING ARRAY
case 1
  @sd  = getmemory rws * sizeof double 'KEY COLUMN NUMBER ARRAY
end select

le   = colwidth[col]                   'LENGTH OF COLUMN STRINGS
k    = colindex[col]                   'POSITION OF COLUMN IN ROW
desc = descend                         'DESCENDING ORDER FLAG
'
j=0 'SELECTED ROWS COUNTER
for i=1 to rows
  m=1                        '
  if seln then m=b : @b++
  if m then
    wi=lcase mid bufo,k,le 'SELECT STRINGS (case-insensitive)
    j++
    select fc
    case 0,2 : ss[j]=wi
    case 1   : sd[j]=val wi
    end select
    idx[j]=j 'INDEX
    ido[j]=i 'ORIG RECORD INDEX
  end if
  k+=totwidth
next
'
'CREATE ORDERED INDEX IDX[..]
'I/O string array ss[], number array sd[], index idx[], element count rws, desc descending, fc datatype selector
'
  macro compare(sw,ii,jj)
  =======================
  '
  'ss    set of strings
  'sd    set of numbers
  'fc    format selector numbers/strings
  'desc  ascend/descend flag
  '
  select fc
  case 0,2 'COMPARE STRINGS
    if desc then
      if ss[ii]<ss[jj] then sw=1 'DESCENDING ORDER
    else
      if ss[ii]>ss[jj] then sw=1 'ASCENDING ORDER
    end if
  case 1 'COMPARE NUMBERS
    if desc then
      if sd[ii]<sd[jj] then sw=1 'DESCENDING ORDER
    else
      if sd[ii]>sd[jj] then sw=1 'ASCENDING ORDER
    end if
  end select
  end macro

mergeSort idx,rws,compare
if @ss then freememory @ss 'DISPOSE STRING LIST
if @sd then freememory @sd 'DISPOSE NUMBER LIST
end method


method GetColData(char*cd) as char*
===================================
'class indexbase 1
byte       bc at strptr cd
static sys col[0x100],nc,rw,v
'
'READ COLUMN NUMBERS RANGING 1 TO COLS
nc=0
do
  select bc
  case 0        : exit do
  case 49 to 57
    v=val cast char bc
    if v<=cols then nc++ : col[nc]=v
    'FLUSH NUMBER
    do
      @bc++
      select bc
      case 0       : @bc-- : exit do
      case 1 to 32 : exit do
      end select
    end do
  end select
  @bc++
end do
'
'SELECT BUFFER AND ROW COUNT
if @idx then
  rw=rws
else
  rw=rows
end if
'
sys    c,d,e,f,g,i,j,k,m
'
'CALC OUTPUT ROW WIDTH
c=0
if nc then
  for i=1 to nc
    j=col[i]
    c+=colwidth[j]
    if i=nc then
      c+=lc
    else
      c+=lp
    end if
  next
else
  c=totwidth
end if
'
'CALC TOTAL COLS*ROWS OUTPUT SPACE
j=rw
if seln then j=seln
bufc=nuls c*j
'
'FILL WITH FIELD DATA
j=1
k=1
@bc=strptr bufr
'
for i=1 to rw
  'SELECTED AND ORDERED ROWS
  if @idx then
    f=idx[i]
    f=ido[f]
    f=totwidth*f-totwidth+1 'GET OFFSET
  else
    f=j
    j+=totwidth 'FOR NEXT INPUT ROW
    if seln then
      if not bc[i] then f=0
    end if
  end if
  if f then 'SELECTED ROW
    if nc then 'SELECTED COLUMNS
      for d=1 to nc
        m=col[d]         'COLUMN NUMBER
        e=colwidth[m]    'COLUMN WIDTH
        g=f+colindex[m]-1 'COLUMN OFFSET
        '
        mid bufc,k,mid(bufo,g,e) : k+=e
        if d=nc then
          mid bufc,k,cr : k+=lc
        else
          mid bufc,k,colpad : k+=lp
        end if
      next 'cols
    else 'WHOLE RECORD
      mid bufc,k,mid(bufo,f,c) : k+=c
    end if
  end if
next 'rw
return bufc
end method

method Metrics(sys i1,*i2,*i3) as sys
=====================================
select i1
case 0         : i2=cols : i3=rows : i4=totwidth : return len bufo
case 1 to cols : i2=colindex[i1] : i3=colwidth[i1] : i4=totwidth : return i4
case else      : i2=0 : i3=0 : i4=0 : return 0
end select
end method

method ShowMetrics() as char*
=============================
string qu = chr 34
pr="METRICS:" cr cr
pr+="cols" tab "rows" tab "row sz" tab "padding"   cr
pr+=cols   tab rows   tab totwidth tab qu colpad qu cr cr
pr+="column" tab "Index" tab "width" cr
for i=1 to cols
  pr+=i tab ColIndex[ i ] tab ColWidth[ i ] cr
next
return pr
end method
 
method justify(char*j)
======================
jus=j
end method
 
method delimiter(char*j)
========================
dlm=j
ld=len dlm
end method
 
method padding(char*p)
======================
colpad=p
lp=len colpad
end method
 
method endofline(char*c)
========================
cr=c
lc=len cr
end method
 
method SetTable(char*s)
=======================
bufi=s
measure
build
end method

method GetTable() as char*
==========================
return bufo
end method

 
end class
 
'#recordof TableClass
 

'========
'WRAPPERS
'========

TableClass atxt

function TableTextCreate(char *in,*ju, *pad, *dl, *cr)
======================================================
atxt.init
atxt.justify         ju
atxt.delimiter       dl
atxt.endofline       cr
atxt.padding         pad
atxt.SetTable        in
end function

function TableTextShow() as char*
=================================
return atxt.GetTable
end function

function TableTextShowMetrics() as char*
========================================
return atxt.showmetrics
end function

function TableTextPack() as char*
=================================
return atxt.pack
end function

function TableTextRowData(sys n) as char*
=============================== =========
return atxt.RowData n
end function

function TableTextColData(char*cd) as char*
=============================== ===========
return atxt.GetColData cd
end function

function TableTextSelByCol(optional sys col,slm,char*kew, double mn,mx)
=======================================================================
atxt.SelByCol(col,slm,kew,mn,mx)
end function

function TableTextSortByCol(sys n,descend)
==========================================
atxt.OrderByCol n,descend
end function

end extern