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
/
Camembert.pprx
< prev
next >
Wrap
Text File
|
1993-08-03
|
5KB
|
205 lines
/*
@BCamembert @P @I Ecrit et © par Don Cox en mai 1992
@IN'est pas du Domaine Publique. Tous Droits Réservés.
Traduit par Fabien Larini le 24/07/93.
Ce Génie permet de dessiner des camemberts à l'aide de données fournies
par l'utilisateur.
*/
/* MakePieCharts*/
/* This Genie draws Pie Charts. You must have gdarexxsupport.library in your libs: directory (normally installed with PPage 3).
Written by Don Cox May '92 */
cr = '0a'x
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
call ppm_NewGroup()
if ~show(l, "gdarexxsupport.library") then
if ~addlib("gdarexxsupport.library", 0, -30) then
do
call ppm_Inform(1, "Installez gdarexxsupport.library dans votre répertoire libs: avant d'utiliser ce Genie.")
exit
end
units = ppm_GetUnits()
call ppm_SetUnits(2)
signal on halt
signal on break_c
signal on break_e
signal on break_d
box = ppm_ClickOnBox("Clickez dans la Boîte où Placer le Camenbert")
if box = 0 then
do
call ppm_Inform(1, "Pas de Boîte Sélectionnée",)
call ppm_ClearStatus()
exit
end
/* extract box attributes */
boxsize = ppm_GetBoxSize(box)
boxpos = ppm_GetBoxPosition(box)
if ppm_Inform(2, "Efface la Boîte ?",) = 1 then call ppm_DeleteBox(box)
boxwidth = word(boxsize, 1)
boxheight = word(boxsize, 2)
boxleft = word(boxpos, 1)
boxtop = word(boxpos, 2)
Xcentre = boxleft+(boxwidth/2)
Ycentre = boxtop+(boxheight/2)
if boxwidth>boxheight then radius = boxheight*0.36
else radius = boxwidth*0.3 /* allow room for labels */
nmsegs = GetUserText(4, "Nombres de Portions ")
if nmsegs > 18 then exit_msg("Le Nombre Maxi de Portions est 18")
form = ' Portion 1'
do x = 2 while x <= nmsegs
form = form cr 'Portion' x
end
form = ppm_GetForm("Valeurs en Pourcentages",6,form)
if form = "" then exit_msg("Opération Annulée")
x = 1
do forever
parse var form bdata.x '0a'x form
if bdata.x = "" then leave
cdata.x = bdata.x * 3.6 /* convert %ages to degrees */
x = x + 1
end
form = ' Légende Portion 1'
do x = 2 while x <= nmsegs
form = form cr 'Légende Portion' x
end
form = ppm_GetForm("Légendes pour les Portions",12,form)
if form = "" then exit_msg("Opération Annulée")
x = 1
do forever
parse var form blabel.x '0a'x form
if blabel.x = "" then leave
x = x + 1
end
call ppm_SetLineWeight(1) /* 1-point lines */
facelist = ppm_GetTypeFaceList()
facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
face = ppm_SelectFromList("Choix de la Police",32,18,0,facelist)
oldface = ppm_GetFont()
oldsize = ppm_GetSize()
oldstyle = ppm_GetStyle()
oldjust = ppm_GetJustification()
call ppm_SetJustification(2)
call ppm_SetFont(face)
call ppm_SetSize(radius*3) /* size in points */
call ppm_SetStyle(N)
startangle=0
do i=1 to nmsegs
call ppm_ShowStatus("Travail en cours sur la Portion :" i)
angle=cdata.i
call ppm_SetFillPattern(i//9) /* use modulo to cycle through the available patterns */
boxname=blabel.i
data = bdata.i
endangle = startangle+angle
manylines = Xcentre "0a"x Ycentre "0a"x radius "0a"x startangle "0a"x endangle "0a"x boxname "0a"x data
call drawsector(manylines)
startangle = endangle
end
call ppm_SetFont(oldface)
call ppm_SetSize(oldsize)
call ppm_SetStyle(oldstyle)
call ppm_SetJustification(oldjust)
exit_msg("Terminé")
end
/* -------------------------------------------------------------------- */
/* Procedure to draw a sector for a pie chart */
drawsector: procedure
parse arg Xcentre "0a"x Ycentre "0a"x radius "0a"x startangle "0a"x endangle "0a"x boxname "0a"x data
AA=6.2831853/360 /* 2pi divided by 360 */
drawstring = Xcentre Ycentre"0a"x /* List all the points, beginning at the centre */
if startangle>endangle then
do
xx=startangle
startangle=endangle
endangle=xx
end
if startangle=endangle then return
angle=startangle*AA /* convert to radians */
arcsize = endangle-startangle
radarcsize = arcsize*AA /* convert to radians */
/* Set up values for label box before "angle" gets changed */
labelXradius = radius*1.5
labelYradius = radius*1.25
labelboxheight = radius/4
labelboxwidth = radius*1
labelangle = angle+(radarcsize/2)
labelleft = Xcentre+(labelXradius*cos(labelangle))-(radius/2)
labeltop = Ycentre+(labelYradius*sin(labelangle))-(radius/9)
/* Draw the segment itself, in 1 degree steps to give a smooth curve */
do i = 0 to arcsize
X2=Xcentre+(radius*cos(angle))
Y2=Ycentre+(radius*sin(angle))
angle=angle+AA
drawstring=drawstring||X2 Y2"0a"x
end
drawstring = drawstring||Xcentre Ycentre"0a"x
call ppm_SaveText("ram:arcdata",drawstring)
box = ppm_DrawPoly("ram:arcdata",boxname)
/* Now draw the box for the label */
labelbox = ppm_CreateBox(labelleft, labeltop, labelboxwidth, labelboxheight, 0)
overflow = ppm_TextIntoBox(labelbox,boxname "0a"x data||"%")
return
end
/* --------------------------------------------------------------- */
/* Exit Routines */
break_d:
break_e:
break_c:
halt:
call exit_msg("Abandon du Génie par l'utilisateur !")
error:
syntax:
exit_msg("Arrêt du Génie dû à l'erreur: "errortext(rc))
end
exit_msg:
do
parse arg message
if message ~= "" then call ppm_Inform(1,message,)
call ppm_ClearStatus()
call ppm_AutoUpdate(1)
exit
end