NB. built from project: ~Source\classes\grid\wgrid\wgrid

coclass 'jwgrid'
require 'jzgrid'
coextend 'jzgrid'

NB. select util

info=: wdinfo @ ('Grid'&;)
issparse=: 512&[ < 3!:0
query=: wdquery ('Grid'&;)
todense=: ] NB. $. ^: (_1: * issparse)
tolist=: }.@;@:((10{a.)&,@,@":&.>)

NB. =========================================================
NB.*clipfmt v format data for clipboard
NB. format array of rank 0 1 or 2 for clipboard.
NB. columns are separated by TAB, rows by CRLF.
clipfmt=: 3 : 0
if. 0 e. $y. do. '' return. end.
t=. 3!:0 y.
if. 2=t do.
  y=. ,y.,"1 CRLF
elseif. 32<:t do.
  y=. ,&TAB @ ": &.>y.
  y=. ;,&CRLF@}: &.><@;"1 y
elseif. 1 do.
  y=. ;,&CRLF @ ": &.><"1 y.
  y=. '-' (I. y='_') } y
  y=. TAB (I. y=' ') } y
end.
y
)

NB. =========================================================
NB.*clipunfmt v unformat data read from clipboard
NB. returns boxed matrix from clipboard result,
NB. recognizing TAB and CRLF as separators.
NB. characters are not converted to numbers.
NB. note this is not a true inverse of clipfmt.
NB. e.g. try:  clipunfmt clipfmt i.5 6
clipunfmt=: (<;._2~ e.&(9 10{a.));.2 @ toJ

NB. =========================================================
NB. locale coread namelist
NB. defines global namelist
coread=: 4 : 0
nms=. ;:^:(L. = 0:) y.
cnm=. nms ,each <'_',(":>x.),'_'
msk=. 0=4!:0 cnm
nms=. msk#nms
if. #nms do. (nms)=: vals=. ". each msk#cnm
else. vals=. a: end.
nms ,. vals
)


NB. clipboard code

NB. =========================================================
copy=: 3 : 0
t=. ''
m=. mark-fixr,fixc
ex=. extent
r=. 0{ex
c=. 1{ex
index=. (0{m)+i.0{ex
index=. <index ; (1{m)+i.1{ex
t=. todense index{ dataname~
wd 'clipcopy *',clipfmt t
)

NB. =========================================================
NB. assumes rectangular
paste=: 3 : 0
if. -. editenable do. return. end.
t=. clipunfmt wd 'clippaste'
'r c'=. $t
p=. mark-fixr,fixc
index=. < ((0{p)+i.r) ; (1{p)+i.c
max=. ((0{p)+r),(1{p)+c

NB. should enable this test which is not quite right yet.
NB. check for paste over size...
NB.! paste that increases size
NB. if. resize max do. return. end.

if. 0=L. ".dataname do.
  t=. ". &> t
end.
".dataname,'=: t index}',dataname
setdata''
paintx''
)


NB. globals for wgrid (in addition to standard grid globals)

resetwgrid=: 3 : 0
colwidth=: 50
rowheight=: 20
filltype=: 4
fixtype=: 4
fixeddata=: 0
highlight=: ''
highlighter=: 1
iftotal=: 0
resizeenable=: 0
sizeenable=: 0
colname=: 'coltitle__COCREATOR'
rowname=: 'rowlabel__COCREATOR'
dataname=: 'data__COCREATOR'
typename=: 'dtype__COCREATOR'
)


NB. edit

NB. =========================================================
NB. get marked cell raw data for editing
getedit=: 3 : 0
toHOST ": > (<y. - fixr,fixc) { dataname~
)

NB. =========================================================
NB. resize, return success
resize=: 3 : 0
if. +./datashape < y. do.
  if. resizeenable=0 do.
    info 'You may not increase data size'
    0 return.
  end.
  j=. 'Data size has increased.',LF,LF,'Continue anyway?'
  if. 0 query j do. 0 return. end.
  ".dataname,'=: (y.>.datashape){.',dataname
  setdata ''
  paintx''
end.
1
)

NB. =========================================================
NB. seteditdata pos;data
seteditdata=: 3 : 0
'pos data'=. y.
index=. pos - fixr, fixc
try.
  if. 0 = resize >:index do. 0 return. end.
  index=. <index
  if. L. dataname~ do.
    data=. <data
  else.
    data=. ".data
  end.
  (dataname)=: data index} dataname~
catch.
  'OK'-: wd 'mb Data Error mb_okcancel' return.
  info 'Data error - unable to update data variable'
  0 return.
end.

NB. should be able to do better than this.........
setdata''
NB. setinvalidate 1
NB. (pos,1 1) settext data
NB. (pos,1 1) settype dohighlight data
NB. setinvalidate 0
0
)


NB. highlight code
NB.
NB. executes "highlight" expression if defined
NB. result is scaled by highlighter

NB. =========================================================
NB. dtype dohighlight data
NB. result is new dtype
dohighlight=: 4 : 0
if. 0 = #highlight -.' ' do. ($y.)$x. return. end.
try.
  if. 1 e. 'y.' E. highlight do.
    h=. highlighter * ". highlight
  else.
    h=. highlighter * ". '(',highlight,') y.'
  end.
catch.
  h=. 0
end.
x. + h
)

NB. =========================================================
sethighlight=: 3 : 0
highlight=: y.
setdata''
)



NB. =========================================================
NB. replacement for grid version
NB.
NB. should this be in the grid version?

setincwh=: 3 : 0

'ix iy'=. y.

colwidth=: 1 >. colwidth + iy
rowheight=: 1 >. rowheight + ix

defwidth=: 1 >. defwidth + iy
defheight=: 1 >. defheight + ix

setwidths 1 >. gridws + iy
setheights 1 >. gridhs + ix

paintx ''
)


NB. main

NB. =========================================================
NB.*create v grid
create=: 3 : 0
create_jzgrid_ f. y.
resetwgrid''
)

NB. =========================================================
destroy=: 3 : 0
destroy_jzgrid_ f. y.
)

