home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 200-299 / ff267.lzh / Diglib / diglib.zoo / diglib / MAPIT.FOR < prev    next >
Text File  |  1989-06-20  |  8KB  |  267 lines
  1.         SUBROUTINE MAPIT(XLOW,XHIGH,YLOW,YHIGH,XLAB,YLAB,TITLE,IAXES)
  2.         INCLUDE PLTCOM.PRM
  3.         INCLUDE PLTSIZ.PRM
  4.         INCLUDE PLTCLP.PRM
  5.         INCLUDE PLTPRM.PRM
  6.         INCLUDE GCLTYP.PRM
  7. C
  8.     EXTERNAL LEN
  9.         CHARACTER*1 XLAB(2), YLAB(2), TITLE(2)
  10.         CHARACTER*1 NUMBR(14)
  11.         LOGICAL*1 LOGXX, LOGYY, LOGT, LRMTEX, LSHORT, LRAGGD
  12.         DIMENSION ZLOG(8)
  13. C
  14.         DATA ZLOG /0.3010, 0.4771, 0.6021, 0.6990, 0.7782, 0.8451,
  15.      1   0.9031, 0.9542 /
  16. C       MINIMUM DISTANCE BETWEEN SHORT TICKS (1 MM)
  17.         DATA TMINLD /0.1/
  18. C       SHORT TICKS = TICKLN/SHORTF
  19.         DATA SHORTF /2.0/
  20. C
  21. C       SET LOGX AND LOGY TO FALSE FOR OUR USAGE OF SCALE
  22. C
  23.         LOGX = .FALSE.
  24.         LOGY = .FALSE.
  25. C
  26. C       SEE WHAT TYPE OF AXES ARE DESIRED
  27. C
  28.         LOGXX = IAND(IAXES,1) .NE. 0
  29.         LOGYY = IAND(IAXES,2) .NE. 0
  30.         LRAGGD = IAND(IAXES,256) .NE. 0
  31. C
  32. C       DO THE AXES SCALING
  33. C
  34.         NUMTK = MIN0(10,INT(XVLEN/((ILABSZ()+1.0)*CXSIZE)))
  35.         IF (LOGXX) GO TO 20
  36.         LSHORT = IAND(IAXES,16) .NE. 0
  37.         CALL AXIS(XLOW,XHIGH,NUMTK,LSHORT,LRAGGD,XMIN,XMAX,XTMIN,XTMAX,
  38.      1   XTICK,IXPWR)
  39.         GO TO 40
  40. 20      CALL LAXIS(XLOW,XHIGH,NUMTK,XMIN,XMAX,XTICK)
  41.         XTMIN = XMIN
  42.         XTMAX = XMAX
  43.         IXPWR = 0
  44. 40      NUMTK = MIN0(10,INT(YVLEN/(3.0*CYSIZE)))
  45.         IF (LOGYY) GO TO 60
  46.         LSHORT = IAND(IAXES,32) .NE. 0
  47.         CALL AXIS(YLOW,YHIGH,NUMTK,LSHORT,LRAGGD,YMIN,YMAX,YTMIN,YTMAX,
  48.      1   YTICK,IYPWR)
  49.         GO TO 80
  50. 60      CALL LAXIS(YLOW,YHIGH,NUMTK,YMIN,YMAX,YTICK)
  51.         YTMIN = YMIN
  52.         YTMAX = YMAX
  53.         IYPWR = 0
  54. 80      CONTINUE
  55. C
  56. C       SET UP SCALING FACTORS FOR SCALE
  57. C
  58.         UX0 = XMIN
  59.         UDX = XMAX - XMIN
  60.         UY0 = YMIN
  61.         UDY = YMAX - YMIN
  62. C
  63. C       ********** DRAW Y AXES **********
  64. C
  65.         CALL GSSETC(CYSIZE,0.0)
  66.         LOGT = .FALSE.
  67.         IF (.NOT. LOGYY .OR. YTICK .NE. 1.0) GO TO 90
  68.         CALL SCALE(XMIN,YMIN,VX,TEMP)
  69.         CALL SCALE(XMIN,YMIN+1.0-ZLOG(8),VX,VY)
  70.         IF ((VY-TEMP) .GE. TMINLD) LOGT = .TRUE.
  71. 90      CONTINUE
  72. C
  73. C       DRAW Y AXIS LINE
  74. C
  75.         MXLAB = 3
  76.         TENEXP = 10.0**IYPWR
  77.         X = XMIN
  78. C       TICK SPACING
  79.         TICKSP = AMAX1(0.0,TICKLN)
  80.         IF (IAND(IAXES,64) .NE. 0) YVLEN = YVLEN - TICKSP
  81. C       TICKS TO LEFT FOR LEFT Y AXIS
  82.         TCKSGN = -TICKLN
  83. 100     CONTINUE
  84.         CALL SCALE(X,YMAX,VX,VY)
  85.         CALL GSMOVE(VX,VY)
  86.         CALL SCALE(X,YMIN,VX,VY)
  87.         CALL GSDRAW(VX,VY)
  88. C
  89. C       DRAW AND LABEL Y AXIS TICKS
  90. C
  91.         Y = YTMIN
  92.         N = (YTMAX-YTMIN)/YTICK + 1.1
  93. 110     CONTINUE
  94.         CALL SCALE(X,Y*TENEXP,VX,VY)
  95.         CALL GSMOVE(VX,VY)
  96.         CALL GSDRAW(VX+TCKSGN,VY)
  97.         IF (X .EQ. XMAX) GO TO 185
  98.         IF (IAND(IAXES,1024) .NE. 0) GO TO 183
  99. C
  100. C       PLACE THE APPROPIATE LABEL
  101. C
  102.         IF (LOGYY) GO TO 160
  103.         CALL LINLAB(INT(Y),IYPWR,NUMBR,LRMTEX)
  104.         GO TO 180
  105. 160     CALL LOGLAB(INT(Y),NUMBR)
  106. 180     LN = LEN(NUMBR)
  107.         MXLAB = MAX0(MXLAB,LN)
  108.         CALL GSMOVE(VX-TICKSP-CXSIZE*(LN+0.25),VY-CYSIZE/2.0)
  109.         CALL GSPSTR(NUMBR)
  110. C
  111. C       ADD GRID LINE AT TICK IF DESIRED
  112. C
  113. 183     CONTINUE
  114.         IF (IAND(IAXES,8) .EQ. 0) GO TO 185
  115.         CALL GSLTYP(3)
  116.         CALL GSMOVE(VX,VY)
  117.         CALL SCALE(XMAX,Y*TENEXP,VX,VY)
  118.         CALL GSDRAW(VX,VY)
  119.         CALL GSLTYP(1)
  120. 185     CONTINUE
  121. C
  122. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  123. C
  124.         IF ((.NOT. LOGT) .OR. (Y .EQ. YTMAX)) GO TO 200
  125.         DO 190 J = 1, 8
  126.         CALL SCALE(X,Y+ZLOG(J),VX,VY)
  127.         CALL GSMOVE(VX,VY)
  128. 190     CALL GSDRAW(VX+TCKSGN/SHORTF,VY)
  129. 200     CONTINUE
  130.         Y = Y + YTICK
  131.         N = N-1
  132.         IF (N .GT. 0) GO TO 110
  133.         IF (X .EQ. XMAX) GO TO 300
  134. C
  135. C       IF LINEAR AXIS, PLACE REMOTE EXPONENT IF NEEDED
  136. C
  137.         IF (LOGYY .OR. (.NOT. LRMTEX)) GO TO 260
  138.         IF (IAND(IAXES,1024) .NE. 0) GO TO 260
  139.         CALL SCALE(XMIN,(YTMIN+YTICK/2.0)*TENEXP,VX,VY)
  140.         CALL SCOPY('E'//CHAR(0),NUMBR)
  141.         CALL NUMSTR(IYPWR,NUMBR(2))
  142.         CALL GSMOVE(VX-CXSIZE*(LEN(NUMBR)+0.5),VY-CYSIZE/2.0)
  143.         CALL GSPSTR(NUMBR)
  144. C
  145. C       NOW PLACE Y LABLE
  146. C
  147. 260     CALL SCALE(XMIN,(YMIN+YMAX)/2.0,VX,VY)
  148.         CALL GSMOVE(VX-(MXLAB+0.25)*CXSIZE-TICKSP-CYSIZE,
  149.      1   VY-CXSIZE*LEN(YLAB)/2.0)
  150.         CALL GSSETC(CYSIZE,90.0)
  151.         CALL GSPSTR(YLAB)
  152.         CALL GSSETC(CYSIZE,0.0)
  153.         IF (IAND(IAXES,128) .EQ. 0) GO TO 300
  154.         X = XMAX
  155.         TCKSGN = TICKLN
  156.         GO TO 100
  157. 300     CONTINUE
  158. C
  159. C       ********** DRAW X AXIS **********
  160. C
  161.         LOGT = .FALSE.
  162.         IF (.NOT. LOGXX .OR. XTICK .NE. 1.0) GO TO 310
  163.         CALL SCALE(XMIN,YMIN,TEMP,VY)
  164.         CALL SCALE(XMIN+1.0-ZLOG(8),YMIN,VX,VY)
  165.         IF ((VX-TEMP) .GE. TMINLD) LOGT = .TRUE.
  166. 310     CONTINUE
  167. C
  168. C       DRAW X AXIS LINE
  169. C
  170.         Y = YMIN
  171.         TCKSGN = -TICKLN
  172.         TENEXP = 10.0**IXPWR
  173. C       TICK SPACING
  174.         TICKSP = AMAX1(0.5*CYSIZE,TICKLN)
  175. 320     CONTINUE
  176.         CALL SCALE(XMIN,Y,VX,VY)
  177.         CALL GSMOVE(VX,VY)
  178.         CALL SCALE(XMAX,Y,VX,VY)
  179.         CALL GSDRAW(VX,VY)
  180. C
  181. C       DRAW AND LABEL X AXIS TICKS
  182. C
  183.         X = XTMIN
  184.         N = (XTMAX-XTMIN)/XTICK + 1.1
  185. 400     CONTINUE
  186.         CALL SCALE(X*TENEXP,Y,VX,VY)
  187.         CALL GSMOVE(VX,VY)
  188.         CALL GSDRAW(VX,VY+TCKSGN)
  189.         IF (Y .EQ. YMAX) GO TO 430
  190.         IF (IAND(IAXES,512) .NE. 0) GO TO 423
  191.         IF (LOGXX) GO TO 410
  192.         CALL LINLAB(INT(X),IXPWR,NUMBR,LRMTEX)
  193.         GO TO 420
  194. 410     CALL LOGLAB(INT(X),NUMBR)
  195. 420     CALL GSMOVE(VX-CXSIZE*LEN(NUMBR)/2.0,VY-TICKSP-1.5*CYSIZE)
  196.         CALL GSPSTR(NUMBR)
  197. C
  198. C       ADD GRID LINE AT TICK IF DESIRED
  199. C
  200. 423     CONTINUE
  201.         IF (IAND(IAXES,4) .EQ. 0) GO TO 430
  202.         CALL GSLTYP(3)
  203.         CALL GSMOVE(VX,VY)
  204.         CALL SCALE(X*TENEXP,YMAX,VX,VY)
  205.         CALL GSDRAW(VX,VY)
  206.         CALL GSLTYP(1)
  207. 430     CONTINUE
  208. C
  209. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  210. C
  211.         IF ((.NOT. LOGT) .OR. (X .EQ. XTMAX)) GO TO 490
  212.         DO 450 J = 1, 8
  213.         CALL SCALE(X+ZLOG(J),Y,VX,VY)
  214.         CALL GSMOVE(VX,VY)
  215.         CALL GSDRAW(VX,VY+TCKSGN/SHORTF)
  216. 450     CONTINUE
  217. 490     CONTINUE
  218.         X = X + XTICK
  219.         N = N-1
  220.         IF (N .GT. 0) GO TO 400
  221.         IF (Y .EQ. YMAX) GO TO 590
  222. C
  223. C       NOW PLACE REMOTE EXPONENT IF NEEDED ON LINEAR AXIS
  224. C
  225.         IF (LOGXX .OR. (.NOT. LRMTEX)) GO TO 520
  226.         IF (IAND(IAXES,512) .NE. 0) GO TO 520
  227.         CALL SCALE(XMIN,YMIN,VX,VY)
  228.         CALL SCOPY('E'//CHAR(0),NUMBR)
  229.         CALL NUMSTR(IXPWR,NUMBR(2))
  230.         CALL GSMOVE(VX+3*CXSIZE,VY-TICKSP-2.75*CYSIZE)
  231.         CALL GSPSTR(NUMBR)
  232. C
  233. C       NOW PLACE X AXIS LABLE
  234. C
  235. 520     CALL SCALE((XMIN+XMAX)/2.0,YMIN,VX,VY)
  236.         CALL GSMOVE(VX-CXSIZE*LEN(XLAB)/2.0,VY-TICKSP-4.0*CYSIZE)
  237.         CALL GSPSTR(XLAB)
  238.         IF (IAND(IAXES,64) .EQ. 0) GO TO 590
  239.         Y = YMAX
  240.         TCKSGN = TICKLN
  241.         GO TO 320
  242. 590     CONTINUE
  243. C
  244. C       ********** PLACE TITLE **********
  245. C
  246.         CALL SCALE((XMIN+XMAX)/2.0,YMAX,VX,VY)
  247.         TCKSGN = 0.0
  248.         IF (IAND(IAXES,64) .NE. 0) TCKSGN = TICKSP
  249.         CALL GSMOVE(VX-CXSIZE*LEN(TITLE)/2.0,VY+TCKSGN+CYSIZE)
  250.         CALL GSPSTR(TITLE)
  251. C
  252. C       MAKE SURE "PLTCLP" CONTAINS LIMITS PICKED BY MAPIT.   ONLY MAINTAINED
  253. C       FOR CALLERS INFO.
  254. C
  255.         IF (.NOT. LOGXX) GO TO 610
  256.                 XMIN = 10.0**XMIN
  257.                 XMAX = 10.0**XMAX
  258.                 LOGX = .TRUE.
  259. 610     CONTINUE
  260.         IF (.NOT. LOGYY) GO TO 620
  261.                 YMIN = 10.0**YMIN
  262.                 YMAX = 10.0**YMAX
  263.                 LOGY = .TRUE.
  264. 620     CONTINUE
  265.         RETURN
  266.         END
  267.