home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0925.lha / DonsGenies / DonsGenies.lha / Don'sGenies / FitTextToBoxes.pprx < prev    next >
Text File  |  1993-07-03  |  7KB  |  191 lines
  1. /* This Genie will fit text into a box or chain of boxes, keeping the proportions of differing sizes of text in a box. All the text in a box or linked chain will be changed. No new boxes are created, unlike AutoImport. The text must be already in the box before running the genie.
  2. Note that any style tags applying to the text will be cancelled. 
  3. The limiting factor for accurate fitting is the 1/8 point step in the available font sizes. I have set the genie to underflow rather than overflow.
  4. Written by Don Cox    July 92  Revised July 93  Not Public Domain. All rights reserved. */
  5.  
  6. trace n
  7. signal on error
  8. signal on syntax
  9. address command
  10. call SafeEndEdit.rexx()
  11. call ppm_AutoUpdate(0)
  12. cr="0a"x
  13.  
  14. cpage = ppm_CurrentPage()
  15. counter=0
  16.  
  17. do forever
  18.     box=ppm_ClickOnBox("Click on boxes to be fitted")
  19.     if box=0 then break
  20.     counter=counter+1
  21.     boxes.counter=box
  22.     call ppm_SelectBox(box)
  23. end
  24.  
  25. if counter=0 then exit_msg("No boxes selected")
  26.  
  27.  
  28. currentunits=ppm_GetUnits()
  29. call ppm_SetUnits(2)
  30.  
  31.  
  32.  
  33. call ppm_ShowStatus("  Fitting text...")
  34. do i=1 to counter
  35.     box=boxes.i
  36.     
  37.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  38.     if boxtype~="TEXT" then iterate
  39.     box = ppm_ArtFirstBox(box)
  40.     text = ppm_GetArticleText(box,1)
  41.     iter = 1
  42.     factor = 0.5 /* first find max size quickly */
  43.     do 9  /* 9 is enough doublings  */
  44.         factor2 = factor /* format number for display */
  45.         if pos(".",factor2) = 0 then factor2 = factor||"."
  46.         factor2 = left(factor2,8,"0")
  47.         call ppm_ShowStatus("  Fitting text... Iteration "right(iter,2," ")"    Size factor "factor2)
  48.         oldfactor = factor
  49.         factor = factor*2
  50.         newtext = text /* go back to original each time */
  51.         newtext = ResizeFonts(newtext,factor) 
  52.         if newtext~="" then do /* ResizeFonts returns empty string if over size limit (720 points)  */
  53.             gone = ppm_DeleteContents(box)
  54.             overflow = ppm_TextIntoBox(box,newtext)
  55.             end
  56.         if newtext="" | overflow = 1  then break 
  57.         end
  58.  
  59.     max = factor
  60.     factor = (oldfactor+factor)/2
  61.     min = 0
  62.  
  63.     do 18  /* Don't go on iterating for ever... */
  64.  
  65.         factor2 = factor /* format number for display */
  66.         if pos(".",factor2) = 0 then factor2 = factor||"."
  67.         factor2 = left(factor2,8,"0")
  68.         call ppm_ShowStatus("  Fitting text... Iteration "right(iter,2," ")"    Size factor "factor2)
  69.  
  70.         iter = iter+1
  71.         newtext = text /* go back to original each time */
  72.         newtext = ResizeFonts(newtext,factor) 
  73.         if newtext~="" then do /* ResizeFonts returns empty string if over size limit (720 points)  */
  74.             gone = ppm_DeleteContents(box)
  75.             overflow = ppm_TextIntoBox(box,newtext)
  76.             end
  77.         if overflow = 1 | newtext = "" then do
  78.             max = factor
  79.             factor = (factor+min)/2
  80.             end
  81.         else do
  82.             min = factor
  83.             factor = (factor+max)/2
  84.             end
  85.     end
  86. factor = min  /* just reduce a little at the end to cover the oscillations */
  87. newtext = ResizeFonts(text,factor) /* go back to original each time */
  88. gone = ppm_DeleteContents(box)
  89. overflow = ppm_TextIntoBox(box,newtext)
  90. end
  91.  
  92. newpage = ppm_GoToPage(cpage)
  93. call ppm_SetUnits(currentunits)
  94.  
  95. call exit_msg()
  96. end
  97.  
  98. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  99.  
  100. ResizeFonts: procedure
  101. parse arg text, factor
  102. position = 1
  103. position2 = 1
  104.  
  105. do forever  /* we have to open up style tags to get sizes */
  106.     position = pos("\dS<",text,position2)
  107.     if position = 0 then break
  108.     position2 = pos(">",text,position)
  109.     if position2 = 0 then break
  110.     styletag = substr(text,position+4, position2-position-4)
  111.     styledef = ppm_GetStyleTagData(styletag)
  112.     styledef = left(styledef,pos("}",styledef)-1) /* remove name of tag */
  113.     styledef = substr(styledef,pos("{",styledef)+1)
  114.     text = delstr(text,position, (position2-position+1)) /* delete tag name */
  115.     text = insert("\ds"styledef,text,(position-1))
  116.     end
  117.  
  118. position2 = 1
  119. do forever  /* first change font sizes */
  120.     position = pos("\fs<",text,position2)+4
  121.     if position = 4 then break  /* would be 0 but we added 4 */
  122.     position2 = pos(">",text,position)
  123.     if position2 = 0 then break
  124.     oldsize = substr(text,position, position2-position)
  125.     text = delstr(text,position, position2-position) /* delete old size */
  126.     newsize = oldsize*factor
  127.     if newsize>720 then do
  128.         text = ""  /* return empty text if over limit  - this is different from the standard Text Resize module used in other genies */
  129.         break
  130.         end
  131.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  132.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  133.     else newsize = newsize-oddsize
  134.     text = insert(newsize,text,position-1)
  135.     end
  136.  
  137. if text = "" then return text /* again, different from standard module */
  138.  
  139. position2 = 1
  140. do forever  /*  now fixed line spacings  */
  141.     position = pos("\lf<",text,position2)+4
  142.     if position = 4 then break  /* would be 0 but we added 4 */
  143.     position2 = pos(">",text,position)
  144.     if position2 = 0 then break
  145.     oldsize = substr(text,position, position2-position)
  146.     text = delstr(text,position, position2-position) /* delete old size */
  147.     newsize = oldsize*factor
  148.     if newsize>720 then newsize = 720
  149.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  150.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  151.     else newsize = newsize-oddsize
  152.     text = insert(newsize,text,position-1)
  153.     end
  154.  
  155. position2 = 1
  156. do forever   /* and fixed leading  */
  157.     position = pos("\ll<",text,position2)+4
  158.     if position = 4 then break  /* would be 0 but we added 4 */
  159.     position2 = pos(">",text,position)
  160.     if position2 = 0 then break
  161.     oldsize = substr(text,position, position2-position)
  162.     text = delstr(text,position, position2-position) /* delete old size */
  163.     newsize = oldsize*factor
  164.     if newsize>720 then newsize = 720
  165.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  166.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  167.     else newsize = newsize-oddsize
  168.     text = insert(newsize,text,position-1)
  169.     end
  170.  
  171. return text
  172.  
  173. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  174.  
  175. error:
  176. syntax:
  177.     do
  178.     exit_msg("Genie failed due to error: "errortext(rc))
  179.     end
  180.  
  181. exit_msg:
  182.     do
  183.     parse arg message
  184.     if message ~= "" then
  185.     call ppm_Inform(1,message,"Resume")
  186.     call ppm_ClearStatus()
  187.     call ppm_AutoUpdate(1)
  188.     exit
  189.     end
  190.  
  191.