home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d7xx / d724 / donsgenies.lha / DonsGenies / DonsGenies.lha / Don'sGenies / FitTextToBoxes.pprx < prev    next >
Text File  |  1992-08-01  |  6KB  |  186 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  */
  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. oldcolormode = ppm_GetColorMode()
  14. /*call ppm_SetColorMode(1)   This command seems to be causing crashes */
  15.  
  16. cpage = ppm_CurrentPage()
  17. counter=0
  18.  
  19. do forever
  20.     box=ppm_ClickOnBox("Click on boxes to be fitted")
  21.     if box=0 then break
  22.     counter=counter+1
  23.     boxes.counter=box
  24.     call ppm_SelectBox(box)
  25. end
  26.  
  27. if counter=0 then exit_msg("No boxes selected")
  28.  
  29.  
  30. currentunits=ppm_GetUnits()
  31. call ppm_SetUnits(2)
  32.  
  33.  
  34.  
  35. call ppm_ShowStatus("  Fitting text...")
  36. do i=1 to counter
  37.     box=boxes.i
  38.     
  39.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  40.     if boxtype~="TEXT" then iterate
  41.     box = ppm_ArtFirstBox(box)
  42.     text = ppm_GetArticleText(box,1)
  43.     iter = 1
  44.     factor = 0.5 /* first find max size quickly */
  45.     do 9  /* 9 is enough doublings  */
  46.         call ppm_ShowStatus("  Fitting text... Iteration "right(iter,2," ")"    Size factor "left(factor,8,"0"))
  47.         oldfactor = factor
  48.         factor = factor*2
  49.         newtext = text /* go back to original each time */
  50.         newtext = ResizeFonts(newtext,factor) 
  51.         if newtext~="" then do /* ResizeFonts returns empty string if over size limit (720 points)  */
  52.             gone = ppm_DeleteContents(box)
  53.             overflow = ppm_TextIntoBox(box,newtext)
  54.             end
  55.         if newtext="" | overflow = 1  then break 
  56.         end
  57.  
  58.     max = factor
  59.     factor = (oldfactor+factor)/2
  60.     min = 0
  61.  
  62.     do 18  /* Don't go on iterating for ever... */
  63.         call ppm_ShowStatus("  Fitting text... Iteration "right(iter,2," ")"    Size factor "left(factor,8,"0"))
  64.         iter = iter+1
  65.         newtext = text /* go back to original each time */
  66.         newtext = ResizeFonts(newtext,factor) 
  67.         if newtext~="" then do /* ResizeFonts returns empty string if over size limit (720 points)  */
  68.             gone = ppm_DeleteContents(box)
  69.             overflow = ppm_TextIntoBox(box,newtext)
  70.             end
  71.         if overflow = 1 | newtext = "" then do
  72.             max = factor
  73.             factor = (factor+min)/2
  74.             end
  75.         else do
  76.             min = factor
  77.             factor = (factor+max)/2
  78.             end
  79.     end
  80. factor = min  /* just reduce a little at the end to cover the oscillations */
  81. newtext = ResizeFonts(text,factor) /* go back to original each time */
  82. gone = ppm_DeleteContents(box)
  83. overflow = ppm_TextIntoBox(box,newtext)
  84. end
  85.  
  86. newpage = ppm_GoToPage(cpage)
  87. call ppm_SetUnits(currentunits)
  88.  
  89. call exit_msg()
  90. end
  91.  
  92. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  93.  
  94. ResizeFonts: procedure
  95. parse arg text, factor
  96. position = 1
  97. position2 = 1
  98.  
  99. do forever  /* we have to open up style tags to get sizes */
  100.     position = pos("\dS<",text,position2)
  101.     if position = 0 then break
  102.     position2 = pos(">",text,position)
  103.     if position2 = 0 then break
  104.     styletag = substr(text,position+4, position2-position-4)
  105.     styledef = ppm_GetStyleTagData(styletag)
  106.     styledef = left(styledef,pos("}",styledef)-1) /* remove name of tag */
  107.     styledef = substr(styledef,pos("{",styledef)+1)
  108.     text = delstr(text,position, (position2-position+1)) /* delete tag name */
  109.     text = insert("\ds"styledef,text,(position-1))
  110.     end
  111.  
  112. position2 = 1
  113. do forever  /* first change font sizes */
  114.     position = pos("\fs<",text,position2)+4
  115.     if position = 4 then break  /* would be 0 but we added 4 */
  116.     position2 = pos(">",text,position)
  117.     if position2 = 0 then break
  118.     oldsize = substr(text,position, position2-position)
  119.     text = delstr(text,position, position2-position) /* delete old size */
  120.     newsize = oldsize*factor
  121.     if newsize>720 then do
  122.         text = ""  /* return empty text if over limit  - this is different from the standard Text Resize module used in other genies */
  123.         break
  124.         end
  125.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  126.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  127.     else newsize = newsize-oddsize
  128.     text = insert(newsize,text,position-1)
  129.     end
  130.  
  131. if text = "" then return text /* again, different from standard module */
  132.  
  133. position2 = 1
  134. do forever  /*  now fixed line spacings  */
  135.     position = pos("\lf<",text,position2)+4
  136.     if position = 4 then break  /* would be 0 but we added 4 */
  137.     position2 = pos(">",text,position)
  138.     if position2 = 0 then break
  139.     oldsize = substr(text,position, position2-position)
  140.     text = delstr(text,position, position2-position) /* delete old size */
  141.     newsize = oldsize*factor
  142.     if newsize>720 then newsize = 720
  143.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  144.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  145.     else newsize = newsize-oddsize
  146.     text = insert(newsize,text,position-1)
  147.     end
  148.  
  149. position2 = 1
  150. do forever   /* and fixed leading  */
  151.     position = pos("\ll<",text,position2)+4
  152.     if position = 4 then break  /* would be 0 but we added 4 */
  153.     position2 = pos(">",text,position)
  154.     if position2 = 0 then break
  155.     oldsize = substr(text,position, position2-position)
  156.     text = delstr(text,position, position2-position) /* delete old size */
  157.     newsize = oldsize*factor
  158.     if newsize>720 then newsize = 720
  159.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  160.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  161.     else newsize = newsize-oddsize
  162.     text = insert(newsize,text,position-1)
  163.     end
  164.  
  165. return text
  166.  
  167. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  168.  
  169. error:
  170. syntax:
  171.     do
  172.     exit_msg("Genie failed due to error: "errortext(rc))
  173.     end
  174.  
  175. exit_msg:
  176.     do
  177.     parse arg message
  178.     if message ~= "" then
  179.     call ppm_Inform(1,message,"Resume")
  180.     call ppm_ClearStatus()
  181. /*    call ppm_SetColorMode(oldcolormode)*/
  182.     call ppm_AutoUpdate(1)
  183.     exit
  184.     end
  185.  
  186.