home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / GFX / Raytracing / Raytracer / LightWave.lha / Lightwave / Toaster / Arexx_Examples / lwm / comptext.lwm < prev    next >
Encoding:
Text File  |  1992-12-05  |  3.1 KB  |  136 lines
  1. /* CMD: Compose Text
  2.  * By Stuart Ferguson
  3.  * Layout text line -- Modeler ARexx program
  4.  */
  5.  
  6. /* trace results */
  7.  
  8. address "LWModelerARexx.port"
  9. libadd = addlib("LWModelerARexx.port",0)
  10.  
  11. check = addlib("rexxmathlib.library",0,-30,0)
  12.  
  13.  
  14. sysnam = "Compose Text"
  15.  
  16. call req_begin sysnam
  17.  
  18. id_fdir = req_addcontrol("   Font Directory", 's')
  19. id_fam  = req_addcontrol("      Font Family", 's')
  20. id_txt  = req_addcontrol("String to Compose", 's')
  21.  
  22. call req_setval id_fdir, "Objects/Fonts/"
  23. call req_setval id_fam,  "Common"
  24.  
  25. if (~req_post()) then exit
  26.  
  27. fontdir = req_getval(id_fdir)
  28. family  = req_getval(id_fam)
  29. txt     = req_getval(id_txt)
  30.  
  31. call req_end
  32.  
  33. basefont = fontdir || family || "/" || family || "."
  34. fin = curlayer()
  35. empty = emptylayers()
  36. scr = word(empty, 1)
  37. if (scr = fin) then scr = word(empty, 2)
  38.  
  39. if (scr == "") then do
  40.     call notify 1, '@'sysnam, "!Need an empty layer for scratch work."
  41.     exit 10
  42. end
  43.  
  44. badchar = ""
  45.  
  46. /* Compute spacing based on width of "M" character.
  47.  */
  48. setlayer scr
  49. mfil = charfile("M")
  50. if (mfil = "") then do
  51.     call notify 1, '@'sysnam, "!Problem with font:" basefont
  52.     exit 10
  53. end
  54. load mfil
  55. parse value boundingbox() with num x0 x1 y0 y1 z0 z1 .
  56. gap = (x1 - x0) / 10
  57. space = (x1 - x0) / 2
  58. dy = (y1 - y0) / 5
  59. blot = "makebox l[" || -gap/2 "," y0+dy "," z0 "] h[" gap/2 "," y1-dy "," z1 "]"
  60. delete
  61.  
  62. /* Load first character into final layer and set start and insertion
  63.  * points.
  64.  */
  65. setlayer fin
  66. delete
  67. parse value loadfont(substr(txt,1,1)) with x0 x1
  68.  
  69. /* Load remaining letters.
  70.  */
  71. do i=2 to length(txt)
  72.     chr = substr(txt,i,1)
  73.     if (chr = ' ') then do
  74.     /* Process spaces by just adding to insertion point.
  75.      */
  76.     x1 = x1 + space
  77.     end; else do
  78.     /* Load any real characters into the scratch buffer and shift to
  79.      * final position.  Move them to final buffer and advance
  80.      * insertion point.
  81.      */
  82.     setlayer scr
  83.     parse value loadfont(chr) with p0 p1
  84.     move '[' (x1 + gap - p0) ',,]'
  85.     cut
  86.     setlayer fin
  87.     paste
  88.     x1 = x1 + (p1 - p0) + gap
  89.     end
  90. end i
  91.  
  92. /* Center text in final layer.
  93.  */
  94. move '[' (x0 + x1) / -2 ',,]'
  95.  
  96. /* Inform user about bad characters in string, if any.
  97.  */
  98. if (badchar ~= "") then call notify 1, '@'sysnam, '!Characters not
  99.  found in font: "' || badchar || '"'
  100.  
  101. if (libadd) then call remlib("LWModelerARexx.port")
  102. exit
  103.  
  104.  
  105. /* Load a character and return X-extent.
  106.  */
  107. loadfont: procedure expose basefont blot badchar
  108.     parse arg chr
  109.     fil = charfile(chr)
  110.     if (fil = "") then do
  111.     blot
  112.     badchar = badchar || chr
  113.     end; else load fil
  114.     parse value boundingbox() with num x0 x1 .
  115.     return x0 x1
  116.  
  117.  
  118. /* Get the filename for a character from the base font name.  Checks for
  119.  * file existence.  Name is returned in double quotes for Modeler command
  120.  * formatting.
  121.  */
  122. charfile: procedure expose basefont
  123.     parse arg ch
  124.     let = ch
  125.     if (ch >= 'A' & ch <= 'Z') then let = "Cap." || ch
  126.     else if (ch = ':' | ch = '/') then let = "Junk"
  127.     else do
  128.     p = pos(ch, '.?()&$,!#%')
  129.     if (p ~= 0) then let = word('Period Question LeftParen RightParen ',
  130.                  || 'Ampersand DollarSign Comma Exclamation ',
  131.                  || 'NumberSign PercentSign', p)
  132.     end
  133.     nam = basefont || let
  134.     if (~exists(nam)) then return ""
  135.     return ('"' || nam || '"')
  136.