1*-----------------------------------------------------------------------
2*     WORKSTATION TRANSFORMATION
3*-----------------------------------------------------------------------
4*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
5*-----------------------------------------------------------------------
6      SUBROUTINE STFWTR(RX,RY,WX,WY)
7
8      LOGICAL   LWTRFZ,LGSWRC,LPRMSG,LRNE1
9
10      EXTERNAL  LRNE1
11
12      SAVE
13
14      DATA      LWTRFZ/.FALSE./,LGSWRC/.FALSE./,LPRMSG/.TRUE./
15
16
17      IF (.NOT.LWTRFZ) THEN
18        CALL MSGDMP('E','STFWTR',
19     +    'WORKSTATION TRANSFORMATION IS NOT DEFINED.')
20      END IF
21      IF (.NOT.LGSWRC) THEN
22        CALL MSGDMP('E','STFWTR',
23     +    'WORKSTATION RECTANGLE IS NOT DEFINED.')
24      END IF
25
26      WXX = CX*RX + WX0
27      WYY = CY*RY + WY0
28      IF (IWTRFZ.EQ.1) THEN
29        WX =  WXX + WSXMNZ
30        WY =  WYY + WSYMNZ
31      ELSE IF (IWTRFZ.EQ.2) THEN
32        WX =  WYY + WSXMNZ
33        WY = -WXX + WSYMXZ
34      END IF
35
36      RETURN
37*-----------------------------------------------------------------------
38      ENTRY STIWTR(WX,WY,RX,RY)
39
40      IF (.NOT.LWTRFZ) THEN
41        CALL MSGDMP('E','STIWTR',
42     +    'WORKSTATION TRANSFORMATION IS NOT DEFINED.')
43      END IF
44      IF (.NOT.LGSWRC) THEN
45        CALL MSGDMP('E','STIWTR',
46     +    'WORKSTATION RECTANGLE IS NOT DEFINED.')
47      END IF
48
49      IF (IWTRFZ.EQ.1) THEN
50        WXX =  WX - WSXMNZ
51        WYY =  WY - WSYMNZ
52      ELSE IF (IWTRFZ.EQ.2) THEN
53        WXX = -WY + WSYMXZ
54        WYY =  WX - WSXMNZ
55      END IF
56      RX = (WXX - WX0) / CX
57      RY = (WYY - WY0) / CY
58
59      RETURN
60*-----------------------------------------------------------------------
61      ENTRY STSWTR(RXMIN,RXMAX,RYMIN,RYMAX,
62     +             WXMIN,WXMAX,WYMIN,WYMAX,IWTRF)
63
64      IF (.NOT.(RXMIN.LT.RXMAX .AND. RYMIN.LT.RYMAX)) THEN
65        CALL MSGDMP('E','STSWTR',
66     +    'WORKSTATION WINDOW DEFINITION IS INVALID.')
67      END IF
68      IF (.NOT.((0.LE.RXMIN .AND. RXMAX.LE.1)
69     +    .AND. (0.LE.RYMIN .AND. RYMAX.LE.1))) THEN
70        CALL MSGDMP('E','STSWTR','WORKSTATION WINDOW IS NOT WITHIN '
71     +    //'THE NORMALIZED DEVICE COORDINATE UNIT SQUARE.')
72      END IF
73      IF (.NOT.(IWTRF.EQ.1 .OR. IWTRF.EQ.2)) THEN
74        CALL MSGDMP('E','STSWTR',
75     +    'TRANSFORMATION FUNCTION NUMBER IS INVALID.')
76      END IF
77
78      RWN = (RYMAX-RYMIN) / (RXMAX-RXMIN)
79      RVP = (WYMAX-WYMIN) / (WXMAX-WXMIN)
80
81      IF (LRNE1(RWN,RVP).AND.LPRMSG) THEN
82        CALL MSGDMP('W','STSWTR',
83     +    'WORKSTATION VIEWPORT WAS MODIFIED.')
84        LPRMSG=.FALSE.
85      END IF
86
87      DX  = WXMAX - WXMIN
88      DY  = WYMAX - WYMIN
89      DWX = MIN (DX,     DY/RWN)
90      DWY = MIN (DX*RWN, DY    )
91
92      WXMINZ = (WXMIN + WXMAX - DWX)/2
93      WXMAXZ = (WXMIN + WXMAX + DWX)/2
94      WYMINZ = (WYMIN + WYMAX - DWY)/2
95      WYMAXZ = (WYMIN + WYMAX + DWY)/2
96
97      RXMINZ = RXMIN
98      RXMAXZ = RXMAX
99      RYMINZ = RYMIN
100      RYMAXZ = RYMAX
101
102      IWTRFZ = IWTRF
103      LWTRFZ = .TRUE.
104
105      CX = (WXMAXZ-WXMINZ) / (RXMAXZ-RXMINZ)
106      CY = (WYMAXZ-WYMINZ) / (RYMAXZ-RYMINZ)
107      WX0 = WXMINZ - CX*RXMINZ
108      WY0 = WYMINZ - CY*RYMINZ
109
110      CALL SZSCLL(RXMINZ,RXMAXZ,RYMINZ,RYMAXZ,0)
111
112      RETURN
113*-----------------------------------------------------------------------
114      ENTRY STQWTR(RXMIN,RXMAX,RYMIN,RYMAX,
115     +             WXMIN,WXMAX,WYMIN,WYMAX,IWTRF)
116
117      IF (.NOT.LWTRFZ) THEN
118        CALL MSGDMP('E','STQWTR',
119     +    'WORKSTATION TRANSFORMATION IS NOT DEFINED.')
120      END IF
121
122      RXMIN = RXMINZ
123      RXMAX = RXMAXZ
124      RYMIN = RYMINZ
125      RYMAX = RYMAXZ
126
127      WXMIN = WXMINZ
128      WXMAX = WXMAXZ
129      WYMIN = WYMINZ
130      WYMAX = WYMAXZ
131
132      IWTRF = IWTRFZ
133
134      RETURN
135*-----------------------------------------------------------------------
136      ENTRY STSWRC(WSXMN,WSXMX,WSYMN,WSYMX)
137
138      IF (.NOT.(WSXMN.LT.WSXMX .AND. WSYMN.LT.WSYMX)) THEN
139        CALL MSGDMP('E','STSWRC',
140     +    'WORKSTATION RECTANGLE IS INVALID.')
141      END IF
142
143      WSXMNZ = WSXMN
144      WSXMXZ = WSXMX
145      WSYMNZ = WSYMN
146      WSYMXZ = WSYMX
147      LGSWRC = .TRUE.
148
149      RETURN
150*-----------------------------------------------------------------------
151      ENTRY STQWRC(WSXMN,WSXMX,WSYMN,WSYMX)
152
153      IF (.NOT.LGSWRC) THEN
154        CALL MSGDMP('E','STQWRC',
155     +    'WORKSTATION RECTANGLE IS NOT DEFINED.')
156      END IF
157
158      WSXMN = WSXMNZ
159      WSXMX = WSXMXZ
160      WSYMN = WSYMNZ
161      WSYMX = WSYMXZ
162
163      RETURN
164      END
165