define FOGR,0  rem  section dealing with graph as a whole
define FSGR,1
define FAGR,2
define TCGR,3
define LCGR,4
define LWGR,5
define PDGR,6
define PSGR,7
define BGGR,8
define PWGR,9
define PHGR,10
define BWGR,11
define DCOLGR,12
define GRGR,17
define ROWS,18
define COLUMNS,19
define TDGR,20
define GRAPHTYPE,21
define XLABEL,22
define YLABELS,23
define THICKNESSGR,29
define FRGR,30
define OLGR,31
define OTGR,32
define ORGR,33
define OBGR,34
define ILGR,35
define ITGR,36
define IRGR,37
define IBGR,38
define MTGR,39
define MSGR,40
define PIGR,41
define MAGR,42
define PSIZE,43
define FOA,0   rem  Section dealing with axis
define FSA,1
define FAA,2
define TCA,3
define LCA,4
define LWA,5
define STA,6
define LGA,7
define INA,8
define UPA,9
define LOA,10
define NSA,11
define AA,12
define BA,13
define WIDTHA,14
define HEIGHTA,15
define HOTXA,16
define HOTYA,17
define FORMATA,18
define LENGTHA,19
define PAXIS,20
define FOD,0    rem Section dealing with data set
define FSD,1
define FAD,2
define TCD,3
define LWD,4
define LCD,5
define PDD,6
define PSD,7
define FCD,8
define MTD,9
define MSD,10
define MCD,11
define FRD,12
define TDD,13
define PDATA, 14
define FOM,0    rem Section dealing with marker keys - text properties
define FSM,1
define FAM,2
define TCM,3
define LWM,4    rem line properties
define LCM,5
define PDM,6
define PSM,7
define MTM,8    rem marker properties- repeated 5 times
define MSM,9
define MCM,10
define XSM,28
define YSM,29
define XEM,30
define YEM,31
define NSM,32
define MDATA,33
define FOC,0    rem Section dealing with colour keys - text properties
define FSC,1
define FAC,2
define TCC,3
define LWC,4    rem line properties
define LCC,5
define PDC,6
define PSC,7
define FCC,8    rem colour (repeated 16 times)
define XSC,20
define YSC,21
define XEC,22
define YEC,23
define CDATA,24
define LINES_ONLY,0   rem types of 2D graph
define POINTS_ONLY,1
define LINES_AND_POINTS,2
define VERTICAL_HISTOGRAM,3
define HORIZONTAL_HISTOGRAM,4
define STACKED_VERTICAL_HISTOGRAM,5
define STACKED_HORIZONTAL_HISTOGRAM,6
define PICTOGRAM,7
define PIE_CHART,8
define TWO_LINES,9
define BOX_AND_TAILS,10
define DISTRIBUTION,11
define GENERAL,12
define DRAG_ALLOWED, 0x1
define SELECT_ALLOWED, 0x2
define TEXT_EFFECTS, 0x4
define FILL_EFFECTS, 0x8
define LINE_EFFECTS, 0x10
define GRAPH_COLOUR_ALLOWED, 0x20
define THREE_DEE_ALLOWED, 0x40
define GRID_ALLOWED, 0x80
define EXPLODE_ALLOWED, 0x100
define COLOURS_ALLOWED, 0x200
define BAR_WIDTH_ALLOWED, 0x400
define POINT_DETAILS_ALLOWED, 0x800
define TICKS_ALLOWED, 0x1000
define DIMENSIONS_ALLOWED, 0x2000
define TOP_ALLOWED, 0x4000
define DELETE_ALLOWED, 0x8000
define ALL_SELECTED, 0x10000
define NONE_SELECTED, 0x20000
define REDRAW_NEEDED, 0x40000


rem - **************************************************************
rem - This module looks after pie-charts of various sorts
rem - ************************************************************** 


                 
   
rem - ***************************************************************
rem - This macro draws a thick slice of cake.  The parameters are
rem -    w = the window handle
rem -    start, end : Starting and ending angles (in degrees)
rem -    thickness : The thickness of the slice
rem -    cx,cy :  The centre of the cake
rem -    radius:  The radius of the cake
rem -    ecc :    The excentricity of the cake (as it is seen)
rem -    colour:  The colour of the top of the slice. The sides
rem -             are a bit darker

