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
define NOGRAPH, 0

REM AXES

rem : *****************************************************************
rem : General Commentary on Axes
rem : 
rem : In general, an axis contains the following items:
rem : 
rem : 1)   An axis line which represents the range of the variable plotted
rem : 
rem : 2)   Two or more 'major ticks' which represent specific values on
rem : that line.  Each tick is labelled with a number.
rem : 
rem : 3)   Possibly some 'minor ticks' between pairs of major ticks. These
rem : represent specific but unlabelled values.  On a linear axis both major
rem : and minor ticks are regularly spaced.  On a log axis the major ticks
rem : are evenly spaced one decade apart and the minor ticks are 
rem : logarithmically spaced in between.
rem : 
rem : 4)  Possibly an axis label. We follow certain conventions:
rem : 
rem :     The label is always in the same typeface and colour as the numbers
rem : used to label the axis, but magnified 1.5 times.
rem : 
rem : Labels on horizontal axes are centred under the axis
rem : 
rem : Labels on vertical axes are placed at the top.
rem : 
rem : On a normal vertical axis, the numbers are to the left and ticks to the
rem : right. If an axis is inverted the numbers come to the right and ticks 
rem : are one the left.   Inverted vertical axes can be placed at the 
rem : left of a graph.
rem : 
rem : Horizontal axes do not need to be inverted.
rem : 
rem : An axis has several 'public' features:
rem : 
rem : 1)    Its dimensions : breadth and height.
rem : 
rem : 2).   The position of the 'hot spot' relative to the bottom corner
rem : of the axis. The hot spot is the 'low' end of the axis line.
rem : 
rem : 3).   Two constants, a and b, are used to convert the value of a 
rem : variable x into a graph position along the axis. The formulas used 
rem : are
rem :            x' = ax+b           for a linear axis, and
rem :            x" = a log(x) +b    for a logarithmic axis
rem : 
rem : Each axis type has two separate calls: One to determine its 
rem : dimensions and the relative position of the hot spot, and a 
rem : second to actually display it.
rem : 
rem : Addition (930307) :  This addition is needed when axes are being drawn
rem : for 3-D graphs. The grid-lines stemming from an axis are imagined
rem : as being drawn on the inside of a shallow open box which 'contains'
rem : the graph. Each axis function terefore needs an extra parameter which 
rem : represents the 'thickness' of the graph.  We regard this as a general
rem : graph property and put in to the GR parameter block.

rem : This function is entered with the extreme values of an axis.
rem : It returns the greater number of places needed by either
rem : of the two values, plus 1
rem : If the NSA marker is set, the axis is not drawn and only
rem : a null object is planted

macro CRM_decimal_places (x,y)
local j,k 
      j = len(format(x,"%0.5g"))
      k = len(format(y,"%0.5g"))
      if ( k > j) then = k+1
      =j+1
endmacro

rem : *****************************************************************
rem : This function plans a horizontal axis to appear in the given window.
rem : The function is passed a complete GR parameter list in p,and
rem : a partially complete axis list in xp. In particular, xp(WIDTHA)
rem : is set to the required width of the axis. It may be a dummy!
rem : The function computes the height and the position of the hot-spot.
rem : and the height of the axis
rem : if xp(LGA) is set the axis is taken as logarithmic

macro CRM_plan_horizontal_axis(w,xp(),p())


     local res, firstlength,lastlength,z,l,h,a,scalelength
     on_error_exit
                                   rem : set required font  
     res = font(w,xp(FOA),xp(FSA),xp(FSA)*xp(FAA)/100)

                  rem : set true axis length, starting in middle of first
                  rem : value and ending in middle of last
     
     firstlength = textwidth(w,format(xp(LOA),"%0.5g"))
     lastlength = textwidth(w,format(xp(UPA),"%0.5g"))
     scalelength = xp(WIDTHA) - (firstlength+lastlength)/2-0.33*p(THICKNESSGR)
     if xp(LGA) then
          z = CRM_log_scale(xp(LOA),xp(UPA),scalelength)
     else
          z = CRM_linear_scale(xp(LOA),xp(UPA),scalelength)
     endif
     if z = "0:0" then = "Bad axis"
     xp(AA) = CRM_extract(z,"a=")
     xp(BA) = CRM_extract(z,"b=")
     l=CRM_extract(z,"l=")
     h = CRM_extract(z,"h")
     a = CRM_extract(z,"a")
     firstlength = textwidth(w,format(l,"%0.5g"))
     xp(HOTXA) = firstlength/2
     if len(p(XLABEL)) > 0 then
          xp(HEIGHTA) = 8*xp(FSA)    : rem was 7
     else
          xp(HEIGHTA) = 5*xp(FSA)    : rem was 4
     endif
     xp(HOTYA) = xp(HEIGHTA)
     xp(LENGTHA) = scalelength
     =0
endmacro



rem : *********************************************************************
rem : This function plans a vertical axis to appear in the given window.
rem : The function is passed a complete GR parameter list in p,and
rem : a partially complete axis list in yp. In particular, xp(HEIGHTA)
rem : is set to the required height of the axis. It may be a dummy or 
rem : an estimate!
rem : The function computes the height and the position of the hot-spot.
rem : and the width of the axis
macro CRM_plan_vertical_axis(w,yp(),p())

   local z,a,b,l,h,i,res,y,qq
   local charheight, scalelength,labelwidth,q,tf
   on_error_exit

                                              rem : set required font  
   res = font(w,yp(FOA),yp(FSA),yp(FSA)*yp(FAA)/100)
                         rem : set true axis length, starting in middle of 
                         rem : first value and ending in middle of last
   charheight = textheight(w,"1")
   tf = p(TDGR)*0.55 * p(THICKNESSGR)
   scalelength = yp(HEIGHTA)-charheight-tf-(len(p(YLABELS)) > 0) * yp(FSA)*3.0
                                              rem : calculate scale parameters
   z = CRM_linear_scale(yp(LOA),yp(UPA),scalelength)
   if z = "0:0" then = "Bad vertical axis"
   a = CRM_extract(z,"a=")
   b = CRM_extract(z,"b=")
   yp(AA) = a
   yp(BA) = b
   l=CRM_extract(z,"l=")
   h=CRM_extract(z,"h=")
   i=CRM_extract(z,"i=")
   if i = 0 then = "Bad vertical axis"
   if a=0 then ="A=0"
   while i*a < 1.2* charheight
      i = i * 2
   endwhile
   q = (h-l)/i
   i = (h-l)/floor(q)
               rem : Now generate all label values and find maximum width
   labelwidth = 0
   y=l
   while (y <= h + i/2)
      q = textwidth(w,format(y,"%0.5g"))
      if q > labelwidth then labelwidth = q
      if (i > 0.000001) then
          y=round(y+i,6)
      else
          y=y+i
      endif
   endwhile
   yp(WIDTHA) = labelwidth + charheight
   yp(HOTXA) =  yp(WIDTHA)
   yp(HOTYA) = 0
   yp(LENGTHA) = scalelength
   =0  
endmacro
        


rem : **********************************************************************
rem : This function actually draws the axis specified in p and xp, with the
rem : hot-spot located at xs,ys. It is assumed that the axis has already been
rem : planned with plan_horizontal_axis
rem : tl is set to the length of the grid-lines needed, and 
rem : tag is the drawing tag
rem : cp is the position where the axis is crossed by the y-axis

macro CRM_draw_horizontal_axis(w,xs,ys,dpp,xp(),p(),tl,tag,cp)

     local firstlength, lastlength,scaleoffset,numberlength,pos
     local linelevel,numberlevel,tick,dump,res,l,h,i,q,x,string,z,a,b
     local active_length,dp,ii
                                             rem : Set attributes as needed

     res = lineattributes(w,1,p(LWGR),xp(LCA),0)
     res = font(w,xp(FOA),xp(FSA),xp(FSA)*xp(FAA)/100)

               rem : set true axis length, stating in middle of first value
     firstlength = textwidth(w,format(xp(LOA),"%0.5g"))
     lastlength = textwidth(w,format(xp(UPA),"%0.5g"))
     dp = CRM_decimal_places(xp(LOA),xp(UPA))
rem  scalelength = xp(WIDTHA) - (firstlength+lastlength)/2-0.33*p(THICKNESSGR)
 
                                                     rem : determine scale

     z = CRM_linear_scale(xp(LOA),xp(UPA),xp(LENGTHA))
     if z = "0:0" then = "Bad horizontal axis"
     xp(AA) = CRM_extract(z,"a=")
     xp(BA) = CRM_extract(z,"b=") + xs
     l=CRM_extract(z,"l=")
     h=CRM_extract(z,"h=")
     i=CRM_extract(z,"i=")
     a = xp(AA)
     b = xp(BA)
     while i*a < 0.6*(firstlength+lastlength)
        i = i * 2
     endwhile
     linelevel = ys+dpp
     numberlevel = linelevel - 2.25 * textheight(w,"1")
     tick = xp(FSA)/2
     q = (h-l)/i
     i = (h-l)/floor(q)
             
                                           rem : Set up initial conditions
     res = settag(tag,TICKS_ALLOWED+SELECT_ALLOWED+TEXT_EFFECTS+DELETE_ALLOWED+REDRAW_NEEDED)
     res = group(w)
                               rem : don't output a font inside a group!!!
     res = line(w,xs,linelevel,xp(LENGTHA),0)
     if xp(NSA) = 0 then
    
                                        rem : Draw scale values and major ticks
         x=l  
         while(x < h+i/2)
            if (x<>0) then
               if abs(l/x) > 50 then x=0
            endif
            string = format(x,"%0.5g")
            numberlength = textwidth(w,string)
            pos = x*a+b-numberlength/2
            if p(GRGR) = 0 then res=line(w,x*a+b,linelevel,0,2*tick)
            if round(x,dp) <>0 or dpp = 0 then
                res=string(w,pos,numberlevel,string,xp(TCA),p(BGGR))
            endif
            x=x+i
         endwhile
    
                                      rem : Draw grid lines across the picture
    
                                                        rem : Draw minor ticks
        if (xp(STA) > 1) then
           ii=i/xp(STA)
           x=l
           while (x < h)
              if (x>l) then res = LINE (w,x*a+b,linelevel,0,tick)
              x = x + ii
           endwhile
        endif
        if p(GRGR) > 0 then
           res = lineattributes(w,1,p(LWGR),0xAAAAAA00,0)
           linelevel = ys
           x=l+i
           while ( x <= h+i/2)
              if (p(THICKNESSGR) = 0 ) then
                  res = line(w,x*a+b,linelevel,0,tl)
              else
                  res = line(w,x*a+b,linelevel,0.33*p(THICKNESSGR),0.55*p(THICKNESSGR))
                  res = line(w,x*a+b+0.33*p(THICKNESSGR),linelevel+0.55*p(THICKNESSGR),0,tl)
              endif        
              x=x+i
           endwhile
           res = lineattributes(w,1,p(LWGR),xp(LCA),0)
        endif
                                     rem outputlabel
        if len(p(XLABEL)) > 0 then
          dump = xp(FSA)
          xp(FSA) = 1.5 * xp(FSA)
          h = CRM_extract(CRM_finddims(w,xp,p(XLABEL)),"x=")
          if cp <= 2 then res =CRM_showlabel(w,xp,p(XLABEL),xs+(xp(WIDTHA)-h)/2, ys-4.7*xp(FSA))
          if cp > h then res = CRM_showlabel(w,xp,p(XLABEL),xs,ys-3.7*xp(FSA))
          if cp > 2 and cp <=h then res = CRM_showlabel(w,xp,p(XLABEL),xp(WIDTHA)-h,ys-4.7*xp(FSA))
          xp(FSA) = dump
       endif
    endif
    res = endgroup(w)
    =0
endmacro


rem : **********************************************************************

macro CRM_draw_horlog_axis(w,xs,ys,dpp,xp(),p(),tl,tag)

rem : This function draws a logarithmic horizontal axis as specified in
rem :  p and xp, with the hot-spot located as xs,ys.
rem : tl is set to the length of the grid-lines needed and tag is
rem : the drawing tag
   local firstlength, lastlength,scaleoffset,numberlength,pos
   local linelevel, numberlevel, tick, dump,res,l,h,i,q,x,string,z,a,b
   local alog,d,y
   on_error_exit
   rem : Set attributes as needed
   res = lineattributes(w,1,p(LWGR),xp(LCA),0)
   res = font(w,xp(FOA),xp(FSA),xp(FSA)*xp(FAA)/100)
             rem : set true axis length, stating in middle of first value
   firstlength = textwidth(w,format(xp(LOA),"%0.5g"))
   lastlength = textwidth(w,format(xp(UPA),"%0.5g"))
rem   scalelength = xp(WIDTHA) - (firstlength+lastlength)/2-0.55*p(THICKNESSGR)
   rem : scaleoffset = xs+firstlength/2
   scaleoffset = xs
   if xp(LENGTHA) < 200  then = "X"
   
   rem : determine scale
   z = CRM_log_scale(xp(LOA),xp(UPA),xp(LENGTHA))
   a=CRM_extract(z,"a=")
   b=CRM_extract(z,"b=") + scaleoffset
   xp(AA) = a
   xp(BA) = b
   l=log(CRM_extract(z,"l="))
   h=log(CRM_extract(z,"h="))
   i=CRM_extract(z,"i=")
   rem : Set up initial conditions 
   res = settag(tag,TICKS_ALLOWED+SELECT_ALLOWED+TEXT_EFFECTS+DELETE_ALLOWED+REDRAW_NEEDED)
   linelevel = ys+dpp
   res = group(w)
          rem don't output a font inside a group!!!
   res = line(w,scaleoffset,ys,xp(LENGTHA),0)
   if xp(NSA) = 0 then
       
                     rem : Draw scale values and major ticks
          x=l
          while(x <= h+0.5)
              alog = CRM_antilog(x)
              numberlength = textwidth(w,format(alog,"%0.5g"))
              pos = x*a+b-numberlength/2
              res=line(w,x*a+b,linelevel,0,xp(FSA))
              if x = l then pos = pos + numberlength
              res=string(w,pos,ys-2*xp(FSA),format(alog,"%0.5g"),xp(TCA),p(BGGR))
                x=x+1
          endwhile
       
          rem : Draw grid lines across the picture
          if p(GRGR) > 0 then
             res = lineattributes(w,1,p(LWGR),0xAAAAAA00,0)
             x=l+1   
             linelevel = ys
             while ( x <= h+0.5)
               d=x*a+b
                if (p(THICKNESSGR) = 0) then
                    res = line(w,d,linelevel,0,tl)
                 else
                    res = line(w,d,linelevel,0.33*p(THICKNESSGR),0.55*p(THICKNESSGR))
                    res = line(w,d+0.33*p(THICKNESSGR),linelevel+0.55*p(THICKNESSGR),0,tl)
              endif        
                  x=x+1
             endwhile
          res = lineattributes(w,1,p(LWGR),xp(LCA),0)
          endif
       
          rem : Draw minor ticks
          if (xp(STA) > 0) then
             x = l
             while (x < h)
                for q = 2 to 9
                   y = log(q)+x
                   res = LINE (w,y*a+b,ys,0,xp(FSA))
                next q
                x = x + 1
             endwhile
          endif
          res = endgroup(w)
    
          if len(p(XLABEL)) > 0 then
            dump = xp(FSA)
            xp(FSA) = 1.5 * xp(FSA)
            res=CRM_extract(CRM_finddims(w,xp,p(XLABEL)),"x=")
            res=CRM_showlabel(w,xp,p(XLABEL),xs+(xp(WIDTHA)-res)/2, ys-3.7*xp(FSA))
            xp(FSA) = dump
          endif
      endif
      res = endgroup(w)
      =0
