home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0925.lha / DonsGenies / FrenchGenies.lha / Rexx / Camembert.pprx < prev    next >
Text File  |  1993-08-03  |  5KB  |  205 lines
  1. /*
  2. @BCamembert @P @I Ecrit et ⌐ par Don Cox en mai 1992
  3. @IN'est pas du Domaine Publique. Tous Droits RΘservΘs.
  4. Traduit par Fabien Larini le 24/07/93.
  5.  
  6. Ce GΘnie permet de dessiner des camemberts α l'aide de donnΘes fournies
  7. par l'utilisateur.
  8. */
  9.  
  10.  
  11. /* MakePieCharts*/
  12. /* This Genie draws Pie Charts. You must have gdarexxsupport.library in your libs: directory (normally installed with PPage 3).
  13. Written by Don Cox  May '92  */
  14.  
  15.  
  16.  
  17. cr = '0a'x
  18. call SafeEndEdit.rexx()
  19. call ppm_AutoUpdate(0)
  20. call ppm_NewGroup()
  21.  
  22.  
  23. if ~show(l, "gdarexxsupport.library") then
  24.    if ~addlib("gdarexxsupport.library", 0, -30) then
  25.    do
  26.       call ppm_Inform(1, "Installez gdarexxsupport.library dans votre rΘpertoire libs: avant d'utiliser ce Genie.")
  27.       exit
  28.    end
  29.  
  30. units = ppm_GetUnits()
  31. call ppm_SetUnits(2)
  32.  
  33. signal on halt
  34. signal on break_c
  35. signal on break_e
  36. signal on break_d
  37.  
  38. box = ppm_ClickOnBox("Clickez dans la Boεte o∙ Placer le Camenbert")
  39.  
  40. if box = 0 then
  41. do
  42.     call ppm_Inform(1, "Pas de Boεte SΘlectionnΘe",)
  43.     call ppm_ClearStatus()
  44.     exit
  45. end
  46.  
  47. /*  extract box attributes  */
  48. boxsize = ppm_GetBoxSize(box)
  49. boxpos = ppm_GetBoxPosition(box)
  50.  
  51. if ppm_Inform(2, "Efface la Boεte ?",) = 1 then call ppm_DeleteBox(box)
  52.  
  53. boxwidth = word(boxsize, 1)
  54. boxheight = word(boxsize, 2)
  55. boxleft = word(boxpos, 1)
  56. boxtop = word(boxpos, 2)
  57. Xcentre = boxleft+(boxwidth/2)
  58. Ycentre = boxtop+(boxheight/2)
  59.  
  60. if boxwidth>boxheight then radius = boxheight*0.36
  61. else radius = boxwidth*0.3 /* allow room for labels */
  62.  
  63. nmsegs = GetUserText(4, "Nombres de Portions ")
  64. if nmsegs > 18 then exit_msg("Le Nombre Maxi de Portions est 18")
  65.  
  66. form = ' Portion 1'
  67. do x = 2 while x <= nmsegs
  68.  form = form cr 'Portion' x
  69. end
  70.  
  71.  
  72. form = ppm_GetForm("Valeurs en Pourcentages",6,form)
  73. if form = "" then exit_msg("OpΘration AnnulΘe")
  74.  
  75. x = 1
  76. do forever
  77.     parse var form bdata.x '0a'x form
  78.     if bdata.x = "" then leave
  79.     cdata.x = bdata.x * 3.6   /* convert %ages to degrees */
  80.     x = x + 1
  81. end
  82.  
  83. form = ' LΘgende Portion 1'
  84. do x = 2 while x <= nmsegs
  85.    form = form cr 'LΘgende Portion' x
  86. end
  87.  
  88. form = ppm_GetForm("LΘgendes pour les Portions",12,form)
  89. if form = "" then exit_msg("OpΘration AnnulΘe")
  90.  
  91. x = 1
  92. do forever
  93.    parse var form blabel.x '0a'x form
  94.    if blabel.x = "" then leave
  95.    x = x + 1
  96. end
  97. call ppm_SetLineWeight(1) /* 1-point lines */
  98. facelist = ppm_GetTypeFaceList()
  99. facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
  100. face = ppm_SelectFromList("Choix de la Police",32,18,0,facelist)
  101.  
  102.  
  103. oldface = ppm_GetFont()
  104. oldsize = ppm_GetSize()
  105. oldstyle = ppm_GetStyle()
  106. oldjust = ppm_GetJustification()
  107. call ppm_SetJustification(2)
  108. call ppm_SetFont(face)
  109. call ppm_SetSize(radius*3)  /* size in points */
  110. call ppm_SetStyle(N)
  111.  
  112. startangle=0
  113. do i=1 to nmsegs
  114.     call ppm_ShowStatus("Travail en cours sur la Portion :" i)
  115.     angle=cdata.i
  116.     call ppm_SetFillPattern(i//9) /* use modulo to cycle through the available patterns */
  117.     boxname=blabel.i
  118.     data = bdata.i
  119.     endangle = startangle+angle
  120.     manylines = Xcentre "0a"x Ycentre "0a"x radius "0a"x startangle "0a"x endangle "0a"x boxname "0a"x data
  121.     call drawsector(manylines)
  122.     startangle = endangle
  123.     end
  124.  
  125. call ppm_SetFont(oldface)
  126. call ppm_SetSize(oldsize)
  127. call ppm_SetStyle(oldstyle)
  128. call ppm_SetJustification(oldjust)
  129. exit_msg("TerminΘ")
  130. end
  131.  
  132. /* -------------------------------------------------------------------- */
  133.  
  134. /* Procedure to draw a sector for a pie chart */
  135.  
  136. drawsector: procedure
  137.  
  138. parse arg Xcentre "0a"x Ycentre "0a"x radius "0a"x startangle "0a"x endangle "0a"x boxname "0a"x data
  139. AA=6.2831853/360    /* 2pi divided by 360 */
  140.  
  141. drawstring = Xcentre Ycentre"0a"x  /* List all the points, beginning at the centre */
  142.  
  143. if startangle>endangle then
  144.     do
  145.     xx=startangle
  146.     startangle=endangle
  147.     endangle=xx
  148.     end
  149. if startangle=endangle then return
  150.  
  151. angle=startangle*AA /* convert to radians */
  152. arcsize = endangle-startangle
  153. radarcsize = arcsize*AA /* convert to radians */
  154.  
  155. /* Set up values for label box before "angle" gets changed */
  156. labelXradius = radius*1.5
  157. labelYradius = radius*1.25
  158. labelboxheight = radius/4
  159. labelboxwidth = radius*1
  160. labelangle = angle+(radarcsize/2)
  161. labelleft = Xcentre+(labelXradius*cos(labelangle))-(radius/2)
  162. labeltop = Ycentre+(labelYradius*sin(labelangle))-(radius/9)
  163.  
  164. /* Draw the segment itself, in 1 degree steps to give a smooth curve */
  165. do i = 0 to arcsize
  166.     X2=Xcentre+(radius*cos(angle))
  167.     Y2=Ycentre+(radius*sin(angle))
  168.     angle=angle+AA
  169.     drawstring=drawstring||X2 Y2"0a"x
  170.     end
  171. drawstring = drawstring||Xcentre Ycentre"0a"x
  172. call ppm_SaveText("ram:arcdata",drawstring)
  173.  
  174. box = ppm_DrawPoly("ram:arcdata",boxname)
  175.  
  176. /* Now draw the box for the label */
  177. labelbox = ppm_CreateBox(labelleft, labeltop, labelboxwidth, labelboxheight, 0)
  178. overflow = ppm_TextIntoBox(labelbox,boxname "0a"x data||"%")
  179.  
  180. return
  181. end
  182.  
  183. /* --------------------------------------------------------------- */
  184.  
  185. /* Exit Routines */
  186. break_d:
  187. break_e:
  188. break_c:
  189. halt:
  190.     call exit_msg("Abandon du GΘnie par l'utilisateur !")
  191.  
  192. error:
  193. syntax:
  194.     exit_msg("ArrΩt du GΘnie d√ α l'erreur: "errortext(rc))
  195.     end
  196.  
  197. exit_msg:
  198.     do
  199.     parse arg message
  200.     if message ~= "" then call ppm_Inform(1,message,)
  201.     call ppm_ClearStatus()
  202.     call ppm_AutoUpdate(1)
  203.     exit
  204.     end
  205.