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 /* Table of constant values */
16
17 static logical c_false = FALSE_;
18
19 /* ----------------------------------------------------------------------- */
20 /* UYPLBB : PLOT LABELS ( BETWEEN THE POINTS ) */
21 /* ----------------------------------------------------------------------- */
22 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
23 /* ----------------------------------------------------------------------- */
uyplbb_(real * uy,char * ch,integer * nc,integer * n,real * upx,real * roffy,real * rsize,integer * irota,integer * icent,integer * index,real * rbtwn,logical * lbound,logical * lbmsg,ftnlen ch_len)24 /* Subroutine */ int uyplbb_(real *uy, char *ch, integer *nc, integer *n,
25 real *upx, real *roffy, real *rsize, integer *irota, integer *icent,
26 integer *index, real *rbtwn, logical *lbound, logical *lbmsg, ftnlen
27 ch_len)
28 {
29 /* System generated locals */
30 integer i__1;
31 real r__1;
32
33 /* Local variables */
34 static integer i__, lc, lcz;
35 static real cwy, vpx, vpy, vwy, vpy1, vpy2;
36 extern integer lenc_(char *, ftnlen);
37 static real wxch, wych;
38 static integer jrota;
39 extern /* Subroutine */ int sglget_(char *, logical *, ftnlen), msgdmp_(
40 char *, char *, char *, ftnlen, ftnlen, ftnlen);
41 static logical lclipz;
42 extern /* Subroutine */ int sglset_(char *, logical *, ftnlen), stftrf_(
43 real *, real *, real *, real *), sztxcl_(void), sztxop_(real *,
44 integer *, integer *, integer *), szqtxw_(char *, integer *, real
45 *, real *, ftnlen), sztxzv_(real *, real *, char *, ftnlen);
46
47 /* Parameter adjustments */
48 ch -= ch_len;
49 --uy;
50
51 /* Function Body */
52 if (*nc <= 0) {
53 msgdmp_("E", "UYPLBB", "CHARACTER LENGTH IS LESS THAN OR EQUAL TO ZE"
54 "RO.", (ftnlen)1, (ftnlen)6, (ftnlen)47);
55 }
56 if (*n <= 1) {
57 msgdmp_("E", "UYPLBB", "NUMBER OF POINTS IS INVALID.", (ftnlen)1, (
58 ftnlen)6, (ftnlen)28);
59 }
60 if (*rsize <= 0.f) {
61 msgdmp_("E", "UYPLBB", "TEXT HEIGHT IS LESS THAN ZERO.", (ftnlen)1, (
62 ftnlen)6, (ftnlen)30);
63 }
64 if (! (-1 <= *icent && *icent <= 1)) {
65 msgdmp_("E", "UYPLBB", "CENTERING OPTION IS INVALID.", (ftnlen)1, (
66 ftnlen)6, (ftnlen)28);
67 }
68 if (*index <= 0) {
69 msgdmp_("E", "UYPLBB", "TEXT INDEX IS INVALID.", (ftnlen)1, (ftnlen)6,
70 (ftnlen)22);
71 }
72 sglget_("LCLIP", &lclipz, (ftnlen)5);
73 sglset_("LCLIP", &c_false, (ftnlen)5);
74 i__1 = *irota * 90;
75 sztxop_(rsize, &i__1, icent, index);
76 i__1 = *n - 1;
77 for (i__ = 1; i__ <= i__1; ++i__) {
78 lc = lenc_(ch + i__ * ch_len, ch_len);
79 szqtxw_(ch + i__ * ch_len, &lcz, &wxch, &wych, ch_len);
80 stftrf_(upx, &uy[i__], &vpx, &vpy1);
81 stftrf_(upx, &uy[i__ + 1], &vpx, &vpy2);
82 vwy = (r__1 = vpy2 - vpy1, abs(r__1));
83 jrota = *irota % 2;
84 if (jrota != 0) {
85 cwy = *rsize * wxch;
86 } else {
87 cwy = *rsize * wych;
88 }
89 if (cwy > vwy && *lbound) {
90 if (*lbmsg) {
91 msgdmp_("W", "UYPLBB", "SPACE FOR LABEL IS NOT ENOUGH.", (
92 ftnlen)1, (ftnlen)6, (ftnlen)30);
93 }
94 goto L10;
95 }
96 vpy = (vpy1 + vpy2) / 2 + (vwy - cwy) / 2 * *rbtwn;
97 vpx += *roffy;
98 sztxzv_(&vpx, &vpy, ch + i__ * ch_len, lc);
99 L10:
100 ;
101 }
102 sztxcl_();
103 /* L15: */
104 sglset_("LCLIP", &lclipz, (ftnlen)5);
105 return 0;
106 } /* uyplbb_ */
107
108