NB. print package
NB. built from project: ~Source\packages\print\print\print
NB. z definitions

script_z_ '~system\main\gl2.ijs'

coclass 'jprint'


coextend 'jgl2'
COCLASSPATH copath coname''

NB. printfns.ijs        - print functions
NB.
NB. DEFFONT            default print font (if config not available)
NB. DEFFONT2           default print2 font (if config not available)
NB.
NB. TOPM BOTM LEFTM RIGHTM FOOTM        - print margins
NB. TOPM2 BOTM2 LEFTM2 RIGHTM2 FOOTM2   - print2 margins
NB. COLS2              columns for print2

NB. main definitions:
NB.*print v print text
NB.*printfile v print file
NB.*print2 v print text in 2-up mode
NB.*printfile2 v print file in 2-up mode

NB. utilities:
NB. printopts v print options

NB. default fonts (if configure font not available or not set)
DEFFONT=: '"courier new" 11 bold oem'
DEFFONT2=: '"courier new" 7.5 bold oem'

NB. margins for print are inches from page edge:
TOPM=: 0.4
BOTM=: 0.75
FOOTM=: 0.4
LEFTM=: 0.5
RIGHTM=: 0.5

NB. margins for print2 are fractions of page:
TOPM2=: 0.02
BOTM2=: 0.04
LEFTM2=: 0.02
FOOTM2=: 0.02

NB. columns for print2:
COLS2=: 80

NB. =========================================================
NB. print
NB. print text
print=: 3 : 0
'' print y.
:

if. IFJAVA do. x. printjava y. return. end.

if. 0 e. $ j=. 0 printopts x. do. return. end.
'ascii j filename fit font header footer orient ruler tab'=. j

TFONT=: font
fascii=. boxascii^:ascii

if. wdisparent 'print' do.
  wd 'psel print'
else.
  wd 'pc print;cc g0 isigraph'
end.
glzcreate ''

glzstartdoc 'print'
glzdevmode 'orientation ' , ":orient
getprintpage ''

'x y width height'=. getframe LEFTM , TOPM , (-RIGHTM) , -FOOTM

header=. >width printheader header ; filename
rhdr=. #header

