1*******************************************************************************
2*               Support routines for libgd labels                             *
3*******************************************************************************
4*     Version 3.0
5*
6* PCC Apr 2010	- Initial version (some code came from r3dtops.f)
7* PCC May 2010	- Allow for LABELSTRING to have null pointers
8* EAM Dec 2010	- Fix antialiasing scales
9*******************************************************************************
10*
11* These routines are called from render.f to handle object types 10, 11 and 12.
12* The parsed information will be passed onto the mylabel_() function in local.c
13*
14* The "libgd file" describes a canvas with the same dimension in pixels as
15* the image created by render. The libgd canvas can be composited on top
16* of the rendered image to produce a labeled figure.
17*
18*	Object types 10 and 11 are used for specifying labels.
19*	Label object types are
20*	  - type 10: Font_Name size alignment
21*	  - type 11: XYZ RGB on first line
22*		     label (ascii characters enclosed in quotes) on second line
23*	Object type 12 is reserved to go with this, as I have a nagging
24*	suspicion more information may turn out to be necessary.
25*
26*******************************************************************************
27      SUBROUTINE LOPEN( FILENAME )
28      CHARACTER*132 FILENAME
29      RETURN
30      END
31
32      SUBROUTINE LCLOSE( )
33      RETURN
34      END
35
36      SUBROUTINE LSETUP( PSCALE, BKGND, TITLE )
37      REAL     PSCALE
38      REAL     BKGND(3)
39      CHARACTER*80 TITLE
40      COMMON /OPTIONS/ FONTSCALE, GAMMA, ZOOM, NSCHEME, SHADOWFLAG, XBG,
41     &                 NAX, NAY, OTMODE, QUALITY, INVERT, LFLAG
42      REAL             FONTSCALE, GAMMA, ZOOM
43      INTEGER          NSCHEME, SHADOWFLAG, XBG
44      INTEGER*4        NAX, NAY, OTMODE, QUALITY
45      LOGICAL*2        INVERT, LFLAG
46C     Might as well always handle labels?
47C	LFLAG = .TRUE.
48      RETURN
49      END
50*******************************************************************************
51
52      SUBROUTINE LINP( INPUT, INTYPE, MATCOL, RGBMAT )
53      IMPLICIT NONE
54
55      INTEGER  I, J, LEN
56      INTEGER  INPUT, INTYPE
57      LOGICAL  MATCOL
58      REAL     RGBMAT(3)
59      REAL     AASCALE
60*
61*     Input transformation
62      COMMON /MATRICES/ XCENT, YCENT, SCALE, EYEPOS, SXCENT, SYCENT,
63     &                  TMAT, TINV, TINVT, SROT, SRTINV, SRTINVT
64     &                 ,RAFTER, TAFTER
65      REAL   XCENT, YCENT, SCALE, SXCENT, SYCENT
66*     Transformation matrix, inverse of transpose, and transposed inverse
67      REAL   TMAT(4,4), TINV(4,4), TINVT(4,4)
68*     Shortest rotation from light source to +z axis
69      REAL   SROT(4,4), SRTINV(4,4), SRTINVT(4,4)
70*     Post-hoc transformation on top of original TMAT
71      REAL   RAFTER(4,4), TAFTER(3)
72      EXTERNAL DET
73      REAL     DET
74*     Distance (in +z) of viewing eye
75      REAL   EYEPOS
76*
77      EXTERNAL PERSP
78      REAL     PERSP, PFAC
79*
80*     Stuff for labels
81      CHARACTER*80  FONTNAME, FONTALIGN
82      CHARACTER*128 LABELSTRING
83      SAVE          FONTNAME
84      SAVE          LABELSTRING
85      INTEGER       MAXLABLEN
86      PARAMETER    (MAXLABLEN = 128)
87      INTEGER      IALIGN
88      SAVE         IALIGN
89      INTEGER      FONT, LABEL
90      PARAMETER   (FONT = 10, LABEL = 11)
91      REAL         XA, YA, ZA, RED, GRN, BLU
92      REAL         FONTSIZE
93      SAVE         FONTSIZE
94*
95*     Keep track of actual coordinate limits
96      COMMON /NICETIES/ TRULIM, ZLIM, FRONTCLIP, BACKCLIP, ISOLATION
97      REAL              TRULIM(3,2), ZLIM(2), FRONTCLIP, BACKCLIP
98      INTEGER           ISOLATION
99*
100*     Command line options (Aug 1999) NB: nax,nay,quality MUST be integer*2
101      COMMON /OPTIONS/ FONTSCALE, GAMMA, ZOOM, NSCHEME, SHADOWFLAG, XBG,
102     &                 NAX, NAY, OTMODE, QUALITY, INVERT, LFLAG
103      REAL             FONTSCALE, GAMMA, ZOOM
104      INTEGER          NSCHEME, SHADOWFLAG, XBG
105      INTEGER*4        NAX, NAY, OTMODE, QUALITY
106      LOGICAL*2        INVERT, LFLAG
107*
108*     Copy of NOISE for ASSERT to see
109      COMMON /ASSCOM/ NOISE, VERBOSE
110      INTEGER NOISE
111      LOGICAL VERBOSE
112
113c*****DEFAULTS:
114c FONTSCALE = 1.0
115c
116c     Read in next object
117      IF (INTYPE .EQ. FONT) THEN
118	READ (INPUT,*,END=50) FONTNAME, FONTSIZE, FONTALIGN
119	IF (FONTALIGN(1:1).EQ.'C') THEN
120	    IALIGN=1
121	ELSE IF (FONTALIGN(1:1).EQ.'R') THEN
122	    IALIGN=2
123	ELSE IF (FONTALIGN(1:1).EQ.'O') THEN
124	    IALIGN=3
125	ELSE
126	    IALIGN=0
127	ENDIF
128c
129* TODO: The following can probably be removed
130c	len = 0
131c	DO i=1,80
132c	    if (fontname(i:i).ne.' ') len = i
133c	enddo
134
135      ELSE IF (INTYPE .EQ. LABEL ) THEN
136	READ (INPUT,*,END=50) XA, YA, ZA, RED, GRN, BLU
137	IF (MATCOL) THEN
138	    RED = RGBMAT(1)
139	    GRN = RGBMAT(2)
140	    BLU = RGBMAT(3)
141	ENDIF
142c
143c       Here is where Perl would shine
144c
145	READ (INPUT,'(A)',END=50) LABELSTRING
146	len = len_trim(LABELSTRING)
147c
148c Isolated objects not transformed by TMAT, but still subject to inversion.
149        IF (ISOLATION.GT.0) THEN
150          IF (INVERT) YA = -YA
151	  if (isolation.eq.2) then
152	    if (xcent.gt.ycent) xa = xa * xcent / ycent
153	    if (xcent.lt.ycent) ya = ya * ycent / xcent
154	  endif
155        ELSE
156c modify the input, as it were
157	  IF (IALIGN.NE.3) THEN
158	    CALL TRANSF (XA,YA,ZA, TMAT)
159c           YA = -YA
160	  ENDIF
161        ENDIF
162c perspective
163        IF (EYEPOS.GT.0) THEN
164	    PFAC = PERSP(ZA)
165	ELSE
166	    PFAC = 1.0
167	ENDIF
168c
169	AASCALE = 1.0
170	IF (NSCHEME.EQ.2) AASCALE = 0.5
171	IF (NSCHEME.EQ.3) AASCALE = 2./3.
172	IF (NSCHEME.EQ.4) AASCALE = 2./3.
173
174	IF (IALIGN.EQ.3) THEN
175	    XA = XA * SCALE
176	    YA = YA * SCALE
177	ELSE IF (ISOLATION.GT.0) THEN
178	    XA = XA * SCALE + XCENT
179	    YA = YA * SCALE + YCENT
180	ELSE
181c scale and translate to pixel space
182	    XA = XA * PFAC * SCALE + XCENT
183	    YA = YA * PFAC * SCALE + YCENT
184	    ZA = ZA
185	ENDIF
186
187c allow for the antialiasing
188	XA = XA * AASCALE
189	YA = YA * AASCALE
190	ZA = ZA * AASCALE
191
192c
193c 	IF (ZA * SCALE .LT. BACKCLIP .OR. ZA * SCALE .GT. FRONTCLIP) RETURN
194
195	CALL CHKRGB( RED, GRN, BLU, 'invalid label color')
196c	WRITE (0,*) 'COLOR VALUES = ', RED, GRN, BLU
197	RED = SQRT(RED)
198	GRN = SQRT(GRN)
199	BLU = SQRT(BLU)
200c
201c
202C =============================================================================
203C Ready to pass on information to libgd via local.c
204c
205	CALL ADDLABEL(FONTNAME//CHAR(0), FONTSIZE, FONTSCALE, IALIGN,
206     &  XA,YA,ZA, RED,GRN,BLU, LABELSTRING//CHAR(0))
207c
208C =============================================================================
209c
210c
211  800   FORMAT(A,'-x,y,z: ',3F10.3)
212  801   FORMAT(A,4F10.1)
213      ENDIF
214      RETURN
215
216c
217c Error handling
218c
219 50     WRITE (NOISE,*) '>>> Unrecognized label command'
220        RETURN
221
222        END
223