← Back to branch summary

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

« back to all changes in this revision

Viewing changes to examples/f77/x23f.fm4

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