legend Subroutine

public subroutine legend(corner, series, lineWidths, markScales, markCounts, ncol)

Create legend for plot data

FIXME: Text sizing should be modifiable

Arguments

Type IntentOptional AttributesName
character(len=*), intent(in) :: corner

Corner for legend

character(len=*), intent(in), dimension(:,:):: series

Data series in rows [name,textColor,lineStyle,lineColor,markStyle,markColor,boxColor]

real(kind=wp), intent(in), optional dimension(:):: lineWidths

Line widths for the plots

real(kind=wp), intent(in), optional dimension(:):: markScales

Marker sizes for the plots

integer, intent(in), optional dimension(:):: markCounts

Marker counts for the plots

integer, intent(in), optional :: ncol

Number of columns

Calls

proc~~legend~~CallsGraph proc~legend legend pllegend pllegend proc~legend->pllegend
Help

Called By

proc~~legend~~CalledByGraph proc~legend legend proc~dolegend doLegend proc~dolegend->proc~legend program~examples_prg examples_prg program~examples_prg->proc~dolegend
Help

Source Code


Source Code

	subroutine legend(corner,series,lineWidths,markScales,markCounts,ncol)
		!! Create legend for plot data
		!!
		!! FIXME: Text sizing should be modifiable
		character(*),intent(in)::corner
			!! Corner for legend
		character(*),dimension(:,:),intent(in)::series
			!! Data series in rows
			!! [name,textColor,lineStyle,lineColor,markStyle,markColor,boxColor]
		real(wp),dimension(:),intent(in),optional::lineWidths
			!! Line widths for the plots
		real(wp),dimension(:),intent(in),optional::markScales
			!! Marker sizes for the plots
		integer,dimension(:),intent(in),optional::markCounts
			!! Marker counts for the plots
		integer,intent(in),optional::ncol
			!! Number of columns
		
		real(pp)::width,height,xoff,yoff
		real(pp)::plotWidth
		integer::opt,cornerl
		integer::bg_color,bb_color,bb_style,lncol,lnrow
		integer,dimension(size(series,1))::opts
		real(pp),dimension(size(series,1))::lwidths,mscales
		integer,dimension(size(series,1))::mcounts,text_colors
		real(pp)::text_offset,text_scale,text_spacing,text_justification
		integer,dimension(size(series,1))::box_colors,box_patterns
		real(pp),dimension(size(series,1))::box_scales,box_line_widths
		integer,dimension(size(series,1))::line_colors,line_styles
		integer,dimension(size(series,1))::mark_colors
		character(64),dimension(size(series,1))::mark_styles
		integer::k
		
		call doLegendBox()
		
		opts = 0
		do k=1,size(series,1)
			if(series(k,3)/='') opts(k) = ior(opts(k),PL_LEGEND_LINE)
			if(series(k,5)/='') opts(k) = ior(opts(k),PL_LEGEND_SYMBOL)
			if(series(k,7)/='') opts(k) = ior(opts(k),PL_LEGEND_COLOR_BOX)
		end do
		
		call doText()
		call doBoxes()
		call doLines()
		call doMarkers()
		
		call pllegend(width,height,opt,cornerl,xoff,yoff,plotWidth, &
			& bg_color,bb_color,bb_style, &
			& lnrow,lncol,size(series,1),opts,text_offset, &
			& text_scale,text_spacing,text_justification,text_colors,series(:,1), &
			& box_colors,box_patterns,box_scales,box_line_widths, &
			& line_colors,line_styles,lwidths, &
			& mark_colors,mscales,mcounts,mark_styles)
		
	contains
	
		subroutine doLegendBox
			opt = PL_LEGEND_BACKGROUND+PL_LEGEND_BOUNDING_BOX
			cornerl = getCorner(corner)
			xoff = 0.0_pp
			yoff = 0.0_pp
			plotWidth = 0.05_pp
			bg_color = 0
			bb_color = 1
			bb_style = getLineStyleCode('-')
			
			lncol = 1
			if(present(ncol)) lncol = ncol
			lnrow = size(series,1)/lncol
		end subroutine doLegendBox
	
		subroutine doText
			text_offset  = 0.3_pp
			text_scale   = fontScale
			text_spacing = 3.0_pp
			text_justification = 0.0_pp
			
			do k=1,size(series,1)
				text_colors = getColorCode(series(k,2))
			end do
		end subroutine doText
	
		subroutine doBoxes
			do k=1,size(series,1)
				box_colors(k) = getColorCode(series(k,7))
			end do
			box_patterns = 0
			box_scales = 0.5_pp
			box_line_widths = 0.0_pp
		end subroutine doBoxes
	
		subroutine doLines
			lwidths = 1.0_pp
			if(present(lineWidths)) lwidths = real(lineWidths,pp)
			
			do k=1,size(series,1)
				line_colors(k) = getColorCode(series(k,4))
				line_styles(k) = getLineStyleCode(series(k,3))
			end do
		end subroutine doLines
	
		subroutine doMarkers
			mcounts = 2
			if(present(markCounts)) mcounts = markCounts
			mscales = 1.0_pp
			if(present(markScales)) mscales = real(markScales,pp)
			
			do k=1,size(series,1)
				mark_colors(k) = getColorCode(series(k,6))
				mark_styles(k) = getSymbolCode(series(k,5))
			end do
		end subroutine doMarkers
	
		function getCorner(text) result(code)
			character(*),intent(in)::text
			integer::code
			
			code = PL_POSITION_INSIDE
			if( startsWith(text,'upper') ) code = code+PL_POSITION_TOP
			if( startsWith(text,'lower') ) code = code+PL_POSITION_BOTTOM
			if(   endsWith(text,'right') ) code = code+PL_POSITION_RIGHT
			if(   endsWith(text,'left' ) ) code = code+PL_POSITION_LEFT
		end function getCorner
	
	end subroutine legend