macro thickslice(w,start,end,thickness,cx,cy,radius,ecc,colour)
local list(30), array(70)
local res,k,p,q, cycles
local c1x,c1y,c2x,c2y
local sstart,send, shade
shade = darker(colour,0.875)
res = group(w)
p=1
                     rem - find outside corner positions of slice

res = partellipse(cx,cy,start,end,radius, radius/2,0,list)
c1x = list(0)
c1y = list(1)
c2x = list(res-2)
c2y = list(res-1)
if (start > 180 or end > 180) then
                                  rem draw curved side if visible
    sstart = start
    if sstart  < 180 then sstart = 180
    send = end
    if send > 360 then send = 360 
                                  rem only part you can see

    res = partellipse(cx,cy,sstart,send,radius, radius/2,0,list)
                                  rem list is path for top edge
    array(0) = 2
    for k = 0 to res-1
        array(p) = list(k)
        p=p+1
    next k
    res = partellipse(cx,cy-thickness,sstart,send,radius,radius/2,0,list)
                rem list path for bottom edge but must be used backwards
                rem to keep the whole path going the same way
    array(p) = 8
    p=p+1
                   rem   scan list backwards to go the other way
    array(p) = list(res-2)
    array(p+1) = list(res-1)
    p=p+2
    cycles = (res-2)/7
    for q = cycles-1 to 0 step -1
       array(p) = 6
       array(p+1) = list(7*q+5)
       array(p+2) = list(7*q+6)
       array(p+3) = list(7*q+3)
       array(p+4) = list(7*q+4)
       array(p+5) = list(7*q)
       array(p+6) = list(7*q+1)
       p=p+7
    next q
    array(p) = 5
    array(p+1) = 0
    p=p+2
    res = lineattributes(w,0,1,shade,0)
    res = drawobject(w,array,p,shade)
endif
                        rem *  Now draw sides of cake
array(0) = 2
array(1) = cx
array(2) = cy
array(3) = 8
array(4) = cx
array(5) = cy-thickness
array(6) = 8
array(7) = c1x
array(8) = c1y-thickness
array(9) = 8
array(10)= c1x
array(11) = c1y
array(12) = 5
array(13) = 0
if (start >270 or start < 90) then
          res = lineattributes(w,0,1,shade,0)
          res=drawobject(w,array,14,shade)
endif
array(7) = c2x
array(8) = c2y-thickness
array(10) = c2x
array(11) = c2y
if (end >90 and end < 270) then
        res = lineattributes(w,0,1,shade,0)
        res=drawobject(w,array,14,shade)
endif
res = partellipse(cx,cy,start,end,radius, radius/2,0,list)
p=4
for k=0 to res-1
  array(p) = list(k)
  p=p+1
next k
array(p) = 5
array(p+1)=0
res = lineattributes(w,0,1,colour,0)
res = drawobject(w,array, p+2,colour)  
res = endgroup(w)
=0
endmacro


rem - ***************************************************************
rem - This macro draws a thin (2D) slice of cake.  The parameters are
rem -    w = the window handle
rem -    start, end : Starting and ending angles (in degrees)
rem -    cx,cy :  The centre of the cake
rem -    radius:  The radius of the cake

rem -    colour:  The colour of the top of the slice. The sides
rem -             are a bit darker

macro thinslice(w,start,end,cx,cy,radius,colour)
local list(30), array(70)
local res, k, p,shade
p=4
res = group(w)
shade = darker(colour, 0.875)
array(0) = 2
array(1) = cx
array(2) = cy
array(3) = 8
res = partcircle(cx,cy,start,end,radius,list)
for k = 0 to res-1
    array(p) = list(k)
    p=p+1
next k
array(p) = 5
array(p+1)=0
res = lineattributes(w,0,1,shade,0)
res = drawobject(w,array, p+2,colour)  
res = endgroup(w)
=0
endmacro

rem : *************************************************************
rem : Next pair of macros fin the lesser and greater of two numbers
rem :

macro mymin(a,b)
if a<b then 
    =a
else
    =b
endif
endmacro

macro mymax (a,b)
if a> b then
   =a
else
   =b
endif
endmacro