glextentfont TFONT
hite=. {.glqtextmetrics ''

fb=. 1440 * BOTM - FOOTM
headbox=. x , (y + height - hite * rhdr) , width , hite * rhdr
texthite=. height - fb + hite * rhdr
footbox=. x , y , width , hite
textbox=. x , (y + fb) , width , texthite

txt=. cleanup y.
if. 0 e. $txt do. return. end.
txt=. fascii txt
txt=. tab xtab txt
if. fit do. txt=. topara txt end.
txt=. FF cutopen txt
txt=. width wraptext each txt

if. ruler do.
  if. (2 = 3!:0 y.) *. 1 < # $y. do.
    cls=. {: $y.
  else.
    cls=. >./ ; #&> each txt
  end.
  rule=. fascii each printruler cls

  rulebox=. x , (y + fb + texthite - 3 * hite) , width , 3 * hite
  textbox=. x , (y + fb) , width , texthite - 3 * hite


else.
  rule=: rulebox=: ''
end.

page=. 1
lftr=. (-.0 e. $footer) # < ,: ,footer
rftr=. [: < [: ,: (tstamp '')&stamp

while. #txt do.
  p1=. 0 pick txt
  txt=. }.txt

  while. #p1 do.

    glzstartpage ''

    glclear ''
    glfont TFONT
    glextentfont TFONT

    place 0 ; headbox ; '' ; '' ; '' ; 1 ; <header
    place 0 ; rulebox ; '' ; '' ; '' ; 1 ; <rule
    'pos p1'=. place 0 ; textbox ; '' ; '' ; '' ; 1 ; <p1
    place 0 ; footbox ; '' ; '' ; '' ; 1 ; <lftr
    place 1 ; footbox ; '' ; '' ; '' ; 1 ; <rftr page

    page=. >:page

    glshow ''
    glzprint ''
    glzendpage ''

  end.
end.

glzenddoc ''
wd 'pclose'
)

NB. =========================================================
NB. print2
NB. print text in 2-up mode

print2=: 3 : 0
'' print2 y.
:

if. IFJAVA do. x. printjava2 y. return. end.

if. 0 e. $j=. 1 printopts x. do. return. end.
'ascii cols filename j font header footer j ruler tab'=. j

header=. >0 printheader header ; filename
ifhdr=. 0 < #header

TFONT=: font
fascii=. boxascii^:ascii

rule=. fascii > printruler cols

if. wdisparent 'print2' do.
  wd 'psel print2'
else.
  wd 'pc print2;cc g0 isigraph'
end.
glzcreate ''

glzstartdoc 'print'

glzdevmode 'orientation 2'
'wid len'=. getpagesize ''
glfont TFONT
glextentfont TFONT
hite=. {.glqtextmetrics ''

inlen=. len * 1 - TOPM2 + BOTM2
rws=. <.inlen % hite * 1.2

leftm0=. wid * LEFTM2
leftm1=. leftm0 + -:wid
ftrow=. len * FOOTM2

irws=. (len * 1 - TOPM2) - inlen * (i.rws) % rws

n=. #header
rws=. rws - n

lhdr=. rnd0 leftm0 ,. n {. irws
rhdr=. rnd0 leftm1 ,. n {. irws
ltxt=. rnd0 leftm0 ,. n }. irws
rtxt=. rnd0 leftm1 ,. n }. irws
lftr=. rnd0 leftm0 , ftrow
rftr=. rnd0 leftm1 , ftrow

line=. rnd0 , (-:wid) ,. ,. (len * 1 - TOPM2) , (len * FOOTM2) - hite

page=. 0
foot=. (((cols - 28) {.!.' ' footer) , tstamp '')&stamp

dat=. cleanup y.
dat=. fascii dat
dat=. tab xtab dat
dat=. FF cutopen dat

dat=. (cols&fold) each dat
dat=. ((4 * ruler) - rws)&(<\) each dat
dat=. > ;dat

if. ruler do.
  dat=. rule ,"2 dat
end.

mat=. rws , cols

cmd=. (gltext@[ gltextxy)"1

while. #dat do.

  glzstartpage ''
  glclear ''
  glfont TFONT
  glpen 5 , 0
  gllines line

  if. ifhdr do. header cmd lhdr end.
  (mat {. {.dat) cmd ltxt
  dat=. }.dat
  page=. >:page
  (foot page) cmd lftr

  if. #dat do.
    if. ifhdr do. header cmd rhdr end.
    (mat {. {.dat) cmd rtxt
    dat=. }.dat
    page=. >:page
    (foot page) cmd rftr
  end.

  glshow ''
  glzprint ''
  glzendpage ''

end.

glzenddoc ''
wd 'pclose'
)

NB. =========================================================
NB. printfile
NB. print text files
printfile=: ''&$: : (4 : 0)
(x. ; 0) printfiles y.
)

NB. =========================================================
NB. printfile2
NB. print text files in 2-up mode
printfile2=: ''&$: : (4 : 0)
(x. ; 1) printfiles y.
)

NB. =========================================================
NB. printfiles
NB. print text files
printfiles=: 4 : 0

'opt type'=. x.
fn=. 'print' , (type = 1) # '2'
y=. getfile y.
for_f. y do.
  try. dat=. 1!:1 f
  catch.
    empty wdinfo 'print' ; 'file not found: ' , >f return.
  end.
  ph=. 'filename ' , >f
  sep=. ' '
  ph=. ph , sep , (pfsize f) , sep , pfstamp f
  (ph , ';' , opt) fn~ dat

end.
empty ''
)

NB. =========================================================
pfsize=: 3 : 0
}. ;',' , each |. _3 <@|.\ |. ":fsize y.
)

fsize=: 1!:4 ::(_1:)@boxopen
fstamp=: (1: >@{ , @ (1!:0)) :: _1:

NB. =========================================================
pfstamp=: 3 : 0
'y r'=. split fstamp y.
y=. (":y) , ;_2&{.@('0'&,)@":&> r
n=. 'xxxx-xx-xx xx:xx:xx'
y (I. n = 'x') } n
)

NB. =========================================================
NB. return print options or empty if error
NB. options given are:
NB.   ascii cols filename fit font fontsize header footer
NB.   land|landscape ruler tab
printopts=: 4 : 0

std=. PRINTOPT_j_
y=. std,((0<#std)#';'),y.

if. x. do.
  font=. P2UPFONT_j_
else.
  font=. PRINTERFONT_j_
end.

filename=: ''
header=. ''
footer=. ''
cols=. COLS2
tab=. 4

def=. 0: = 4!:0@<

if. #y do.
  opts=. dltb each ';' cutopen y
  opts=. ((tolower@{. ; }.@}.)~ i.&' ')&> opts
  try. ({."1 opts)=. {:"1 opts
  catch.
    wdinfo 'Error in print options' return.
  end.
end.

fit=. def 'fit'
ruler=. def 'ruler'

if. def 'ascii' do.
  ascii=. {. 1 ". ascii,' 1'
else.
  ascii=. 0
end.

if. 2 = 3!:0 cols do.
  cols=. {. COLS2 ". cols
end.

if. 2 = 3!:0 tab do.
  tab=. {. 4 ". tab
end.

if. +./ def&> 'port' ; 'portrait' do.
  orient=. 1
elseif. +./ def&> 'land' ; 'landscape' do.
  orient=. 2
elseif. 1 do.
  orient=. {. getdevmode''
end.

font=. font2twips font

if. def 'fontsize' do.
  defsize=. ". >1 { boxfont font
  font=. font changefont 20 * defsize ". fontsize
end.

ascii ; cols ; filename ; fit ; font ; header ; footer ; orient ; ruler ; tab
)

NB. =========================================================
NB. printruler
printruler=: 3 : 0
j=. >.0.2 * len=. y.
'a b c'=. 1 4 7 { , 9!:6 ''
r=. len #"1 ,. c , ' ' , a
i=. }.5 * i.j
r=. b (<0 2 ; 0 , i) } r
r=. '0' (<1 ; 0) } r
if. len > 5 do.
  r=. (3 ": ,.i) (<1 ; i -/ 2 1 0) } r
end.
<"1 r
)

NB. =========================================================
NB. printfilename
NB. returns filename and filename2 to fit
NB.
printfilename=: 4 : 0
f=. y.
f2=. ''
tag=. '...'
if. x. printnofit f do.
  ndx=. (_21 }. f) i: ' '
  f2=. (ndx + 1) }. f
  f=. dltb ndx {. f
  while. x. printnofit f do.
    f=. (3 * tag -: 3 {. f) }. f
    f=. (PATHSEP_j_ = {.f) }. f
    f=. tag , f }.~ f i. PATHSEP_j_
  end.
end.
f ; f2
)

NB. =========================================================
printnofit=: 4 : 0
if. x. do. w=. {.x. fitline y. else. w=. COLS2 end.
w < #y.
)

NB. =========================================================
NB. printheader
NB. return print header as boxed list
NB. width printheader header;filename
printheader=: 4 : 0
'hdr fnm'=. y.
'fnm fnm2'=. x. printfilename fnm
r=. ''
if. #hdr do. r=. hdr ; '' end.
r , (boxxopen fnm) , (boxxopen fnm2) , boxxopen (0 < #fnm) # ' '
)


NB. printfnsjava
NB.
NB. for nonce just send file to printer

NB. =========================================================
printjava=: 4 : 0

NB. if. 0 e. $ j=. 0 printopts x. do. return. end.
NB. 'ascii j filename fit font header footer orient ruler tab'=. j

ascii=. 0
tab=. 4

txt=. cleanup y.
if. 0 e. $txt do. return. end.
if. ascii do. txt=. boxascii txt end.
txt=. tab xtab txt
txt=. toHOST txt

tmp=. jpath '~temp\jprint.txt'
txt 1!:2 <tmp

if. IFUNIX do.
  wd 'winexec */bin/sh -c "lpr ',tmp,'"'
else.
  wd 'winexec *print ',tmp
end.

)

NB. =========================================================
printjava2=: 4 : 0
x. printjava y.
)


