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 LINE_HISTO,13
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
define SEC_COL_ALLOWED, 0x80000


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

 
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
   = CRM_mymin( sin(a), sin(b))
endif
endmacro

rem - **************************************************************
rem -       CRM_hexout converts a colour into a hex value

macro CRM_hexout(n)
local j,k,q
q = ""
for j = 0 to 7
   k = n & 15
   if k < 10 then q = k cat q else q = chr(asc("a")+k-10) cat q
   n = n >> 4
next j
=q
endmacro

rem - ***************************************************************
rem
rem                   CRM_thickslice
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
rem -    number     : The identifying number for the segment, which is
rem                   included in the tag. If number < 0 no tag needed
rem -    explode    : 1 if the segment has special explosion status

  
macro CRM_thickslice(w,start,end,thickness,cx,cy,radius,ecc,colour,number,explode)
local list(32), array(70)
local res,k,p,q, cycles,tag
local c1x,c1y,c2x,c2y
local sstart,send, shade
on_error_exit
shade = darker(colour,0.875)
if number >= 0 then
              rem output D tag with colour,explode status and number
   tag = "D(H"cat number cat "K"cat CRM_hexout(colour)
   if explode then tag = tag cat "V)" else tag = tag cat ")"
   res = settag(tag,0x122+ (1<<19))          rem fix for MacEdit bug
endif
if start =end then
  rem draw an invisible line so we have something to attach the tag to
  res = lineattributes(w,0,0,0xFFFFFFFF,0)
  res = line(w, cx, cy, radius*cos(start), radius*sin(start)) 
  =0
endif
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 
             rem backwards 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,0,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,0,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,0,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,0,colour,0)
res = drawobject(w,array, p+2,colour)  
res = endgroup(w)
=0
endmacro


rem - **************************************************************
rem
rem                      CRM_thinslice
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.
rem -    number     : The identifying number for the segment
rem -    explode    : 1 if the segment has special explosion status

macro CRM_thinslice(w,start,end,cx,cy,radius,colour,number,explode)
local list(30), array(70)
local res, k, p,shade,tag
on_error_exit
p=4
if number >= 0 then
               rem make D tag with colour, explode status and number
    tag = "D(H"cat number cat "K"cat CRM_hexout(colour)
    if explode then tag = tag cat "V)" else tag = tag cat ")"
    if (explode >= 0) then res = settag(tag,0x122 + (1 << 19))
endif
if start =end then
  rem draw an invisible line so we have something to attach the tag to
  res = lineattributes(w,0,0,0xFFFFFFFF,0)
  res = line(w, cx, cy, radius*cos(start), radius*sin(start)) 
  =0
endif
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,0,shade,0)
res = drawobject(w,array, p+2,colour)
res = endgroup(w)
  
=0
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 CRM_display_piechart_labels(w,data(),p(),x,y,cols,height,width,table)
local j,k,xpos,ypos,color,res
res = settag("F()",SELECT_ALLOWED + DRAG_ALLOWED + TEXT_EFFECTS)
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 = table(j,0)       
   res =lineattributes(w,0,p(LWGR),color,0)
   res = box(w,xpos,ypos-0.5*p(FSGR),2.5*p(FSGR),2.5*p(FSGR),color)
   res = string(w,xpos+4*p(FSGR),ypos,data(j,0),0,p(BGGR))
   if (cols = 2 and (j&1) = 0) then
       xpos = xpos + width/2
   else
       xpos = x+10
       ypos = ypos - 2.5*p(FSGR)
  endif
next j
res = endgroup(w)
=0
endmacro
  

rem : **************************************************************
rem
rem :              CRM_flex_pie_chart
rem:
rem : This is the main pie-chart plotting program, called when the
rem : data has been collected.

macro CRM_flex_pie_chart(data(),s,p(),v)
local gr_tag, res,w,ww, ecc,j,k,t,radius,thickness,d_string,qq,rr
local top,bottom,left, right,sqright,width,height,osheight,oswidth
local labelwidth,labelheight,labelcols,xsm_dump,ysm_dump,xx,yy,le_tag
local kk(MDATA)
local xpos(6),ypos(6)
local table (p(ROWS),2)
on_error_exit
d_string = 0
gr_tag = psexsub(v)
                       rem see if 3D is needed
ecc = pscontains(v,"W")
res = settag(gr_tag,LINE_EFFECTS+TEXT_EFFECTS+GRAPH_COLOUR_ALLOWED+THREE_DEE_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
rem 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
rem endif 
                                                      rem set dummy colours 
for j = 0 to p(ROWS)-1  
       table(j,0) = p(DCOLGR + (j % 5))
     if j = p(ROWS)-1 and table(j,0) = p(DCOLGR) then table(j,0) = p(DCOLGR+1)
next j
                                                    rem look for D-type tag
res = CRM_close_string(v)
v = CRM_find_substring(s,"D")
if v <> (-1) then
      d_string = 1
      repeat
         res = psexdec(v,"H",-1)
         if res < 0 or res >= p(ROWS) then
             qq = query("H value out of range:" cat res,"Y","N")
             = "Error A"
         endif
         table(res,0) = psexhex(v,"K",0)
         table(res,1) = pscontains(v,"V")
         res = psstep(v)
      until res <> ASC("D")  
endif                    rem if labels looks for a legend parameter
if labelcols > 0 then
      xsm_dump = 0
      ysm_dump = 0
      res = CRM_close_string(v)
         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)
       v = psregister(s)
       res = psstep(v)