abs abs_t acos_t ad_t add_t arg arrayToChar asin_t assignment(=) atan_t bar barh biCGSTAB_t biConjugateGradientStabilized binData box charToArray checkPrecision colorbar colorbar2 colorize colorMap config_t conjg conjugateGradient conjugateGradient_t contour contourf cos_a cos_t cpuTime cubicSpline_t deDup DFT div_t doBar doContour doError doFillBetween doFunction doHist doLegend doLogPlot doPlot doQuiver doScatter doSurface endsWith errorbar eval_test eval_testN evalR_abs evalR_acos evalR_add evalR_asin evalR_atan evalR_cos evalR_div evalR_exp evalR_imag evalR_log evalR_log10 evalR_mul evalR_neg evalR_p evalR_pow evalR_real evalR_sin evalR_sqrt evalR_sub evalR_tan evalR_var evalZ_abs evalZ_acos evalZ_add evalZ_asin evalZ_atan evalZ_cos evalZ_div evalZ_exp evalZ_imag evalZ_log evalZ_log10 evalZ_mul evalZ_neg evalZ_p evalZ_pow evalZ_real evalZ_sin evalZ_sqrt evalZ_sub evalZ_tan evalZ_var exp exp exp_t f FFT FFT_freq figure fillBetween fillBetweenx findInterval flatten function_t gaussSeidel gaussSeidel_t hist iDFT iFFT imag_t intToChar inv jacobi jacobi_t labels legend linearInterp linearSpline_t lineSearch_t linspace log log log10 log10 log10_t log_t makeLogo matmul matmul maxval mean meshGridX meshGridY minimumResidual minval mixval mul_t neg_t newAbs newAcos newAdd newAsin newAtan newCos newDiv newExp newImag newIterator newLog newLog10 newMul newNeg newNodeStack newPow newReal newSin newSparse newSpvec newSqrt newSub newTan newToken newVar nint nodeStack_t norm2 norm2 operator(*) operator(*) operator(*) operator(**) operator(+) operator(+) operator(+) operator(-) operator(-) operator(.d.) operator(.o.) operator(.o.) operator(.oo.) operator(.sx.) operator(.x.) operator(/) operator(/) operator(<) operator(>) plot plot3 pop pow_t printTypes push quat_t quiver randomNormal randomUniform readGrid readStep real_t realToChar realToTime removeSpaces scaler scatter setRandomSeed setup show showProgress sin_a sin_t solveLU solveLU solverProgress SOR_t span sqrt sqrt_t startReport startsWith stDev steepestDescent sub_t subplot successiveOverRelaxation sum sum surface symmetricGaussSeidel symmetricSuccessiveOverRelaxation tan_a tan_t TDMA TDMA testBasic testBasicSolvers testColorize testColorMap testConstants testCpuTime testDeDup testDiff testDot testEndsWith testFFT testFlatten testFunction testIFFT testIntToChar testLinearInterp testLinspace testLU testMean testMeshGrid testMixval testNewConfig testNewSparse testNewSpline testNext testObjective testObjectiveN testPlot testPrecision testRandomNormal testRandomUniform testRead testReadGmsh testRealToChar testRealToTime testRemoveSpaces testSetRandomSeed testSolvers testSpan testSplineX testSpvec testStartsWith testStDev testTDMA testWallTime testWrite testWriteMat testWriteVTK testWriteVTK ticks title token_t tokenize toRPN transpose v2m var_t vector wait wallTime wireframe writeGrid writeGridVTK writeHeaderVTK writeMat writeScalarVTK writeStep writeVectorVTK xlabel xlim xticks xylim xyzlim ylabel ylim yticks