%TITLE "Generic Pie Chart Routine"
%SBTTL "VAX BASIC Graphics Example"

SUB Pie (LONG input_points, SINGLE data_arr (), STRING labels(), TITLE())

!+
! This subprogram will draw a PIE chart using VAX BASIC Graphics.  The input
! parameters are as follows:
!
!   input_points - The number of data points in the DATA_ARR and LABELS arrays.
!
!   data_arr     - An array containing the data values to be used in generating 
!		   the PIE chart.
!
!   labels	 - The labels to be used on the PIE chart.  The label in the
!		   ith position in this array corresponds to the data in the 
!		   same position in the DATA_ARR array.
!-

    OPTION TYPE = EXPLICIT, CONSTANT TYPE = INTEGER

    DECLARE LONG CONSTANT npoints = 100
    DECLARE SINGLE CONSTANT radius = 0.275
    DECLARE LONG area_color, pies, first_point, last_point, too_big, &
	    loop_count, inner_loop, max_color, x_dir, mid_point, device_type
    DECLARE SINGLE xs(npoints), ys(npoints), x_pie(npoints), y_pie (npoints)
    DECLARE SINGLE DC_Y_MAX,DC_X_MAX, data_total, pie_completed, &
		mid_pie_x, mid_pie_y, temp_data
    DECLARE STRING temp_label, area_style
    DECLARE SINGLE xextent(3),yextent(3),xmin, xmax, ymin, ymax, theight

    ASK DEVICE SIZE dc_x_max, dc_y_max
    ASK DEVICE TYPE device_type
    ASK MAX COLOR max_color

    SET WINDOW -.5*dc_x_max/dc_y_max,.5*dc_x_max/dc_y_max,-.5,.5
    SET VIEWPORT 0,1,0,dc_y_max/dc_x_max
    SET DEVICE WINDOW 0,1,0,dc_y_max/dc_x_max
    SET DEVICE VIEWPORT 0, dc_x_max, 0, dc_y_max
    SET AREA STYLE "SOLID"
    SET AREA STYLE INDEX 1
    SET CLIP "OFF"
    SET TEXT JUSTIFY "CENTER", "HALF"

    IF device_type = 13
    THEN
	SET TEXT COLOR 3
	SET LINE COLOR 3
    END IF
	  
    ASK WINDOW xmin, xmax, ymin, ymax
    SET TEXT HEIGHT .030*(xmax - xmin)

    too_big = -1

    !+
    !   Check that the TITLE fits.  If not, reduce the spacing repeatedly
    !   until it does fit.
    !-

    DECLARE SINGLE expand_val, y_val

    FOR loop_count = 1 TO 2

	y_val = 2.0 * RADIUS - (loop_count * .25 * radius)
	WHILE too_big
	    ASK TEXT EXTENT, title(loop_count) AT 0, y_val : xextent, yextent
	    too_big = 0		IF xextent(0) > xmin OR xextent(1) < xmax

	    IF too_big
	    THEN
		ASK TEXT EXPAND expand_val
		SET TEXT EXPAND expand_val * .9
	    END IF

	NEXT	

	GRAPH TEXT AT 0, y_val: TITLE(loop_count)
	SET TEXT EXPAND 1.0
    NEXT loop_count

    !+
    !   Fill the XS and YS arrays with points to be used in drawing the PIE.
    !-

    FOR loop_count = 0 TO npoints
	xs(npoints - loop_count) = COS ( 2*PI/npoints*loop_count ) * radius
	ys(npoints - loop_count) = SIN ( 2*PI/npoints*loop_count ) * radius
    NEXT loop_count

    !+
    !   Order the input points by decreasing value, and total the values.
    !-

    IF input_points > 1
    THEN 
	FOR loop_count = 1 TO input_points - 1
	    FOR inner_loop = loop_count + 1 TO input_points
		IF data_arr(inner_loop) > data_arr(loop_count)
		THEN
		    temp_data = data_arr (loop_count)
		    temp_label = labels (loop_count)
		    data_arr(loop_count) = data_arr(inner_loop)
		    labels (loop_count) = labels (inner_loop)
		    data_arr(inner_loop) = temp_data
		    labels (inner_loop) = temp_label
		END IF
	    NEXT inner_loop
	NEXT loop_count
    END IF

    data_total = 0
    FOR loop_count = 1 TO input_points 
	data_total = data_total + data_arr(loop_count)
    NEXT loop_count

    !+
    !   Group all data points below some level into 
    !   an 'OTHER' category.
    !-

    cleanup_points:

    FOR loop_count = 1 TO input_points 
	IF data_arr (loop_count) < .02 * data_total
	THEN
	    last_point = loop_count
	    labels (last_point) = "OTHER"
	    FOR inner_loop = loop_count + 1 TO input_points
		data_arr(last_point) = data_arr (last_point) + data_arr (inner_loop)
	    NEXT inner_loop
	    input_points = last_point	
	    EXIT cleanup_points
	END IF
    NEXT loop_count

    pie_completed = 0
    area_color = 1
    SET AREA STYLE 'HATCH'

    !+
    !   Walk through the DATA array, generating the appropriate PIE segments.
    !-

    FOR loop_count = input_points TO 1 STEP -1

	First_point = INT(npoints* pie_completed/data_total)
	Last_point = INT (npoints*(pie_completed + data_arr(loop_count))/data_total)
	FOR pies = first_point TO last_point
	    x_pie (pies-first_point) = xs(pies)
	    y_pie (pies-first_point) = ys(pies)
	NEXT pies

	pie_completed = pie_completed + data_arr(loop_count)
	    
	!+
	!   In all cases except where there is one data point that makes
	!   up the entire pie, add the center point to the array containing
	!   the points for this datas "slice".
	!-

	IF (pies - first_point) < npoints
	THEN
	    Pies = pies + 1
	    x_pie (pies - first_point) = 0
	    y_pie (pies - first_point) = 0
	END IF

	!+
	!   Alternate between SOLID and HATCH fill area styles every
	!   time we cycle through all the colors.
	!-

	IF area_color = 1
	THEN
	    ASK AREA STYLE area_style
	    SELECT area_style

	    CASE "SOLID"
		SET AREA STYLE "HATCH"
	    CASE "HATCH"
		SET AREA STYLE "SOLID"
			
	    END SELECT
	END IF

	SET AREA COLOR area_color
	ASK AREA STYLE area_style 

	!+
	!   Avoid having the first and last (adjacent)
	!   pieces of the pie being the same color and fill
	!-
	
	IF (loop_count = 1) AND  &
	    (area_color = 1) AND	&
	    (area_style = 'SOLID')
	THEN
	    SET AREA COLOR max_color
	END IF
	       
	area_color = MOD(area_color, max_color) + 1
	    
	!+
	!   GRAPH the PIE "slice"
	!-

	MAT GRAPH AREA , count (pies-first_point+1) : x_pie, y_pie

	!+
	!   Draw the LABEL for this "slice" of the PIE.
	!-

	mid_point = first_point + (last_point-first_point)/2
	mid_pie_x = xs(mid_point )
	mid_pie_y = ys(mid_point )

	IF mid_pie_x < 0
	THEN
	    x_dir = -1
	    SET TEXT JUSTIFY 'RIGHT', 'HALF'
	ELSE
	    x_dir = 1
	    SET TEXT JUSTIFY 'LEFT', 'HALF'
	END IF

	GRAPH LINES mid_pie_x, mid_pie_y ; &
		1.15*mid_pie_x+(.05*x_dir), 1.15*mid_pie_y

	ASK WINDOW xmin, xmax, ymin, ymax
	SET TEXT HEIGHT .020*(xmax - xmin)

	too_big = -1
	temp_label = labels (loop_count) + ' ' + &
		    FORMAT$(data_arr(loop_count)*100.0/data_total, "###.#") + '%'

	!+
	!   Check that the label fits.  If not, reduce the size repeatedly
	!   until it does fit.
	!-

	WHILE too_big
	    ASK TEXT EXTENT, temp_label AT &
		    1.15*mid_pie_x+(.09*x_dir), 1.15*mid_pie_y: xextent, yextent

	    too_big = 0		IF x_dir = -1 AND xextent(0) > xmin
	    too_big = 0		IF x_dir = 1  AND xextent(1) < xmax

	    IF too_big
	    THEN
		ASK TEXT HEIGHT theight
		SET TEXT HEIGHT theight*.9
	    END IF

	NEXT

	GRAPH TEXT AT 1.15*mid_pie_x+(.09*x_dir), 1.15*mid_pie_y: temp_label 
    NEXT loop_count

END SUB