1! Demonstrate most pllegend capability including unicode symbols. 2! 3! Copyright (C) 2010-2016 Alan W. Irwin 4! 5! This file is part of PLplot. 6! 7! PLplot is free software; you can redistribute it and/or modify 8! it under the terms of the GNU Library General Public License as published 9! by the Free Software Foundation; either version 2 of the License, or 10! (at your option) any later version. 11! 12! PLplot is distributed in the hope that it will be useful, 13! but WITHOUT ANY WARRANTY; without even the implied warranty of 14! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15! GNU Library General Public License for more details. 16! 17! You should have received a copy of the GNU Library General Public License 18! along with PLplot; if not, write to the Free Software 19! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 20! 21! N.B. the pl_test_flt parameter used in this code is only 22! provided by the plplot module to allow convenient developer 23! testing of either kind(1.0) or kind(1.0d0) floating-point 24! precision regardless of the floating-point precision of the 25! PLplot C libraries. We do not guarantee the value of this test 26! parameter so it should not be used by users, and instead user 27! code should replace the pl_test_flt parameter by whatever 28! kind(1.0) or kind(1.0d0) precision is most convenient for them. 29! For further details on floating-point precision issues please 30! consult README_precision in this directory. 31! 32! This example designed just for devices (e.g., the cairo-related and 33! qt-related devices) where the best choice of glyph is automatically 34! selected by the related libraries (pango/cairo or Qt4) for each 35! unicode character depending on what system fonts are installed. Of 36! course, you must have the appropriate TrueType fonts installed to 37! have access to all the required glyphs. 38 39 40!-------------------------------------------------------------------------- 41! main 42! 43! Demonstrate most pllegend capability including unicode symbols. 44! -------------------------------------------------------------------------- 45 46program x33f 47 use plplot 48 49 implicit none 50 51 integer, parameter :: MAX_NLEGEND = 7 52 53 integer :: i, k 54 integer :: opt, position 55 integer :: nlegend, nturn 56 integer :: opt_array(MAX_NLEGEND) 57 integer :: text_colors(MAX_NLEGEND) 58 integer :: box_colors(MAX_NLEGEND) 59 integer :: box_patterns(MAX_NLEGEND) 60 real(kind=pl_test_flt) :: box_scales(MAX_NLEGEND) 61 real(kind=pl_test_flt) :: box_line_widths(MAX_NLEGEND) 62 integer :: line_colors(MAX_NLEGEND) 63 integer :: line_styles(MAX_NLEGEND) 64 real(kind=pl_test_flt) :: line_widths(MAX_NLEGEND) 65 integer :: symbol_numbers(MAX_NLEGEND), symbol_colors(MAX_NLEGEND) 66 real(kind=pl_test_flt) :: symbol_scales(MAX_NLEGEND) 67 character(len=200) :: text(MAX_NLEGEND) 68 character(len=20) :: symbols(MAX_NLEGEND) 69 real(kind=pl_test_flt) :: legend_width, legend_height, x, y, xstart, ystart 70 real(kind=pl_test_flt) :: max_height, text_scale 71 integer :: opt_base, nrow, ncolumn 72 73 integer :: position_options(16) 74 character(len=3) :: special_symbols(5) 75 76 real(kind=pl_test_flt) :: values_small(2) 77 real(kind=pl_test_flt) :: values_uneven(9) 78 real(kind=pl_test_flt) :: values_even(9) 79 80 integer, parameter :: COLORBAR_KINDS = 4 81 integer :: colorbar_option_kinds(COLORBAR_KINDS) 82 character(len=100) :: colorbar_option_kind_labels(COLORBAR_KINDS) 83 84 integer, parameter :: COLORBAR_POSITIONS = 4 85 integer :: colorbar_position_options(COLORBAR_POSITIONS) 86 character(len=100) :: colorbar_position_option_labels(COLORBAR_POSITIONS) 87 88 integer, parameter :: COLORBAR_LABELS = 4 89 integer :: colorbar_label_options(COLORBAR_LABELS) 90 character(len=100) :: colorbar_label_option_labels(COLORBAR_LABELS) 91 92 integer, parameter :: COLORBAR_CAPS = 4 93 integer :: colorbar_cap_options(COLORBAR_CAPS) 94 integer :: plparseopts_rc 95 character(len=100) :: colorbar_cap_option_labels(COLORBAR_CAPS) 96 97 ! Pick 5 arbitrary UTF-8 symbols useful for plotting points (✠✚✱✪✽✺✰✴✦). 98 data special_symbols / & 99 '✰', & 100 '✴', & 101 '✱', & 102 '✽', & 103 '✦' / 104 105 data values_small / -1.0_pl_test_flt, 1.0_pl_test_flt / 106 data values_uneven & 107 / -1.0_pl_test_flt, 2.0_pl_test_flt, 2.6_pl_test_flt, 3.4_pl_test_flt, & 108 6.0_pl_test_flt, 7.0_pl_test_flt, 8.0_pl_test_flt, 9.0_pl_test_flt, & 109 10.0_pl_test_flt / 110 data values_even & 111 / -2.0_pl_test_flt, -1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt, & 112 2.0_pl_test_flt, 3.0_pl_test_flt, 4.0_pl_test_flt, 5.0_pl_test_flt, & 113 6.0_pl_test_flt / 114 115 real(kind=pl_test_flt), parameter :: small_factor = 1.e-20_pl_test_flt 116 117 values_small = small_factor*values_small 118 values_uneven = small_factor*values_uneven 119 values_even = small_factor*values_even 120 121 position_options(1) = PL_POSITION_LEFT + PL_POSITION_TOP + PL_POSITION_OUTSIDE 122 position_options(2) = PL_POSITION_TOP + PL_POSITION_OUTSIDE 123 position_options(3) = PL_POSITION_RIGHT + PL_POSITION_TOP + PL_POSITION_OUTSIDE 124 position_options(4) = PL_POSITION_RIGHT + PL_POSITION_OUTSIDE 125 position_options(5) = PL_POSITION_RIGHT + PL_POSITION_BOTTOM + PL_POSITION_OUTSIDE 126 position_options(6) = PL_POSITION_BOTTOM + PL_POSITION_OUTSIDE 127 position_options(7) = PL_POSITION_LEFT + PL_POSITION_BOTTOM + PL_POSITION_OUTSIDE 128 position_options(8) = PL_POSITION_LEFT + PL_POSITION_OUTSIDE 129 position_options(9) = PL_POSITION_LEFT + PL_POSITION_TOP + PL_POSITION_INSIDE 130 position_options(10) = PL_POSITION_TOP + PL_POSITION_INSIDE 131 position_options(11) = PL_POSITION_RIGHT + PL_POSITION_TOP + PL_POSITION_INSIDE 132 position_options(12) = PL_POSITION_RIGHT + PL_POSITION_INSIDE 133 position_options(13) = PL_POSITION_RIGHT + PL_POSITION_BOTTOM + PL_POSITION_INSIDE 134 position_options(14) = PL_POSITION_BOTTOM + PL_POSITION_INSIDE 135 position_options(15) = PL_POSITION_LEFT + PL_POSITION_BOTTOM + PL_POSITION_INSIDE 136 position_options(16) = PL_POSITION_LEFT + PL_POSITION_INSIDE 137 138 ! plcolorbar options 139 140 ! Colorbar type options 141 colorbar_option_kinds(1) = PL_COLORBAR_SHADE 142 colorbar_option_kinds(2) = PL_COLORBAR_SHADE + PL_COLORBAR_SHADE_LABEL 143 colorbar_option_kinds(3) = PL_COLORBAR_IMAGE 144 colorbar_option_kinds(4) = PL_COLORBAR_GRADIENT 145 146 colorbar_option_kind_labels(1) = "Shade colorbars" 147 colorbar_option_kind_labels(2) = "Shade colorbars with custom labels" 148 colorbar_option_kind_labels(3) = "Image colorbars" 149 colorbar_option_kind_labels(4) = "Gradient colorbars" 150 151 ! Which side of the page are we positioned relative to? 152 colorbar_position_options(1) = PL_POSITION_LEFT 153 colorbar_position_options(2) = PL_POSITION_RIGHT 154 colorbar_position_options(3) = PL_POSITION_TOP 155 colorbar_position_options(4) = PL_POSITION_BOTTOM 156 157 colorbar_position_option_labels(1) = "Left" 158 colorbar_position_option_labels(2) = "Right" 159 colorbar_position_option_labels(3) = "Top" 160 colorbar_position_option_labels(4) = "Bottom" 161 162 ! Colorbar label positioning options 163 colorbar_label_options(1) = PL_COLORBAR_LABEL_LEFT 164 colorbar_label_options(2) = PL_COLORBAR_LABEL_RIGHT 165 colorbar_label_options(3) = PL_COLORBAR_LABEL_TOP 166 colorbar_label_options(4) = PL_COLORBAR_LABEL_BOTTOM 167 168 colorbar_label_option_labels(1) = "Label left" 169 colorbar_label_option_labels(2) = "Label right" 170 colorbar_label_option_labels(3) = "Label top" 171 colorbar_label_option_labels(4) = "Label bottom" 172 173 ! Colorbar cap options 174 colorbar_cap_options(1) = PL_COLORBAR_CAP_NONE 175 colorbar_cap_options(2) = PL_COLORBAR_CAP_LOW 176 colorbar_cap_options(3) = PL_COLORBAR_CAP_HIGH 177 colorbar_cap_options(4) = PL_COLORBAR_CAP_LOW + PL_COLORBAR_CAP_HIGH 178 179 colorbar_cap_option_labels(1) = "No caps" 180 colorbar_cap_option_labels(2) = "Low cap" 181 colorbar_cap_option_labels(3) = "High cap" 182 colorbar_cap_option_labels(4) = "Low and high caps" 183 184 ! Parse and process command line arguments 185 186 plparseopts_rc = plparseopts(PL_PARSE_FULL) 187 if(plparseopts_rc .ne. 0) stop "plparseopts error" 188 189 ! Initialize plplot 190 call plinit 191 192 ! First page illustrating the 16 standard positions. 193 call pladv( 0 ) 194 call plvpor( 0.25_pl_test_flt, 0.75_pl_test_flt, 0.25_pl_test_flt, 0.75_pl_test_flt ) 195 call plwind( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt ) 196 call plbox( 'bc', 0.0_pl_test_flt, 0, 'bc', 0.0_pl_test_flt, 0 ) 197 call plsfont( PL_FCI_SANS, -1, -1 ) 198 call plmtex( 't', 8.0_pl_test_flt, 0.5_pl_test_flt, 0.5_pl_test_flt, & 199 'The 16 standard legend positions with' ) 200 call plmtex( 't', 6.0_pl_test_flt, 0.5_pl_test_flt, 0.5_pl_test_flt, & 201 'the same (0.05) offset in x and y' ) 202 203 nlegend = 1 204 ! Only specify legend data that are required according to the 205 ! value of opt_array for that entry. 206 opt_base = PL_LEGEND_BACKGROUND + PL_LEGEND_BOUNDING_BOX 207 opt_array(1) = PL_LEGEND_LINE + PL_LEGEND_SYMBOL 208 line_styles(1) = 1 209 line_widths(1) = 1 210 symbol_scales(1) = 1._pl_test_flt 211 symbol_numbers(1) = 4 212 symbols(1) = "#(728)" 213 214 ! Use monotype fonts so that all legends are the same size. 215 call plsfont( PL_FCI_MONO, -1, -1 ) 216 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 217 218 do k = 1,16 219 position = position_options(k) 220 opt = opt_base 221 text_colors(1) = 1 + mod( k-1, 8 ) 222 line_colors(1) = 1 + mod( k-1, 8 ) 223 symbol_colors(1) = 1 + mod( k-1, 8 ) 224 write( text(1), '(i2.2)' ) k-1 225 226 call pllegend( legend_width, legend_height, opt, position, & 227 0.05_pl_test_flt, 0.05_pl_test_flt, & 228 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 229 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 230 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 231 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 232 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 233 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 234 enddo 235 236 ! Second page illustrating effect of nrow, ncolumn for the same legend 237 ! data. 238 239 call pladv( 0 ) 240 call plvpor( 0.25_pl_test_flt, 0.75_pl_test_flt, 0.25_pl_test_flt, 0.75_pl_test_flt ) 241 call plwind( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt ) 242 call plbox( 'bc', 0.0_pl_test_flt, 0, 'bc', 0.0_pl_test_flt, 0 ) 243 call plsfont( PL_FCI_SANS, -1, -1 ) 244 call plmtex( 't', 8.0_pl_test_flt, 0.5_pl_test_flt, 0.5_pl_test_flt, & 245 'The effect of nrow, ncolumn, PL_LEGEND_ROW_MAJOR,' ) 246 call plmtex( 't', 6.0_pl_test_flt, 0.5_pl_test_flt, 0.5_pl_test_flt, & 247 'and position for the same legend data' ) 248 249 nlegend = 7 250 251 ! Only specify legend data that are required according to the 252 ! value of opt_array for that entry. 253 254 opt_base = PL_LEGEND_BACKGROUND + PL_LEGEND_BOUNDING_BOX 255 do k = 1,nlegend 256 opt_array(k) = PL_LEGEND_LINE + PL_LEGEND_SYMBOL 257 line_styles(k) = 1 258 line_widths(k) = 1 259 symbol_scales(k) = 1._pl_test_flt 260 symbol_numbers(k) = 2 261 symbols(k) = "#(728)" 262 write( text(k), '(i2.2)' ) k-1 263 text_colors(k) = 1 + mod( k-1, 8 ) 264 line_colors(k) = 1 + mod( k-1, 8 ) 265 symbol_colors(k) = 1 + mod( k-1, 8 ) 266 enddo 267 268 ! Use monotype fonts so that all legends are the same size. 269 270 call plsfont( PL_FCI_MONO, -1, -1 ) 271 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 272 273 position = PL_POSITION_TOP + PL_POSITION_OUTSIDE 274 opt = opt_base 275 x = 0._pl_test_flt 276 y = 0.1_pl_test_flt 277 nrow = 1 278 ncolumn = nlegend 279 call pllegend( legend_width, legend_height, opt, position, x, y, & 280 0.05_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 281 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 282 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 283 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 284 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 285 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 286 287 position = PL_POSITION_BOTTOM + PL_POSITION_OUTSIDE 288 opt = opt_base 289 x = 0._pl_test_flt 290 y = 0.1_pl_test_flt 291 nrow = 1 292 ncolumn = nlegend 293 call pllegend( legend_width, legend_height, opt, position, x, y, & 294 0.05_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 295 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 296 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 297 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 298 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 299 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 300 301 position = PL_POSITION_LEFT + PL_POSITION_OUTSIDE 302 opt = opt_base 303 x = 0.1_pl_test_flt 304 y = 0._pl_test_flt 305 nrow = nlegend 306 ncolumn = 1 307 call pllegend( legend_width, legend_height, opt, position, x, y, & 308 0.05_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 309 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 310 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 311 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 312 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 313 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 314 315 position = PL_POSITION_RIGHT + PL_POSITION_OUTSIDE 316 opt = opt_base 317 x = 0.1_pl_test_flt 318 y = 0._pl_test_flt 319 nrow = nlegend 320 ncolumn = 1 321 call pllegend( legend_width, legend_height, opt, position, x, y, & 322 0.05_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 323 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 324 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 325 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 326 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 327 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 328 329 position = PL_POSITION_LEFT + PL_POSITION_TOP + PL_POSITION_INSIDE 330 opt = opt_base 331 x = 0._pl_test_flt 332 y = 0._pl_test_flt 333 nrow = 6 334 ncolumn = 2 335 call pllegend( legend_width, legend_height, opt, position, x, y, & 336 0.05_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 337 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 338 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 339 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 340 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 341 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 342 343 position = PL_POSITION_RIGHT + PL_POSITION_TOP + PL_POSITION_INSIDE 344 opt = opt_base + PL_LEGEND_ROW_MAJOR 345 x = 0._pl_test_flt 346 y = 0._pl_test_flt 347 nrow = 6 348 ncolumn = 2 349 call pllegend( legend_width, legend_height, opt, position, x, y, & 350 0.05_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 351 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 352 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 353 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 354 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 355 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 356 357 position = PL_POSITION_BOTTOM + PL_POSITION_INSIDE 358 opt = opt_base + PL_LEGEND_ROW_MAJOR 359 x = 0._pl_test_flt 360 y = 0._pl_test_flt 361 nrow = 3 362 ncolumn = 3 363 call pllegend( legend_width, legend_height, opt, position, x, y, & 364 0.05_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 365 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 2.0_pl_test_flt, & 366 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 367 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 368 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 369 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 370 371 ! Third page demonstrating legend alignment 372 373 call pladv( 0 ) 374 call plvpor( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 0.9_pl_test_flt ) 375 call plwind( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt ) 376 call plsfont( PL_FCI_SANS, -1, -1 ) 377 call plmtex( 't', 2.0_pl_test_flt, 0.5_pl_test_flt, 0.5_pl_test_flt, & 378 'Demonstrate legend alignment' ) 379 380 x = 0.1_pl_test_flt 381 y = 0.1_pl_test_flt 382 nturn = 5 383 nlegend = 0 384 position = PL_POSITION_TOP + PL_POSITION_LEFT + PL_POSITION_SUBPAGE 385 opt_base = PL_LEGEND_BACKGROUND + PL_LEGEND_BOUNDING_BOX 386 opt = opt_base 387 do i = 1,9 388 389 ! Set up legend arrays with the correct size, type. 390 391 if ( i .le. nturn ) then 392 nlegend = nlegend + 1 393 else 394 nlegend = nlegend - 1 395 endif 396 nlegend = max( 1, nlegend ) 397 398 ! nly specify legend data that are required according to the 399 ! value of opt_array for that entry. 400 401 do k = 1,nlegend 402 opt_array(k) = PL_LEGEND_LINE + PL_LEGEND_SYMBOL 403 line_styles(k) = 1 404 line_widths(k) = 1 405 symbol_scales(k) = 1._pl_test_flt 406 symbol_numbers(k) = 2 407 symbols(k) = "#(728)" 408 write( text(k), '(i2.2)' ) k-1 409 text_colors(k) = 1 + mod( k-1, 8 ) 410 line_colors(k) = 1 + mod( k-1, 8 ) 411 symbol_colors(k) = 1 + mod( k-1, 8 ) 412 enddo 413 414 ! Use monotype fonts so that all legends are the same size. 415 416 call plsfont( PL_FCI_MONO, -1, -1 ) 417 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 418 419 nrow = MIN( 3, nlegend ) 420 ncolumn = 0 421 422 call pllegend( legend_width, legend_height, opt, position, & 423 x, y, & 424 0.025_pl_test_flt, 15, 1, 1, nrow, ncolumn, & 425 opt_array(1:nlegend), 1.0_pl_test_flt, 1.0_pl_test_flt, 1.5_pl_test_flt, & 426 1._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 427 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 428 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 429 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 430 431 if ( i .eq. nturn ) then 432 position = PL_POSITION_TOP + PL_POSITION_RIGHT + PL_POSITION_SUBPAGE 433 opt = opt_base 434 x = 1._pl_test_flt - x 435 y = y + legend_height 436 else 437 x = x + legend_width 438 y = y + legend_height 439 endif 440 enddo 441 442 ! Fourth page illustrating various kinds of legends 443 444 max_height = 0._pl_test_flt 445 xstart = 0.0_pl_test_flt 446 ystart = 0.1_pl_test_flt 447 x = xstart 448 y = ystart 449 text_scale = 0.90_pl_test_flt 450 call pladv( 0 ) 451 call plvpor( 0.0_pl_test_flt, 1._pl_test_flt, 0.0_pl_test_flt, 0.90_pl_test_flt ) 452 call plwind( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt ) 453 ! call plbox('bc', 0.0, 0, 'bc', 0.0_pl_test_flt, 0) 454 call plsfont( PL_FCI_SANS, -1, -1 ) 455 call plmtex( 't', 2.0_pl_test_flt, 0.5_pl_test_flt, 0.5_pl_test_flt, & 456 'Demonstrate Various Kinds of Legends' ) 457 458 nlegend = 5 459 460 ! Only specify legend data that are required according to the 461 ! value of opt_array for that entry. 462 463 position = PL_POSITION_LEFT + PL_POSITION_TOP 464 opt_base = PL_LEGEND_BACKGROUND + PL_LEGEND_BOUNDING_BOX + PL_LEGEND_TEXT_LEFT 465 466 ! Set up None, Box, Line, Symbol, and Line & Symbol legend entries. 467 468 opt_array(1) = PL_LEGEND_NONE 469 text(1) = 'None' 470 text_colors(1) = 1 471 472 opt_array(2) = PL_LEGEND_COLOR_BOX 473 text(2) = 'Box' 474 text_colors(2) = 2 475 box_colors(2) = 2 476 box_patterns(2) = 0 477 box_scales(2) = 0.8_pl_test_flt 478 box_line_widths(2) = 1 479 480 opt_array(3) = PL_LEGEND_LINE 481 text(3) = 'Line' 482 text_colors(3) = 3 483 line_colors(3) = 3 484 line_styles(3) = 1 485 line_widths(3) = 1 486 487 opt_array(4) = PL_LEGEND_SYMBOL 488 text(4) = 'Symbol' 489 text_colors(4) = 4 490 symbol_colors(4) = 4 491 symbol_scales(4) = text_scale 492 symbol_numbers(4) = 4 493 symbols(4) = special_symbols(3) 494 495 opt_array(5) = PL_LEGEND_SYMBOL + PL_LEGEND_LINE 496 text(5) = 'L & S' 497 text_colors(5) = 5 498 line_colors(5) = 5 499 line_styles(5) = 1 500 line_widths(5) = 1 501 symbol_colors(5) = 5 502 symbol_scales(5) = text_scale 503 symbol_numbers(5) = 4 504 symbols(5) = special_symbols(3) 505 506 opt = opt_base 507 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 508 509 call pllegend( legend_width, legend_height, opt, position, x, y, & 510 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 511 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 512 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 513 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 514 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 515 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 516 max_height = max( max_height, legend_height ) 517 518 ! Set up symbol legend entries with various symbols. 519 520 do i = 1,nlegend 521 opt_array(i) = PL_LEGEND_SYMBOL 522 text(i) = 'Symbol ' // special_symbols(i) 523 text_colors(i) = i 524 symbol_colors(i) = i 525 symbol_scales(i) = text_scale 526 symbol_numbers(i) = 4 527 symbols(i) = special_symbols(i) 528 enddo 529 530 opt = opt_base 531 x = x + legend_width 532 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 533 534 call pllegend( legend_width, legend_height, opt, position, x, y, & 535 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 536 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 537 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 538 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 539 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 540 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 541 max_height = max( max_height, legend_height ) 542 543 ! Set up symbol legend entries with various numbers of symbols. 544 545 do i = 1,nlegend 546 opt_array(i) = PL_LEGEND_SYMBOL 547 write( text(i), '(a,i0)' ) 'Symbol Number ', i+1 548 text_colors(i) = i 549 symbol_colors(i) = i 550 symbol_scales(i) = text_scale 551 symbol_numbers(i) = i + 1 552 symbols(i) = special_symbols(3) 553 enddo 554 555 opt = opt_base 556 x = x + legend_width 557 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 558 559 call pllegend( legend_width, legend_height, opt, position, x, y, & 560 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 561 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 562 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 563 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 564 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 565 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 566 max_height = max( max_height, legend_height ) 567 568 ! Set up box legend entries with various colours. 569 570 do i = 1,nlegend 571 opt_array(i) = PL_LEGEND_COLOR_BOX 572 write( text(i), '(a,i0)' ) 'Box Color ', i 573 text_colors(i) = i 574 box_colors(i) = i 575 box_patterns(i) = 0 576 box_scales(i) = 0.8_pl_test_flt 577 box_line_widths(i) = 1 578 enddo 579 580 opt = opt_base 581 582 ! Use new origin 583 584 x = xstart 585 y = y + max_height 586 max_height = 0._pl_test_flt 587 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt) 588 589 call pllegend( legend_width, legend_height, opt, position, x, y, & 590 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 591 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 592 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 593 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 594 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 595 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 596 max_height = max( max_height, legend_height ) 597 598 ! Set up box legend entries with various patterns. 599 600 do i = 1,nlegend 601 opt_array(i) = PL_LEGEND_COLOR_BOX 602 write( text(i), '(a,i0)' ) 'Box Pattern ', i-1 603 text_colors(i) = 2 604 box_colors(i) = 2 605 box_patterns(i) = i - 1 606 box_scales(i) = 0.8_pl_test_flt 607 box_line_widths(i) = 1 608 enddo 609 610 opt = opt_base 611 x = x + legend_width 612 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 613 614 call pllegend( legend_width, legend_height, opt, position, x, y, & 615 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 616 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 617 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 618 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 619 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 620 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 621 max_height = max( max_height, legend_height ) 622 623 ! Set up box legend entries with various box pattern line widths. 624 625 do i = 1,nlegend 626 opt_array(i) = PL_LEGEND_COLOR_BOX 627 write( text(i), '(a,i0)' ) 'Box Line Width ', i 628 text_colors(i) = 2 629 box_colors(i) = 2 630 box_patterns(i) = 3 631 box_scales(i) = 0.8_pl_test_flt 632 box_line_widths(i) = i 633 enddo 634 635 opt = opt_base 636 x = x + legend_width 637 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 638 639 call pllegend( legend_width, legend_height, opt, position, x, y, & 640 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 641 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 642 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 643 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 644 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 645 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 646 max_height = max( max_height, legend_height ) 647 648 ! Set up line legend entries with various colours. 649 650 do i =1,nlegend 651 opt_array(i) = PL_LEGEND_LINE 652 write( text(i), '(a,i0)' ) 'Line Color ', i 653 text_colors(i) = i 654 line_colors(i) = i 655 line_styles(i) = 1 656 line_widths(i) = 1 657 enddo 658 659 opt = opt_base 660 661 ! Use new origin 662 663 x = xstart 664 y = y + max_height 665 max_height = 0._pl_test_flt 666 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 667 668 call pllegend( legend_width, legend_height, opt, position, x, y, & 669 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 670 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 671 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 672 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 673 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 674 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 675 max_height = max( max_height, legend_height ) 676 677 ! Set up line legend entries with various styles. 678 679 do i = 1,nlegend 680 opt_array(i) = PL_LEGEND_LINE 681 write( text(i), '(a,i0)' ) 'Line Style ', i 682 text_colors(i) = 2 683 line_colors(i) = 2 684 line_styles(i) = i 685 line_widths(i) = 1 686 enddo 687 688 opt = opt_base 689 x = x + legend_width 690 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 691 692 call pllegend( legend_width, legend_height, opt, position, x, y, & 693 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 694 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 695 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 696 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 697 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 698 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 699 max_height = max( max_height, legend_height ) 700 701 ! Set up line legend entries with various widths. 702 703 do i =1,nlegend 704 opt_array(i) = PL_LEGEND_LINE 705 write( text(i), '(a,i0)' ) 'Line Width ', i 706 text_colors(i) = 2 707 line_colors(i) = 2 708 line_styles(i) = 1 709 line_widths(i) = i 710 enddo 711 712 opt = opt_base 713 x = x + legend_width 714 call plscol0a( 15, 32, 32, 32, 0.70_pl_test_flt ) 715 716 call pllegend( legend_width, legend_height, opt, position, x, y, & 717 0.1_pl_test_flt, 15, 1, 1, 0, 0, & 718 opt_array(1:nlegend), 1.0_pl_test_flt, text_scale, 2.0_pl_test_flt, & 719 0._pl_test_flt, text_colors(1:nlegend), text(1:nlegend), & 720 box_colors(1:nlegend), box_patterns(1:nlegend), box_scales(1:nlegend), box_line_widths(1:nlegend), & 721 line_colors(1:nlegend), line_styles(1:nlegend), line_widths(1:nlegend), & 722 symbol_colors(1:nlegend), symbol_scales(1:nlegend), symbol_numbers(1:nlegend), symbols(1:nlegend) ) 723 max_height = max( max_height, legend_height ) 724 725 ! Color bar examples 726 727 ! Use unsaturated green background colour to contrast with black caps. 728 call plscolbg( 70, 185, 70 ) 729 ! Cut out the greatest and smallest bits of the color spectrum to 730 ! leave colors for the end caps. 731 call plscmap1_range( 0.01_pl_test_flt, 0.99_pl_test_flt ) 732 733 ! We can only test image and gradient colorbars with two element arrays 734 do i = 2,COLORBAR_KINDS-1 735 call plcolorbar_example( "cmap1_blue_yellow.pal", i, 0, 0._pl_test_flt, 2, values_small ) 736 enddo 737 ! Test shade colorbars with larger arrays 738 do i = 0,1 739 call plcolorbar_example( "cmap1_blue_yellow.pal", i, 4, 2._pl_test_flt, 9, values_even ) 740 enddo 741 do i = 0,1 742 call plcolorbar_example( "cmap1_blue_yellow.pal", i, 0, 0._pl_test_flt, 9, values_uneven ) 743 enddo 744 745 call plend() 746 747contains 748 749 subroutine plcolorbar_example_page( kind_i, label_i, cap_i, cont_color, cont_width, n_values, values ) 750 751 use plplot 752 753 implicit none 754 755 integer :: kind_i, label_i, cap_i, cont_color, n_values 756 real(kind=pl_test_flt) :: cont_width 757 real(kind=pl_test_flt), dimension(:) :: values 758 759 ! Parameters for the colorbars on this page 760 integer :: position_i, position, opt 761 real(kind=pl_test_flt) :: x, y, x_length, y_length; 762 real(kind=pl_test_flt) :: ticks(1) 763 integer :: sub_ticks(1) 764 real(kind=pl_test_flt) :: low_cap_color, high_cap_color 765 logical :: vertical, ifn 766 character(len=20) :: axis_opts(1) 767 integer :: label_opts(1) 768 character(len=200) :: labels(1) 769 character(len=200) :: title 770 real(kind=pl_test_flt) :: colorbar_width, colorbar_height 771 integer :: n_values_array(1); 772 real(kind=pl_test_flt), allocatable, dimension(:,:) :: values_array 773 774 ticks(1) = 0.0_pl_test_flt 775 sub_ticks(1) = 0 776 label_opts(1) = 0 777 778 n_values_array(1) = n_values 779 allocate(values_array(1,n_values)) 780 values_array(1,:) = values(:) 781 782 low_cap_color = 0.0_pl_test_flt; 783 high_cap_color = 1.0_pl_test_flt; 784 785 ! Start a new page 786 call pladv( 0 ) 787 788 ! Draw one colorbar relative to each side of the page 789 do position_i = 0,COLORBAR_POSITIONS-1 790 position = colorbar_position_options(position_i+1); 791 opt = ior( & 792 colorbar_option_kinds(kind_i+1), & 793 ior(colorbar_label_options(label_i+1), & 794 colorbar_cap_options(cap_i+1) ) ) 795 796 vertical = (iand(position, PL_POSITION_LEFT) > 0 .or. iand(position, PL_POSITION_RIGHT) > 0 ) 797 ifn = (iand(position, PL_POSITION_LEFT) > 0 .or. iand(position, PL_POSITION_BOTTOM) > 0 ) 798 799 ! Set the offset position on the page 800 if (vertical .eqv. .true.) then 801 x = 0.0_pl_test_flt 802 y = 0.0_pl_test_flt 803 x_length = 0.05_pl_test_flt 804 y_length = 0.5_pl_test_flt 805 else 806 x = 0.0_pl_test_flt 807 y = 0.0_pl_test_flt 808 x_length = 0.5_pl_test_flt 809 y_length = 0.05_pl_test_flt 810 endif 811 812 ! Set appropriate labelling options. 813 if (ifn .eqv. .true.) then 814 if ( cont_color .eq. 0 .or. cont_width .eq. 0._pl_test_flt ) then 815 axis_opts(1) = "uwtivn" 816 else 817 axis_opts(1) = "uwxvn" 818 endif 819 else 820 if ( cont_color .eq. 0 .or. cont_width .eq. 0._pl_test_flt ) then 821 axis_opts(1) = "uwtivm" 822 else 823 axis_opts(1) = "uwxvm" 824 endif 825 endif 826 827 write(labels(1), '(3A)') trim(colorbar_position_option_labels(position_i+1)), & 828 ', ', trim(colorbar_label_option_labels(label_i+1)) 829 830 ! Smaller text 831 call plschr( 0.0_pl_test_flt, 0.75_pl_test_flt ) 832 ! Small ticks on the vertical axis 833 call plsmaj( 0.0_pl_test_flt, 0.5_pl_test_flt ) 834 call plsmin( 0.0_pl_test_flt, 0.5_pl_test_flt ) 835 836 call plvpor( 0.20_pl_test_flt, 0.80_pl_test_flt, 0.20_pl_test_flt, 0.80_pl_test_flt ) 837 call plwind( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt ) 838 ! Set interesting background colour. 839 call plscol0a( 15, 0, 0, 0, 0.20_pl_test_flt ) 840 call plcolorbar( colorbar_width, colorbar_height, & 841 ior(opt, ior(PL_COLORBAR_BOUNDING_BOX, PL_COLORBAR_BACKGROUND)), position, & 842 x, y, x_length, y_length, & 843 15, 1, 1, & 844 low_cap_color, high_cap_color, & 845 cont_color, cont_width, & 846 label_opts, labels, & 847 axis_opts, ticks, sub_ticks, & 848 n_values_array, values_array ) 849 850 ! Reset text and tick sizes 851 call plschr( 0.0_pl_test_flt, 1.0_pl_test_flt ) 852 call plsmaj( 0.0_pl_test_flt, 1.0_pl_test_flt ) 853 call plsmin( 0.0_pl_test_flt, 1.0_pl_test_flt ) 854 enddo 855 856 857 ! Draw a page title 858 write(title, '(3A)') trim(colorbar_option_kind_labels(kind_i+1)), ' - ', & 859 trim(colorbar_cap_option_labels(cap_i+1)) 860 call plvpor( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt ) 861 call plwind( 0.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt ) 862 call plptex( 0.5_pl_test_flt, 0.5_pl_test_flt, 0.0_pl_test_flt, 0.0_pl_test_flt, 0.5_pl_test_flt, title ) 863 864 deallocate(values_array) 865 866 end subroutine plcolorbar_example_page 867 868 subroutine plcolorbar_example( palette, kind_i, cont_color, cont_width, n_values, values ) 869 character(*) :: palette 870 integer :: kind_i, label_i, cap_i, cont_color, n_values 871 real(kind=pl_test_flt) :: cont_width 872 real(kind=pl_test_flt), dimension(:) :: values 873 874 ! Load the color palette 875 call plspal1( palette, .true. ) 876 877 do label_i = 0,COLORBAR_LABELS-1 878 do cap_i = 0,COLORBAR_CAPS-1 879 call plcolorbar_example_page( kind_i, label_i, cap_i, & 880 cont_color, cont_width, & 881 n_values, values ) 882 enddo 883 enddo 884 end subroutine plcolorbar_example 885 886end program x33f 887