/* CMD: Text
 * By Arnie Cachelin © 1993 NewTek Inc. */
/* Tue Sep 14 20:03:06 1993 */

libadd = addlib("LWModelerARexx.port",0)
signal on error
signal on syntax

call addlib "rexxsupport.library", 0, -30, 0
MATHLIB="rexxmathlib.library"
IF POS(MATHLIB , SHOW('L')) = 0 THEN
  IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
        call notify(1,"!Can't find "MATHLIB)
        exit
        END
sysnam = 'Compose Text Lines'
filnam = 'ENV:Text.state'
version = 'Text v1.0'
lead=50
typ=1
just=1
deep = 0.1
wide = 0.02
lines=4
line.=""
if (exists(filnam)) then do
    if (~open(state, filnam, 'R')) then break
    if (readln(state) ~= version) then break
    parse value readln(state) with lead typ just .
    do i=1 to lines
      line.i = readln(state)
    end
    call close state
end

call req_begin sysnam
styles = 'Flat Block Chisel Round'

id_font = req_addcontrol("Font", 'F')
id_typ = req_addcontrol("Text Type", "CH",Styles)
id_just = req_addcontrol('Place','CH',"Center Left Right Justify Scale")
id_deep = req_addcontrol("Depth", 'n', 1)
id_wide = req_addcontrol("Edge Width", 'n', 1)
do i=1 to lines
  id_line.i = req_addcontrol("> ", 's', 35)
  end
id_lead = req_addcontrol("% Leading", 'n')

do i=1 to lines
  call req_setval id_line.i, line.i
  end
line.i=""

call req_setval id_lead, lead,lead
call req_setval id_just, just,1
call req_setval id_typ, typ,1
call req_setval id_deep, deep,0.1
call req_setval id_wide, wide,0.02

if (~req_post()) then do
    call req_end
    exit
end
LineLen=0
font = req_getval(id_font)
do i=1 to lines
  line.i = req_getval(id_line.i)
  if length(line.i)>LineLen then do
    LineLen=length(line.i)
    longest=line.i
    end
  end
lead = req_getval(id_lead)%1
just = req_getval(id_just)-1
typ = req_getval(id_typ)
wide = req_getval(id_wide)
deep = req_getval(id_deep)
call req_end

if (open(state, filnam, 'W')) then do
    call writeln state, version
    call writeln state, lead typ just+1
    do i=1 to lines
      call writeln state, line.i
    end
    call close state
end


if LineLen=0 then exit
call CUT()
if font=0 then do
  if(notify(2,"!Please Load A Font!","I can't continue without one")) then do
    fname=GetFileName("Load Font","toaster:psfonts/")
    if fname~="(none)" then do
      font=fontload(fname)
      if font=0 then do
        call notify(1,"!Can't load font "fname)
        exit
        end
      end
    end
  end

LineWidth=MAKETEXT(longest,font,'B',wide*2)
if LineWidth~=0 then call UNDO()
call PASTE()
/* call surface(surf) */
/* call meter_begin lines+2, "Creating Formatted Text Object" */
/* call meter_step() */
say line.1
h=CreateText(line.1, typ,just)
stmarg=h + lead*h/100
do i=2 to lines
/*   call meter_step() */
  if line.i~="" then do
    say i h lead typ
    marg=h + lead*h/100
    if type=4 then call MOVE(0 marg 0)
    else call MOVE(0 stmarg 0)
    h=CreateText(line.i, typ)
    say h
    end
end
box=boundingbox()
parse var box n x1 x2 y1 y2 z1 z2
call MOVE(0 0-y1 0)
/* call meter_end() */
if (libadd) then call remlib("LWModelerARexx.port")
exit

syntax:
error:
  call end_all
        t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  if (libadd) then call remlib("LWModelerARexx.port")
        exit

Center: Procedure
  box=boundingbox()  /* Should check out empty list ...  */
  parse var box n x1 x2 y1 y2 z1 z2
  cx=-(x2-x1)/2
  cy=-(y2-y1)/2
  cz=-(z2-z1)/2
  call MOVE(cx cy cz)
  return box