endmacro



rem : ********************************************************************
rem : This function draws a linear vertical axis as specified in
rem : p and xp, with the hot-spot located as xs,ys.
rem : tl is set to the length of the grid-lines needed and tag is
rem : the drawing tag

macro CRM_draw_vertical_axis(w,xs,dpp,ys,yp(),p(),tl,tag,has_top_label)
   local z,a,b,l,h,i,res,y,tick,dump,d
   local charheight, lineoffset,textoffset,q,il,ir
                                          rem : set drawing parameters
   res = lineattributes(w,1,p(LWGR),yp(LCA),0)
   res = font(w,yp(FOA),yp(FSA),yp(FSA)*yp(FAA)/100)
   charheight = textheight(w,"1")
   rem scalelength = yp(HEIGHTA)-charheight - has_top_label * yp(FSA)*3.0
                           rem : calculates scale parameters
   z = CRM_linear_scale(yp(LOA),yp(UPA),yp(LENGTHA))
   if z = "0:0" then = "Bad vertical axis"
   a=CRM_extract(z,"a=")
   b = CRM_extract(z,"b=")+ys
   yp(AA) = a
   yp(BA) = b
   l=CRM_extract(z,"l=")
   h=CRM_extract(z,"h=")
   i=CRM_extract(z,"i=")
   while i*a < 1.2* charheight
      i = i * 2
   endwhile
   q = (h-l)/i
   i = (h-l)/floor(q)
   res = settag(tag,TICKS_ALLOWED+SELECT_ALLOWED+TEXT_EFFECTS+DELETE_ALLOWED+REDRAW_NEEDED)
   res = group(w)
                       rem don't output a font inside a group!!!
   if p(GRGR) > 0 then
       res = lineattributes(w,1,p(LWGR),0xAAAAAA00,0)
       y=l+i
       lineoffset = xs
       while ( y <= h+i/2)
          if round(y,6) <> 0 or p(THICKNESSGR) <> 0 then
              d = y*a+b
                if p(THICKNESSGR) then
                    res = line(w,lineoffset,d, 0.33*p(THICKNESSGR),0.55*p(THICKNESSGR))
                    res = line(w,lineoffset+0.33*p(THICKNESSGR),d+0.55*p(THICKNESSGR),tl,0)
                 else   
                    res = line(w,lineoffset,y*a+b,tl,0)
                 endif
          endif
          y=y+i
        endwhile
   endif
   res = lineattributes(w,1,p(LWGR),yp(LCA),0)
   if yp(INA) = 0 then
       textoffset = xs-yp(HOTXA)+dpp
       lineoffset = xs+dpp
       tick = yp(FSA)/2
   endif
   if yp(INA) <> 0 then
       textoffset = xs+yp(FSA)+dpp
       lineoffset = xs +dpp
       tick = -yp(FSA)/2
   endif
   res = line(w,lineoffset,l*a+b,0,yp(LENGTHA))

   if yp(NSA) = 0 then
       y=l
       lineoffset = xs+dpp
       while(y <= h+i/2)
           if p(GRGR) = 0 then res=line(w,lineoffset,y*a+b,2*tick,0)
            d = y*a+b-charheight/2
            if round(y,6) <>0 or dpp = 0 then
                if y<>0 then
                    if abs(i/y) > 10 then y = 0
                endif
              res = string(w,textoffset,d,format(y,"%0.5g"),yp(TCA),p(BGGR))
           endif
            y=y+i
     endwhile

   
       if (yp(STA) > 1) then
          i=i/yp(STA)
          y=l
          while (y < h)
             if y <> l then  res = LINE (w,lineoffset,y*a+b,tick,0)
             y = y + i
          endwhile
       endif
       if has_top_label then
            il = p(OLGR)+p(IBGR)
            ir = p(PWGR)-p(ORGR)-p(IRGR)
            dump = yp(FSA)
           yp(FSA) = 1.5 * yp(FSA)
           i=CRM_extract(CRM_finddims(w,yp,p(YLABELS)),"x=")
           if lineoffset - i/2 < il then
               res=CRM_showlabel(w,yp,p(YLABELS),il,ys+yp(LENGTHA)+yp(FSA)+0.55*p(THICKNESSGR))
               else
                  if lineoffset +i/2 > ir then
                    res=CRM_showlabel(w,yp,p(YLABELS),ir-i,ys+yp(LENGTHA)+yp(FSA)+0.55*p(THICKNESSGR))
                  else
                    res=CRM_showlabel(w,yp,p(YLABELS),lineoffset-i/2,ys+yp(LENGTHA)+yp(FSA)+0.55*p(THICKNESSGR))
                  endif
           endif
           yp(FSA) = dump
       endif
   endif
   res = endgroup(w)
   =1
endmacro


rem : **********************************************************************
rem : This function draws a logarithmic vertical axis as specified in
rem : p and yp, with the hot-spot located as xs,ys.
rem : tl is set to the length of the grid-lines needed and tag is
rem : the drawing tag
 
macro CRM_draw_verlog_axis(w,xs,dpp,ys,yp(),p(),tl,tag,has_top_label)

    local z,a,b,l,h,i,res,y,alog,q,d,tick,dump
    local charheight, lineoffset,textoffset
    res = lineattributes(w,1,p(LWGR),yp(LCA),0)
    res = font(w,yp(FOA),yp(FSA),yp(FSA)*yp(FAA)/100)
    charheight = textheight(w,"1")
    rem scalelength = yp(HEIGHTA)-charheight - has_top_label*2.5*yp(FSA)
    
    z = CRM_log_scale(yp(LOA),yp(UPA),yp(LENGTHA))
    a=CRM_extract(z,"a=")
    rem b=CRM_extract(z,"b=")+ys+ charheight/2
    b = CRM_extract(z,"b=")+ys
    yp(AA) = a
    yp(BA) = b
    l=log(CRM_extract(z,"l="))
    h=log(CRM_extract(z,"h="))
    i=CRM_extract(z,"i=")
    res = settag(tag,TICKS_ALLOWED+SELECT_ALLOWED+TEXT_EFFECTS+DELETE_ALLOWED+REDRAW_NEEDED)
    res = group(w)
    rem don't output a font inside a group!!!
    
    lineoffset = xs+dpp
    if yp(INA) = 0 then
        textoffset = xs- yp(WIDTHA)
        tick = yp(FSA)/2
    endif
    if yp(INA) <> 0 then
        textoffset = xs + yp(FSA)
        tick = -yp(FSA)/2
    endif
    res = line(w,lineoffset,ys,0,yp(LENGTHA))
if yp(NSA) = 0 then
        y=l
        while(y <= h)
            alog = CRM_antilog(y)
            d = a*y+b
            res=string(w,textoffset,d-charheight/2,format(alog,"%0.5g"),yp(TCA),p(BGGR))   
            res=line(w,lineoffset,d,tick*2,0)
            y=y+1
        endwhile
        if p(GRGR) > 0 then
           res = lineattributes(w,1,p(LWGR),0xAAAAAA00,0)
           y=l+1
           lineoffset = xs
           while ( y <= h+0.5)
                d = a*y+b
                if p(THICKNESSGR) then
                  res = line(w,lineoffset,d, 0.33*p(THICKNESSGR),0.55*p(THICKNESSGR))
                  res = line(w,lineoffset+0.33*p(THICKNESSGR),d+0.55*p(THICKNESSGR),tl,0)
                else   
                    if y > l then res = line(w,lineoffset,d,tl,0)
                endif    
                y=y+1
           endwhile
        res = lineattributes(w,1,p(LWGR),yp(LCA),0)
        endif
        y=l
        if (yp(STA) > 0) then
        while (y < h)
           for q = 2 to 10
             d = log(q)+y
             res = LINE (w,lineoffset,a*d+b,tick,0)
           next q
           y = y + 1
        endwhile
        endif
        if has_top_label then
           dump = yp(FSA)
           yp(FSA) = 1.5 * yp(FSA)
           res =CRM_showlabel(w,yp,p(YLABELS),p(OLGR)+p(ILGR), ys+yp(LENGTHA)+yp(FSA))
           yp(FSA) = dump
        endif
    endif
    res = endgroup(w)
    =1
endmacro

rem : ****************************************************************
rem : plan_horizontal_histo_axis:  This function planss the horizontal
rem : axis for a vertical histogram.  The parameters are: 
rem :       w     : window
rem :       xaxis : The xaxis descriptor
rem :       p     : The graph descriptor
rem :       data  : The data block . Labels are in data(0,0) to data(p(ROWS)-1,0)
rem : The function is entered with the a provisional width of the axis in xaxis(WIDTHA).
rem : It establishes the size of the axis and the relative position of the hotspot.

macro CRM_plan_horizontal_histo_axis(w,xaxis(),p(),data())
   local n,res,in,aa,b,x,xd, maxheight, hh,zz,format
   n = p(ROWS)
   res = font(w,xaxis(FOA),xaxis(FSA),xaxis(FSA)*xaxis(FAA)/100)
           rem : Next survey labels and find the maximum height
   maxheight = 0
   x=0
   xaxis(FORMATA)  = 0
   while x < n
      if textwidth(w,data(x,0)) > xaxis(WIDTHA)/(p(ROWS)) then 
         xaxis(FORMATA)=1
      endif

      hh = textheight(w,data(x,0)) 
      if hh > maxheight then maxheight = hh
      x=x+1
   endwhile
   maxheight = maxheight
   if xaxis(FORMATA) = 1 then maxheight = maxheight * 2.5
   if len(p(XLABEL)) > 0 then maxheight = maxheight + 3*xaxis(FSA)
   xaxis(HEIGHTA) = maxheight+2*xaxis(FSA)
   xaxis(HOTXA) = 0
   xaxis(HOTYA) = xaxis(HEIGHTA)
   xaxis(LENGTHA) = xaxis(WIDTHA) - 0.33*p(TDGR)*p(THICKNESSGR)
   =0
endmacro


rem : *********************************************************
rem : Function draw_horizontal_histo_axis generates a labelled axis suitable
rem : for the display of a DISCRETE variable, such as a histogram. The parameters are:
rem :    w :   a window
rem :    xs,ys : position of the hotspot
rem :    axis  : A set of axis parameters
rem :    p     : A grraph parameter block
rem :    data  : The data block
rem :    tag   : The tage used for labelling the compound object
rem :    tl    : The length of grid-lines
macro CRM_draw_horizontal_histo_axis(w,xs,ys,xaxis(),p(),data(),tag,tl)
   local fs,tc,lc,fo,res,in,aa,b,x,xd, maxheight, hh,zz,format,dump
   local textheight
                                               rem : Set up initial conditions
   res = settag(tag,SELECT_ALLOWED+TEXT_EFFECTS+DELETE_ALLOWED+REDRAW_NEEDED)
   res = group(w)
   aa = xaxis(WIDTHA) / p(ROWS)
   ys=ys-xaxis(HOTYA)
   xs=xs-xaxis(HOTXA)
   b= xs
             rem : Next survey labels and find the maximum height
   maxheight =  xaxis(HOTYA)
   res = lineattributes(w,1,p(LWGR),0,0)
   res = line(w,xs,ys+maxheight,xaxis(WIDTHA),0)
   if xaxis(NSA) = 0 then
       textheight = ys + (len(p(XLABEL))>0)*3*xaxis(FSA)+1.5*xaxis(FSA)
        if p(GRGR) > 0 then
           res = lineattributes(w,1,p(LWGR),0xAAAAAA00,0)
           x=0
           while ( x <= p(ROWS))
              if p(THICKNESSGR) = 0 and x<>0 then
                  res = line(w,x*aa+b,ys+maxheight,0,tl)
              else
                  res = line(w,x*aa+b,ys+maxheight,0.33*p(THICKNESSGR),0.55*p(THICKNESSGR))
                  res = line(w,x*aa+b+0.33*p(THICKNESSGR),ys+maxheight+0.55*p(THICKNESSGR),0,tl)
              endif        
              x=x+1
           endwhile
           res = lineattributes(w,1,p(LWGR),xaxis(LCA),0)
        endif
       x=0
       while(x < p(ROWS))
             xd = aa*x+b
             hh =  how_many_lines(w,data(x,0),xaxis,aa)
            res  = displaytext(w,data(x,0),xaxis,xd,textheight,aa,hh,xaxis(FORMATA),p(BGGR))
             res = line( w,xd,ys+maxheight,0,xaxis(FSA))
             x=x+1
       endwhile
       res = line(w,aa*p(ROWS)+b,ys+maxheight,0,xaxis(FSA))
    
    
                                      rem output centred label
       if len(p(XLABEL)) > 0 then
          dump = xaxis(FSA)
          xaxis(FSA) = 1.5 * xaxis(FSA)
          res = CRM_extract(CRM_finddims(w,xaxis,p(XLABEL)),"x=")
          res =CRM_showlabel(w,xaxis,p(XLABEL),xs+(xaxis(WIDTHA)-res)/2, ys+xaxis(FSA))
          xaxis(FSA) = dump
       endif
   endif 
   res = endgroup(w)
   =0
endmacro

rem : ****************************************************************
rem : plan_vertical_histo_axis:  This function plans the vertical
rem : axis for a horizontal histogram.  The parameters are: 
rem :       w     : window
rem :       yaxis : The yaxis descriptor
rem :       p     : The graph descriptor
rem :       data  : The data block . Labels are in data(0,0) to data(p(ROWS)-1,0)
rem : The function is entered with the a provisional height of the axis in yaxis(HEIGHTA).
rem : It establishes the size of the axis and the relative position of the hotspot.

macro CRM_plan_vertical_histo_axis(w,yaxis(),p(),data())
   local n,res,in,aa,b,x,xd, maxlength, hh,zz,format
   n = p(ROWS)
   res = font(w,yaxis(FOA),yaxis(FSA),yaxis(FSA)*yaxis(FAA)/100)
           rem : Next survey labels and find the maximum length
   maxlength = 0
   x=0
   yaxis(FORMATA)  = 0
   while x < n
      zz = textwidth(w,data(x,0))
        if(zz > maxlength) then maxlength = zz 
      x=x+1
   endwhile
   yaxis(WIDTHA) = maxlength + 2*yaxis(FSA)
  
   yaxis(HOTXA) = yaxis(WIDTHA)
   yaxis(HOTYA) = 0
   yaxis(LENGTHA) = yaxis(HEIGHTA) - 0.33*p(TDGR)*p(THICKNESSGR)
   if len(p(XLABEL)) > 0 then yaxis(LENGTHA) = yaxis(LENGTHA)-7*yaxis(FSA) 
   =0
endmacro