rem : *************************************************************************
rem : Next macro displays legends for a collection of pie charts
rem : Note that we can't use the normal legend functions because
rem : the legends in a pie chart are a complete data set, similar
rem : to the labels column (or row) in a histogram.
rem : The parameters are
rem :  w : The window
rem :  data() : The data block for the chart
rem :  p:  The gr block
rem :  x : The x-position for the label set
rem : y: The y-position for the label set
rem :  cols : 1 or 2 depending on how the labels are to be arranged
rem : height, width : The (predetermined) height and width of the legend block

macro display_piechart_labels(w,data(),p(),x,y,cols,height,width)
local j,k,xpos,ypos,color,res
res = settag("F()",SELECT_ALLOWED + DRAG_ALLOWED)
res = group(w)
xpos = x+10
ypos = y+height
res = font(w,p(FOGR),p(FSGR), p(FSGR)*p(FAGR)/100)
for j = 0 to p(ROWS)-1
   color = p(DCOLGR+j)       
   res =lineattributes(w,0,1,color,0)
   res = box(w,xpos,ypos,2*p(FSGR),p(FSGR),color)
   res = text(w,xpos+3*p(FSGR),ypos,data(j,0),0)
   if (cols = 2 and (j&1) = 0) then
       xpos = xpos + width/2
   else
       xpos = x+10
       ypos = ypos - 2*p(FSGR)
  endif
next j
res = endgroup(w)
=0
endmacro
  

rem : **************************************************************
rem : This is the main pie-chart plotting program, called when the
rem : data has been collected.
macro CRM_pie_chart_plot(data(),s,p(),v)
local gr_tag, res,w,ww,explode,ecc
local j,k,t,radius,thickness
local top,bottom,left, right,sqright,width,height,osheight,oswidth
local labelwidth,labelheight,labelcols
local xsm_dump,ysm_dump,xx,yy
local kk(MDATA),le_tag
local xpos(6),ypos(6)
gr_tag = psexsub(v)
                       rem see if chart is to be exploded
explode = pscontains(v,"V")
                       rem see if 3D is needed
ecc = pscontains(v,"W")
res = settag(gr_tag,GRAPH_COLOUR_ALLOWED+THREE_DEE_ALLOWED+EXPLODE_ALLOWED+COLOURS_ALLOWED+DIMENSIONS_ALLOWED)
                     rem open window
w = gstart(p(PWGR),p(PHGR))
                     rem draw background
res = box(w,0,0,p(PWGR),p(PHGR),p(MAGR))
if p(BGGR) <> p(MAGR) then
   res = box(w,p(OLGR),p(OBGR),p(PWGR)-p(OLGR)-p(ORGR),p(PHGR)-p(OBGR)-p(OTGR),p(BGGR))
endif
                     rem compute working area
bottom = p(OBGR)+p(IBGR)
top = p(PHGR)-p(OTGR)-p(ITGR)
left = p(OLGR)+p(ILGR)
right = p(PWGR)-p(ORGR)-p(IRGR)
width = right-left
height = top-bottom
osheight = height +p(IBGR)+p(ITGR)
oswidth = width+p(ILGR)+p(IRGR)
                    rem now compute label dimensions
labelwidth=0
labelheight=0
labelcols = 1
if (data(0,0) <> 1) then
    labelheight = (p(ROWS)+1) * p(FSGR)*2
    for k = 0 to p(ROWS)-1
         res = CRM_finddims( w,p,data(k,0))
         t = CRM_extract (res,"x=") +50
         if t> labelwidth then labelwidth = t
    next k
    labelcols = 1
    if (labelheight > top-bottom) then
                   rem  Split labels into two columns if needed
        labelheight = labelheight/2
        labelwidth = labelwidth *2
        labelcols=2
    endif
endif    
                            rem if labels looks for a legend parameter
if labelcols > 0 then
      xsm_dump = 0
      ysm_dump = 0
      res = CRM_close_string(v)
 rem     res = CRM_find_substring(s,"F")
 rem     if (res = -1)  then
         v = CRM_find_substring(s,"F")
         if (v = -1) then 
                 rem legend string not found
          le_tag = CRM_get_legend_default_params(p,kk)
       else
          le_tag = psexsub(v)
          res = CRM_get_legend_params(p,kk,v)
          res = CRM_close_string(v)
       endif
       if kk(XSM) > 0 then xsm_dump = kk(XSM)
       if kk(YSM) > 0 then ysm_dump = kk(YSM)
       res = psregister(s)
       res = psstep(v)
