home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / fish / 911-930 / ff925 / 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.