~ubuntu-branches/ubuntu/intrepid/plplot/intrepid

« back to all changes in this revision

Viewing changes to examples/f95/x23f.f90

  • Committer: Bazaar Package Importer
  • Author(s): Rafael Laboissiere
  • Date: 2006-11-04 10:19:34 UTC
  • mfrom: (2.1.8 edgy)
  • Revision ID: james.westby@ubuntu.com-20061104101934-mlirvdg4gpwi6i5q
Tags: 5.6.1-10
* Orphaning the package
* debian/control: Changed the maintainer to the Debian QA Group

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
!      $Id: x23f.f90,v 1.1 2006/05/16 20:24:14 airwin Exp $
 
2
!
 
3
!   Displays Greek letters and mathematically interesting Unicode ranges
 
4
!
 
5
!   Copyright (C) 2005 Alan Irwin
 
6
!   Copyright (C) 2005 Andrew Ross
 
7
!
 
8
!
 
9
!   This file is part of PLplot.
 
10
!
 
11
!   PLplot is free software; you can redistribute it and/or modify
 
12
!   it under the terms of the GNU General Library Public License as published
 
13
!   by the Free Software Foundation; either version 2 of the License, or
 
14
!   (at your option) any later version.
 
15
!
 
16
!   PLplot is distributed in the hope that it will be useful,
 
17
!   but WITHOUT ANY WARRANTY; without even the implied warranty of
 
18
!   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
19
!   GNU Library General Public License for more details.
 
20
!
 
21
!   You should have received a copy of the GNU Library General Public License
 
22
!   along with PLplot; if not, write to the Free Software
 
23
!   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
24
!
 
25
!
 
26
 
 
27
      program x23f
 
28
      use plplot
 
29
      implicit none
 
30
 
 
31
      real(kind=plflt) xmin, xmax, ymin, ymax, ycharacter_scale, yoffset
 
32
      real(kind=plflt) chardef, charht, deltax, deltay, x, y
 
33
      integer i, j, page, length, slice
 
34
      character*20 cmdString
 
35
 
 
36
!
 
37
!  Displays Greek letters and mathematically interesting Unicode ranges
 
38
!
 
39
      character*5  greek(48)
 
40
      integer      type1(166)
 
41
      character*80 title(11)
 
42
      integer      lo(11)
 
43
      integer      hi(11)
 
44
      integer      nxcells(11)
 
45
      integer      nycells(11)
 
46
      integer      offset(11)
 
47
 
 
48
      data (greek(i) ,i=1,48) / &
 
49
       '#gA','#gB','#gG','#gD','#gE','#gZ', &
 
50
       '#gY','#gH','#gI','#gK','#gL','#gM', &
 
51
       '#gN','#gC','#gO','#gP','#gR','#gS', &
 
52
       '#gT','#gU','#gF','#gX','#gQ','#gW', &
 
53
       '#ga','#gb','#gg','#gd','#ge','#gz', &
 
54
       '#gy','#gh','#gi','#gk','#gl','#gm', &
 
55
       '#gn','#gc','#go','#gp','#gr','#gs', &
 
56
       '#gt','#gu','#gf','#gx','#gq','#gw'  /
 
57
 
 
58
      data (type1(i) ,i=1,75) / &
 
59
       z'0020',z'0021',z'0023',z'0025',z'0026', &
 
60
       z'0028',z'0029',z'002b',z'002c',z'002e', &
 
61
       z'002f',z'0030',z'0031',z'0032',z'0033', &
 
62
       z'0034',z'0035',z'0036',z'0037',z'0038', &
 
63
       z'0039',z'003a',z'003b',z'003c',z'003d', &
 
64
       z'003e',z'003f',z'005b',z'005d',z'005f', &
 
65
       z'007b',z'007c',z'007d',z'00a9',z'00ac', &
 
66
       z'00ae',z'00b0',z'00b1',z'00d7',z'00f7', &
 
67
       z'0192',z'0391',z'0392',z'0393',z'0394', &
 
68
       z'0395',z'0396',z'0397',z'0398',z'0399', &
 
69
       z'039a',z'039b',z'039c',z'039d',z'039e', &
 
70
       z'039f',z'03a0',z'03a1',z'03a3',z'03a4', &
 
