/* CMD: Curve Text
 * By Arnie Cachelin © 1992, 1993 NewTek Inc. */


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 = 'Build Curved Text'
filnam = 'ENV:CurveText.state'
version = 'Curved Text v1.0'

lines=2
rad=3
arng=.6
styles = 'Flat Block Chisel Round'
typ=1
deep = 0.1
wide = 0.02
call req_begin sysnam
id_font = req_addcontrol("Use Font",'F')
id_typ = req_addcontrol("Text Type", "CH",Styles)
id_deep = req_addcontrol("Depth", 'n', 1)
id_wide = req_addcontrol("Edge Width", 'n', 1)
RadId = req_addcontrol("Radius",'N',0)
TxtId = req_addcontrol("Text",'S',35)
angId = req_addcontrol("Spacing",'N',0)
axid = req_addcontrol("Axis", "CH",'X Y Z')
surfid = req_addcontrol("Surface",'R')

call req_setval RadId, rad
call req_setval TxtId, ""
call req_setval id_typ, typ,1
call req_setval id_deep, deep,0.1
call req_setval id_wide, wide,0.02
call req_setval angId, arng,0
call req_setval axId, 3

if (~req_post()) then do
    call req_end
    exit
end
font = req_getval(id_font)
rad = req_getval(RadId)
txt = req_getval(TxtId)
arng = req_getval(angId)
ax = req_getval(axId)
name = req_getval(surfId)
typ = req_getval(id_typ)
wide = req_getval(id_wide)
deep = req_getval(id_deep)
call req_end

call CUT()
/*font=fontload(fntname)*/
if font=0 then do
  if(notify(2,"!Please Load A Font!","I just can't go on 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

LetSiz=MAKETEXT('M', font)  /* One emm space (M width)  */
box=boundingbox()  /* Should check out empty list ...  */
if LetSiz~=0 then call UNDO() /* Get rid of M  */
parse var box n x1 x2 y1 y2 z1 z2
if ax=1 then LetSiz=1.5*abs(y2-y1)
call 'PASTE'
L= length(txt)
W=LetSiz*L
astep=(1+4*arng)*36*LetSiz/(-3.141592*rad)    /* Do this in loop to use PS kerning!! */
angle=-astep
call SURFACE(name)
do i=1 to L
  if ax=1 then call ROTATE(astep,'X',0)
  else if ax=2 then call ROTATE(astep,'Y',0)
  else call ROTATE(astep,'Z',0)
  angle=angle+astep
  call CUT()
  c=substr(txt,i,1)
  cw=maketext(c,font)
  h=centerx()
  if ax=1 then call MOVE(0 0 -1*rad)
  else if ax=2 then call MOVE(0 0 -1*rad)
  else  call MOVE(0 rad 0)
  call PASTE()
  end
if ax=1 then call ROTATE(Angle/(-2),'X',0)
else if ax=2 then call ROTATE(Angle/(-2),'Y',0)
else call ROTATE(Angle/(-2),'Z',0)
call ShapeText(typ)
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
  cy=-(y2-y1)/2
  call MOVE(cx 0 0)
  return 2*cy
Bevel_Flat:
    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

ShapeText: PROCEDURE expose wide styles deep
  arg typ
  sl1 = curlayer()
  empty = emptylayers()
  if (words(empty) < 1) then do
    call notify 1,syscode,"!Need an empty layer","!for this operation."
    exit
    end
  sl2 = word(empty, 1)
  call copy
  sbase=cursurface()
  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
  call cut
  call setlayer sl1
  call paste
  return