endif         

                            rem now plan overall layout
res = lineattributes(w,3,1,0xd0d0d000,0)
sqright = right - labelwidth
oswidth = oswidth-labelwidth
width = width - labelwidth
                          rem layout is different for 1,2,3,4 or 5 data sets!
    if p(COLUMNS) = 2 then
                                                              rem 1 data set
         xpos(0) = (left+sqright)/2
         ypos(0) = (top + bottom)/2
         radius = 0.45 *mymin(height,width)
    endif
    if p(COLUMNS) = 3 then
                                                              rem 2 data sets
          xpos(0) = (3*left+sqright)/4
          xpos(1) = (left+3*sqright)/4
          ypos(0) = (top+bottom)/2
          ypos(1) = ypos(0)   
          radius = 0.45*mymin(height,width/2)
    endif 
    if p(COLUMNS) = 4 then
                                                              rem 3 data sets
          xpos(0) = (5*left+sqright)/6
          xpos(1) = (left+sqright) /2
          xpos(2) = (left+5*sqright)/6
          ypos(0) = (top+bottom)/2
          ypos(1) = ypos(0)
          ypos(2) = ypos(1)  
          radius = 0.45*mymin(height,width/3)
    endif 
    if p(COLUMNS) = 5 then
                                                              rem 4 data sets
          xpos(0) = (3*left+sqright)/4
          xpos(1) = (left+3*sqright)/4
          ypos(0) =  (3*top+bottom)/4 
          ypos(1) = ypos(0)  
          xpos(2) = (3*left+sqright)/4
          xpos(3) = (left+3*sqright)/4
          ypos(2) =  (top+3*bottom)/4
          ypos(3) = ypos(2)   
          radius = 0.45*mymin(height/2,width/2)
     endif 
     if p(COLUMNS) = 6 then
                                                              rem 5 data sets 
          xpos(0) = (5*left+sqright)/6
          xpos(1) = (left+sqright) /2
          xpos(2) = (left+5*sqright)/6
          ypos(0) = (3*top+bottom)/4   
          ypos(1) = ypos(0)
          ypos(2) = ypos(1)
          xpos(3) = (5*left+sqright)/6
          xpos(4) = (left+sqright) /2
          ypos(3) = (top+3*bottom)/4   
          ypos(4) = ypos(3)
          radius = 0.45*mymin(height/2,width/3)
     endif
                        rem push everything down if not 3D view     
     if (ecc = 0) then
         for k = 0 to 4
            ypos(k) =ypos(k) - 2*p(FSGR)
         next k
         if explode >0 then radius = 0.8*radius
     endif

     thickness = radius/3
     res = settag("D()",0)
REM     res = group(w)
         rem now display pie_charts
     for k = 0 to p(COLUMNS)-2
        if (ecc) then
           res = plotcake(w,data,p,k+1,xpos(k),ypos(k),radius,thickness,ecc,thickness/3*explode)
        else
           res = plotpancake(w,data,p,k+1,xpos(k),ypos(k),radius, explode*radius/10)
        endif
        if len(p(YLABELS+k)) > 0 then
                    rem attach label to each chart
            res = CRM_finddims(w,p,p(YLABELS+k))
            ww = CRM_extract(res, "x=")
            t = p(FSGR)*p(FAGR)/100
            if (ww > 2*radius) t = t * (2*radius)/ww
            res = font(w,p(FOGR),p(FSGR),t)
            res = text(w, xpos(k)-len(p(YLABELS+k))*t/2,ypos(k)+if ecc then radius*0.6 else radius endif+p(FSGR),p(YLABELS+k),0)
       endif

     next k         
REM     res = endgroup(w)
     if (labelcols > 0) then
         xx = if xsm_dump > 0 then xsm_dump else sqright endif
         yy = if ysm_dump > 0 then ysm_dump else (p(PHGR ) - labelheight)/2 endif
         res = display_piechart_labels(w,data,p,xx,yy,labelcols,labelheight,labelwidth)
     endif
     res = CRM_tail_end(w,asc("A"),v,p)
     =w

endmacro