rem : *********************************************************
rem : Function draw_vertical_histo_axis generates a vertical labelled axis
rem : suitable for the display of a DISCRETE variable, such as a histogram.
rem : The parameters are:
rem :    w :   a window
rem :    xs,ys : position of the hotspot
rem :    axis  : A set of axis parameters
rem :    p     : A graph parameter block
rem :    data  : The data block
rem :    tag   : The tage used for labelling the compound object
rem :    tl    : The length of grid-lines
macro CRM_draw_vertical_histo_axis(w,xs,ys,yaxis(),p(),data(),tag,tl)
   local fs,tc,lc,fo,res,in,aa,b,x,xd, maxheight, hh,zz,format,dump
   local textplace
                                               rem : Set up initial conditions
   res = settag(tag,SELECT_ALLOWED+TEXT_EFFECTS+DELETE_ALLOWED+REDRAW_NEEDED)
   res = group(w)
   aa = yaxis(LENGTHA) / p(ROWS)
   ys=ys-yaxis(HOTYA)
   xs=xs-yaxis(HOTXA)
   b= ys
   res = lineattributes(w,1,p(LWGR),0,0)            
   res = line(w,xs+yaxis(HOTXA),ys,0,yaxis(LENGTHA))
   if yaxis(NSA) = 0 then
       textplace = xs + yaxis(FSA)
        if p(GRGR) > 0 then
           res = lineattributes(w,1,p(LWGR),0xAAAAAA00,0)
           x=0
           while ( x <= p(ROWS))
              if (p(THICKNESSGR) = 0)  then
                  res = line(w,xs+yaxis(HOTXA),b+aa*x,tl,0)
              else
                  res = line(w,xs+yaxis(HOTXA),b+aa*x,0.33*p(THICKNESSGR),0.55*p(THICKNESSGR))
                  res = line(w,xs+yaxis(HOTXA)+0.33*p(THICKNESSGR),b+aa*x+0.55*p(THICKNESSGR),tl,0)
              endif        
              x=x+1
           endwhile
           res = lineattributes(w,1,p(LWGR),yaxis(LCA),0)
        endif
       x=0
       res = font(w,yaxis(FOGR),yaxis(FSGR),yaxis(FSGR)*yaxis(FAGR)/100)
       while(x < p(ROWS))
             xd = aa*x+b
             res = string( w,textplace,b+aa*(x+0.5)-0.5*yaxis(FSA),data(p(ROWS)-1-x,0),yaxis(TCGR),p(BGGR))
             res = line( w,xs+yaxis(HOTXA),xd,yaxis(FSA),0)
             x=x+1
       endwhile
       res = line(w,xs+yaxis(HOTXA),aa*p(ROWS)+b,yaxis(FSA),0)
    
    
                                      rem output centred label
       if len(p(XLABEL)) > 0 then
          dump = yaxis(FSA)
          yaxis(FSA) = 1.5 * yaxis(FSA)
          res = CRM_extract(CRM_finddims(w,yaxis,p(XLABEL)),"y=")
          res =CRM_showlabel(w,yaxis,p(XLABEL),xs,aa*p(ROWS)+b+yaxis(FSA)+p(THICKNESSGR)*0.55)
          yaxis(FSA) = dump
       endif
   endif
   res = endgroup(w)
   =0
endmacro

REM FLEXPIE


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

REM GENERAL
rem : Plotter for general graph.   We use a plotter function which 
rem : examines the data and returns a marker for the graph type.
rem : This must be one of
rem : 
rem :                     VERTICAL_HISTOGRAM
rem :                     HORIZONTAL_HISTOGRAM
rem :                     LINES_ONLY
rem :                     POINTS_ONLY
rem :                     LINE HISTO
rem :            or       -1 (No graph)
rem :            

macro CRM_which_type(data(),s,p(),v,date)
local rows,columns,r,j,k,res
    rows = first(data)-1
    columns = second(data)-1
rem   search top row for labels
    r = 0 
    for j = 0 to columns-1
       if type (data(0,j)) = 3 then r=1
    next j

rem now search rest of graph for numbers
    for k = r to rows-1
        for j = 1 to columns-1
           if type(data(k,j)) > 2 then  =-1
        next j
    next k
rem see what left hand side is
    for k = r to rows-1
       if type(data(k,0)) > 2 then goto cc
    next k
rem now see if numbers increase monotonically
    for k = r to rows -3
        if  data(k+1,0) <= data(k,0) then = POINTS_ONLY
     next k
    =LINES_ONLY
cc:
     if(date and rows <= 16) then = LINE_HISTO
     if (rows < 8) then = VERTICAL_HISTOGRAM
     if (rows < 15) then = HORIZONTAL_HISTOGRAM
     =-1
endmacro
     
     
                           
macro general(a(),s)
graphmacro "General",0x19FF,""
   local v,q,n,res,h,w,j
   local p(PSIZE)
   v = psregister(s)
   q = psstep(v)
   if iserror(q) then = q
   if q<> CRM_code("A") then = "Missing parameter substring"
   res = CRM_get_gr_params(p,v)
   p(GRAPHTYPE) = GENERAL
   h = first(a)
   w = second(a)
   n = CRM_datasets(v,w,h)
  if n <= 1 then = "Graph can't be plotted"
   if pscontains(v,"u") then 
      res = CRM_point_plot_row_data(a,s,v,p,w,n,2)
  else
      res = CRM_point_plot_col_data(a,s,v,p,h,n,2)
   endif
  q= CRM_close_string(v)
  if res = LINES_ONLY then = line_plot(a,s)
   if res = POINTS_ONLY then = scatter_diagram(a,s)
   if res = VERTICAL_HISTOGRAM then 
        = all_histograms(a,s,VERTICAL_HISTOGRAM)
   endif
   if res = HORIZONTAL_HISTOGRAM then 
        = all_histograms(a,s,HORIZONTAL_HISTOGRAM)
   endif
   if res = LINE_HISTO then
          = all_histograms(a,s,LINE_HISTO)
   endif
  = "Can't plot this graph"
   
endmacro

REM HISTOPLOT

rem : ******************************************************************
rem : the following functions all have to do with placing words and
rem : phrases on the screen, fitting them into limited space.
rem : ******************************************************************


rem : ******************************************************************
rem : Function textfit is used to test whether a string will fit into 
rem : a limited space.
rem : w is a window; t is a text string; z a parameter block (of any
rem : kind) and xe is the horizontal space available.
rem : If the string can be made to fit in to the given space the function
rem : returns 1; otherwise 0.
macro textfit(w,t,z(),xe)
   local res,width
   res = font(w,z(FOGR),z(FSGR),z(FSGR) * z(FAGR) / 100)
   width = textwidth(w,t)
   = (width <= xe)  
endmacro


rem : *************************************************************
rem : Function textslice is used to partition string t into two strings:
rem : A head which can be printed on one line, and a tail, which is
rem : the rest. The function returns the head, leaving it to the calling
rem : function to disentangle the head from the tail.
rem : If the whole string fits into one line after all, that line is 
rem : returned entier.   Otherwise the technique is as follows:
rem : First, we cut the string so that first line is completely full.
rem : If the rest of the string is more than one line long, we take this
rem : cut as the final result.  Otherwise, we search backward in the first
rem : half for a space. We accept the first space which still allows the
rem : second half to appear in a single line. If there is no such space
rem : we return the full first half
rem : The parameters are a window, a text, a parameter block and a width
macro textslice (w,t, z(),xe)
   local totalwidth, j,res,toplength,top,bottom,bottomwidth
   local newtop,newbottom,size,topwidth
   xe = xe-8   rem provide a small gap 
   size = len(t)
   res = font(w,z(FOGR),z(FSGR),z(FSGR) * z(FAGR) / 100)
   totalwidth = textwidth(w,t)
   if totalwidth < xe then =t      rem string fits in one line
                 rem : Make estimate of top length
   toplength = floor(size * xe/totalwidth)
                   rem : get maximum characters that fit into the top
   while (toplength > 0)
       top = left(t,toplength)
       topwidth = textwidth(w,top)
       if topwidth <= xe then goto joe
       toplength = toplength-1
   endwhile
joe:
   bottom = right(t, size-toplength)
   bottomwidth = textwidth(w,bottom)
   if bottomwidth > xe then = top   rem bottom half won't fit

               rem :  Now look backwards for a space 
   j = toplength
   while (j > 1)
      if mid(top,j,j) = " " then
           newtop = left(t, j-1)
           newbottom = right(t,size - j)
           if textwidth(w,newbottom) <= xe then 
                = newtop
           else
                 =top
           endif
      endif
      j=j-1
   endwhile
   = top
endmacro

rem : **********************************************************
rem : this macro determines how many lines are needed to display
rem : the given string. The maximum is two, and if the string is
rem : any longer it will eventually be truncated
rem :
macro how_many_lines(w,t,z(),xe)
local ww
ww = textfit(w,t,z,xe)
if ww = 0 then =2
=1
endmacro



rem : **************************************************************
rem : This macro displays a text t at a location starting at xs,ys
rem : If a single line is required format = 0.  If the string is 
rem : allowed to be split into two lines, format = 1. This places single-
rem : line entries at the right height
rem : n is the number of lines actually used.
rem : Other parameters are :  
rem :         w - a window
rem :         t - the text to be displayed,
rem :         z - a parameter block, 
rem :         xs and ys - the bottom left corner of the text display area, 
rem :         xe - the text extent 
macro displaytext(w,t,z(),xs,ys,xe,n,format,background)
   local res,q,r,height,width
   height = 1.5*z(FSGR)
                   rem : Make a small invisible border
   xs = xs+4
   xe = xe-8
                  rem :  First deal with single-line display
   if n = 1 then
      res = font(w,z(FOGR),z(FSGR),z(FSGR) * z(FAGR) / 100)
      width = textwidth(w,t)
      res = string (w,xs+(xe-width)/2,ys+1.5*height*format,t,z(TCGR),background)  
      =0
   endif

                  rem : Now deal with two-line_text
   q = textslice(w,t,z,xe)
   r = right(t, len(t) - len(q))
   if  left(r,1) = " " then  r = right (r,len(r)-1)
   res = font(w,z(FOGR),z(FSGR),z(FSGR) * z(FAGR) / 100)
   width = textwidth(w,q)
                               rem : Display first line
   res = string(w,xs+(xe-width)/2,ys+1.5*height,q,z(TCGR),z(BGGR))
                               rem : truncate second line until it fits
   while (len(r) >1)
      if textfit(w,r,z,xe) > 0 then goto sylvia
      r = left(r,len(r)-1)
   endwhile
sylvia:
      res = font(w,z(FOGR),z(FSGR),z(FSGR) * z(FAGR) / 100)
      width = textwidth(w,r)
      res = string (w,xs+(xe-width)/2,ys,r,z(TCGR),z(BGGR))  
      =0
endmacro
   
rem : ******************************************************
rem : Function darker.  Given a colour c and a factor f, this function
rem : reduces each component of colour c to produce a darker
rem : shade.
macro darker(c,f)
   local red,green,blue
   red = c >> 24
   green = (c >> 16) and 255
   blue = (c >> 8) and 255
   = (int(f*red)<<24)+(int(f*green)<<16)+(int(f*blue)<<8)
endmacro

    
rem : **************************************************************
rem : Function draw_histo_box draws one element of a 
rem : histogram, with the bottom left corner at xa,yam and extent
rem : xe, ye.  The colour is c.  If td is true the box is given
rem : a 3-D appearance with appropriate shading.
macro draw_histo_box(w,xa,ya,xb,yb,c,td,vertical)
   local res,pp(1,4),za,zb
   res = box(w,xa,ya,xb-xa,yb-ya,c)
   if td=0 then =0           rem exit if only 2D
   
   if (vertical) then
       za = 0.33*(xb-xa)
       zb = 0.55 * (xb-xa)
   else
       za = 0.33*(yb-ya)
       zb = 0.55*(yb-ya)
   endif
   pp(0,0) = xb
   pp(1,0) = yb
   pp(0,1) = xb+za
   pp(1,1) = yb+zb
   pp(0,2) = xb+za
   pp(1,2) = ya+zb
   pp(0,3) = xb
   pp(1,3) = ya
   res = poly(w,pp,4,darker(c,0.75))
   pp(0,2) = xa+za
   pp(1,2) = yb+zb
   pp(0,3) = xa
   pp(1,3) = yb
   res = poly(w,pp,4,darker(c,0.875))
   =0
endmacro

      
rem : **************************************************************
rem : This function handles both normal and stacked vertical histograms.
rem : Also line-histograms, as requested.

macro plot_vertical_histo (w,data(),p(),xaxis(),yaxis(),di(),tag,xm,ym,base)
   local res,n,j,color,xa,xb,ya,yb,h_interval,k,col_width,start,m,q
   local c(1,p(ROWS))
   res = lineattributes(w,1,p(LWGR),0,0)
   res = settag(tag,0)
   res =group(w)
   n = p(ROWS)
   k = p(COLUMNS)
   
   h_interval = xaxis(WIDTHA) / n
   if(p(GRAPHTYPE) = LINE_HISTO) then
       for j = 0 to n-1
         c(0,j) = xm+(j+0.5)* h_interval
      next j
      for m = 0 to k-2
         for j = 0 to n-1
            c(1,j) = yaxis(BA) + yaxis(AA) * (q+data(j,m+1))
         next j
         res = lineattributes(w,0,p(LWGR),p(DCOLGR+m),0)
         res = openpoly(w,c,n)
         if(p(MTGR) >0) then
            res = lineattributes(w,1,p(LWGR),0,0)
            res = polymarker(w,c,n,((p(MTGR)+m-1)%5)+1,p(MSGR),p(DCOLGR+m))
         endif
      next m
      res = endgroup(w)
      =0
   endif
   if p(GRAPHTYPE) = STACKED_VERTICAL_HISTOGRAM then
      col_width = h_interval * p(FRGR)/100
      for j = 0 to n-1
         q=0
         xa = xm+ (j+0.5) * h_interval-col_width/2
         xb = xa+col_width
         for m = 0 to k-1
            ya = yaxis(BA) + yaxis(AA) * q + base
            yb = yaxis(BA) + yaxis(AA) * (q+data(j,m+1))
            q = q+data(j,m+1)
            color = p(DCOLGR+m)
            res = draw_histo_box(w,xa,ya,xb,yb,color,p(TDGR),1)
         next m
      next j         
   else   
      col_width = h_interval*p(FRGR)/((k-1)*100)
      for j = 0 to n-1
      
         start = xm + j*h_interval + (100-p(FRGR))*h_interval/200
         for m=0 to k-2
            xa=start + col_width*m
            xb = xa+col_width
            ya = ym+base
            yb = yaxis(BA) + yaxis(AA) * data(j,m+1)
            color = p(DCOLGR+m)
                if yb > ya then
                   res = draw_histo_box(w,xa,ya,xb,yb,color,p(TDGR),1)
                else
                   res = draw_histo_box(w,xa,yb,xb,ya,color,p(TDGR),1)
                endif
         next m         
      next j
   endif   
   res = endgroup(w)
   =0
endmacro
  

rem : **************************************************************
rem : This function handles both normal and stacked horizontal histograms.