CenterX: Procedure
  box=boundingbox()  /* Should check out empty list ...  */
  parse var box n x1 x2 y1 y2 z1 z2
  cx=-(x2-x1)/2
  call MOVE(cx 0 0)
  return (y2-y1) /* Height */

CenterScaleX: Procedure
  arg w
  box=boundingbox()  /* Should check out empty list ...  */
  parse var box n x1 x2 y1 y2 z1 z2
  cx=-(x2-x1)/2
  call MOVE(cx 0 0)
  call SCALE(w/2*cx 1 1,0)
  return (y2-y1) /* Height */

JustifyX: Procedure expose marg  /* 0=center, left=1, 2=right 3=justify 4=Aspect Justify*/
  arg w, type
  say w type
  box=boundingbox()  /* Should check out empty list ...  */
  parse var box n x1 x2 y1 y2 z1 z2
  cx=-(x2-x1)/2
  cy=(y2-y1)/2
  select
    when type=4 then do
      call MOVE(cx 0 0)
      call SCALE(w/(-2*cx) w/(-2*cx) 1,0 y2 0)
      end
    when type=3 then do
      call MOVE(cx 0 0)
      call SCALE(w/(-2*cx) 1 1,0)
      end
    when type=2 then call MOVE(2*cx 0 0)
    when type=0 then call MOVE(cx 0 0)
    otherwise nop
    end
if type=4 then return (y2-y1)*w/(-2*cx) /* Height */
else return (y2-y1)

Bevel_Slab:
  txlayer=curlayer()
  empty=emptylayers()
  if empty~="" then do
    slablayer=word(empty,1)
    end
  else do    /* Need 1 layer to transform in */
    call notify(1,'!'sysnam,'@Sorry, No Scratch Layer Available')
    return
    end
  box=boundingbox()
  parse var box n x1 x2 y1 y2 z1 z2
  z2=z1+deep*2
  call surface("Slab")
  call MAKEBOX(x1 y1 z1, x2 y2 z2)
  call smoothshift(wide)
  call setblayer(txlayer)
  call BOOLEAN(SUBTRACT)
  call setlayer(txlayer)
  call Cut()
  call setlayer(slablayer)
  call Cut()
  call setlayer(txlayer)
  call Paste()
  return

Bevel_Flat:
    call cut
    return

Bevel_Block:
    call bevel(0, deep / 2)
    return

Bevel_Chisel:
    call shapebevel(-wide wide (-wide) deep/2)
    return

Bevel_Round:
    n = 5
    pat = ''
    do i=1 to n
        a = 3.14159/2 * i / n
        pat = pat (-sin(a)*wide) (1-cos(a))*wide
      end i
    call shapebevel(pat (-wide) deep/2)
    return

CreateText: PROCEDURE expose font wide styles deep just LineWidth
  parse arg txt,typ
  say txt typ
  origl = curlayer()
  empty = emptylayers()
  if (words(empty) < 2) then do
    call notify 1,syscode,"!Need at least two empty layers","!for this operation."
    exit
    end
  sl1 = word(empty, 1)
  sl2 = word(empty, 2)
  sbase = ''
  do i=1 to words(txt)
    sbase = sbase || word(txt, i)
    if length(sbase) >= 5 then leave
    end
  if length(sbase) > 15 then sbase = left(sbase, 15)
  corners = 'B B S S S'
  call setlayer sl1
  w= maketext(txt, font, word(corners, typ), wide * 2)
  call copy
  call setlayer sl2
  call paste
  call sel_mode('user')
  call sel_polygon('set')
  interpret 'call Bevel_' || word(styles, typ)
  call cut
  call changesurface(sbase || "_Side")
  call setlayer sl1 /* Get the correct faces from sl1. */
  call changesurface(sbase || "_Face")
  call flip
  call cut
  call setlayer sl2
  call paste
  call mirror(Z, -deep/2)
  call mergepoints
  x=JustifyX(LineWidth,just)
  call cut
  call setlayer origl
  call paste
  return x