1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
*DECK PSSRAI
SUBROUTINE PSSRAI(ISPSP,NSEG,IORDER,CENTER,RADANG)
C
C------------------------- PSSRAI -------------------------------
C
C 1- SUBROUTINE STATISTICS:
C NAME : PSSRAI
C USE : DRAW RECTANGULAR/ANNULAR INTERSECTION
C
C 2- PARAMETERS:
C INPUT
C ISPSP : POSTSCRIPT STRUCTURE I
C NSEG : NUMBER OF REGION INTERSECTION I
C NUMBER OF SEGMENTS IS NSEG-1
C IORDER : TYPE OF REGION R(NSEG)
C = -2 : ARC SEGMENT BEGINS
C = -1 : ARC SEGMENT ENDS
C = 0 : CLOSE PATH
C > 0 : CORNER
C CENTER : X AND Y POSITION OF ANNULUS CENTER R(2)
C RADANG : SEGMENTS INTERSECTION POINTS R(2,NSEG)
C WITH RESPECT TO ANNULAR REGION CENTER
C RADANG(1) = RADIAL POSITION
C RADANG(2) = ANGULAR POSITION
C
C----------------------------------------------------------------------
C
IMPLICIT NONE
INTEGER ISPSP,NSEG
INTEGER IORDER(NSEG)
REAL CENTER(2),RADANG(2,NSEG)
C----
C LOCAL PARAMETERS
C----
REAL CONVER,PI
CHARACTER NAMSBR*6
PARAMETER (CONVER=72.0,PI=3.1415926535897932,
> NAMSBR='PSSRAI')
CHARACTER CMDSTR*132
INTEGER IPT,IDEP,IFIN
REAL XYDEP(2),ANGL(2),XYFIN(2)
C----
C POSITION REFERENCE POINT AT CENTER OF ANNULAR REGION
C----
XYDEP(1)=CENTER(1)
XYDEP(2)=CENTER(2)
CALL PSMOVE(ISPSP,XYDEP,-3)
C----
C MOVE TO FIRST POINT
C----
CMDSTR='Np'
CALL PSCPUT(ISPSP,CMDSTR)
IDEP=IORDER(1)
XYDEP(1)=RADANG(1,1)*COS(RADANG(2,1))
XYDEP(2)=RADANG(1,1)*SIN(RADANG(2,1))
ANGL(1)=180.0*RADANG(2,1)/PI
IF(IDEP .EQ. -1 .OR. IDEP .GT. 0) THEN
CALL PSMOVE(ISPSP,XYDEP,3)
ENDIF
C----
C SCAN SEGMENTS
C----
DO 100 IPT=2,NSEG
CMDSTR=' '
IFIN=IORDER(IPT)
XYFIN(1)=RADANG(1,IPT)*COS(RADANG(2,IPT))
XYFIN(2)=RADANG(1,IPT)*SIN(RADANG(2,IPT))
IF (IDEP .EQ. -2) THEN
C----
C ARC SEGMENT
C FIND ANGLES ASSOCIATED WITH ARC
C----
ANGL(2)=180.0*RADANG(2,IPT)/PI
IF(ANGL(2) .LT. ANGL(1)) THEN
ANGL(2)=ANGL(2)+360.0
ENDIF
WRITE(CMDSTR,'(5(F8.2,1X),A3)')
> 0.0,0.0,RADANG(1,IPT)*CONVER,ANGL(1),ANGL(2),'arc'
CALL PSCPUT(ISPSP,CMDSTR)
ELSE
C----
C LINE
C----
WRITE(CMDSTR,'(2(F8.2,1X),A1)')
> XYFIN(1)*CONVER,XYFIN(2)*CONVER,'L'
CALL PSCPUT(ISPSP,CMDSTR)
ENDIF
IDEP=IFIN
XYDEP(1)=XYFIN(1)
XYDEP(2)=XYFIN(2)
ANGL(1)=180.0*RADANG(2,IPT)/PI
100 CONTINUE
C----
C RESET REFERENCE POINT AT ORIGINAL POSITION
C----
CMDSTR='Cs'
CALL PSCPUT(ISPSP,CMDSTR)
XYDEP(1)=-CENTER(1)
XYDEP(2)=-CENTER(2)
CALL PSMOVE(ISPSP,XYDEP,-3)
RETURN
END
|
