DTP Toolbox/DTPToolbox.iso/propage4.0/arexx/makepiechart.pprx

Text File | 1995-06-25 | 5.3 KB | 205 lines

/* 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. Improved July 94, June 95.  */

/* $VER: MakePieChart June 95 */

call open("STDERR","ram:trace","W")
trace r

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,0) then
    do
        call ppm_Inform(1,"Please install the gdarexxsupport.library in your libs: directory before running this Genie.")
    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("Click on box to make chart..")

if box = 0 then
do
    call ppm_Inform(1, "No box selected",)
    call ppm_ClearStatus()
    exit
end

/*  extract box attributes  */
boxsize = ppm_GetBoxSize(box)
boxpos = ppm_GetBoxPosition(box)

if ppm_Inform(2, "Delete box?",) = 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, "Number of Segments")
if nmsegs > 18 then exit_msg("Max number of segments is 18")

form = ' Segment 1'
do x = 2 while x <= nmsegs
 form = form cr 'Segment' x
end

fillsegs = 0
if ppm_Inform(2,"Fill sectors with patterns?",)=1 then fillsegs = 1

form = ppm_GetForm("Type in Values",12,form)
if form = "" then exit_msg("Operation Cancelled")

total = 0
do x = 1 to nmsegs
    parse var form bdata.x '0a'x form
    if bdata.x = "" then bdata.x = 0
    if ~datatype(bdata.x,n) then exit_msg("Not a number: "bdata.x)
    total = total+bdata.x
end

do x = 1 to nmsegs
    cdata.x = (bdata.x * 360)/total   /* convert to %ages & then degrees */
    end

form = ' Segment label 1'
do x = 2 while x <= nmsegs
   form = form cr 'Segment label' x
end

form = ppm_GetForm("Labels for Segments",12,form)
if form = "" then exit_msg("Operation Cancelled")

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("Select Typeface",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("Working on segment:" i)
    angle=cdata.i
    if fillsegs = 1 then call ppm_SetFillPattern(i//9) /* use modulo to cycle through the available patterns */
    boxname=blabel.i
    data = bdata.i
    endangle = trunc(startangle+angle) /* use whole degrees to avoid gaps */
    if i=nmsegs then endangle=360 /*close up gap */
    manylines = Xcentre "0a"x Ycentre "0a"x radius "0a"x startangle "0a"x endangle "0a"x boxname "0a"x data "0a"x total
    call drawsector(manylines)
    startangle = endangle
    end

call ppm_SetFont(oldface)
call ppm_SetSize(oldsize)
call ppm_SetStyle(oldstyle)
call ppm_SetJustification(oldjust)
exit_msg("Done")
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 "0a"x total
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)
datatr = trunc(data,2)
dataper = trunc((data*100)/total, 2) /* two decimal places */
overflow = ppm_TextIntoBox(labelbox,boxname "0a"x datatr"   "dataper||"%")

return
end

/* --------------------------------------------------------------- */

/* Exit Routines */
break_d:
break_e:
break_c:
halt:
    call exit_msg("User aborted Genie!")

error:
syntax:
    do exit_msg("Genie failed due to error: "errortext(rc))
    end

exit_msg:
    do
    parse arg message
    if message ~= "" then call ppm_Inform(1,message,"Resume")
    call ppm_ClearStatus()
    call ppm_AutoUpdate(1)
    exit
    end