macro plot_horizontal_histo (w,data(),p(),xaxis(),yaxis(),di(),tag,xm,ym,base)
   local res,n,j,color,xa,xb,ya,yb,h_interval,k,row_width,start,m,q
   res = lineattributes(w,1,p(LWGR),0,0)
   res = settag(tag,0)
   res =group(w)
   n = p(ROWS)
   k = p(COLUMNS)-1
   
   h_interval = yaxis(LENGTHA) / n
   if p(GRAPHTYPE) = STACKED_HORIZONTAL_HISTOGRAM then
      row_width = h_interval * p(FRGR)/100
      for j = 0 to n-1
         q=0
         ya = ym+ (j+0.5) * h_interval-row_width/2
         yb = ya+row_width
         for m = 0 to k-1
            xa = xaxis(BA) + xaxis(AA) * q + base
            xb = xaxis(BA) + xaxis(AA) * (q+data(n-1-j,m+1))
            q = q+data(n-1-j,m+1)
            color = p(DCOLGR+m)
            res = draw_histo_box(w,xa,ya,xb,yb,color,p(TDGR),0)
         next m
      next j         
   else
      row_width = h_interval*p(FRGR)/(k*100)
      for j = 0 to n-1
      
         start = ym + j*h_interval + (100-p(FRGR))*h_interval/200
         for m=0 to k-1
            ya=start + row_width*m
            yb = ya+row_width
            xa = xm+base
            xb = xaxis(BA) + xaxis(AA) * data(n-1-j,m+1)
            color = p(DCOLGR+m)
            if xb > xa then
               res = draw_histo_box(w,xa,ya,xb,yb,color,p(TDGR),0)
            else
               res = draw_histo_box(w,xb,ya,xa,yb,color,p(TDGR),0)
            endif
         next m         
      next j
   endif   
   res = endgroup(w)
   =0
endmacro
  


rem : *******************************************************************
rem : this macro is called when the data for the vertical or stacked 
rem :vertical histogram has been arranged in a regular way in array data. 

macro CRM_v_histo_plot(data(),s,p(),v)

   local xaxis(PAXIS),yaxis(PAXIS),di(PDATA),kk(MDATA)
   local miny,maxy,flag
   local x_axis_height,y_axis_width
   local x_tag,y_tag,gr_tag,le_tag,base
   local j,k,res,w,hor_label_dims,ver_label_dims,q
   local data_up,data_right,data_height,data_width
   local dsc,dsp,stacked
   local has_legend
   local has_tag,bitmap
   local has_top_label,divisor
   local xsm_dump,ysm_dump
   has_tag = 0
               rem find max and min values in both axes
   stacked = (p(GRAPHTYPE) = STACKED_VERTICAL_HISTOGRAM)
   divisor = if stacked then 1 else p(COLUMNS-1) endif
   has_top_label = ((len(p(YLABELS)) > 0) and (p(COLUMNS) = 2))
   gr_tag = psexsub(v)
   has_legend = 0
   bitmap =  LINE_EFFECTS+TEXT_EFFECTS+GRAPH_COLOUR_ALLOWED+THREE_DEE_ALLOWED+COLOURS_ALLOWED+BAR_WIDTH_ALLOWED+DIMENSIONS_ALLOWED  
   if p(GRAPHTYPE) = LINE_HISTO then bitmap = LINE_EFFECTS+GRAPH_COLOUR_ALLOWED+COLOURS_ALLOWED+POINT_DETAILS_ALLOWED+DIMENSIONS_ALLOWED                                         rem open window
   res = settag(gr_tag,bitmap)
   w = gstart(p(PWGR),p(PHGR))
                                        rem find data minima and maxima
   if stacked then
          rem : for a stacked histgram the minimum must be 0. Also
          rem : negative values are not allowed
      miny = 0
      maxy=0
      for j = 0 to p(ROWS)-1
         q=0
         for k = 1 to p(COLUMNS)-1
             if data(j,k) < 0 then
               = "Negative value in stacked histogram"
             endif
             q=q+data(j,k)
         next k
         if q > maxy then maxy = q
      next j    
   else
      miny = data(0,1)
      maxy = data(0,1)
      for j = 0 to p(ROWS)-1
            for k = 1 to p(COLUMNS)-1
            if data(j,k) > maxy then maxy = data(j,k)
            if data(j,k) < miny then miny = data(j,k)
         next k
      next j
      if miny = maxy then
             if maxy > 0 then miny = 0: maxy = 1.2 * maxy
             if maxy < 0 then miny = 1.2*miny: maxy = 0
             if maxy=0 then maxy = 1
      endif
      if maxy > 0 and miny > 0 then 
          miny = 0
          base = 0
      endif
   endif    
   if (p(COLUMNS) >= 3) and (len(p(YLABELS)) > 0 )then  
                 rem look for a legend substring
      has_legend = 1
      xsm_dump=0
      ysm_dump=0
      res = CRM_close_string(v)
      v = CRM_find_substring(s,"F")
      if (v = -1) then 
                  rem legend 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)
          has_tag = 1
      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 extract x-axis data
   res = psstep(v)
   if iserror(res) then = res
   if res<> CRM_code("B") then = "Missing B() Parameter"
   x_tag = psexsub(v)
   res = CRM_get_ax_params(p,xaxis,v)
                                      rem   Now extract y-axis data
   res = psstep(v)
   if iserror(res) then = res
   if res<> CRM_code("C") then = "Missing C() Parameter"
   y_tag = psexsub(v)
   res = CRM_get_ax_params(p,yaxis,v)
                                                     rem set limits
   if yaxis(LOA) = (-1) or yaxis(LOA) > miny then yaxis(LOA) = miny
   if yaxis(UPA) = (-1) or yaxis(UPA) < maxy then yaxis(UPA) = maxy
   if (has_legend) then 
       res = CRM_size_of_legend(w,p,kk,p(GRAPHTYPE))
       if kk(XSM) = 0 then
            kk(XSM) = p(PWGR) - p(ORGR)-p(IRGR) - kk(XEM)
            kk(YSM) = p(PHGR)/2 - kk(YEM)/2
       endif
   else
       kk(XEM) = 0
       kk(YEM) = 0
   endif
                rem now plan layout using dummy width for x-axis and
                rem dummy height for y-axis

   xaxis(WIDTHA) = p(PWGR)-p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-200 - kk(XEM)
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)-200
   p(THICKNESSGR) = 0
   if p(TDGR) then p(THICKNESSGR) = xaxis(WIDTHA)*p(FRGR)*0.01/ (p(ROWS)*divisor)
      res = CRM_plan_horizontal_histo_axis(w,xaxis,p,data)
   if type(res)=3 then =res
   res = CRM_plan_vertical_axis(w,yaxis,p) 
   if type(res) = 3 then =res
                           rem now compute sheet geography correctly
                           rem get true values for width and height
   xaxis(WIDTHA) = p(PWGR)-p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-yaxis(WIDTHA)-kk(XEM)
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)-xaxis(HEIGHTA)
   data_right = yaxis(WIDTHA)+p(OLGR)+p(ILGR)+xaxis(HOTXA)
   data_up = xaxis(HEIGHTA)+p(OBGR)+p(IBGR)+yaxis(HOTYA)
   data_width = p(PWGR) -p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-data_right-0.33*p(THICKNESSGR)
   if kk(XEM) > 0 then data_width = data_width -20 -kk(XEM)
   data_height = p(PHGR) -p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)- data_up
                            rem fill sheet with white
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR) - xaxis(HEIGHTA)
   xaxis(WIDTHA) = data_width
   res = CRM_plan_vertical_axis(w,yaxis,p) 
   if type(res) = 3 then =res
   res = box(w,0,0,p(PWGR),p(PHGR),p(MAGR))
                            rem draw background if not white
   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
  
   p(THICKNESSGR) = 0
   if p(TDGR) then p(THICKNESSGR) = xaxis(WIDTHA)*p(FRGR)*0.01/ (p(ROWS)*divisor)
   res = CRM_plan_horizontal_histo_axis(w,xaxis,p,data)
   if type(res) = 3 then =res
   res = CRM_draw_horizontal_histo_axis(w, data_right,data_up,xaxis,p,data,x_tag,yaxis(LENGTHA))
   if type(res) = 3 then =res
   res = CRM_draw_vertical_axis(w,data_right,0,data_up,yaxis,p,xaxis(WIDTHA),y_tag,has_top_label)
   if type(res) = 3 then =res
   base = yaxis(BA)-data_up        
   res = CRM_get_di_default_params(p,di,dsc)
   res = plot_vertical_histo(w,data,p,xaxis,yaxis,di,res,data_right,data_up,base)
   if has_legend then 
      if xsm_dump > 0 then kk(XSM) = xsm_dump
      if ysm_dump > 0 then kk(YSM) = ysm_dump
      if has_tag = 0 then le_tag = "F(X"cat kk(XSM) cat "Y" cat kk(YSM) cat ")"
      res = CRM_draw_legend(w,p,kk,le_tag,p(GRAPHTYPE))
   endif
   res = CRM_close_string(v)
   res = CRM_tail_end(w,s,p)
   if res then =res     
=w                 
endmacro

rem : *******************************************************************
rem : this macro is called when the data for the horizontal or stacked 
rem : horizontal histogram has been arranged in a regular way in array data. 

macro CRM_h_histo_plot(data(),s,p(),v)

   local xaxis(PAXIS),yaxis(PAXIS),di(PDATA),kk(MDATA)
   local miny,maxy,flag
   local x_axis_height,y_axis_width
   local x_tag,y_tag,gr_tag,le_tag,base
   local j,k,res,w,hor_label_dims,ver_label_dims,q
   local data_up,data_right,data_height,data_width
   local dsc,dsp,stacked
   local has_legend,dump,has_tag
   local has_top_label,divisor
   has_tag = 1 
               rem find max and min values in both axes
   stacked = (p(GRAPHTYPE) = STACKED_HORIZONTAL_HISTOGRAM)
   divisor = if stacked then 1 else p(COLUMNS)-1 endif
   has_top_label = ((len(p(YLABELS)) > 0) and (p(COLUMNS) = 2))
   gr_tag = psexsub(v)
   has_legend = 0
                                        rem open window
   res = settag(gr_tag, LINE_EFFECTS+TEXT_EFFECTS+GRAPH_COLOUR_ALLOWED+THREE_DEE_ALLOWED+COLOURS_ALLOWED+BAR_WIDTH_ALLOWED+DIMENSIONS_ALLOWED)
   w = gstart(p(PWGR),p(PHGR))
                                        rem find data minima and maxima
   if stacked then
          rem : for a stacked histgram the minimum must be 0. Also
          rem : negative values are not allowed
      miny = 0
      maxy=0
      for j = 0 to p(ROWS)-1
         q=0
         for k = 1 to p(COLUMNS)-1
             if data(j,k) < 0 then
               = "Negative value in stacked histogram"
             endif
             q=q+data(j,k)
         next k
         if q > maxy then maxy = q
      next j    
   else
      miny = data(0,1)
      maxy = data(0,1)
      for j = 0 to p(ROWS)-1
            for k = 1 to p(COLUMNS)-1
            if data(j,k) > maxy then maxy = data(j,k)
            if data(j,k) < miny then miny = data(j,k)
         next k
      next j
      if miny = maxy then
             if maxy > 0 then miny = 0: maxy = 1.2 * maxy
             if maxy < 0 then miny = 1.2*miny: maxy = 0
             if maxy=0 then maxy = 1
      endif
      if maxy > 0 and miny > 0 then 
          miny = 0
          base = 0
      endif
   endif    
   if (p(COLUMNS) >= 3) and (len(p(YLABELS)) > 0 )then  
                 rem look for a legend substring
      has_legend = 1
      res = CRM_close_string(v)
      v = CRM_find_substring(s,"F")
      if (v = -1) then 
                  rem legend 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)
          has_tag = 1
      endif
      v = psregister(s)
      res = psstep(v)
   endif   
                             rem   Now extract x-axis data
   res = psstep(v)
   if iserror(res) then = res
   if res<> CRM_code("B") then = "Missing B() Parameter"
   x_tag = psexsub(v)
   res = CRM_get_ax_params(p,xaxis,v)
                                      rem   Now extract y-axis data
   res = psstep(v)
   if iserror(res) then = res
   if res<> CRM_code("C") then = "Missing C() Parameter"
   y_tag = psexsub(v)
   res = CRM_get_ax_params(p,yaxis,v)
                                                     rem set limits
   if xaxis(LOA) = (-1) then xaxis(LOA) = miny
   if xaxis(UPA) = (-1) then xaxis(UPA) = maxy
   if xaxis(LOA) = (-1) then xaxis(LOA) = miny
   if (has_legend) then 
       res = CRM_size_of_legend(w,p,kk,p(GRAPHTYPE))
       if kk(XSM) = 0 then
           kk(XSM) = p(PWGR) - p(ORGR)-p(IRGR) - kk(XEM)
           kk(YSM) = p(PHGR)/2 - kk(YEM)/2
       endif
   else
       kk(XEM) = 0
       kk(YEM) = 0
   endif
                rem now plan layout using dummy width for x-axis and
                rem dummy height for y-axis

   xaxis(WIDTHA) = p(PWGR)-p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-200 - kk(XEM)
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)-200
   p(THICKNESSGR) = 0
   if p(TDGR) then p(THICKNESSGR) = yaxis(HEIGHTA)*p(FRGR)*0.01/ (p(ROWS)*divisor)
      res = CRM_plan_vertical_histo_axis(w,yaxis,p,data)
   if type(res) = 3 then =res
   res = CRM_plan_horizontal_axis(w,xaxis,p) 
   if type(res) = 3 then =res

                           rem now compute sheet geography correctly
                           rem get true values for width and height
   xaxis(WIDTHA) = p(PWGR)-p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-yaxis(WIDTHA)-kk(XEM)
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)-xaxis(HEIGHTA)
   data_right = yaxis(WIDTHA)+p(OLGR)+p(ILGR)+xaxis(HOTXA)
   data_up = xaxis(HEIGHTA)+p(OBGR)+p(IBGR)+yaxis(HOTYA)
   data_width = p(PWGR) -p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR) - data_right
   if kk(XEM) > 0 then data_width = data_width -20 -kk(XEM)
   data_height = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR) - data_up-0.55*p(THICKNESSGR)
                            rem fill sheet with white
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR) - xaxis(HEIGHTA)
   xaxis(WIDTHA) = data_width
   res = CRM_plan_vertical_histo_axis(w,yaxis,p,data) 
   res = box(w,0,0,p(PWGR),p(PHGR),p(MAGR))
                            rem draw background if not white
   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

   p(THICKNESSGR) = 0
   if p(TDGR) then p(THICKNESSGR) = yaxis(HEIGHTA)*p(FRGR)*0.01/ (p(ROWS)*divisor)
   res = CRM_plan_vertical_histo_axis(w,yaxis,p,data)
   if type(res) = 3 then =res

   dump = p(XLABEL)
   p(XLABEL) = p(YLABELS) 
   res = CRM_draw_horizontal_axis(w,data_right,data_up,0,xaxis,p,yaxis(LENGTHA),x_tag,0)
   p(XLABEL) = dump
   res = CRM_draw_vertical_histo_axis(w, data_right,data_up,yaxis,p,data,y_tag,xaxis(LENGTHA))
   base = xaxis(BA)-data_right        
   res = CRM_get_di_default_params(p,di,dsc)
              
   res = plot_horizontal_histo(w,data,p,xaxis,yaxis,di,res,data_right,data_up,base)
   if type(res) = 3 then =res
   
   if has_legend then res = CRM_draw_legend(w,p,kk,le_tag,p(GRAPHTYPE))
   res = CRM_close_string(v)
   res = CRM_tail_end(w,s,p)
   if res then =res
    =w                 