71
       z'03a5',z'03a6',z'03a7',z'03a8',z'03a9', &
 
72
       z'03b1',z'03b2',z'03b3',z'03b4',z'03b5', &
 
73
       z'03b6',z'03b7',z'03b8',z'03b9',z'03ba' /
 
74
      data (type1(i) ,i=76,166) / &
 
75
       z'03bb',z'03bc',z'03bd',z'03be',z'03bf', &
 
76
       z'03c0',z'03c1',z'03c2',z'03c3',z'03c4', &
 
77
       z'03c5',z'03c6',z'03c7',z'03c8',z'03c9', &
 
78
       z'03d1',z'03d2',z'03d5',z'03d6',z'2022', &
 
79
       z'2026',z'2032',z'2033',z'203e',z'2044', &
 
80
       z'2111',z'2118',z'211c',z'2122',z'2126', &
 
81
       z'2135',z'2190',z'2191',z'2192',z'2193', &
 
82
       z'2194',z'21b5',z'21d0',z'21d1',z'21d2', &
 
83
       z'21d3',z'21d4',z'2200',z'2202',z'2203', &
 
84
       z'2205',z'2206',z'2207',z'2208',z'2209', &
 
85
       z'220b',z'220f',z'2211',z'2212',z'2215', &
 
86
       z'2217',z'221a',z'221d',z'221e',z'2220', &
 
87
       z'2227',z'2228',z'2229',z'222a',z'222b', &
 
88
       z'2234',z'223c',z'2245',z'2248',z'2260', &
 
89
       z'2261',z'2264',z'2265',z'2282',z'2283', &
 
90
       z'2284',z'2286',z'2287',z'2295',z'2297', &
 
91
       z'22a5',z'22c5',z'2320',z'2321',z'2329', &
 
92
       z'232a',z'25ca',z'2660',z'2663',z'2665', &
 
93
       z'2666' /
 
94
 
 
95
      data (title(i) ,i=1,11 )/ &
 
96
   "#<0x10>PLplot Example 23 - Greek Letters", &
 
97
   "#<0x10>PLplot Example 23 - Type 1 Symbol Font Glyphs by Unicode (a)", &
 
98
   "#<0x10>PLplot Example 23 - Type 1 Symbol Font Glyphs by Unicode (b)", &
 
99
   "#<0x10>PLplot Example 23 - Type 1 Symbol Font Glyphs by Unicode (c)", &
 
100
   "#<0x10>PLplot Example 23 - Number Forms Unicode Block", &
 
101
   "#<0x10>PLplot Example 23 - Arrows Unicode Block (a)", &
 
102
   "#<0x10>PLplot Example 23 - Arrows Unicode Block (b)", &
 
103
   "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (a)", &
 
104
   "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (b)", &
 
105
   "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (c)", &
 
106
   "#<0x10>PLplot Example 23 - Mathematical Operators Unicode Block (d)" /
 
107
 
 
108
      data (lo(i) ,i=1,11) / &
 
109
        z'0', &
 
110
        z'0', &
 
111
        z'40', &
 
112
        z'80', &
 
113
        z'2153', &
 
114
        z'2190', &
 
115
        z'21d0', &
 
116
        z'2200', &
 
117
        z'2240', &
 
118
        z'2280', &
 
119
        z'22c0' /
 
120
 
 
121
      data (hi(i) ,i=1,11) / &
 
122
        z'30', &
 
123
        z'40', &
 
124
        z'80', &
 
125
        z'A6', &
 
126
        z'2184', &
 
127
        z'21d0', &
 
128
        z'2200', &
 
129
        z'2240', &
 
130
        z'2280', &
 
131
        z'22c0', &
 
132
        z'2300' /
 
133
 
 
134
      data (nxcells(i) ,i=1,11) / &
 
135
      12, &
 
136
      8, &
 
137
      8, &
 
138
      8, &
 
139
      8, &
 
140
      8, &
 
141
      8, &
 
142
      8, &
 
143
      8, &
 
144
      8, &
 
145
      8 /
 
146
 
 
147
      data (nycells(i) ,i=1,11) / &
 
148
      8, &
 
149
      8, &
 
150
      8, &
 
151
      8, &
 
152
      8, &
 
153
      8, &
 
154
      8, &
 
155
      8, &
 