NB. prutil.ijs        - print utilities
NB.
NB. TAGS               HTML tags
NB. TAGIDS             tag ids
NB.
NB. addwmfheader       add metafile header to wmf file
NB. boxfont            box font
NB. changefont         change font
NB. changetag          change font using HTML tags
NB. cleanup            flatten array and remove control chars
NB. deb                delete extra blanks
NB. defaults           set default values
NB. detab              detab line
NB. dlb                delete leading blanks
NB. dltb               delete leading and trailing blanks
NB. dtb                delete trailing blanks
NB. flatten            flatten array to char string
NB. fitchars           fit characters to given width
NB. fitline            fit text to line
NB. fitwords           fit words to given width
NB. fold               fold text to width
NB. font2twips         change font size to twips
NB. getfile            get file name (respects short names)
NB. getframe           convert frame definitions inches to twips
NB. getpagesize        get page size
NB. getpos             convert frame position in inches to twips
NB. getprintpage       defines PRINTPAGE
NB. place              place text paragraph
NB. placeline          place text line
NB. preview            preview page
NB. printers           list all printers
NB. printerspecs       list printer specs
NB. removetag          remove tags from text
NB. round              round to nearest x.
NB. rnd0               round to nearest integer
NB. setcolor           set fore, back colors
NB. setfont            set TFONT
NB. stamp              stamp page with time and page number
NB. taketag            separate tags from text
NB. tolist             convert boxed list to character string
NB. topara             convert text to paragraphs
NB. tstamp             timestamp
NB. xtab               remove tabs
NB. xtabline           remove tabs from single line
NB. wrappara           wrap fitted paragraph (no LF)
NB. wraptext           wrap fitted text (may contain LF)