endmacro



rem : *****************************************************************
rem : This is the high-level macro called to plot all histograms

macro all_histograms(a(),s,type)
   local v,q,n,res,h,w,j,z
   local p(PSIZE)

   v = psregister(s)
   q = psstep(v)
   if iserror(q) then = q
   if q<> CRM_code("A") then = "Missing parameter substring"

   res = CRM_get_gr_params(p,v)
   p(GRAPHTYPE)=type
   h = first(a)
   w = second(a)
   n = CRM_datasets(v,w,h)

  if pscontains(v,"u") then 
      res = CRM_point_plot_row_data(a,s,v,p,w,n,1)
   else 
      res = CRM_point_plot_col_data(a,s,v,p,h,n,1)
   endif
   q= CRM_close_string(v)
   = res
endmacro


rem : *****************************************************************
rem : This is the high-level macro called to plot a vertical histogram

macro vertical_histogram(a(),s)
graphmacro "Vertical histogram",0x19F7,""
   = all_histograms(a,s,VERTICAL_HISTOGRAM)
endmacro


rem : *****************************************************************
rem : This is the high-level macro called to plot a stacked vertical 
rem : histogram

macro s_v_h(a(),s)
graphmacro "Stacked vertical histogram",0x19F7,""
   = all_histograms(a,s,STACKED_VERTICAL_HISTOGRAM)
endmacro


rem : *****************************************************************
rem : This is the high-level macro called to plot a horizontal histogram

macro horizontal_histogram(a(),s)
graphmacro "Horizontal histogram",0x19F7,""
   = all_histograms(a,s,HORIZONTAL_HISTOGRAM)
endmacro


rem : *****************************************************************
rem : This is the high-level macro called to plot a stacked
rem : horizontal histogram

macro stacked_horizontal_histogram(a(),s)
graphmacro "Stacked horizontal histo",0x19F7,""
   = all_histograms(a,s,STACKED_HORIZONTAL_HISTOGRAM)
endmacro

rem : *****************************************************************
rem : This is the high-level macro called to plot a line histogram


macro Line_histogram(a(),s)
graphmacro "Line histogram",0x19F7,""
   = all_histograms(a,s,LINE_HISTO)
endmacro


REM LEGENDS


rem : *******************************************************************
rem : General comments on legends

rem : A legend key serves to identify the various symbols used on a graph. 
rem : Legend keys are boxed rows of items, where each item consists of
rem : a symbol , a colon and a word.

rem : The symbol can be a short segment of line,  a marker or a 
rem : box of colour, depending on the
rem : type of graph.

rem : This module contains two groups of functions:

rem : 1.  For planning purposes, it is essential to know the width and 

rem : height of the legend box.  We use macro
rem :      size_of_legend

rem :      this macro takes four parameters:
rem :      *   The current window handle
rem :      *   The graph descriptor array   
rem :      *   The legend descriptor array          
rem :      *   The graph type - LINES_ONLY, POINTS_ONLY,LINES_AND_POINTS
rem :      *    or BOXES           
rem :      The legend descriptor array needs only the text parameters to 
rem :      be filled in

rem : 2.   Eventually the legend box must be drawn.  Again the function
rem :      provided is:
rem :       
rem :      draw_legend


rem :      this macros takes four parameters:
rem :      *   The current window handle
rem :      *   The graph descriptor array   
rem :      *   The legend descriptor array          
rem :      *   The graph type

