home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d4xx / d499 / diglib.lha / Diglib / diglib.lzh / source / SYAXIS.for < prev    next >
Encoding:
Text File  |  1991-05-22  |  4.1 KB  |  160 lines
  1.         SUBROUTINE SYAXIS(YLOW,YHIGH,YLAB,IAXES)
  2.     IMPLICIT NONE
  3.         INCLUDE DIGLIB$KOM:PLTCOM.PRM
  4.         INCLUDE DIGLIB$KOM:PLTSIZ.PRM
  5.         INCLUDE DIGLIB$KOM:PLTCLP.PRM
  6.         INCLUDE DIGLIB$KOM:PLTPRM.PRM
  7. C
  8.         EXTERNAL LEN
  9.         CHARACTER*1 YLAB(2)
  10.         CHARACTER*1 NUMBR(14)
  11.         LOGICAL LOGYY, LOGT, LRMTEX, LSHORT, LRAGGD
  12.     INTEGER*1 IAND
  13.         REAL*4 ZLOG(8)
  14.     INTEGER NUMTK,IYPWR,MXLAB,N,J,LEN
  15.     REAL*4 YTMAX,VX,VY,TEMP,TENEXP,X,TICKSP,TCKSGN,DELMX,Y,DEL
  16.     REAL GSLENS
  17.     REAL*4 TMINLD,SHORTF,YTMIN,YTICK
  18. C
  19.         DATA ZLOG /0.3010, 0.4771, 0.6021, 0.6990, 0.7782, 0.8451,
  20.      1   0.9031, 0.9542 /
  21. C       MINIMUM DISTANCE BETWEEN SHORT TICKS (1 MM)
  22.  
  23.         DATA TMINLD /0.1/
  24. C       SHORT TICKS = TICKLN/SHORTF
  25.         DATA SHORTF /2.0/
  26.  
  27. C
  28. C
  29. C
  30. C       SET LOGY TO FALSE FOR OUR USAGE OF SCALE
  31. C
  32.         LOGY = .FALSE.
  33. C
  34. C       SEE WHAT TYPE OF AXIS IS DESIRED
  35. C
  36.         LOGYY = IAND(IAXES,2) .NE. 0
  37.         LRAGGD = IAND(IAXES,256) .NE. 0
  38. C
  39. C       DO THE AXES SCALING
  40. C
  41.         NUMTK = MIN0(10,INT(YVLEN/(3.0*CYSIZE)))
  42.         IF (LOGYY) GO TO 60
  43.         LSHORT = IAND(IAXES,32) .NE. 0
  44.         CALL AXIS(YLOW,YHIGH,NUMTK,LSHORT,LRAGGD,YMIN,YMAX,YTMIN,YTMAX,
  45.      1   YTICK,IYPWR)
  46.         GO TO 80
  47. 60      CALL LAXIS(YLOW,YHIGH,NUMTK,YMIN,YMAX,YTICK)
  48.         YTMIN = YMIN
  49.         YTMAX = YMAX
  50.         IYPWR = 0
  51. 80      CONTINUE
  52. C
  53. C       SET UP TEMPORARY SCALING FACTORS
  54. C
  55.         UY0 = YMIN
  56.         UDY = YMAX - YMIN
  57. C
  58. C       ********** DRAW Y AXES **********
  59. C
  60.         CALL GSSETC(CYSIZE,0.0)
  61.         LOGT = .FALSE.
  62.         IF (.NOT. LOGYY .OR. YTICK .NE. 1.0) GO TO 90
  63.         CALL SCALE(XMIN,YMIN,VX,TEMP)
  64.         CALL SCALE(XMIN,YMIN+1.0-ZLOG(8),VX,VY)
  65.         IF ((VY-TEMP) .GE. TMINLD) LOGT = .TRUE.
  66. 90      CONTINUE
  67. C
  68. C       DRAW Y AXIS LINE
  69. C
  70.         MXLAB = 3
  71.         TENEXP = 10.0**IYPWR
  72.         X = XMAX
  73. C       TICK SPACING
  74.         TICKSP = AMAX1(0.0,TICKLN)
  75.         IF (IAND(IAXES,64) .NE. 0) YVLEN = YVLEN - TICKSP
  76.         TCKSGN = -TICKLN
  77. 100     CONTINUE
  78.         CALL SCALE(X,YMAX,VX,VY)
  79.         CALL GSMOVE(VX,VY)
  80.         CALL SCALE(X,YMIN,VX,VY)
  81.         CALL GSDRAW(VX,VY)
  82. C
  83. C       DRAW AND LABEL Y AXIS TICKS
  84. C
  85.         DELMX = 0.0
  86.         Y = YTMIN
  87.         N = (YTMAX-YTMIN)/YTICK + 1.1
  88. 110     CONTINUE
  89.         CALL SCALE(X,Y*TENEXP,VX,VY)
  90.         CALL GSMOVE(VX,VY)
  91.         CALL GSDRAW(VX+TICKLN,VY)
  92. C
  93. C       PLACE THE APPROPIATE LABEL
  94. C
  95.         IF (IAND(IAXES,1024) .NE. 0) GO TO 183
  96.         IF (LOGYY) GO TO 160
  97.         CALL LINLAB(INT(Y),IYPWR,NUMBR,LRMTEX)
  98.         GO TO 180
  99. 160     CALL LOGLAB(INT(Y),NUMBR)
  100. 180     DEL = GSLENS(NUMBR)
  101.         DELMX = AMAX1(DEL,DELMX)
  102.         CALL GSMOVE(VX+TICKSP+0.5*CXSIZE,VY-CYSIZE/2.0)
  103.         CALL GSPSTR(NUMBR)
  104. 183     CONTINUE
  105. C
  106. C       ADD GRID LINE AT TICK IF DESIRED
  107. C
  108.         IF (IAND(IAXES,8) .EQ. 0) GO TO 185
  109.         CALL GSLTYP(3)
  110.         CALL GSMOVE(VX,VY)
  111.         CALL SCALE(XMIN,Y*TENEXP,VX,VY)
  112.         CALL GSDRAW(VX,VY)
  113.         CALL GSLTYP(1)
  114. 185     CONTINUE
  115. C
  116. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  117. C
  118.         IF ((.NOT. LOGT) .OR. (Y .EQ. YTMAX)) GO TO 200
  119.         DO 190 J = 1, 8
  120.         CALL SCALE(X,Y+ZLOG(J),VX,VY)
  121.         CALL GSMOVE(VX,VY)
  122. 190     CALL GSDRAW(VX+TICKLN/SHORTF,VY)
  123. 200     CONTINUE
  124.         Y = Y + YTICK
  125.         N = N-1
  126.         IF (N .GT. 0) GO TO 110
  127. C
  128. C       IF LINEAR AXIS, PLACE REMOTE EXPONENT IF NEEDED
  129. C
  130.         IF (LOGYY .OR. (.NOT. LRMTEX)) GO TO 260
  131.         IF (IAND(IAXES,1024) .NE. 0) GO TO 260
  132.         CALL SCALE(XMAX,(YTMIN+YTICK/2.0)*TENEXP,VX,VY)
  133.         CALL SCOPY('E',NUMBR)
  134.         CALL NUMSTR(IYPWR,NUMBR(2))
  135.         CALL GSMOVE(VX+0.5*CXSIZE,VY-CYSIZE/2.0)
  136.         CALL GSPSTR(NUMBR)
  137. C
  138. C       NOW PLACE Y LABLE
  139. C
  140. 260     CALL SCALE(X,(YMIN+YMAX)/2.0,VX,VY)
  141.         CALL GSMOVE(VX+0.5*CXSIZE+DELMX+TICKSP+1.5*CYSIZE,
  142.      1   VY-GSLENS(YLAB)/2.0)
  143.         CALL GSSETC(CYSIZE,90.0)
  144.         CALL GSPSTR(YLAB)
  145.         CALL GSSETC(CYSIZE,0.0)
  146. 300     CONTINUE
  147. C
  148. C       TELL USER THE SCALING LIMITS
  149. C
  150.         IF (.NOT. LOGYY) GO TO 320
  151.                 YMIN = 10.0**YMIN
  152.                 YMAX = 10.0**YMAX
  153. 320     CONTINUE
  154. C
  155. C       TELL SCALE ABOUT LOG AXIS SCALING NOW
  156. C
  157.         LOGY = LOGYY
  158.         RETURN
  159.         END
  160.