TAB=: 9 { a.
TAGS=: '<b>';'</b>';'<i>';'</i>'
TAGIDS=: ;:'bold nobold italic noitalic'
BLACK=: 0
WHITE=: <:2^24

deb=: #~ (+. 1: |. (> </\))@(' '&~:)
dlb=: }.~ =&' ' i. 0:
dltb=: #~ [: (+./\ *. +./\.) ' '&~:
dtb=: #~ [: +./\. ' '&~:
round=: [ * [: <. 0.5"_ + %~
rnd0=: <.@(0.5&+)
tolist=: }.@;@:(LF&,@,@":&.>)

NB. =========================================================
NB. [outfile] addwmfheader infile
NB.
NB. metafiles used by Word etc. require 22 byte header
NB.
NB. outfile addwmfheader infile ; width height (%1000 of inches)
addwmfheader=: 3 : 0
({.y.)addwmfheader y.
:
a=. 16bd7 16bcd 16bc6 16b9a 0 0 0 0 0 0, 1 0 3 2{,256 256 #: >1{y.
a=. a,232 3 0 0 0 0
a=. a, ([: ~:/&.#: ,)"1 |: 10 2$a
a=. a{a.
(a,1!:1 {.y.) 1!:2 boxopen x.
)

NB. =========================================================
NB. boxascii  - use ascii box-drawing characters
boxascii=: 3 : 0
fm=. 'ÚÂ¿ÃÅ´ÀÁÙ³Ä'
to=. '+++++++++|-'
(to,a.) {~ (fm,a.) i. y.
)

NB. =========================================================
NB. boxfont    box fontspec
boxfont=: 3 : 0
font=. ' ',y.
b=. (font=' ') > ~:/\font='"'
a: -.~ b <;._1 font
)

NB. =========================================================
NB. changefont    font changefont optlist
NB.
NB. optlist may contain:  bold    nobold
NB.                       italic  noitalic
NB.                       oem     nooem
NB.                       {number} = size in twips
NB.
NB. font should be: fontname size [bold] [italic] [oem]
NB.
NB. e.g. 'Arial 240 oem' changefont 'bold';280
NB.
changefont=: 4 : 0
font=. ' ',x.
b=. (font=' ') > ~:/\font='"'
font=. a: -.~ b <;._1 font
opt=. y.
if. 0=L. opt do. opt=. cutopen ":opt end.
opt=. a: -.~ (-.&' ' @ ":) each opt
num=. _1 ~: _1 ". &> opt
if. 1 e. num do.
  font=. ({.num#opt) 1} font
  opt=. (-.num)#opt
end.
ayes=. ;:'bold italic oem'
noes=. ;:'nobold noitalic noem'
font=. font , opt -. noes
font=. font -. (noes e. opt)#ayes
}: ; ,&' ' each ~. font
)

NB. =========================================================
NB. changetag    font changetag tag
NB. supports <b> </b> <i> </i> for bold, italic
NB. calls changefont for given tag
changetag=: 4 : 0
x. changefont TAGIDS {~ TAGS i. boxopen y.
)

NB. =========================================================
NB. cleanup  (remove unwanted characters)
cleanup=: 3 : 0
y=. flatten y.
toJ ' ' (I.  y e. 26 27{a.) } y
)

NB. =========================================================
NB. cutpara text   - cut text into paragraphs
cutpara=: 3 : 0
txt=. topara y.
txt=. txt,(LF ~: {:txt)#LF
b=. (}.b,0) < b=. txt=LF
b <;._2 txt
)

NB. =========================================================
emptymatrix=: ,:`empty @. (0:=#)

NB. =========================================================
NB. fitchars   width fitchars chars
NB. fits characters to width
NB. result is #chars, length
fitchars=: 4 : 0

fit=. {. @ glqextent @ ({.&y.)
max=. #y.
avg=. 5{ glqtextmetrics''

try=. max <. >. x. % avg
if. x. > fit try do.
  while.
    (max > try) *. x. >: fit >: try
  do. try=. >: try end.
else.
  while.
    (0 < try) *. x. < fit try
  do. try=. <: try end.
end.
try, fit try
)

NB. =========================================================
NB. fitline   width fitline chars
NB. fits line  (allows for tags)
NB. result is #chars (including tags), width
fitline=: 4 : 0
wid=. x.
txt=. y.
b=. +./ E.&txt &> TAGS

NB. if no tags just fitwords (or fitchars): ===============
if. -. 1 e. b do.
  num=. wid fitwords txt
  if. 0={.num do.
    num=. wid fitchars txt
  end.
  return.
end.

NB. else step through tags: ===============================
tnum=. tlen=. 0

while. 1 do.
  ndx=. b i. 1

  if. ndx>0 do.
    'num len'=. wid fitwords ndx{.txt

    tnum=. tnum + num
    tlen=. tlen + len

    if. num<ndx do.
      if. 0=tnum do.
        wid fitchars txt
      else.
        tnum,tlen
      end.
      return.
    end.

    wid=. wid-len
    txt=. ndx}.txt

    if. (wid <: 0) +. 0 = #txt do. tnum,tlen return. end.
  end.

  'tag txt'=. taketag txt
  tnum=. tnum + #;tag

  TFONT=: TFONT changetag tag
  glextentfont TFONT

  if. 0=#txt do. tnum,tlen return. end.

  b=. +./ E.&txt &> TAGS

end.
)

NB. =========================================================
NB. fitwords   width fitwords chars
NB. fits words to width
NB. words are delimited by blanks; if none, cut on any character
NB. result is #chars, length
fitwords=: 4 : 0

ndx=. 0, I. (y.=' '),1 1
fit=. {. @ glqextent @ ({.&y.) @ ({&ndx)
max=. _2+#ndx
avg=. 5{ glqtextmetrics''

try=. max <. 1 i.~ ndx >: x. % avg

if. x. > len=. fit try do.
  while.
    (max > try) *. x. >: trylen=. fit >: try
  do. len=. trylen [ try=. >: try end.

else.
  while.
    (0 < try) *. x. < len=. fit try
  do. try=. <: try end.
end.

(try{ndx) , len

)

NB. =========================================================
NB. flatten
flatten=: 3 : 0
dat=. ": y.
if. 2 > #$dat do. return. end.
dat=. 1 1}. _1 _1}. ": <dat
}: (,|."1 [ 1,.-. *./\"1 |."1 dat=' ')#,dat,.LF
)

NB. =========================================================
NB. fold
NB. Syntax: width fold text
NB. argument is text string, result is matrix of given width
fold=: 4 : 0
dat=. toJ y.
dat=. <;._2 dat,LF #~ LF ~: {: dat
dat=. ({.!.' '~ 1&>.@#) &.> dat
> ,&.> / (-x.) (x.&{.) \ &.> dat
)

NB. =========================================================
NB. font2twips   - change font size to twips
font2twips=: 3 : 0
font=. boxfont y.
size=. <":<.20*".>1{font
font=. size 1}font
}: ; ,&' ' each font
)

NB. =========================================================
getdevmode=: 3 : 0
wd 'pc qdevmode'
wd 'cc g isigraph'
glzcreate''
r=. glqdevmode''
glzdelete''
wd 'pclose'
r
)

NB. =========================================================
getfile=: 3 : 0
try. {."1 getscripts_j_ y.
catch. <^:(< -: {:@;~) y.
end.
)

NB. =========================================================
NB. opt getframe xywh
NB.
NB. opt=0  =  from topleft, width, height  (in inches)
NB.    returns xywh for frame in twips, where xy is relative
NB.    to the printable area and is the bottom left point.
NB.    if wh <: 0, calculate from far margins
NB. opt=1  =  convert back to inches
NB. e.g. getframe 0 0 0 0 = entire printable area
NB.        getframe 1 2 2 4 = topleft=1 2, size=2 by 4
getframe=: 3 : 0
0 getframe y.
:
'px py pw ph j j wid hit'=. ,PRINTPAGE
if. x.=0 do.
  'x y w h'=. 1440 * y.
  x=. 0 >. x - px
  if. w <: 0 do. w=. wid + w - x + px end.
  w=. w <. pw - x
  y=. 0 >. y - py
  if. h <: 0 do. h=. hit + h - y + py end.
  h=. h <. ph - y
  x,(ph-y+h),w,h
else.
  'x y w h'=. y.
  x=. px + x
  y=. py + ph - y + h
  1440 %~ x,y,w,h
end.
)

NB. =========================================================
NB. getpagesize
NB. return printable page size in twips
getpagesize=: 3 : 0
1440 * %/ (2 3 ,: 4 5) { glqprinter''
)

NB. =========================================================
NB. opt getpos xy
NB.
NB. opt=0  =  from topleft (in inches)
NB.    returns xy for frame in twips, where xy is relative
NB.    to the printable area and is the bottom left point.
NB.    if xy < 0, calculate from far margins
NB. opt=1  =  convert back to inches
NB. e.g. getbox 0 0 = top left corner
NB.      getbox _ _ = bottom right corner
getpos=: 3 : 0
0 getpos y.
:
'px py pw ph j j wid hit'=. ,PRINTPAGE
if. x.=0 do.
  'x y'=. 1440 * y.
  if. x >: 0 do.
    x=. pw <. 0 >. x - px
  else.
    x=. 0 >. wid + x - px
  end.
  if. y >: 0 do.
    y=. 0 >. ph - 0 >. y - py
  else.
    y=. ph - 0 >. hit + y - py
  end.
  x,y
else.
  'x y'=. y.
  x=. px + x
  y=. py + ph - y + h
  1440 %~ x,y
end.
)

NB. opt=1  =  convert back to inches
NB. e.g. getframe 0 0 0 0 = entire printable area
NB.        getframe 1 2 2 4 = topleft=1 2, size=2 by 4
getframe=: 3 : 0
0 getframe y.
:
if. x.=0 do.
  'x y w h'=. 1440 * y.
  'px py pw ph j j wid hit'=. ,PRINTPAGE
  x=. 0 >. x - px
  if. w <: 0 do. w=. wid + w - x + px end.
  w=. w <. pw - x
  y=. 0 >. y - py
  if. h <: 0 do. h=. hit + h - y + py end.
  h=. h <. ph - y
  x,(ph-y+h),w,h
else.
  'x y w h'=. y.
  'px py pw ph j j wid hit'=. ,PRINTPAGE
  x=. px + x
  y=. py + ph - y + h
  1440 %~ x,y,w,h
end.
)

NB. =========================================================
NB. getprintpage
NB.
NB. defines PRINTPAGE, a 2 row matrix:
NB.   0{PRINTPAGE = x y w h for printable area
NB.   1{PRINTPAGE = 0 0, pagewidth, pageheight
NB.
getprintpage=: 3 : 0
dat=. glqprinter''
pxl=. 1440 % 4 5{dat
'wres hres'=. pxl * 2 3{dat
'w h x y'=. (4$pxl) * 12 13 14 15{dat
PRINTPAGE=: 1 round (x,(h-hres+y),wres,hres) ,: 0 0,w,h
)

NB. =========================================================
NB. place      - place paragraph
NB.
NB.   dat has 7 elements:
NB.      justification;xywh;font;forecolor;backcolor;linespace;text
NB.
NB. text is a boxed list of lines, and may contain tags
NB.
NB. returns: (xywh remaining);(text remaining)
NB.
NB. positions are in twips, measured from bottom left
NB.
NB. justification:  0=left 1=right 2=both 3=centered
place=: 3 : 0

'just xywh font foreclr backclr lspace txt'=. y.

rws=. #txt
if. 0=rws do. return. end.

if. #font do.
  TFONT=: font
  glfont TFONT
  glextentfont TFONT
end.

'x y width height'=. xywh
lspace=. {.lspace,1

setcolor foreclr,backclr

hite=. lspace*{.glqtextmetrics''

len=. <.height%hite
pos=. x,y + height

rws=. rws <. len
NB. res=. (<x,y,width,hite*len-rws) , <len }. txt
res=. (<x,y,width,height-hite*rws) , <len }. txt
txt=. len {. txt

while. #txt do.

  line=. ,0 pick txt
  txt=. }.txt

  if. 0=#line do.
    pos=. pos-0,hite
    continue.
  end.

NB. output line with no font change: ==================
  if. -. 1 e. , E.&line &> TAGS do.

    if. just=0 do.
      gltextxy rnd0 pos
      gltext line

    elseif. just=1 do.
      gltextxy rnd0 pos+width,0

      gltextalign TA_RIGHT
      gltext line
      gltextalign TA_LEFT

    elseif. just=2 do.
      blk=. +/line=' '
      wid=. {. glqextent line

      if. (1<blk) *. (wid >: width*4r5) *. ' ' ~: 1{.line do.
        gltextjustify rnd0 (width-wid),blk
      end.

      gltextxy rnd0 pos
      gltext line
      gltextjustify 0 0

    elseif. just=3 do.

      gltextxy rnd0 pos+-:width,0
      gltextalign TA_CENTER
      gltext line
      gltextalign TA_LEFT

    end.

NB. output line with font change: =====================
  else.

    curfont=. TFONT
    'num wid'=. width fitline line

    glfont TFONT
    glextentfont TFONT

    if. just=0 do.
      placeline pos;line

    elseif. just=1 do.

      placeline (pos+(width-wid),0);line

    elseif. just=2 do.
      blk=. +/line=' '

      if. (1<blk) *. wid >: width*3r4 do.
        opt=. (width-wid),blk
        opt placeline pos;line
      else.
        placeline pos;line
      end.

    elseif. just=3 do.
      placeline (pos+-:(width-wid),0);line

    end.

  end.

  pos=. pos-0,hite

end.

setcolor''
res
)

NB. =========================================================
placeline=: 3 : 0
0 0 placeline y.
:
'pos txt'=. y.
'pad blk'=. x.

while. #txt do.
  b=. +./ E.&txt &> TAGS
  ndx=. b i. 1
  bit=. ndx{.txt
  if. blk do.
    num=. +/bit=' '
    space=. >.pad*num%blk
    gltextjustify space,num
    pad=. pad-space
    blk=. blk-num
  else.
    space=. 0
  end.

  gltextxy rnd0 pos
  gltext bit
  pos=. pos + 2{. space + {. glqextent bit

  txt=. ndx}.txt
  if. 0=#txt do. break. end.

  'tag txt'=. taketag txt

  TFONT=: TFONT changetag tag
  glfont TFONT
  glextentfont TFONT
  b=. +./ E.&txt &> TAGS

end.

gltextjustify 0 0
)

NB. =========================================================
preview=: 3 : 0
glwindowext (<0;2 3){PRINTPAGE
glpaint glshow''
wd'pshow;ptop'
)

NB. =========================================================
NB. printerspecs    - list printer specs
NB. form: printerspecs ''      - specs for default printer
NB.       printerspecs 'name'  - specs for given printer
printerspecs=: 3 : 0
wd 'pc printerspecs;cc g isigraph;'
glsel,'g'
glzcreate y.
dat=. glqprinter''
wd 'pclose'
j=. 'horzsize vertsize horzres vertres logpixelsx logpixelsy'
j=. j,' bitspixel planes numcolors aspectx aspecty aspectxy'
j=. j,' width height offsetx offsety'
(;: j),.<&>dat
)

NB. =========================================================
NB. printers      - list all printers
printers=: }: @ wd bind 'qprinters'

NB. =========================================================
NB. removetag text   - remove tags from text
removetag=: 3 : 0
r=. ''
y=. y.
while. 1 e. b=. +./ E.&y &> TAGS do.
  ndx=. b i. 1
  r=. r,ndx{.y
  y=. ndx}.y
  y=. (>:y i.'>')}.y
end.
r=. r,y
)


NB. =========================================================
NB. setcolor     set fore,back color, or if empty set default
setcolor=: 3 : 0
if. #y. do.
  'fore back'=. y.
  glbkcolor glrgb 256 256 256#:{.back
  gltextcolor glrgb 256 256 256#:{.fore
else.
  glbkcolor glrgb 255 255 255
  gltextcolor glrgb 0 0 0
end.
)

NB. =========================================================
setfont=: 3 : 0
TFONT=: y.
glfont TFONT
glextentfont TFONT
)

NB. =========================================================
stamp=: 4 : 0
x.,'  Page ',":y.
)

NB. =========================================================
NB. taketag text   - return tag(s);text from text
taketag=: 3 : 0
tag=. ''
txt=. y.
while. '<' = 1{.txt do.
  ind=. >:txt i.'>'
  tag=. tag,<ind {.txt
  txt=. ind }. txt
end.
tag;txt
)

NB. =========================================================
NB. topara text   - convert text to paragraphs
NB. replaces single LFs not followed by blanks by spaces.
topara=: 3 : 0
if. 0=#y. do. '' return. end.
if. 1<#$y. do. y. return. end.
txt=. toJ y.
b=. txt=LF
c=. b +. txt=' '
b=. b > (0,}:b) +. }.c,0
txt=. ' ' (b#i.#b) } txt
return.
b=. b *: 0,}:b=. txt=LF
txt=. b#txt
)

NB. =========================================================
tstamp=: 3 : 0
y=. <.y.,(0=#y.)#6!:0 ''
'y m d h n s'=. 6{.y
mth=. _3[\'   JanFebMarAprMayJunJulAugSepOctNovDec'
f=. _2: {. '0'&,@":
t=. (2":d),(m{mth),(":y),;f&.>h,n,s
r=. 'xx xxx xxxx xx:xx:xx'
t (I. r='x') } r
)

NB. =========================================================
NB.*xtabline v remove tab stops
NB. remove tabs from single line
xtabline=: 4 : 0
r=. y.
while.
  i=. >: r i. TAB
  i <: #r
do.
  r=. ((x. * >. i % x.){.!.' ' }:i{.r) , i}.r
end.
)

NB. =========================================================
NB.*xtab v remove tab stops from character string
xtab=: 4 : 0
if. -. TAB e. y. do. y. return. end.
y=. <;._2 y.,(LF ~: {:y.)#LF
b=. TAB e.&> y
tolist (x. xtabline each b#y) (I. b)} y
)

NB. =========================================================
NB. width wrappara text   - wrap paragraph
NB. return boxed list of lines
wrappara=: 4 : 0
if. 0=#y. do. <a: return. end.
r=. ''
txt=. y.
while. #txt do.
  len=. {.x. fitline txt
  line=. len{.txt
  txt=. len}.txt
  txt=. (' '=1{.txt)}.txt
  r=. r,<line
end.
<r
)

NB. =========================================================
NB. width wraptext text
NB. return boxed list of lines
NB. assumes paras delimited by LF
NB. if text is a matrix, just return the boxed rows
wraptext=: 4 : 0
if. 0 e. $y. do. '' return. end.
if. 2=#$y. do. ;/y. return. end.
txt=. toJ y.
if. -. LF e. txt do. >x. wrappara txt return. end.
txt=. txt,(LF~:{:txt)#LF
txt=. ;x.&wrappara ;._2 txt
)


print_z_=: print_jprint_
printfile_z_=: printfile_jprint_
print2_z_=: print2_jprint_
printfile2_z_=: printfile2_jprint_