rem : ******************************************************************
rem : size of legend.  This function calculates the size of the
rem : marker legend and leaves it in k(XEM,k(YEM) 
macro CRM_size_of_legend(w, p(), k(),type )
   local width , n, q,res,t,h,v
                        rem find width of widest legend
   width = 0
   for n = 0 to p(COLUMNS) -2
       res = CRM_finddims(w,k,p(YLABELS+n))
       t = CRM_extract(res,"x=")
       if t > width then width = t
   next n
                        rem :  + 3 * character height+20
   h =  width + 20  + 3 * k(FSM)*k(FAM)/100 
                        rem : If marker to be shown add its size; else 20
   if type = POINTS_ONLY or type = LINES_AND_POINTS then
       h = h + 2*k(MSM)
   else
       h=h+20
   endif        
                             
                        rem find vertical size. Take larger of text,marker
   v =  k(FSM)
   if  (type = POINTS_ONLY or type = LINES_AND_POINTS) and v < k(MSM) then 
      v = k(MSM)
   endif    
   v = 2*v* (p(COLUMNS)-1) + 10
   k(XEM) = h
   k(YEM)=v
   = 0
endmacro
     

rem : ***********************************************************
rem : draw_legend.  This macro draws the legend, starting
rem : at k(XSM) and k(YSM).
macro CRM_draw_legend(w, p(),k(),tag,type)
   local res,n, text_height, v, sign_offset,text,color
   local datapoints(1,1)
   on_error_exit
             rem draw enclosing box
   res = font(w,k(FOM),k(FSM),k(FSM)*k(FAM)/100)
   res = settag(tag,SELECT_ALLOWED+DRAG_ALLOWED+TEXT_EFFECTS+DELETE_ALLOWED+REDRAW_NEEDED)
   res = group(w)
   if k(NSM) = 1 then
      res = box(w,1,1,1,1,p(BGGR)):  rem dummy 
   else
       res = lineattributes(w,k(PSM),k(LWM),k(LCM),k(PDM))     
       res = box(w,k(XSM)-12,k(YSM),k(XEM),k(YEM),0xffffff00)
    
       text_height = 10 + k(YSM)
       v =  2*k(FSM)
       if  (type = POINTS_ONLY or type = LINES_AND_POINTS) and v < 2*k(MSM) then 
          v = 2*k(MSM)
       endif    
       
       for n = 0 to p(COLUMNS)-2
           
          datapoints(0,0) = k(XSM)+10
          datapoints(1,0) = text_height+k(FSM)/2
          if type = LINES_ONLY then
             res=lineattributes(w,1,2048,k(MCM+3*n),0)
             res=line(w,datapoints(0,0)-10,datapoints(1,0),40,0)
          endif   
          if type = POINTS_ONLY or type = LINES_AND_POINTS then
             res=lineattributes(w,p(LWGR),0,0,0)
             res = polymarker( w, datapoints,1,k(MTM+3*n),k(MSM+3*n),k(MCM+3*n))
          endif
          if type = LINE_HISTO or type = VERTICAL_HISTOGRAM  or type = HORIZONTAL_HISTOGRAM  or type = STACKED_VERTICAL_HISTOGRAM or type = STACKED_HORIZONTAL_HISTOGRAM then
             color = p(DCOLGR+n)
             res = lineattributes(w,1,p(LWGR),color,0)
             res = box (w,datapoints(0,0)-10,datapoints(1,0)-10, 2.2*k(FSM),1.7*k(FSM),color)
          endif    
          text = "  " cat p(YLABELS+n)
          res = string(w,k(XSM)+10+k(MSM), text_height,text,0,p(BGGR))
          
          text_height = text_height + v
       next n
   endif
   res = endgroup(w)
   =0
endmacro

REM LINEPOINT
                

rem : ********************************************************************
rem : macro CRM_plot_point_set plots a data set in a line plot or
rem : scatter diagram. w is the window, data the normalised data block,
rem : p, xaxis, yaxis and di are the inherited parameters, dsc is the
rem : data set number.
macro CRM_plot_point_set (w,data(),p(),xaxis(),yaxis(),di(),dsc)
   local k,res,color,kk,xc,yc,zc
   local z(1,p(ROWS))
   local c(1,4)
   kk=0
           rem : first assemble data set from array data and scale
   for k=0 to p(ROWS)-1
     if (type(data(k,0)) < 3 and type(data(k,dsc)) < 3) then 
        if xaxis(LGA) = 0 then 
            z(0,kk) = data(k,0) * xaxis(AA) + xaxis(BA)
        else 
            z(0,kk) = log(data(k,0)) * xaxis(AA) + xaxis(BA)
        endif
        if yaxis(LGA) = 0 then
             z(1,kk) = data(k,dsc) * yaxis(AA) + yaxis(BA)
        else
             z(1,kk) = log(data(k,dsc)) * yaxis(AA) + yaxis(BA)
        endif
        kk=kk+1
     endif
   next k
   if p(THICKNESSGR) <> 0 then
      zc = p(THICKNESSGR)/(p(COLUMNS)-1)
      xc = (p(COLUMNS)-1-dsc) * 0.33*zc
      yc = (p(COLUMNS)-1-dsc) * 0.55*zc
      for k = 0 to p(ROWS)-1
         z(0,k) = z(0,k)+xc
         z(1,k)=z(1,k)+yc
      next k
   endif
   if (kk < 2) then = "Too few points to plot"
   res = lineattributes(w,1,p(LWGR),di(LCD),0)
   if ( (p(GRAPHTYPE) <> POINTS_ONLY) and (p(THICKNESSGR) <> 0)) then
       res = group(w)
       for k = 0 to p(ROWS)-2
          c(0,0) = z(0,k)
          c(1,0) = z(1,k)
          c(0,1) = z(0,k+1)
          c(1,1) = z(1,k+1)
          c(0,2) = c(0,1)+ 0.33*zc
          c(1,2) = c(1,1)+0.55*zc
          c(0,3) = c(0,0) + 0.33*zc
          c(1,3) = c(1,0)+0.55*zc
          res = poly(w,c,4,di(LCD))
       next k
       res = lineattributes(w,1,p(LWGR),0,0)         
       res = openpoly(w,z,kk)
       res = endgroup(w)
       =res  
   endif   

   res = group(w)
   if p(GRAPHTYPE) <> POINTS_ONLY then res = openpoly(w,z,kk)
   if p(GRAPHTYPE) <> LINES_ONLY then
   res = polymarker(w,z,kk,di(MTD),di(MSD),di(MCD))
   endif
   res = endgroup(w)
   =res
endmacro



rem : this macro is called when the data for the point-plot
rem : has been arranged in a regular way in array data. 

macro CRM_point_plot_x(data(),s,p(),v)

   local xaxis(PAXIS),yaxis(PAXIS),di(PDATA),kk(MDATA)
   local minx,maxx,miny,maxy,flag
   local x_axis_height,y_axis_width
   local x_tag,y_tag,gr_tag,le_tag
   local j,k,res,w,hor_label_dims,ver_label_dims
   local data_up,data_right,data_height,data_width
   local dsc,dsp,sss,ttt
   local has_legend
   local has_top_label
   local bitmap 
               rem find max and min values in both axes
   p(THICKNESSGR) = p(THICKNESSGR) * (p(COLUMNS)-1)
   has_top_label = ((len(p(YLABELS)) > 0) and (p(COLUMNS) = 2))
   gr_tag = psexsub(v)
   has_legend = 0
   bitmap = LINE_EFFECTS+TEXT_EFFECTS+GRAPH_COLOUR_ALLOWED+GRID_ALLOWED+COLOURS_ALLOWED+TICKS_ALLOWED+DIMENSIONS_ALLOWED 
   if p(GRAPHTYPE) = LINES_AND_POINTS  then 
           bitmap = bitmap + POINT_DETAILS_ALLOWED
   endif
   if p(GRAPHTYPE) = POINTS_ONLY then
           bitmap=bitmap+POINT_DETAILS_ALLOWED
   endif
   bitmap=bitmap + 0x40
   res = settag(gr_tag,bitmap)
   w = gstart(p(PWGR),p(PHGR))
                                       rem find data minima and maxim
   minx=data(0,0)
   maxx=data(0,0)
   miny = data(0,1)
   maxy = data(0,1)
   for j = 0 to p(ROWS)-1
      if data(j,0) > maxx then maxx = data(j,0)
      if data(j,0) < minx then minx = data(j,0)
      for k = 1 to p(COLUMNS)-1
         if type(data(j,k)) = 3 then = "Bad data"
         if data(j,k) > maxy then maxy = data(j,k)
         if data(j,k) < miny then miny = data(j,k)
      next k
   next j
   sss = minx
   if minx = maxx then
       if sss > 0 then maxx = 2*minx : minx = 0
       if sss < 0 then minx = 2 * minx:maxx = 0
       if sss = 0 then  minx = -1 : maxx = 1
   endif
   sss = miny
   if miny = maxy then
       if sss > 0 then maxy = 2*miny : miny = 0
       if sss < 0 then miny = 2*miny : maxy = 0
       if sss = 0 then miny = -1 : maxy = 1
   endif
   if (p(COLUMNS) >= 3) and (len(p(YLABELS)) > 0 )then  
                 rem look for a legend substring
      has_legend = 1
      res = CRM_close_string(v)
      v = CRM_find_substring(s,"F")
      if (v = -1) then 
                  rem legend 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
      v = psregister(s)
      res = psstep(v)
   endif   
                             rem   Now extract x-axis data
   res = psstep(v)
   if iserror(res) then = res
   if res<> CRM_code("B") then = "Missing B() Parameter"
   x_tag = psexsub(v)
   res = CRM_get_ax_params(p,xaxis,v)                                     rem   Now extract y-axis data
   res = psstep(v)
   if iserror(res) then = res
   if res<> CRM_code("C") then = "Missing C() Parameter"
   y_tag = psexsub(v)
   res = CRM_get_ax_params(p,yaxis,v)
                                                     rem set limits
   if xaxis(LOA) = (-1) or xaxis(LOA) > minx then xaxis(LOA) = minx
   if xaxis(UPA) = (-1) or xaxis(UPA) < maxx then xaxis(UPA) = maxx
   if yaxis(LOA) = (-1) or yaxis(LOA) > miny then yaxis(LOA) = miny
   if yaxis(UPA) = (-1) or yaxis(UPA) < maxy then yaxis(UPA) = maxy

                rem now plan layout using dummy width for x-axis and
                rem dummy height for y-axis

   xaxis(WIDTHA) = 500
   yaxis(HEIGHTA) = 500
   res = CRM_plan_horizontal_axis(w,xaxis,p)
   if type(res) = 3 then =res
   res = CRM_plan_vertical_axis(w,yaxis,p) 
   if type(res) = 3 then =res
   if (has_legend) then 
       res = CRM_size_of_legend(w,p,kk,p(GRAPHTYPE))
       if kk(XSM) = 0 then
             kk(XSM) = p(PWGR) - p(ORGR)-p(IRGR)+20 - kk(XEM)
             kk(YSM) = p(PHGR)/2 - kk(YEM)/2
       endif
   else
       kk(XEM) = 0
       kk(YEM) = 0
   endif

                           rem now compute sheet geography correctly

   data_right = yaxis(WIDTHA)+p(OLGR)+p(ILGR)+xaxis(HOTXA)
   data_up = xaxis(HEIGHTA)+p(OBGR)+p(IBGR)+yaxis(HOTYA)
   data_width = p(PWGR) - p(ORGR)-p(IRGR) - data_right -0.33*p(THICKNESSGR)
   if kk(XEM) > 0 then data_width = data_width -40 -kk(XEM)
   data_height = p(PHGR) - p(OTGR)-p(ITGR)-p(OBGR)-p(IBGR) - data_up-0.55*p(THICKNESSGR)
                            rem fill sheet with white
   yaxis(HEIGHTA) = p(PHGR)- p(OTGR)-p(ITGR)-p(OBGR)-p(IBGR)- xaxis(HEIGHTA)
   xaxis(WIDTHA) = p(PWGR) - p(OLGR)-p(ILGR)-p(ORGR)-p(IRGR) - kk(XEM)-yaxis(WIDTHA)
   res = box(w,0,0,p(PWGR),p(PHGR),p(MAGR))
                            rem draw background if not white
   if p(BGGR) <> p(MAGR) then
       res = box(w,p(OLGR),p(OBGR),p(PWGR)-p(OLGR)-p(ORGR),p(PHGR)-p(OTGR)-p(OBGR),p(BGGR))
   endif
                  rem do it again to dispose of residual errors 
   res = CRM_plan_horizontal_axis(w,xaxis,p)
   res = CRM_plan_vertical_axis(w,yaxis,p)
   sss=0
   if maxy * miny < 0 then sss = yaxis(BA)
   ttt=0
   if maxx*minx < 0 then ttt = xaxis(BA)
   if xaxis(LGA) then
       res = CRM_draw_horlog_axis(w,data_right,data_up,sss,xaxis,p,yaxis(LENGTHA),x_tag)
   else
       res = CRM_draw_horizontal_axis(w,data_right,data_up,sss,xaxis,p,yaxis(LENGTHA),x_tag,xaxis(BA))
   endif
   if type(res) = 3 then =res
   if yaxis(LGA) then
        res = CRM_draw_verlog_axis(w,data_right,ttt,data_up,yaxis,p,xaxis(LENGTHA),y_tag,has_top_label)
   else
        res = CRM_draw_vertical_axis(w,data_right,ttt,data_up,yaxis,p,xaxis(LENGTHA),y_tag,has_top_label)
   endif  
   if type(res) = 3 then =res

   dsc = 1
   while dsc < p(COLUMNS) 
      res = CRM_get_di_default_params(p,di,dsc)
      if has_legend then
           kk(MTM+ 3*(dsc-1))= di(MTD)
           kk(MSM+3*(dsc-1)) = di(MSD)
           kk(MCM+3*(dsc-1)) = di(MCD)
       endif
       res = CRM_plot_point_set(w,data,p,xaxis,yaxis,di,dsc)
       if (type(res))=3 then =res
       dsc = dsc+1
   endwhile
   if has_legend then res = CRM_draw_legend(w,p,kk,le_tag,p(GRAPHTYPE))
   res=CRM_close_string(v)
   res = CRM_tail_end(w,s,p)
      if res then =res     
=w                 
endmacro


rem : *****************************************************************
rem : This is the high-level macro called to plot a line graph.
rem : In the absence of any DI substrings it plots all the datasets
rem : lines, with undecorated points.
rem : The graph may of course be post-edited to mark the points.
macro line_plot(a(),s)
graphmacro "Line plot",0x19FF,""
   local v,q,n,res,h,w,j
   local p(PSIZE)
   v = psregister(s)
   q = psstep(v)
   if iserror(q) then = q
   if q<> CRM_code("A") then = "Missing parameter substring"
   res = CRM_get_gr_params(p,v)
   p(GRAPHTYPE) = LINES_ONLY
   h = first(a)
   w = second(a)
   n = CRM_datasets(v,w,h)
   if n <= 1 then = "Graph can't be plotted"
   if pscontains(v,"u") then 
      res = CRM_point_plot_row_data(a,s,v,p,w,n,0)
   else
      res = CRM_point_plot_col_data(a,s,v,p,h,n,0)
   endif
   q= CRM_close_string(v)
   = res
endmacro


rem : *****************************************************************
rem : This is the high-level macro called to plot a scatter diagram.
rem : In the absence of any DI substrings it plots all the datasets
rem : as unconnected points.
rem : The graph may of course be post-edited to modify the points.
macro scatter_diagram(a(),s)
graphmacro "Scatter diagram",0x18FF,""
   local v,q,n,res,h,w,j
   local p(PSIZE)

   v = psregister(s)
   q = psstep(v)
   if iserror(q) then = q
   if q<> CRM_code("A") then = "Missing parameter substring"

   res = CRM_get_gr_params(p,v)
   p(GRAPHTYPE) = POINTS_ONLY
   h = first(a)
   w = second(a)
   n = CRM_datasets(v,w,h)
   if pscontains(v,"u") then 
      res = CRM_point_plot_row_data(a,s,v,p,w,n,0)
   else
      res = CRM_point_plot_col_data(a,s,v,p,h,n,0)
   endif
   q= CRM_close_string(v)
   = res
endmacro


rem : *****************************************************************
rem : This is the high-level macro called to plot a line graph marked
rem : with points.
rem : The graph may of course be post-edited to mark the points.
macro marked_lines(a(),s)
graphmacro "Marked lines",0x18FF,""
   local v,q,n,res,h,w,j
   local p(PSIZE)

   v = psregister(s)
   q = psstep(v)
   if iserror(q) then = q
   if q<> CRM_code("A") then = "Missing parameter substring"

   res = CRM_get_gr_params(p,v)
   p(GRAPHTYPE) = LINES_AND_POINTS
   h = first(a)
   w = second(a)
   n = CRM_datasets(v,w,h)
  if pscontains(v,"u") then 
      res = CRM_point_plot_row_data(a,s,v,p,w,n,0)
   else
      res = CRM_point_plot_col_data(a,s,v,p,h,n,0)
   endif
   q= CRM_close_string(v)
   = res
endmacro

REM PICTOPLOT

rem : *****************************************************
rem : This macro takes the maxumum count in any row or
rem : column and returns a scaling factor. For the interval
rem : 1-10 it is 1.
rem : for 10-20 it is 2. 21 to 40, 4; and 41 to 100, 10.
rem : for higher powers of 10 it is pro rata.

macro CRM_vertical_scale (x)
   local p,q
   if (x <=10) then =1
   p = 1
   while (x > 100)
      x = x/10
      p = 10*p
   endwhile
   if x <= 20 then =2*p
   if x <= 40 then = 5*p
   = 10*p
endmacro


 
macro CRM_plot_vertical_picto (w,data(),p(),xaxis(),yaxis(),di(),tag,xm,ym,base,vs)
   local res,n,j,color,xa,xb,ya,yb,h_interval,col_width,start,m,q,g
   local grlist(30)
   n = p(ROWS)
   g = fetchgraph(p(PIGR))
   if iserror(g) then ="Error in fetchgraph"
   for j = 0 to n-1
     grlist(j) = fetchgraph(data(j,0))
     if iserror(grlist(j))  then  grlist(j) = g
    next j
   h_interval = xaxis(WIDTHA) / n
   for j = 0 to n-1
      start = xm + (j+0.2)*h_interval
      m = 1
      while m <= data(j,1)/vs +0.5     
         yb = yaxis(BA) + yaxis(AA) * (m-0.8)*vs
         res = scaledpicture(w,grlist(j),start,yb,h_interval*0.7,yaxis(AA)*0.8*vs)
         m=m+1
      endwhile
   next j   
  =0
endmacro
  



rem : *******************************************************************
rem : this macro is called when the data for the vertical pictogram 
rem : has been arranged in a regular way in array data. Only the first
rem : two columns are used

macro CRM_picto_plot(data(),s,p(),v)

   local xaxis(PAXIS),yaxis(PAXIS),di(PDATA),kk(MDATA)
   local miny,maxy,flag
   local x_axis_height,y_axis_width
   local x_tag,y_tag,gr_tag,le_tag,base
   local j,k,res,w,hor_label_dims,ver_label_dims,q
   local data_up,data_right,data_height,data_width
   local dsc,dsp,vs
   local has_legend
   local has_top_label
   local xsm_dump,ysm_dump
               rem find max and min values in both axes
  
   has_top_label = len(p(YLABELS)) > 0
   gr_tag = psexsub(v)
   has_legend = 0
                  rem open window
   res = settag(gr_tag, LINE_EFFECTS+TEXT_EFFECTS+COLOURS_ALLOWED+GRAPH_COLOUR_ALLOWED+DIMENSIONS_ALLOWED)
   w = gstart(p(PWGR),p(PHGR))
                  rem find data minima and maxima
      miny = data(0,1)
      maxy = data(0,1)
      for j = 0 to p(ROWS)-1
            if data(j,1) > maxy then maxy = data(j,1)
            if data(j,1) < miny then miny = data(j,1)
      next j
      maxy = 1.1*maxy
      vs = CRM_vertical_scale(maxy)
      if (vs > 1) then
         if has_top_label then
            p(YLABELS) = p(YLABELS) cat "   One symbol stands for "cat vs cat " units."
         else
            has_top_label = 1
            p(YLABELS) = "  One symbol stands for " cat vs cat " units."
         endif 
      endif

      if miny = maxy then ="Bad vertical axis"
      if maxy > 0 and miny > 0 then 
          miny = 0
          base = 0
      endif
                             rem   Now extract x-axis data
   res = psstep(v)
   if iserror(res) then = "psstep failed"
   if res<> CRM_code("B") then = "Missing B() Parameter"
   x_tag = psexsub(v)
   res = CRM_get_ax_params(p,xaxis,v)
                rem   Now extract y-axis data
   res = psstep(v)
   if iserror(res) then = "psstep failed"
   if res<> CRM_code("C") then = "Missing C() Parameter"
   y_tag = psexsub(v)
   res = CRM_get_ax_params(p,yaxis,v)
                                                     rem set limits
   if yaxis(LOA) = (-1) or yaxis(LOA) > miny then yaxis(LOA) = miny
   if yaxis(UPA) = (-1) or yaxis(UPA) < maxy then yaxis(UPA) = maxy

       kk(XEM) = 0
       kk(YEM) = 0

                rem now plan layout using dummy width for x-axis and
                rem dummy height for y-axis

   xaxis(WIDTHA) = p(PWGR)-p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-200 - kk(XEM)
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)-200
      res = CRM_plan_horizontal_histo_axis(w,xaxis,p,data)
   if type(res)=3 then = "Plan horizontal axis failed"
   res = CRM_plan_vertical_axis(w,yaxis,p) 
   if type(res) = 3 then ="Plan vertical axis failed"
                           rem now compute sheet geography correctly
                           rem get true values for width and height
   xaxis(WIDTHA) = p(PWGR)-p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-yaxis(WIDTHA)-kk(XEM)
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)-xaxis(HEIGHTA)
   data_right = yaxis(WIDTHA)+p(OLGR)+p(ILGR)+xaxis(HOTXA)
   data_up = xaxis(HEIGHTA)+p(OBGR)+p(IBGR)+yaxis(HOTYA)
   data_width = p(PWGR) -p(OLGR)-p(ILGR)-p(IRGR)-p(ORGR)-data_right-0.33*p(THICKNESSGR)
   if kk(XEM) > 0 then data_width = data_width -20 -kk(XEM)
   data_height = p(PHGR) -p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR)- data_up
                            rem fill sheet with white
   yaxis(HEIGHTA) = p(PHGR)-p(OTGR)-p(ITGR)-p(IBGR)-p(OBGR) - xaxis(HEIGHTA)
   xaxis(WIDTHA) = data_width
   res = CRM_plan_vertical_axis(w,yaxis,p) 
   if type(res) = 3 then =res
   res = box(w,0,0,p(PWGR),p(PHGR),p(MAGR))
                            rem draw background if not white
   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
 
   p(THICKNESSGR) = 0
   res = CRM_plan_horizontal_histo_axis(w,xaxis,p,data)
   if type(res) = 3 then =res
   res = CRM_draw_horizontal_histo_axis(w, data_right,data_up,xaxis,p,data,x_tag,yaxis(LENGTHA))
   if type(res) = 3 then =res
   res = CRM_draw_vertical_axis(w,data_right,0,data_up,yaxis,p,xaxis(WIDTHA),y_tag,has_top_label)
   if type(res) = 3 then =res
   base = yaxis(BA)-data_up        
   res = CRM_get_di_default_params(p,di,dsc)
   res = CRM_plot_vertical_picto(w,data,p,xaxis,yaxis,di,res,data_right,data_up,base,vs)
   res = CRM_close_string(v)
   res = CRM_tail_end(w,s,p)
   if res then =res
   =w                 
endmacro


rem : *********************************************************
rem : This function plots a vertical pictogram
macro pictogram (a(),s)
graphmacro "Pictogram",0x1AF5," "
   local v,q,n,res,h,w
   local p(PSIZE)

   v = psregister(s)
   q = psstep(v)
   if iserror(q) then = "Error in pstep"
   if q<> CRM_code("A") then = "Missing parameter substring"

   res = CRM_get_gr_params(p,v)
   h = first(a)
   w = second(a)
   p(GRAPHTYPE)=PICTOGRAM
   n = CRM_datasets(v,w,h)
   if pscontains(v,"u") then
       res = CRM_point_plot_row_data(a,s,v,p,w,n,1)
   else
      res = CRM_point_plot_col_data(a,s,v,p,h,n,1)
   endif
   
   =res
endmacro


REM UTILITIES

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

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

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


rem : ******************************************************************
rem  : This macro finds the dimensions of the text t according to the
rem  : axis parameter z. The function returns a compound
rem  : string of the form x=nn,y=mm where both nn and mm are in OS-units 

rem macro finddims(w,z(),t)
rem    local x,y,res
rem    on_error_exit
rem    if len(t) = 0 then = "x=0 y=0"
rem    res  = font(w,z(FOA),z(FSA), int(z(FSA)*z(FAA)/100))
rem    x = textwidth(w,t) + z(FSA)/2
rem    y = textheight(w,t)
rem    = "x=" cat x cat "y=" cat y
rem endmacro



rem : ******************************************************************
rem  : This macro finds displays the text t according to the
rem  : axis parameter z. The function returns 0 

rem macro CRM_showlabel(w,z(),t,xs,ys)
rem    local res,x,y
rem    on_error_exit
rem    res  = font(w,z(FOA),z(FSA), int(z(FSA)*z(FAA)/100))
rem    res = string(w,xs,ys,t,z(TCA),0xffffff00)
rem    =0
rem endmacro


rem : ******************************************************************
rem : This macro is entered with a string in A and a two-letter
rem : code in B.  The macro searches a for an occurence of B.
rem : if found it returns the number which immediately follows 
rem : the occurence. 
rem :
rem : The macro is used to decode the result strings of macros which
rem : return several values (like  scale)

macro CRM_extract (a,b)
   local res
   on_error_exit
   res = find(a,b)
   =mid(a,res+2,res+35)+0.0
endmacro



rem:  *****************************************************************
rem:  X is a one-letter parameter code type code.  This function
rem:  returns asc(first letter)
rem:

macro CRM_code (x)
   = asc(x)
endmacro



rem : *****************************************************************
rem : This macro returns the (decimal) antilog of X.
rem : the constant is the natural log of 10