NB. =========================================================
NB. flip
flip=: 3 : 0
mark=: |. mark
extent=: |. extent
'maxr maxc'=: maxc,maxr
'skipr skipc'=: skipc, skipr
'scrollr scrollc'=: scrollc, scrollr
redisplay''
)

NB. =========================================================
NB.*refresh v refresh display
refresh=: 3 : 0
mark=: fixr,fixc
extent=: 1 1
skipr=: 0
skipc=: 0
scrollr=: 0
scrollc=: 0
redisplay''
)

NB. =========================================================
redisplay=: 3 : 0
skipr=: skipr <. screenoffrows''
skipc=: skipc <. screenoffcols''
gridfocus''
NB. next 2 lines may call setdata twice...
get ''
fit 1
setmark mark,extent
setscrollbars''
paintx''
)


NB. setdata

NB. =========================================================
NB. set data in grid
setdata=: 3 : 0

reqrc=. getreqrc''      NB. data rows/cols required by grid

offrws=. skipr + fixr   NB. current row/col offsets
offcls=. skipc + fixc

d=. dataname~           NB. get grid data

datashape=: $d
'maxr maxc'=: datashape + fixr,fixc
'rws cls'=. shape=. reqrc <. datashape - skipr,skipc
'frws fcls'=. fshape=. shape + fixr,fixc

xndx=. skipr + i. rws
yndx=. skipc + i. cls

NB. ---------------------------------------------------------
NB. set grid sizes:
setgrid fshape

if. (#colwidth) > fixc + 1 do.
  setwidths (fixc {. colwidth), offcls }. colwidth
else.
  setwidths fcls stretch colwidth
end.

if. (#rowheight) > fixr + 1 do.
  setheights (fixr {. rowheight), offrws }. rowheight
else.
  setheights frws stretch rowheight
end.

NB. ---------------------------------------------------------
NB. labels
if. #rowname do.
  try. rlab=. xndx { rowname~
  catch. rlab=. ": each xndx [ rowname=: '' end.
else.
  rlab=. ": each xndx
end.

if. #colname do.
  try. clab=. yndx { colname~
  catch. clab=. ": each yndx [ colname=: ''end.
else.
  clab=. ": each yndx
end.

(offrws,0,rws,1) settext rlab
(0,offcls, 1,cls) settext clab

NB. ---------------------------------------------------------
NB. data
d=. (<xndx;yndx) { d
if. 1024 <: 3!:0 d do. d=. $. inverse d end.
(offrws,offcls,shape) settext mfmt d

NB. ---------------------------------------------------------
NB. data type
if. #typename do.
  try. dtype=. typename~
    if. 2=#$dtype do.
      dt=. (<xndx;yndx) { dtype
    else.
      dt=. shape $ cls stretch (skipc }. dtype),{:dtype
    end.
  catch.
    dt=. 1
    typename=: ''
  end.
else.
  dt=. 1
end.

(offrws,offcls,shape) settype dt dohighlight d

NB. ---------------------------------------------------------
NB. set total (last row/col) attribute (example only):
NB. ((offrws+rws-1),offcls,1,cls) settype cls$16
NB. (offrws,(offcls+cls-1),rws,1) settype rws$16

NB. ---------------------------------------------------------
NB. trailing edges:
NB. j=. (offrws+rws-1),0 1,(offcls+cls),(12$0),1 0 0 0
NB. j=. j,0,(maxc-1),maxr,1,(8$0),8{.1

NB. temporary kludge - need better way of defining borders:
'br bc'=. 2 * iftotal *  0 >: (maxr,maxc) - reqrc + (skipr,skipc)
j=. (offrws+rws-1),0 1,(offcls+cls),; 4{.each 0,br,0 1
j=. j,0,(maxc-1),maxr,1,(8{.bc),8{.1
setborder j

)
