1-- Displays Greek letters and mathematically interesting Unicode ranges. 2 3-- Copyright (C) 2008 Jerry Bauck 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 21with 22 Ada.Text_IO, 23 Ada.Integer_Text_IO, 24 Ada.Strings.Unbounded, 25 Ada.Characters.Handling, 26 Ada.Strings, 27 Ada.Strings.Fixed, 28 Ada.Numerics, 29 Ada.Numerics.Long_Elementary_Functions, 30 PLplot_Auxiliary, 31 PLplot_Standard; 32use 33 Ada.Text_IO, 34 Ada.Integer_Text_IO, 35 Ada.Strings.Unbounded, 36 Ada.Strings, 37 Ada.Strings.Fixed, 38 Ada.Numerics, 39 Ada.Numerics.Long_Elementary_Functions, 40 PLplot_Auxiliary, 41 PLplot_Standard; 42 43procedure xstandard23a is 44 45 Greek : array(0 .. 47) of String(1 .. 3) := ( 46 "#gA","#gB","#gG","#gD","#gE","#gZ","#gY","#gH","#gI","#gK","#gL","#gM", 47 "#gN","#gC","#gO","#gP","#gR","#gS","#gT","#gU","#gF","#gX","#gQ","#gW", 48 "#ga","#gb","#gg","#gd","#ge","#gz","#gy","#gh","#gi","#gk","#gl","#gm", 49 "#gn","#gc","#go","#gp","#gr","#gs","#gt","#gu","#gf","#gx","#gq","#gw"); 50 51 Type1 : array (0 .. 165) of Integer := ( 52 16#0020#,16#0021#,16#0023#,16#0025#,16#0026#, 53 16#0028#,16#0029#,16#002b#,16#002c#,16#002e#, 54 16#002f#,16#0030#,16#0031#,16#0032#,16#0033#, 55 16#0034#,16#0035#,16#0036#,16#0037#,16#0038#, 56 16#0039#,16#003a#,16#003b#,16#003c#,16#003d#, 57 16#003e#,16#003f#,16#005b#,16#005d#,16#005f#, 58 16#007b#,16#007c#,16#007d#,16#00a9#,16#00ac#, 59 16#00ae#,16#00b0#,16#00b1#,16#00d7#,16#00f7#, 60 16#0192#,16#0391#,16#0392#,16#0393#,16#0394#, 61 16#0395#,16#0396#,16#0397#,16#0398#,16#0399#, 62 16#039a#,16#039b#,16#039c#,16#039d#,16#039e#, 63 16#039f#,16#03a0#,16#03a1#,16#03a3#,16#03a4#, 64 16#03a5#,16#03a6#,16#03a7#,16#03a8#,16#03a9#, 65 16#03b1#,16#03b2#,16#03b3#,16#03b4#,16#03b5#, 66 16#03b6#,16#03b7#,16#03b8#,16#03b9#,16#03ba#, 67 16#03bb#,16#03bc#,16#03bd#,16#03be#,16#03bf#, 68 16#03c0#,16#03c1#,16#03c2#,16#03c3#,16#03c4#, 69 16#03c5#,16#03c6#,16#03c7#,16#03c8#,16#03c9#, 70 16#03d1#,16#03d2#,16#03d5#,16#03d6#,16#2022#, 71 16#2026#,16#2032#,16#2033#,16#203e#,16#2044#, 72 16#2111#,16#2118#,16#211c#,16#2122#,16#2126#, 73 16#2135#,16#2190#,16#2191#,16#2192#,16#2193#, 74 16#2194#,16#21b5#,16#21d0#,16#21d1#,16#21d2#, 75 16#21d3#,16#21d4#,16#2200#,16#2202#,16#2203#, 76 16#2205#,16#2206#,16#2207#,16#2208#,16#2209#, 77 16#220b#,16#220f#,16#2211#,16#2212#,16#2215#, 78 16#2217#,16#221a#,16#221d#,16#221e#,16#2220#, 79 16#2227#,16#2228#,16#2229#,16#222a#,16#222b#, 80 16#2234#,16#223c#,16#2245#,16#2248#,16#2260#, 81 16#2261#,16#2264#,16#2265#,16#2282#,16#2283#, 82 16#2284#,16#2286#,16#2287#,16#2295#,16#2297#, 83 16#22a5#,16#22c5#,16#2320#,16#2321#,16#2329#, 84 16#232a#,16#25ca#,16#2660#,16#2663#,16#2665#, 85 16#2666#); 86 87 88 function title(which : Integer) return String is 89 begin 90 if which = 0 then return "#<0x10>PLplot Example 23 - Greek Letters"; end if; 91 if which = 1 then return "#<0x10>PLplot Example 23 - Type 1 Symbol Font Glyphs by Unicode (a)"; end if; 92 if which = 2 then return "#<0x10>PLplot Example 23 - Type 1 Symbol Font Glyphs by Unicode (b)"; end if; 93 if which = 3 then return "#<0x10>PLplot Example 23 - Type 1 Symbol Font Glyphs by Unicode (c)"; end if; 94 if which = 4 then return "#<0x10>PLplot Example 23 - Number Forms Unicode Block"; end if; 95 if which = 5 then return "#<0x10>PLplot Example 23 - Arrows Unicode Block (a)"; end if; 96 if which = 6 then return "#<0x10>PLplot Example 23 - Arrows Unicode Block (b)"; end if; 97 if which = 7 then return "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (a)"; end if; 98 if which = 8 then return "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (b)"; end if; 99 if which = 9 then return "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (c)"; end if; 100 if which = 10 then return "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (d)"; end if; 101 return "oops"; 102 end title; 103 104 105 lo : array (0 .. 10) of Integer := ( 106 16#0#, 107 16#0#, 108 16#40#, 109 16#80#, 110 16#2153#, 111 16#2190#, 112 16#21d0#, 113 16#2200#, 114 16#2240#, 115 16#2280#, 116 16#22c0# 117 ); 118 119 hi : array (0 .. 10) of Integer := ( 120 16#30#, 121 16#40#, 122 16#80#, 123 16#A6#, 124 16#2184#, 125 16#21d0#, 126 16#2200#, 127 16#2240#, 128 16#2280#, 129 16#22c0#, 130 16#2300# 131 ); 132 133 nxcells : array (0 .. 10) of Integer := ( 134 12, 135 8, 136 8, 137 8, 138 8, 139 8, 140 8, 141 8, 142 8, 143 8, 144 8 145 ); 146 147 nycells : array (0 .. 10) of Integer := ( 148 8, 149 8, 150 8, 151 8, 152 8, 153 8, 154 8, 155 8, 156 8, 157 8, 158 8 159 ); 160 161 -- non-zero values must be consistent with nxcells and nycells. 162 offset : array (0 .. 10) of Integer := ( 163 0, 164 0, 165 64, 166 128, 167 0, 168 0, 169 0, 170 0, 171 0, 172 0, 173 0 174 ); 175 176 -- 30 possible FCI values. 177 FCI_COMBINATIONS : constant integer := 30; 178 fci : array (0 .. 29) of Unicode := ( 179 16#80000000#, 180 16#80000001#, 181 16#80000002#, 182 16#80000003#, 183 16#80000004#, 184 16#80000010#, 185 16#80000011#, 186 16#80000012#, 187 16#80000013#, 188 16#80000014#, 189 16#80000020#, 190 16#80000021#, 191 16#80000022#, 192 16#80000023#, 193 16#80000024#, 194 16#80000100#, 195 16#80000101#, 196 16#80000102#, 197 16#80000103#, 198 16#80000104#, 199 16#80000110#, 200 16#80000111#, 201 16#80000112#, 202 16#80000113#, 203 16#80000114#, 204 16#80000120#, 205 16#80000121#, 206 16#80000122#, 207 16#80000123#, 208 16#80000124# 209 ); 210 211 212 function family(which : Integer) return String is 213 begin 214 if which = 0 then return "sans-serif"; end if; 215 if which = 1 then return "serif"; end if; 216 if which = 2 then return "monospace"; end if; 217 if which = 3 then return "script"; end if; 218 if which = 4 then return "symbol"; end if; 219 return "oops"; 220 end family; 221 222 223 function style(which : Integer) return String is 224 begin 225 if which = 0 then return "upright"; end if; 226 if which = 1 then return "italic"; end if; 227 if which = 2 then return "oblique"; end if; 228 return "oops"; 229 end style; 230 231 232 function weight(which : Integer) return String is 233 begin 234 if which = 0 then return "medium"; end if; 235 if which = 1 then return "bold"; end if; 236 return "oops"; 237 end weight; 238 239 xmin, xmax, ymin, ymax, ycharacter_scale, yoffset : Long_Float; 240 chardef, charht, deltax, deltay, x, y : Long_Float; 241 length, slice : Integer; 242 cmdString : Unbounded_String; 243 fci_old : Unicode; 244 ifamily, istyle, iweight : Integer; 245 dy : Long_Float := 0.030; 246 family_index, style_index, weight_index : Integer; 247 248 -- Must be big enough to contain the prefix strings, the font-changing 249 -- commands, and the "The quick brown..." string. 250 a_string : Unbounded_String; 251 252 package Unicode_IO is new Ada.Text_IO.Modular_IO(Unicode); -- fix this probably not used 253 use Unicode_IO; 254 255 -- Make a four-character hexadecimal string image of integers. 256 -- Useful for font manipulations. 257 -- To_Lower is used to make C-like output for A..F 258 -- so that the PostScript files generated by C and Ada are identical. 259 -- Integer values greater than 65535 (2^16-1) are treated modulo 2^16. 260 -- Based on Stephen Leake's SAL.Generic_Hex_Image. 261 -- Original: Copyright (C) 2005 Stephen Leake. All Rights Reserved, and 262 -- offered under GNU General Public License version 2 or later. 263 function Hex_Image_4 (Item : in Integer) return String is 264 Temp : Integer := Item; 265 Nibble : Integer; 266 Image : String (1 .. 4); 267 begin 268 for I in reverse Image'Range loop 269 Nibble := Temp mod 16; 270 Temp := Temp / 16; 271 if Nibble > 9 then 272 Image (I) := Character'Val (Character'Pos ('A') + Nibble - 10); 273 else 274 Image (I) := Character'Val (Character'Pos ('0') + Nibble); 275 end if; 276 end loop; 277 Image := Ada.Characters.Handling.To_Lower(Image); 278 return Image; 279 end Hex_Image_4; 280 281 282 -- Make a eight-character hexadecimal string image of Unicode. 283 function Hex_Image_8 (Item : in Unicode) return String is 284 -- Long_Long_Integer so don't overflow Integer 285 Temp : Long_Long_Integer := Long_Long_Integer(Item); 286 Nibble : Long_Long_Integer; 287 Image : String (1 .. 8); 288 begin 289 for I in reverse Image'Range loop 290 Nibble := Temp mod 16; 291 Temp := Temp / 16; 292 if Nibble > 9 then 293 Image (I) := Character'Val(Character'Pos ('A') + Nibble - 10); 294 else 295 Image (I) := Character'Val(Character'Pos ('0') + Nibble); 296 end if; 297 end loop; 298 Image := Ada.Characters.Handling.To_Lower(Image); 299 return Image; 300 end Hex_Image_8; 301 302begin 303 Parse_Command_Line_Arguments(Parse_Full); 304 305 Initialize_PLplot; 306 307 for page in 0 .. 10 loop 308 Advance_To_Subpage(Next_Subpage); 309 310 -- Set up viewport and window 311 Set_Viewport_Normalized(0.02, 0.98, 0.02, 0.90); 312 Set_Viewport_World(0.0, 1.0, 0.0, 1.0); 313 Get_Subpage_Boundaries(xmin, xmax, ymin, ymax); 314 Set_Character_Height(0.0, 0.8); 315 ycharacter_scale := (1.0 - 0.0) / (ymax - ymin); 316 317 -- Factor should be 0.5, but heuristically it turns out to be larger. 318 Get_Character_Height(chardef, charht); 319 yoffset := 1.0 * charht * ycharacter_scale; 320 321 -- Draw the grid using Box_Around_Viewport 322 Set_Pen_Color(Yellow); 323 deltax := 1.0 / Long_Float(nxcells(page)); 324 deltay := 1.0 / Long_Float(nycells(page)); 325 Box_Around_Viewport("bcg", deltax, 0, "bcg", deltay, 0); 326 Set_Pen_Color(White); 327 length := hi(page) - lo(page); 328 slice := 0; 329 for j in reverse -1 .. nycells(page) - 1 loop 330 y := (0.5 + Long_Float(j)) * deltay; 331 for i in 0 .. nxcells(page) - 1 loop 332 x := (0.5 + Long_Float(i)) * deltax; 333 if slice < length then 334 if page = 0 then 335 cmdString := To_Unbounded_String(Greek(slice)); 336 337 elsif page >= 1 and page <= 3 then 338 cmdString := To_Unbounded_String("#[0x" & Hex_Image_4(Type1(offset(page)+slice)) & "]"); 339 340 elsif page >= 4 then 341 cmdString := To_Unbounded_String("#[0x" & Hex_Image_4(lo(page)+slice) & "]"); 342 end if; 343 Write_Text_World(x, y + yoffset, 1.0, 0.0, 0.5, To_String(cmdString)); 344 Write_Text_World(x, y - yoffset, 1.0, 0.0, 0.5, "#" & To_String(cmdString)); 345 end if; 346 slice := slice + 1; 347 end loop; -- i 348 end loop; -- j 349 350 Set_Character_Height(0.0, 1.0); 351 352 -- Page title 353 Write_Text_Viewport("t", 1.5, 0.5, 0.5, title(page)); 354 end loop; --page 355 356 -- Demonstrate methods of getting the current fonts 357 Get_Font_Characterization_Integer(fci_old); 358 Get_Font(ifamily, istyle, iweight); 359 Put("For example 23 prior to page 12 the FCI is "); 360 361 -- The following hack in outputting the hexadecimal value of fci_old in "C" 362 -- style, e.g. 0x00000000 instead of "Ada" style 16#00000000#, is done in 363 -- order to create the same textual output as the C example x23c. 364 -- Put(fci_old, Base => 16, Width => 0); -- Outputs "Ada" style. 365 Put("0x" & Hex_Image_8(fci_old)); -- Outputs "C" style. 366 New_Line; 367 Put("For example 23 prior to page 12 the font family, style and weight are " 368 & family(ifamily) & " " & style(istyle) & " " & weight(iweight)); 369 New_Line; 370 371 for page in 11 .. 15 loop 372 Advance_To_Subpage(Next_Subpage); 373 Set_Viewport_Normalized(0.02, 0.98, 0.02, 0.90); 374 Set_Viewport_World(0.0, 1.0, 0.0, 1.0); 375 Set_Font_Characterization_Integer(0); 376 if page = 11 then 377 Write_Text_Viewport("t", 1.5, 0.5, 0.5, 378 "#<0x10>PLplot Example 23 - " & 379 "Set Font with plsfci"); 380 elsif page = 12 then 381 Write_Text_Viewport("t", 1.5, 0.5, 0.5, 382 "#<0x10>PLplot Example 23 - " & 383 "Set Font with plsfont"); 384 elsif page = 13 then 385 Write_Text_Viewport("t", 1.5, 0.5, 0.5, 386 "#<0x10>PLplot Example 23 - " & 387 "Set Font with ##<0x8nnnnnnn> construct"); 388 elsif page = 14 then 389 Write_Text_Viewport("t", 1.5, 0.5, 0.5, 390 "#<0x10>PLplot Example 23 - " & 391 "Set Font with ##<0xmn> constructs"); 392 elsif page = 15 then 393 Write_Text_Viewport("t", 1.5, 0.5, 0.5, 394 "#<0x10>PLplot Example 23 - " & 395 "Set Font with ##<FCI COMMAND STRING/> constructs"); 396 end if; 397 Set_Character_Height(0.0, 0.75); 398 for i in 0 .. FCI_COMBINATIONS - 1 loop 399 family_index := i mod 5; 400 style_index := (i / 5) mod 3; 401 weight_index := ((i / 5) / 3) mod 2; 402 if page = 11 then 403 Set_Font_Characterization_Integer(fci(i)); 404 a_string := To_Unbounded_String( 405 "Page 12, " & 406 family(family_index) & ", " & 407 style (style_index) & ", " & 408 weight(weight_index) & ": " & 409 "The quick brown fox jumps over the lazy dog"); 410 elsif page = 12 then 411 Set_Font(family_index, style_index, weight_index); 412 a_string := To_Unbounded_String( 413 "Page 13, " & 414 family(family_index) & ", " & 415 style (style_index) & ", " & 416 weight(weight_index) & ": " & 417 "The quick brown fox jumps over the lazy dog"); 418 elsif page = 13 then 419 a_string := To_Unbounded_String( 420 "Page 14, " & 421 family(family_index) & ", " & 422 style (style_index) & ", " & 423 weight(weight_index) & ": " & 424 "#<0x" & Hex_Image_8(fci(i)) & ">" & 425 "The quick brown fox jumps over the lazy dog"); 426 elsif page = 14 then 427 a_string := To_Unbounded_String( 428 "Page 15, " & 429 family(family_index) & ", " & 430 style (style_index) & ", " & 431 weight(weight_index) & ": " & 432 "#<0x" & Trim(Integer'Image(family_index), Left) & 433 "0>#<0x" & Trim(Integer'Image(style_index), Left) & 434 "1>#<0x" & Trim(Integer'Image(weight_index), Left) & "2>" & 435 "The quick brown fox jumps over the lazy dog"); 436 elsif page = 15 then 437 a_string := To_Unbounded_String( 438 "Page 16, " & 439 family(family_index) & ", " & 440 style (style_index) & ", " & 441 weight(weight_index) & ": " & 442 "#<" & family(family_index) & "/>#<" & style (style_index) & 443 "/>#<" & weight(weight_index) & "/>" & 444 "The quick brown fox jumps over the lazy dog"); 445 end if; 446 Write_Text_World (0.0, 1.0 - (Long_Float(i) + 0.5) * dy, 1.0, 0.0, 0.0, To_String(a_string)); 447 end loop; -- i 448 449 Set_Character_Height(0.0, 1.0); 450 end loop; -- page 451 452 -- Restore defaults 453 Set_Pen_Color(Red); 454 455 End_PLplot; 456end xstandard23a; 457