macro CRM_antilog (x)
   = exp(2.302585093 * x)
endmacro



rem : *****************************************************************
rem :  This macro calculates an appropriate linear scale for displaing
rem :  values in the range (SMALLEST to LARGEST) in a space of SIZE 
rem :  os-units.  The macro returns a string of the form 
rem :      a=aa b=bb i = ii l = ll h = hh      where    
rem :  aa and bb let any value be transformed to a display
rem :  coordinate according to the formula  x = aa*value + bb
rem :  ii gives the number of intervals on the axis
rem :  ll and hh are the lowest and highest plottable values
rem :  note that (ll - hh) encloses (smallest - largest)
rem :  if smallest and largest are the same the function returns "0:0"

macro CRM_linear_scale(smallest,largest,size)

   local dump,power,diff,span,lowest,highest,interval,a,b
   if (smallest = largest)  then 
         largest = smallest+0.45
         smallest = smallest - 0.45
   endif
        
   loop:
   diff = abs(largest-smallest)
   if (diff < 10e-50) then = "0:0"
                   rem : Establish scales to the nearest power of 10

   power=0
   while(diff >= 10)
       power=power+1
       diff=diff/10
   endwhile
   while(diff < 1)
       power=power-1
       diff=diff*10
   endwhile
   
                   rem : adjust scale by smaller factors

   if diff > 5 then span=10
   if diff <= 5 & diff > 2 then span = 5
   if diff <= 2 & diff > 1 then span = 2
   if diff = 1 then span = 1 
   span = span * (10^power)
   
   interval = span/10
   lowest = floor(smallest/interval) * interval
   highest = ceil(largest / interval) *interval
   a=size/(highest-lowest)
   b= -(lowest*a)
   = "a=" cat a cat "b=" cat b cat "i=" cat interval cat "l=" cat lowest cat "h=" cat highest 
endmacro



rem : **********************************************************************
rem : This macro calculates an appropriate logarithmic scale for displaying
rem : values in the range (SMALLEST to LARGEST) in a space of SIZE os_units.
rem : The axis always contains an integral number of decades.
rem : The macro returns a string of the form a=aa b=bb i = ii l = ll h = hh
rem : where    
rem : aa and bb let any value be transformed to a display
rem : coordinate according to the formula  x = aa*log(value) + bb
rem : ii gives the number of decades on the axis
rem : ll and hh are the lowest and highest plottable values
rem : note that (ll - hh) encloses (smallest - largest)
rem : If the scale cannot be drawn because smallest > largest or 
rem : smallest <= 0 the function returns "0:0"

macro CRM_log_scale(smallest,largest,size)
   local lowest, highest,aa,bb,ii,ll,hh
   on_error_exit
   if smallest >= largest  then ="0:0"
   if smallest <= 0 then ="0.0"
   lowest = floor(log(smallest))
   highest = ceil(log(largest))
   ii = highest - lowest
   ll = CRM_antilog(lowest)
   hh = CRM_antilog(highest)
   aa = size/ii
   bb = -lowest *aa
   = "a="cat aa cat"b="cat bb cat"i="cat ii cat"l="cat ll cat"h="cat hh 
endmacro



rem : *********************************************************************
rem : given a parameter string s and a two-letter code key, this
rem : function opens the string and tries to select the substring with
rem : the given key. If found it exits with a handle. If not, it returns -1
rem : Note that after the handle has been used the string must be closed by
rem : calling close_string

macro CRM_find_substring(s,key)
   local v,q
   v =  psregister(s)
   if iserror(v) then = v
   repeat 
       q = psstep (v)
       if iserror(q) then = -1
       if q = CRM_code(key) then = v
   until  q = 0 or iserror(q)
   = (-1)
endmacro



rem : ********************************************************************
rem : This function closes the string with current handle v
macro CRM_close_string(v)
   local q
   repeat
      q = psstep(v)
      if iserror(q) then = 0
   until q=0
   =0
endmacro



rem : ********************************************************************
rem  : This macro finds the dimensions of the text t according to the
rem  : parameter array indicated by p. The function returns a compound
rem  : string of the form x=nn,y=mm where both nn and mm are in OS-units 
macro CRM_finddims(w,p(),t)
   local res,x,y
   res  = font(w,p(FOA),p(FSA), int(p(FSA)*p(FAA)/100))
   x = textwidth(w,t) + p(FSA)/2
   y = textheight(w,t)
   = "x=" cat x cat "y=" cat y
endmacro


rem : ********************************************************************
rem  : This macro finds displays the text t at xs,ys according to the
rem  : parameter array indicated by p. The function returns 0 
macro CRM_showlabel(w,p(),t,xs,ys)
   local res
   res  = font(w,p(FOA),p(FSA), int(p(FSA)*p(FAA)/100))
   res = string(w,xs,ys,t,p(TCA),0xffffff00)
   =0
endmacro



rem : ********************************************************************
rem : Macro datasets is called with a control string registered
rem : at v.  It computes and returns the number of data sets
rem : making proper assumption for defaults
rem : The number is limited to 5

macro CRM_datasets(v, cols, rows)
   local n,u,p,s
   p = psexhex(v,"P",-1)
   u = pscontains(v,"u")
   n=0
   if pscontains(v,"Q") then n=n+1     
   if pscontains(v,"R") then n=n+1
   if pscontains(v,"S") then n=n+1
   if pscontains(v,"T") then n=n+1
   if pscontains(v,"U") then n=n+1
   if (p < 0 and n= 0) then
        s = if u then rows+1 else cols+1 endif
    endif
rem case 2:  x axis selected only. Take rest
    if (p>= 0 and n = 0) then
          s = if u then rows-p else cols-p endif
    endif
rem case 3  y_axes given (with or without x-axis)
    if (n > 0) then
          s = n+1
    endif
    = if s < 6 then s else 6 endif
endmacro

macro CRM_psexcol(v,s,def)
   local q
   q = psexhex(v,s,0xffffffff)
   if q = 0xffffffff then =def
   = q
endmacro

rem : **************************************************
rem : New colour handling code starts here.

macro crm_get_hex(a,b)
     rem gets a hex value from string a starting at position b
local x,y,z,w
z=0
for x = 0 to 5
  y = mid(a,b+x,b+x)
  if y >= "0" and y <= "9" then w = asc(y) - asc("0")
  if y >= "A" and y <= "F" then w = asc(y) - asc("A")+10
  if y >= "a" and y <= "f" then w = asc(y) - asc("a")+10
  z=(z<<4)  or w
next x
  =z<<8
endmacro

rem : *******************************************************************
rem : Macro get_gr_params scans a gr control substring and extracts
rem : values for FO,FC,FA,TC,LC,LW,PD,PS,BG,PW,PH,TD,OL,OT,OR,OB,IL,IT,IR,IB
macro CRM_get_gr_params(p(),v)
local q
    p(FOGR) = psexstr(v,"#","Trinity.Medium")
    p(FSGR) = psexdec(v,"H",12)
    p(FAGR) = psexhex(v,"I",100)
    p(TCGR) = CRM_psexcol(v,"J",0)
    p(LCGR) = CRM_psexcol(v,"L",0)
    p(LWGR) = psexhex(v,"M",0)
    p(PDGR) = psexhex(v,"N",1)
    p(PSGR) = psexhex(v,"O",0)
    p(PWGR) = psexhex(v,"i",800)
    p(PHGR) = psexhex(v,"j",600)
    q = psexhex(v,"g",0x05050505)
    p(OLGR) =  (q & 0xff000000) >> 22
    p(OTGR) =  (q & 0xff0000) >> 14
    p(ORGR) =  (q & 0xff00) >> 6
    p(OBGR) =  (q & 0xff) << 2

   q = psexhex(v,"h",0x05050505)
    p(ILGR) = (q & 0xff000000) >> 22
    p(ITGR) = (q & 0xff0000) >> 14
    p(IRGR) = (q & 0xff00) >> 6
    p(IBGR) = (q & 0xff) << 2
    p(TDGR) = pscontains(v,"W")
    p(BGGR) = psexstr(v,"@","no")
    if p(BGGR) ="no" then
           REM set default colours
          p(BGGR) = 0xECECEC00
          p(DCOLGR) = 0xA0A0A000
          p(DCOLGR+1) = 0xff0000
          p(DCOLGR+2) = 0xff00
          p(DCOLGR+3) = 0xff000000
          p(DCOLGR+4) = 0xffff0000
          p(MAGR) = 0xffffff00
       else
          p(DCOLGR) = crm_get_hex(p(BGGR),7)
          p(DCOLGR+1) = crm_get_hex(p(BGGR),13)
          p(DCOLGR+2) = crm_get_hex(p(BGGR),19)
          p(DCOLGR+3) = crm_get_hex(p(BGGR),25)
          p(DCOLGR+4) = crm_get_hex(p(BGGR),31)
          p(MAGR) = crm_get_hex(p(BGGR),37)
          p(BGGR) = crm_get_hex(p(BGGR),1)
    endif

    p(GRGR) = pscontains(v,"V")
    p(FRGR) = psexhex(v,"o",70)
    p(THICKNESSGR) = if p(TDGR)=0 then 0 else 28 endif
    p(MTGR) = psexhex(v,"q",1)
    p(MSGR) = psexhex(v,"r",20)
    p(PIGR) = psexstr(v,"$","blob")
    =0
endmacro



rem : *******************************************************************
rem: macro get_ax_params extracts axis parameters from an ax or ay
rem: control substring.
macro CRM_get_ax_params(p(),q(),v)
    q(FOA) = psexstr(v,"#",p(FOGR))
    q(FSA) = psexdec(v,"H",p(FSGR))
    q(FAA) = psexhex(v,"I",p(FAGR))
    q(TCA) = CRM_psexcol(v,"J",p(TCGR))
    q(LCA) = CRM_psexcol(v,"L",p(LCGR))
    q(LWA) = psexhex(v,"M",p(LWGR))
    q(STA) = psexhex(v,"t",0)
    q(LGA) = pscontains(v,"s")
    q(INA) = 0
    q(UPA) = psexdec(v,"v",-1)
    q(LOA) = psexdec(v,"w",-1)
    q(NSA) = pscontains(v,"G")
    =0
endmacro



rem : *******************************************************************
rem : macro get_di_params extracts data set parameters from a DI string
rem : macro CRM_get_di_params(p(),q(),v,type)
rem :     q(FOD) = psexstr(v,"#",p(FOGR))
rem :     q(FSD) = psexdec(v,"H",p(FSGR))
rem :     q(FAD) = psexhex(v,"I",p(FAGR))
rem :     q(TCD) = CRM_psexcol(v,"J",p(TCGR))
rem :     q(LWD) = psexhex(v,"L",p(LWGR))
rem :     q(LCD) = CRM_psexcol(v,"L",p(DCOLGR+type-1))
rem :     q(PDD) = psexhex(v,"N",p(PDGR))
rem :     q(PSD) = psexhex(v,"O",p(PSGR))
rem :     q(FCD) = CRM_psexcol(v,"K",0xffffff00)
rem :     q(MTD) = if p(MTGR)=0 then 0 else (p(MTGR)-2+type) %5 +1  endif
rem :     q(MSD) = psexhex(v,"r",p(MSGR))
rem :     q(MCD) = CRM_psexcol(v,"n",p(DCOLGR+type-1))
rem :     q(FRD) = psexhex(v,"o",75)
rem :     q(TDD) = pscontains(v,"W") or p(TDGR)
rem :     =0
rem : endmacro



rem : *******************************************************************
rem : macro get_di_default_params sets up a data set parameters if
rem : there is no DI string. The marker type is given as a parameter.
rem : It also returns a dummy string to be used as a tag
macro CRM_get_di_default_params (p(),q(),type)
    q(FOD) = p(FOGR)
    q(FSD) = p(FSGR)
    q(FAD) = p(FAGR)
    q(TCD) = p(TCGR)
    q(LWD) = p(LWGR)
    q(LCD) = p(DCOLGR+type-1)
    q(PDD) = p(PDGR)
    q(PSD) = p(PSGR)
    q(FCD) = 0xffffff00
    q(MTD) = if p(MTGR) = 0 then 0 else (p(MTGR)-2+type)%5+1  endif
    q(MSD) = p(MSGR)
    q(MCD) = p(DCOLGR+type-1)
    q(LCD) = q(MCD)
    q(FRD) = 75
    q(TDD) = p(TDGR)
    = "D(q" cat type cat ")"
endmacro


rem : *******************************************************************
rem : macro get_legend_params extracts legend parameters from a LE string
macro CRM_get_legend_params(p(),q(),v)
    q(FOM) = psexstr(v,"#",p(FOGR))
    q(FSM) = psexdec(v,"H",p(FSGR))
    q(FAM) = psexhex(v,"I",p(FAGR))
    q(TCM) = CRM_psexcol(v,"J",p(TCGR))
    q(LWM) = psexhex(v,"M",p(LWGR))
    q(LCM) = CRM_psexcol(v,"L",p(LCGR))
    q(PDM) = psexhex(v,"N",p(PDGR))
    q(PSM) = psexhex(v,"O",p(PSGR))
    q(MSM) = psexhex(v,"r",20)
    q(XSM) = psexdec(v,"X",0)
    q(YSM) = psexdec(v,"Y",0)
    q(NSM) = pscontains(v,"G")
    =0
endmacro



rem : *******************************************************************
rem : macro get_legend_default_params sets up legend parameters if
rem : there is no LE string. 
rem : It also returns a dummy string to be used as a tag
macro CRM_get_legend_default_params (p(),q())
    q(FOM) = p(FOGR)
    q(FSM) = p(FSGR)
    q(FAM) = p(FAGR)
    q(TCM) = p(TCGR)
    q(LWM) = p(LWGR)
    q(LCM) = p(LCGR)
    q(PDM) = p(PDGR)
    q(PSM) = p(PSGR)
    q(MSM) = 20
    q(XSM) = 0
    q(YSM) = 0
    q(NSM)=0

    = "F()"
endmacro



rem : ******************************************************************
rem : handle_text looks after a text sub-string. W is the current window, 
rem : V is the handle to the parameter substring, and T is the text to be
rem : used by default if the parameter substring holds no text
rem :
rem : The parameter string MUST include  XS,YS (position) and FS 
rem : (character size) fields.
rem : It MAY include TC (text colour), FA (aspect ratio) AL (alignment) 
rem :FO(font) and TT (text to be used instead of default text T)
macro CRM_handle_text (w,v,t,p())

   local xs, ys, bg,fs,tc,fc,fa,al,fo, tt,res,width,substring
   rem extract parameters and put in defaults
   xs = psexdec(v,"X",0)
   ys = psexdec(v,"Y",0)
   fs = psexdec(v,"H",0)
   if (xs = 0 or ys = 0 or fs = 0) then =0

   tc = CRM_psexcol(v,"J",0)
   fc = CRM_psexcol(v,"k",p(BGGR)) 
   fa = psexhex(v,"I",100)
   al = psexhex(v,"p",0)
   tt = psexstr(v,"&",t)
   fo = psexstr(v,"#","Trinity.Medium")
   res = font(w,fo,fs, int(fs*fa/100))
   if (al > 0) then
      width = textwidth(w,tt)
      if al = 1 then xs = xs - width/2
      if al = 2 then xs=xs-width
   endif
   if xs < 0 then xs = 0
   if ys < 0 then ys = 0
   substring = psexsub(v)
   res  = res or settag(substring,DRAG_ALLOWED+SELECT_ALLOWED+TEXT_EFFECTS)
   res = res or string(w,xs,ys,tt,tc,fc)
   =res
