1 /* -- translated by f2c (version 20100827).
2 You must link the resulting object file with libf2c:
3 on Microsoft Windows system, link with libf2c.lib;
4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 or, if you install libf2c.a in a standard place, with -lf2c -lm
6 -- in that order, at the end of the command line, as in
7 cc *.o -lf2c -lm
8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10 http://www.netlib.org/f2c/libf2c.zip
11 */
12
13 #include "libtinyf2c.h"
14
15 /* ----------------------------------------------------------------------- */
16 /* TEXT PRIMITIVE */
17 /* ----------------------------------------------------------------------- */
18 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
19 /* ----------------------------------------------------------------------- */
sgtxu_0_(int n__,real * ux,real * uy,char * chars,real * vx,real * vy,real * rx,real * ry,real * rsize,integer * irota,integer * icent,integer * index,ftnlen chars_len)20 /* Subroutine */ int sgtxu_0_(int n__, real *ux, real *uy, char *chars, real *
21 vx, real *vy, real *rx, real *ry, real *rsize, integer *irota,
22 integer *icent, integer *index, ftnlen chars_len)
23 {
24 /* Initialized data */
25
26 static real rsizez = .05f;
27 static integer irotaz = 0;
28 static integer icentz = 0;
29 static integer indexz = 1;
30
31 extern /* Subroutine */ int msgdmp_(char *, char *, char *, ftnlen,
32 ftnlen, ftnlen), sztxcl_(void), sztxop_(real *, integer *,
33 integer *, integer *), sztxzr_(real *, real *, char *, ftnlen),
34 sztxzu_(real *, real *, char *, ftnlen), sztxzv_(real *, real *,
35 char *, ftnlen);
36
37 switch(n__) {
38 case 1: goto L_sgtxv;
39 case 2: goto L_sgtxr;
40 case 3: goto L_sgstxs;
41 case 4: goto L_sgqtxs;
42 case 5: goto L_sgstxr;
43 case 6: goto L_sgqtxr;
44 case 7: goto L_sgstxc;
45 case 8: goto L_sgqtxc;
46 case 9: goto L_sgstxi;
47 case 10: goto L_sgqtxi;
48 }
49
50 if (rsizez == 0.f) {
51 msgdmp_("M", "SGTXU", "TEXT HEIGHT IS 0 / DO NOTHING.", (ftnlen)1, (
52 ftnlen)5, (ftnlen)30);
53 return 0;
54 }
55 if (rsizez < 0.f) {
56 msgdmp_("E", "SGTXU", "TEXT HEIGHT IS LESS THAN ZERO.", (ftnlen)1, (
57 ftnlen)5, (ftnlen)30);
58 }
59 if (! (-1 <= icentz && icentz <= 1)) {
60 msgdmp_("E", "SGTXU", "CENTERING OPTION IS INVALID.", (ftnlen)1, (
61 ftnlen)5, (ftnlen)28);
62 }
63 if (indexz == 0) {
64 msgdmp_("M", "SGTXU", "TEXT INDEX IS 0 / DO NOTHING.", (ftnlen)1, (
65 ftnlen)5, (ftnlen)29);
66 return 0;
67 }
68 if (indexz < 0) {
69 msgdmp_("E", "SGTXU", "TEXT INDEX IS LESS THAN 0.", (ftnlen)1, (
70 ftnlen)5, (ftnlen)26);
71 }
72 sztxop_(&rsizez, &irotaz, &icentz, &indexz);
73 sztxzu_(ux, uy, chars, chars_len);
74 sztxcl_();
75 return 0;
76 /* ----------------------------------------------------------------------- */
77
78 L_sgtxv:
79 if (rsizez == 0.f) {
80 msgdmp_("M", "SGTXV", "TEXT HEIGHT IS 0 / DO NOTHING.", (ftnlen)1, (
81 ftnlen)5, (ftnlen)30);
82 return 0;
83 }
84 if (rsizez < 0.f) {
85 msgdmp_("E", "SGTXV", "TEXT HEIGHT IS LESS THAN ZERO.", (ftnlen)1, (
86 ftnlen)5, (ftnlen)30);
87 }
88 if (! (-1 <= icentz && icentz <= 1)) {
89 msgdmp_("E", "SGTXV", "CENTERING OPTION IS INVALID.", (ftnlen)1, (
90 ftnlen)5, (ftnlen)28);
91 }
92 if (indexz == 0) {
93 msgdmp_("M", "SGTXV", "TEXT INDEX IS 0 / DO NOTHING.", (ftnlen)1, (
94 ftnlen)5, (ftnlen)29);
95 return 0;
96 }
97 if (indexz < 0) {
98 msgdmp_("E", "SGTXV", "TEXT INDEX IS LESS THAN 0.", (ftnlen)1, (
99 ftnlen)5, (ftnlen)26);
100 }
101 sztxop_(&rsizez, &irotaz, &icentz, &indexz);
102 sztxzv_(vx, vy, chars, chars_len);
103 sztxcl_();
104 return 0;
105 /* ----------------------------------------------------------------------- */
106
107 L_sgtxr:
108 if (rsizez == 0.f) {
109 msgdmp_("M", "SGTXR", "TEXT HEIGHT IS 0 / DO NOTHING.", (ftnlen)1, (
110 ftnlen)5, (ftnlen)30);
111 return 0;
112 }
113 if (rsizez < 0.f) {
114 msgdmp_("E", "SGTXR", "TEXT HEIGHT IS LESS THAN ZERO.", (ftnlen)1, (
115 ftnlen)5, (ftnlen)30);
116 }
117 if (! (-1 <= icentz && icentz <= 1)) {
118 msgdmp_("E", "SGTXR", "CENTERING OPTION IS INVALID.", (ftnlen)1, (
119 ftnlen)5, (ftnlen)28);
120 }
121 if (indexz == 0) {
122 msgdmp_("M", "SGTXR", "TEXT INDEX IS 0 / DO NOTHING.", (ftnlen)1, (
123 ftnlen)5, (ftnlen)29);
124 return 0;
125 }
126 if (indexz < 0) {
127 msgdmp_("E", "SGTXR", "TEXT INDEX IS LESS THAN 0.", (ftnlen)1, (
128 ftnlen)5, (ftnlen)26);
129 }
130 sztxop_(&rsizez, &irotaz, &icentz, &indexz);
131 sztxzr_(rx, ry, chars, chars_len);
132 sztxcl_();
133 return 0;
134 /* ----------------------------------------------------------------------- */
135
136 L_sgstxs:
137 rsizez = *rsize;
138 return 0;
139 /* ----------------------------------------------------------------------- */
140
141 L_sgqtxs:
142 *rsize = rsizez;
143 return 0;
144 /* ----------------------------------------------------------------------- */
145
146 L_sgstxr:
147 irotaz = *irota;
148 return 0;
149 /* ----------------------------------------------------------------------- */
150
151 L_sgqtxr:
152 *irota = irotaz;
153 return 0;
154 /* ----------------------------------------------------------------------- */
155
156 L_sgstxc:
157 icentz = *icent;
158 return 0;
159 /* ----------------------------------------------------------------------- */
160
161 L_sgqtxc:
162 *icent = icentz;
163 return 0;
164 /* ----------------------------------------------------------------------- */
165
166 L_sgstxi:
167 indexz = *index;
168 return 0;
169 /* ----------------------------------------------------------------------- */
170
171 L_sgqtxi:
172 *index = indexz;
173 return 0;
174 } /* sgtxu_ */
175
sgtxu_(real * ux,real * uy,char * chars,ftnlen chars_len)176 /* Subroutine */ int sgtxu_(real *ux, real *uy, char *chars, ftnlen chars_len)
177 {
178 return sgtxu_0_(0, ux, uy, chars, (real *)0, (real *)0, (real *)0, (real *
179 )0, (real *)0, (integer *)0, (integer *)0, (integer *)0,
180 chars_len);
181 }
182
sgtxv_(real * vx,real * vy,char * chars,ftnlen chars_len)183 /* Subroutine */ int sgtxv_(real *vx, real *vy, char *chars, ftnlen chars_len)
184 {
185 return sgtxu_0_(1, (real *)0, (real *)0, chars, vx, vy, (real *)0, (real *
186 )0, (real *)0, (integer *)0, (integer *)0, (integer *)0,
187 chars_len);
188 }
189
sgtxr_(real * rx,real * ry,char * chars,ftnlen chars_len)190 /* Subroutine */ int sgtxr_(real *rx, real *ry, char *chars, ftnlen chars_len)
191 {
192 return sgtxu_0_(2, (real *)0, (real *)0, chars, (real *)0, (real *)0, rx,
193 ry, (real *)0, (integer *)0, (integer *)0, (integer *)0,
194 chars_len);
195 }
196
sgstxs_(real * rsize)197 /* Subroutine */ int sgstxs_(real *rsize)
198 {
199 return sgtxu_0_(3, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
200 (real *)0, (real *)0, rsize, (integer *)0, (integer *)0, (integer
201 *)0, (ftnint)0);
202 }
203
sgqtxs_(real * rsize)204 /* Subroutine */ int sgqtxs_(real *rsize)
205 {
206 return sgtxu_0_(4, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
207 (real *)0, (real *)0, rsize, (integer *)0, (integer *)0, (integer
208 *)0, (ftnint)0);
209 }
210
sgstxr_(integer * irota)211 /* Subroutine */ int sgstxr_(integer *irota)
212 {
213 return sgtxu_0_(5, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
214 (real *)0, (real *)0, (real *)0, irota, (integer *)0, (integer *)
215 0, (ftnint)0);
216 }
217
sgqtxr_(integer * irota)218 /* Subroutine */ int sgqtxr_(integer *irota)
219 {
220 return sgtxu_0_(6, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
221 (real *)0, (real *)0, (real *)0, irota, (integer *)0, (integer *)
222 0, (ftnint)0);
223 }
224
sgstxc_(integer * icent)225 /* Subroutine */ int sgstxc_(integer *icent)
226 {
227 return sgtxu_0_(7, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
228 (real *)0, (real *)0, (real *)0, (integer *)0, icent, (integer *)
229 0, (ftnint)0);
230 }
231
sgqtxc_(integer * icent)232 /* Subroutine */ int sgqtxc_(integer *icent)
233 {
234 return sgtxu_0_(8, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
235 (real *)0, (real *)0, (real *)0, (integer *)0, icent, (integer *)
236 0, (ftnint)0);
237 }
238
sgstxi_(integer * index)239 /* Subroutine */ int sgstxi_(integer *index)
240 {
241 return sgtxu_0_(9, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
242 (real *)0, (real *)0, (real *)0, (integer *)0, (integer *)0,
243 index, (ftnint)0);
244 }
245
sgqtxi_(integer * index)246 /* Subroutine */ int sgqtxi_(integer *index)
247 {
248 return sgtxu_0_(10, (real *)0, (real *)0, (char *)0, (real *)0, (real *)0,
249 (real *)0, (real *)0, (real *)0, (integer *)0, (integer *)0,
250 index, (ftnint)0);
251 }
252
253