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