endmacro


rem : ********************************************************************
rem : Handles a solid sub-string. W is the current window, V is the handle 
rem : to the parameter substring.
rem : The substring MUST include XS,YS (position) , XY,YE (extent) and FC 
rem : (colour)
rem : It may include LC (line colour) and LW (line thickness)
macro CRM_handle_solid (w,v,flag)

   local xs, ys, xe,ye,fc,lw,lc,substring,res
   rem extract parameters and put in defaults
   xs = psexdec(v,"X",0)
   ys = psexdec(v,"Y",0)
   xe = psexdec(v,"x",0)
   ye = psexdec(v,"y",0)
   fc = CRM_psexcol(v,"K",(-1))
   if (xs = 0 or ys = 0 or ye=0 or xe = 0) then =0
   lc = CRM_psexcol(v,"L",fc)
   lw = psexhex(v,"M",0)
   substring = psexsub(v)
   res = res or settag(substring,DRAG_ALLOWED+SELECT_ALLOWED+FILL_EFFECTS)
   res = res or lineattributes(w,1,lw,lc,0x14)
   if flag = CRM_code("b") then
       res = res or box(w,xs,ys,xe,ye,fc)
   endif
   if flag = CRM_code("f") then
      res = res or ellipse(w, xs+xe/2,ys+ye/2,0,360,xe/2,ye/2,0,fc)
   endif
   if flag = CRM_code("c") then
      res = res or arc(w,xs+xe/2,ys+ye/2,0,360,xe/2,fc)
   endif
   =res
endmacro

rem : *****************************************************************
rem : Handles a line sub-string. W is the current window, W is the 
rem : handle to the parameter substring
rem : The string MUST include XS,YS (position) and XY,YE (extent) 
rem : It may include LC(line colour),LW (line thickness) PD (dots and 
rem : dashes) and PS (Path style)
macro CRM_handle_line (w,v)

   local xs, ys, xe,ye,lw,lc,ps,pd,substring,res
   rem extract parameters and put in defaults
   xs = psexdec(v,"X",0)
   ys = psexdec(v,"Y",0)
   xe = psexdec(v,"x",0)
   ye = psexdec(v,"y",0)
   if (xs = 0 or ys = 0 or ye=0 or xe = 0) then =0
   lc = CRM_psexcol(v,"L",0)
   lw = psexhex(v,"M",1)
   ps = psexhex(v,"O",0)
   pd = psexhex(v,"N",0)
   substring = psexsub(v)
   res = res or settag(substring, DRAG_ALLOWED+SELECT_ALLOWED+LINE_EFFECTS)
   res = res or lineattributes(w,pd,lw,lc,ps)
   res = res or line(w,xs,ys,xe,ye)
   =res
endmacro


rem : *****************************************************************
rem : Handles a drawfile. W is the current window, V is the 
rem : handle to the parameter substring
rem : The string MUST include X,Y (position) and $ (file name).
rem : It may include x,y (extent) and A (picture type)
macro CRM_handle_drawfile (w,v)

   local xs, ys, xe,ye,fn,ft,res,k,substring
   rem extract parameters and put in defaults
   xs = psexdec(v,"X",0)
   ys = psexdec(v,"Y",0)
   xe = psexdec(v,"x",100)
   ye = psexdec(v,"y",100)
   fn = psexstr(v,"$","blob")
   ft = psexhex(v,"A",0)
   substring = psexsub(v)
   res = res or settag(substring, DRAG_ALLOWED+SELECT_ALLOWED)
   k = fetchgraph(fn)
   if ft = 0 then res = picture(w,k,xs,ys)
   if ft=1 then res = scaledpicture(w,k,xs,ys,xe,ye)
   if ft=2 then res = squeezedpicture(w,k,xs,ys,xe,ye)   
   =res
endmacro

rem : ******************************************************
rem : This macro handles all the tail-end substrings at the
rem : end of a parameter string. s is the string parameter
rem : The string is assumed to be unregistered at the 
rem : moment of entry
rem : recent object read
macro CRM_tail_end (w,s,p())
   local v,j,flag
   v = psregister(s)
   flag = psstep(v)
   while (flag > 0)
      if flag = CRM_code("e")  j=CRM_handle_text(w,v,"NULL",p)
      if flag = CRM_code("b")  j= CRM_handle_solid(w,v,flag)
      if flag = CRM_code("a")  j= CRM_handle_line(w,v)
      if flag = CRM_code("f")  j = CRM_handle_solid(w,v,flag)
      if flag = CRM_code("c")  j = CRM_handle_solid(w,v,flag)
      if flag = CRM_code("d")  j = CRM_handle_drawfile(w,v)
      flag = psstep(v)
   endwhile
   = flag
endmacro

rem : ********************************************************************
rem : macro point_plot_row_data is entered with an array a in which the data
rem : sets are in rows and may not be contiguous.  The data set to be used
rem : as x-axis (if any) is given by parameter CA, and the others by CB, CC, etc.
rem : The macro extracts the data sets, and arranges them into compact columns
rem : in array data.  If CA is absent, the first column is filled with the
rem : numbers 1,2,3 ...   This process *normalises* the data.
rem : If any row has a string as its first item, all the first items are
rem : taken as labels and copied to the parameter array p.
rem : 
rem : When the data array has been set up, the function calls a function which
rem : depends on the type of graph being plotted.
rem :   
macro CRM_point_plot_row_data(a(),s,v,p(),w,n,flag)
   local data(w,n)
   local date,val
   local x,t,j,k
   local y(5)
   x = psexhex(v,"P",-1)
   if ( x < 0) then
      y(0) = psexhex(v,"Q",if n>1.5 then 0 else -1 endif)
      y(1) = psexhex(v,"R",if n>2.5 then 1 else -1 endif)
      y(2) = psexhex(v,"S",if n>3.5 then 2 else -1 endif)
      y(3) = psexhex(v,"T",if n>4.5 then 3 else -1 endif)
      y(4) = psexhex(v,"U",if n>5.5 then 4 else -1 endif)
   else
      y(0) = psexhex(v,"Q",if n>0.5 then x+1 else -1 endif)
      y(1) = psexhex(v,"R",if n>1.5 then x+2 else -1 endif)
      y(2) = psexhex(v,"S",if n>2.5 then x+3 else -1 endif)
      y(3) = psexhex(v,"T",if n>3.5 then x+4 else -1 endif)
      y(4) = psexhex(v,"U",if n>4.5 then x+5 else -1 endif)
   endif
                                          rem: look for titles
   t=0
   if x >= 0 and (p(GRAPHTYPE) = LINES_ONLY or p(GRAPHTYPE) = POINTS_ONLY or p(GRAPHTYPE) = LINES_AND_POINTS or p(GRAPHTYPE)=GENERAL) then
       if type(a(x,0)) = 3 then t=1
   endif
   if y(0) >= 0 then
       if type(a(y(0),0)) = 3 then t=1
   endif
   if y(1) >= 0 then
       if type(a(y(1),0)) = 3 then t=1
   endif
   if y(2) >= 0 then
       if type(a(y(2),0)) = 3 then t=1
   endif
   if y(3) >= 0 then
       if type(a(y(3),0)) = 3 then t=1
   endif
   if y(4) >= 0 then
       if type(a(y(4),0)) = 3 then t=1
   endif
   rem extract titles if any
   if t = 1 then
      if x >= 0 then p(XLABEL) = a(x,0)
      for j = 0 to 4
          p(YLABELS+j) = a(y(j),0)
          if p(YLABELS+j) = 0 then p(YLABELS+j) = "" 
      next j
   else
      p(XLABEL) = ""
      for j = 0 to 4
          p(YLABELS+j) = ""
      next j
   endif
   rem set up x-axis

   date = 0
   if x >= 0 then
      for j = t to  w-1
          data(j-t,0) = a(x,j)
          if flag =1 then
             data(j-t,0) = cell(a(x,j)..a(x,j),"Formatted")
          endif
          if flag = 2 then
             val = cell(a(x,j)..a(x,j), "Customformat")
             if (find(val,"%d") >= 0 or find(val,"%m") >= 0 or find(val,"%24")>= 0) then
                 data(j-t,0) = cell(a(x,j)..a(x,j),"Formatted")
                 date=1
             endif 
          endif               
      next j                
    else
       for j = t to w-1
          data(j-t,0) = j-t+1
       next j
    endif
    rem set up y-columns
    for k = 1 to n-1
       for j = t to w-1
          data(j-t,k) = a(y(k-1),j)
       next j
    next k
    p(ROWS) = w-t
    p(COLUMNS) = n
    if t=1 & x = (-1) then p(XLABEL) = "Implicit axis"
   if p(GRAPHTYPE)=LINES_ONLY or p(GRAPHTYPE)=POINTS_ONLY or p(GRAPHTYPE)=LINES_AND_POINTS then
          = CRM_point_plot_x(data,s,p,v)
    endif
    if p(GRAPHTYPE)= VERTICAL_HISTOGRAM or p(GRAPHTYPE) = STACKED_VERTICAL_HISTOGRAM or p(GRAPHTYPE) = LINE_HISTO then
          = CRM_v_histo_plot(data,s,p,v)
    endif
    if p(GRAPHTYPE)= HORIZONTAL_HISTOGRAM or p(GRAPHTYPE) = STACKED_HORIZONTAL_HISTOGRAM then
          = CRM_h_histo_plot(data,s,p,v)
    endif
    if p(GRAPHTYPE) = PIE_CHART then
           = CRM_flex_pie_chart(data,s,p,v)
    endif
    if p(GRAPHTYPE) = PICTOGRAM then
           = CRM_picto_plot (data,s,p,v)
    endif  
    if p(GRAPHTYPE) = GENERAL then
           = CRM_which_type(data,s,p,v,date)
    endif
   ="Unknown graph type"
endmacro



rem : ******************************************************************
rem : macro point_plot_col_data is entered with an array a in which the data
rem : sets are in columns and may not be contiguous.  The data set to be used
rem : as x-axis (if any) is given by parameter CA, and the others by CB, CC, etc.
rem : The macro extracts the data sets, and arranges them into compact columns
rem : in array data.  If P is absent, the first column is filled with the
rem : numbers 1,2,3 ...
rem : If any column has a string as its first item, all the first items are
rem : taken as labels and copied to the parameter array p.
rem : 
rem : When the data array has been set up, the function calls point_plot_x
rem :   
macro CRM_point_plot_col_data(a(),s,v,p(),h,n,flag)
   local data(h,n)
   local x,t,j,k,res
   local y(5)
   local date,val
   x = psexhex(v,"P",-1)
    if ( x < 0) then
      y(0) = psexhex(v,"Q",if n>1.5 then 0 else -1 endif)
      y(1) = psexhex(v,"R",if n>2.5 then 1 else -1 endif)
      y(2) = psexhex(v,"S",if n>3.5 then 2 else -1 endif)
      y(3) = psexhex(v,"T",if n>4.5 then 3 else -1 endif)
      y(4) = psexhex(v,"U",if n>5.5 then 4 else -1 endif)
   else
      y(0) = psexhex(v,"Q",if n>1.5 then x+1 else -1 endif)
      y(1) = psexhex(v,"R",if n>2.5 then x+2 else -1 endif)
      y(2) = psexhex(v,"S",if n>3.5 then x+3 else -1 endif)
      y(3) = psexhex(v,"T",if n>4.5 then x+4 else -1 endif)
      y(4) = psexhex(v,"U",if n>5.5 then x+5 else -1 endif)
   endif
   rem look for titles
   t=0
   if x >= 0 and (p(GRAPHTYPE) = LINES_ONLY or p(GRAPHTYPE) = POINTS_ONLY or p(GRAPHTYPE) = LINES_AND_POINTS or p(GRAPHTYPE)=GENERAL) then
       if type(a(0,x)) = 3 then t=1
   endif
   if y(0) >= 0 then
       if type(a(0,y(0)))=3 then t=1
   endif
   if y(1) >= 0 then
       if type(a(0,y(1))) = 3 then t=1
   endif
   if y(2) >= 0 then
       if type(a(0,y(2))) = 3 then t=1
   endif
   if y(3) >= 0 then
       if type(a(0,y(3))) = 3 then t=1
   endif
   if y(4) >= 0 then
       if type(a(0,y(4))) = 3 then t=1
   endif
   rem extract titles if any
   if t = 1 then
      if x >= 0 then p(XLABEL) = a(0,x)
      for j = 0 to 4
          p(YLABELS+j) = a(0,y(j))
          if p(YLABELS+j) = 0 then p(YLABELS+j) = ""
      next j
   else
      p(XLABEL) = ""
      for j = 0 to 4
          p(YLABELS+j) = ""
      next j
   endif

   rem set up x-axis
   date = 0
   if x >= 0 then
      for j = t to  h-1
          data(j-t,0) = a(j,x)
          if flag =1 then
             data(j-t,0) = cell(a(j,x)..a(j,x),"Formatted")
          endif
          if flag = 2 then
             val = cell(a(j,x)..a(j,x), "Customformat")
             if (find(val,"%d") >= 0 or find(val,"%m") >= 0 or find(val,"%24")>= 0) then
                 data(j-t,0) = cell(a(j,x)..a(j,x),"Formatted")
                 date=1
             endif 
          endif               
      next j                
    else
       for j = t to h-1
          data(j-t,0) = j-t+1
       next j
    endif
    rem set up y-columns
    for k = 1 to n-1
       for j = t to h-1
          data(j-t,k) = a(j,y(k-1))
       next j
    next k
    p(ROWS) = h-t
    p(COLUMNS) = n
    if t=1 & x = (-1) then p(XLABEL) = "Implicit axis"
    if p(GRAPHTYPE)=LINES_ONLY or p(GRAPHTYPE)=POINTS_ONLY or p(GRAPHTYPE)=LINES_AND_POINTS then
          = CRM_point_plot_x(data,s,p,v)
    endif
    if p(GRAPHTYPE)= VERTICAL_HISTOGRAM or p(GRAPHTYPE) = STACKED_VERTICAL_HISTOGRAM or p(GRAPHTYPE) = LINE_HISTO then
          = CRM_v_histo_plot(data,s,p,v)
    endif
    if p(GRAPHTYPE)= HORIZONTAL_HISTOGRAM or p(GRAPHTYPE) = STACKED_HORIZONTAL_HISTOGRAM then
          = CRM_h_histo_plot(data,s,p,v)
    endif      
    if p(GRAPHTYPE) = PIE_CHART then
           = CRM_flex_pie_chart(data,s,p,v)
    endif
    if p(GRAPHTYPE) = PICTOGRAM then
            = CRM_picto_plot(data,s,p,v)
    endif
    if p(GRAPHTYPE) = GENERAL then
           = CRM_which_type(data,s,p,v,date)
    endif
    ="Bad graph type"
endmacro

   
   
        




