home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0925.lha / DonsGenies / FrenchGenies.lha / Rexx / AjusteTexteAuxBoîtes.pprx < prev    next >
Text File  |  1993-08-03  |  7KB  |  209 lines
  1. /*
  2. @BAjustTexteAuxBoεtes @P @I Ecrit et ⌐ par Don Cox en juillet 1992
  3. @IRΘvisΘ en juillet 1993. N'est pas du Domaine Publique. 
  4. @ITous Droits RΘservΘs.
  5. Traduit par Fabien Larini le 23/07/93.
  6.  
  7. Ce GΘnie fait rentrer tout le texte dans une boεte ou une chaεne de boεtes
  8. en respectant les proportions des tailles de caractΦres. Tout le texte
  9. dans la boεte sera modifiΘ. Il n'y a pas crΘation de boεtes comme dans
  10. ImportationAuto. Il doit y avoir du texte dans la boεte avant de lancer
  11. le GΘnie.
  12. Remarque : les formats de styles appliquΘs au texte seront annulΘs. Le
  13. facteur minimal de rΘduction est 1/8 point dans les tailles de caractΦres
  14. disponibles. Ce GΘnie prΘfΦre sous-remplir une boεte que de la faire
  15. dΘborder
  16. */
  17.  
  18. /*FitTextToBoxes*/
  19. /* 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.
  20. Note that any style tags applying to the text will be cancelled. 
  21. 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.
  22. Written by Don Cox    July 92  Revised July 93  Not Public Domain. All rights reserved. */
  23.  
  24. trace n
  25. signal on error
  26. signal on syntax
  27. address command
  28. call SafeEndEdit.rexx()
  29. call ppm_AutoUpdate(0)
  30. cr="0a"x
  31.  
  32. cpage = ppm_CurrentPage()
  33. counter=0
  34.  
  35. do forever
  36.     box=ppm_ClickOnBox("Clickez dans les Boεtes o∙ le Texte doit Ωtre AjustΘ")
  37.     if box=0 then break
  38.     counter=counter+1
  39.     boxes.counter=box
  40.     call ppm_SelectBox(box)
  41. end
  42.  
  43. if counter=0 then exit_msg("Pas de Boεte SΘlectionnΘe")
  44.  
  45.  
  46. currentunits=ppm_GetUnits()
  47. call ppm_SetUnits(2)
  48.  
  49.  
  50.  
  51. call ppm_ShowStatus("Ajustement du Texte ...")
  52. do i=1 to counter
  53.     box=boxes.i
  54.     
  55.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  56.     if boxtype~="TEXTE" then iterate
  57.     box = ppm_ArtFirstBox(box)
  58.     text = ppm_GetArticleText(box,1)
  59.     iter = 1
  60.     factor = 0.5 /* first find max size quickly */
  61.     do 9  /* 9 is enough doublings  */
  62.         factor2 = factor /* format number for display */
  63.         if pos(".",factor2) = 0 then factor2 = factor||"."
  64.         factor2 = left(factor2,8,"0")
  65.         call ppm_ShowStatus("Ajustement du Texte ... ItΘration "right(iter,2," ")"    Rapport "factor2)
  66.         oldfactor = factor
  67.         factor = factor*2
  68.         newtext = text /* go back to original each time */
  69.         newtext = ResizeFonts(newtext,factor) 
  70.         if newtext~="" then do /* ResizeFonts returns empty string if over size limit (720 points)  */
  71.             gone = ppm_DeleteContents(box)
  72.             overflow = ppm_TextIntoBox(box,newtext)
  73.             end
  74.         if newtext="" | overflow = 1  then break 
  75.         end
  76.  
  77.     max = factor
  78.     factor = (oldfactor+factor)/2
  79.     min = 0
  80.  
  81.     do 18  /* Don't go on iterating for ever... */
  82.  
  83.         factor2 = factor /* format number for display */
  84.         if pos(".",factor2) = 0 then factor2 = factor||"."
  85.         factor2 = left(factor2,8,"0")
  86.         call ppm_ShowStatus("Ajustement du Texte ... ItΘration "right(iter,2," ")"    Rapport "factor2)
  87.  
  88.         iter = iter+1
  89.         newtext = text /* go back to original each time */
  90.         newtext = ResizeFonts(newtext,factor) 
  91.         if newtext~="" then do /* ResizeFonts returns empty string if over size limit (720 points)  */
  92.             gone = ppm_DeleteContents(box)
  93.             overflow = ppm_TextIntoBox(box,newtext)
  94.             end
  95.         if overflow = 1 | newtext = "" then do
  96.             max = factor
  97.             factor = (factor+min)/2
  98.             end
  99.         else do
  100.             min = factor
  101.             factor = (factor+max)/2
  102.             end
  103.     end
  104. factor = min  /* just reduce a little at the end to cover the oscillations */
  105. newtext = ResizeFonts(text,factor) /* go back to original each time */
  106. gone = ppm_DeleteContents(box)
  107. overflow = ppm_TextIntoBox(box,newtext)
  108. end
  109.  
  110. newpage = ppm_GoToPage(cpage)
  111. call ppm_SetUnits(currentunits)
  112.  
  113. call exit_msg()
  114. end
  115.  
  116. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  117.  
  118. ResizeFonts: procedure
  119. parse arg text, factor
  120. position = 1
  121. position2 = 1
  122.  
  123. do forever  /* we have to open up style tags to get sizes */
  124.     position = pos("\dS<",text,position2)
  125.     if position = 0 then break
  126.     position2 = pos(">",text,position)
  127.     if position2 = 0 then break
  128.     styletag = substr(text,position+4, position2-position-4)
  129.     styledef = ppm_GetStyleTagData(styletag)
  130.     styledef = left(styledef,pos("}",styledef)-1) /* remove name of tag */
  131.     styledef = substr(styledef,pos("{",styledef)+1)
  132.     text = delstr(text,position, (position2-position+1)) /* delete tag name */
  133.     text = insert("\ds"styledef,text,(position-1))
  134.     end
  135.  
  136. position2 = 1
  137. do forever  /* first change font sizes */
  138.     position = pos("\fs<",text,position2)+4
  139.     if position = 4 then break  /* would be 0 but we added 4 */
  140.     position2 = pos(">",text,position)
  141.     if position2 = 0 then break
  142.     oldsize = substr(text,position, position2-position)
  143.     text = delstr(text,position, position2-position) /* delete old size */
  144.     newsize = oldsize*factor
  145.     if newsize>720 then do
  146.         text = ""  /* return empty text if over limit  - this is different from the standard Text Resize module used in other genies */
  147.         break
  148.         end
  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. if text = "" then return text /* again, different from standard module */
  156.  
  157. position2 = 1
  158. do forever  /*  now fixed line spacings  */
  159.     position = pos("\lf<",text,position2)+4
  160.     if position = 4 then break  /* would be 0 but we added 4 */
  161.     position2 = pos(">",text,position)
  162.     if position2 = 0 then break
  163.     oldsize = substr(text,position, position2-position)
  164.     text = delstr(text,position, position2-position) /* delete old size */
  165.     newsize = oldsize*factor
  166.     if newsize>720 then newsize = 720
  167.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  168.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  169.     else newsize = newsize-oddsize
  170.     text = insert(newsize,text,position-1)
  171.     end
  172.  
  173. position2 = 1
  174. do forever   /* and fixed leading  */
  175.     position = pos("\ll<",text,position2)+4
  176.     if position = 4 then break  /* would be 0 but we added 4 */
  177.     position2 = pos(">",text,position)
  178.     if position2 = 0 then break
  179.     oldsize = substr(text,position, position2-position)
  180.     text = delstr(text,position, position2-position) /* delete old size */
  181.     newsize = oldsize*factor
  182.     if newsize>720 then newsize = 720
  183.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  184.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  185.     else newsize = newsize-oddsize
  186.     text = insert(newsize,text,position-1)
  187.     end
  188.  
  189. return text
  190.  
  191. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  192.  
  193. error:
  194. syntax:
  195.     do
  196.     exit_msg("ArrΩt du GΘnie d√ α l'erreur: "errortext(rc))
  197.     end
  198.  
  199. exit_msg:
  200.     do
  201.     parse arg message
  202.     if message ~= "" then
  203.     call ppm_Inform(1,message,)
  204.     call ppm_ClearStatus()
  205.     call ppm_AutoUpdate(1)
  206.     exit
  207.     end
  208.  
  209.