rem : ************************************************************************8
rem : This function plots a flat pie chart. The parameters are
rem :  w : The window
rem :  data : The main data block
rem :  p   : The primary gr array
rem :  The column nujber in the data block
rem :  xpos, ypos: The poxition of the centre of the chart
rem :  radius : The radius of the chart
rem :  explode: The amount segments are moved out from the centre

macro plotpancake(w,data(),p(),col,xpos,ypos,radius,explode)
local j, a,t, cxloc,cyloc,sum, res,colour
                         rem add up all available data 
    sum = 0 
    for j = 0 to p(ROWS)-1
        sum = sum + data(j,col)
    next j
    t = 0
    for j = 0 to p(ROWS)-1
      colour = p(DCOLGR + (j % 5))
     if j = p(ROWS)-1 and colour = p(DCOLGR) then colour = p(DCOLGR+1)
      a = data(j,col) *360 /sum
       cxloc = xpos + explode * cos(t+a/2)
       cyloc = ypos+explode * sin(t+a/2)
       res = thinslice(w,t,a+t,cxloc,cyloc,radius,colour)
      t=t+a
    next j
=0
endmacro

  
rem  ********************************************************
rem : This function supplies the minimum sine of any angle
rem   between a and b

macro minsin(a,b)
if (a < 270 and b > 270) then
   = -1
else
   = mymin( sin(a), sin(b))
endif
endmacro

rem : ************************************************************
rem : This macro plots a perspective view of a (possibly exploded)
rem : cake.  To get a correct picture the various segments must
rem : be plotted in the right order.  Reentrant segments cause
rem : special problems since the can be both in front of and behind
rem : other segments.  We break them into smaller pieces to overcome
rem : this little snagoid.
rem: The parameters are
rem :  w : The window
rem :  data : The main data block
rem :  p   : The primary gr array
rem :  k : The column number in the data block
rem :  cx, cy: The poxition of the centre of the cake
rem :  radius : The radius of the cake
rem :  Thickness: the thickness of the cake
rem :  ecc : The eccentricity (ratio of minor to major axis when viewed)
rem :  explode: The amount segments are moved out from the centre
rem 
macro plotcake(w,data(),p(),k,cx,cy,radius, thickness, ecc,explode)
local sum,j,t,a,res,jj,z, list(p(ROWS)+4,7),q,h,b, cxloc,cyloc,colour
q=0
j=0
sum=0
                         rem add up all available data  
for j = 0 to p(ROWS)-1
sum = sum + data(j,k)
next j
t = 0
                         rem list positions and distances of all segments
                         rem segments > 90 degrees are split into smaller
                         rem segments to avoid problems with reentrant objects
for j=0 to p(ROWS)-1
     colour = p(DCOLGR + (j % 5))
     if j = p(ROWS)-1 and colour = list(0,6) then colour = p(DCOLGR+1)
     a = 360*data(j,k)/sum
     cxloc = cx + explode * cos(t+a/2)
     cyloc = cy + explode * sin(t+a/2)
      b=a
     while (a > 90)
       list(q,0) = t
       list(q,1) = t+90
       list(q,2) = cy + radius * minsin(t,t+90)
       list(q,3) = j
       list(q,4) = cxloc
       list(q,5) = cyloc
       list(q,6) = colour
       t=t+90
       a=a-90
       q=q+1
     endwhile
     list(q,0) = t
     list(q,1) = t+a
     list(q,2) = cy + radius*minsin(t,t+a)
     list(q,3) = j
     list(q,4) = cxloc
     list(q,5) = cyloc
     list(q,6) = colour
     q=q+1
     t=t+a
next j
            rem display segments from furthest to nearest

for j=0 to q-1
    z=0
    for jj = 0 to q-1
       if list(jj,2) > z then
           z= list(jj,2)
           k = jj
       endif
     next jj
     list(k,2)=0
     t = list(k,3)
     res = thickslice(w,list(k,0),list(k,1),thickness,list(k,4),list(k,5),radius,ecc,list(k,6))
next j
=0
endmacro


rem - **********************************************************
rem - This is the high-level macro which plots pie-charts
rem - In the main control strings certain symbols have
rem - special meanings:
rem -    s means "explode"
rem -    V means "pull out first slice
rem -  At the organisational level a pie chart is regarded as
rem - a kind of histogram
macro pie_chart (a(),s)
graphmacro "Pie chart",0x19C3,""
  = all_histograms(a,s,PIE_CHART)
endmacro