endif         
                            rem now plan overall layout
res = lineattributes(w,3,p(LWGR),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 *CRM_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*CRM_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*CRM_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*CRM_mymin(height/2.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*CRM_mymin(height/2.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
     endif

     thickness = radius/3
     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 = CRM_display_piechart_labels(w,data,p,xx,yy,labelcols,labelheight,labelwidth,table)
     endif
         rem now display pie_charts
     for k = 0 to p(COLUMNS)-2
        if (ecc) then
           res = CRM_plotcake(w,data,p,k+1,xpos(k),ypos(k),radius,thickness,ecc,0,thickness/3,table,d_string)
        else
           res = CRM_plotpancake(w,data,p,k+1,xpos(k),ypos(k),radius,0,radius/10,table,d_string)
        endif
        if type(res) = 3 then = res
        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 = string(w, xpos(k)-len(p(YLABELS+k))*t/2,ypos(k)+if ecc then radius*0.6 else radius*1.07 endif+p(FSGR),p(YLABELS+k),0,p(BGGR))
       endif

     next k
     res = CRM_close_string(v)         
     res = CRM_tail_end(w,s,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 number 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 CRM_plotpancake(w,data(),p(),col,xpos,ypos,radius,g_exp,explode,table,d_string)
local j, a,t, cxloc,cyloc,sum, res,colour,l_explode,number
on_error_exit
                         rem add up all available data 
    sum = 0 
    for j = 0 to p(ROWS)-1
        if data(j,col)<0 then ="Negative data"
        sum = sum + data(j,col)
    next j
    if sum = 0 then ="All zeros"
    l_explode = g_exp*explode
    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)
     if(d_string) then
         l_explode = if table(j,1)= g_exp then 0 else explode endif
         colour = table(j,0)
      endif
      a = data(j,col) *360 /sum
      if a = 360 then a=359.9
       cxloc = xpos + l_explode * cos(t+a/2)
       cyloc = ypos+l_explode * sin(t+a/2)
       number = if p(COLUMNS) = 2 then j else -1 endif
       res = CRM_thinslice(w,t,a+t,cxloc,cyloc,radius,colour,number,l_explode)
      t=t+a
    next j
=0
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 CRM_plotcake(w,data(),p(),k,cx,cy,radius, thickness, ecc,g_exp,explode,table,d_string)
local sum,j,t,a,res,jj,z, list(p(ROWS)+4,9),q,h,b, cxloc,cyloc,colour
local l_explode,number
on_error_exit
q=0
j=0
sum=0
                         rem add up all available data  
for j = 0 to p(ROWS)-1
  if data(j,k) < 0 then ="Negative data"
  sum = sum + data(j,k)
next j
if sum=0 then sum="All zeros"     rem special case of all zeros
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
     if a=360 then a=359.9
     if(d_string) then
         l_explode = if table(j,1)= g_exp then 0 else explode endif
         colour = table(j,0)
      endif
     cxloc = cx + l_explode * cos(t+a/2)
     cyloc = cy + l_explode * sin(t+a/2)
if   ( t < 90 and t+a > 90) then
     list(q,0) = t
     list(q,1) = 90
     list(q,2) = cy + radius
     list(q,3) = j
     list(q,4) = cxloc
     list(q,5) = cyloc
     list(q,6) = colour
     list(q,7) = j
     list(q,8) = l_explode
     a = a+t-90
     t = 90
     q = q+1
endif
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
    list(q,7) = j
    list(q,8) = l_explode
    q=q+1
    t=t+a
     
rem :       b=a
rem :      while (a > 90)
rem :        list(q,0) = t
rem :        list(q,1) = t+90
rem :        list(q,2) = cy + radius * minsin(t,t+90)
rem :        list(q,3) = j
rem :        list(q,4) = cxloc
rem :        list(q,5) = cyloc
rem :        list(q,6) = colour
rem :        list(q,7) = j
rem :        list(q,8) = l_explode
rem :        t=t+90
rem :        a=a-90
rem :        q=q+1
rem :      endwhile
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)
     number = if p(COLUMNS) = 2 then list(k,7) else -1 endif
     res = CRM_thickslice(w,list(k,0),list(k,1),thickness,list(k,4),list(k,5),radius,ecc,list(k,6),number,list(k,8))
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 flex_pie (a(),s)
graphmacro "Pie chart",0x19C3,""
local res
res = macroangle(0)
  = all_histograms(a,s,PIE_CHART)
endmacro