156
      8, &
 
157
      8, &
 
158
      8 /
 
159
 
 
160
!  non-zero values Must be consistent with nxcells and nycells. */
 
161
      data (offset(i) ,i=1,11) / &
 
162
      0, &
 
163
      0, &
 
164
      64, &
 
165
      128, &
 
166
      0, &
 
167
      0, &
 
168
      0, &
 
169
      0, &
 
170
      0, &
 
171
      0, &
 
172
      0 /
 
173
 
 
174
      call plparseopts(PL_PARSE_FULL)
 
175
 
 
176
      call plinit()
 
177
 
 
178
      do 130 page = 1,11
 
179
         call pladv(0)
 
180
 
 
181
!        Set up viewport and window
 
182
 
 
183
         call plvpor(0.02_plflt, 0.98_plflt, 0.02_plflt, 0.90_plflt)
 
184
         call plwind(0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt)
 
185
         call plgspa(xmin, xmax, ymin, ymax)
 
186
         call plschr(0._plflt, 0.8_plflt)
 
187
         ycharacter_scale = (1.0_plflt - 0.0_plflt)/(ymax-ymin)
 
188
 
 
189
!        Factor should be 0.5, but heuristically it turns out to be larger.
 
190
 
 
191
         call plgchr(chardef, charht)
 
192
         yoffset = 1.0_plflt*charht*ycharacter_scale
 
193
 
 
194
!        Draw the grid using plbox
 
195
 
 
196
         call plcol0(2)
 
197
         deltax = 1.0_plflt/nxcells(page)
 
198
         deltay = 1.0_plflt/nycells(page)
 
199
         call plbox("bcg", deltax, 0, "bcg", deltay, 0)
 
200
         call plcol0(15)
 
201
         length=hi(page)-lo(page)
 
202
         slice = 1
 
203
         do 120 j=nycells(page),0,-1
 
204
            y = (j-0.5_plflt)*deltay
 
205
            do 110 i=1,nxcells(page)
 
206
               x  = (i-0.5_plflt)*deltax
 
207
               if (slice .le. length) then
 
208
                  if (page .eq. 1) then
 
209
                     write(cmdString, '("#",a)') Greek(slice)
 
210
                  elseif (page .ge. 1 .and. page .le. 4) then
 
211
                     write(cmdString, '("##[0x",z4.4,"]")') &
 
212
                        type1(offset(page)+slice)
 
213
!                     Not required for command which is case insensitive,
 
214
!                     but lowercase the command simply to get same
 
215
!                     lowercase display of command as corresponding C example.
 
216
                     call lowercase23(cmdString)
 
217
                  elseif (page .ge. 5) then
 
218
                     write(cmdString, '("##[0x",z4.4,"]")') &
 
219
                        lo(page)+slice-1
 
220
!                     Not required for command which is case insensitive,
 
221
!                     but lowercase the command simply to get same
 
222
!                     lowercase display of command as corresponding C example.
 
223
                     call lowercase23(cmdString)
 
224
                  endif
 
225
                  call plptex(x,y+yoffset,1._plflt,0._plflt,0.5_plflt, &
 
226
                    cmdString(2:20))
 
227
                  call plptex(x,y-yoffset,1._plflt,0._plflt,0.5_plflt, &
 
228
                    cmdString)
 
229
               endif
 
230
               slice = slice + 1
 
231
  110       continue
 
232
 
 
233
  120    continue
 
234
 
 
235
         call plschr(0._plflt, 1.0_plflt)
 
236
         call plmtex("t", 1.5_plflt, 0.5_plflt, 0.5_plflt, title(page))
 
237
  130 continue
 
238
 
 
239
!     Restore defaults
 
240
 
 
241
      call plcol0(1)
 
242
 
 
243
      call plend()
 
244
 
 
245
      end
 
246
 
 
247
      subroutine lowercase23(string)
 
248
      implicit none
 
249
      character*(*) string
 
250
      integer i, len, iascii
 
251
      do i = 1, len(string)
 
252
        iascii = iachar(string(i:i))
 
253
        if(65.le.iascii.and.iascii.le.90) then
 
254
!          convert uppercase to lowercase.
 
255
          string(i:i) = achar(iascii+32)
 
256
        endif
 
257
      enddo
 
258
      end