home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / 14 / spot.f < prev    next >
Encoding:
Text File  |  1990-07-13  |  4.0 KB  |  129 lines
  1.     subroutine spot (x,y,ht,ich,ang)
  2. c **** Modified for Marine Geology Vax Unix system for use with
  3. c      houston symbol routine.
  4. c  Purpose:  accept parameters from program written with old 
  5. c    Benson-Lehner spot calls and translate symbol code to the
  6. c     equivalent symbol in the houston 'symbol' routine.
  7.  
  8. c  Graig McHendrie, March 7, 1984
  9.  
  10.  
  11. c ---- Initialize values for conversion from B-L spot integers
  12. c ---- to Houston integers. ----
  13.     integer bls2hs (102)
  14.     data bls2hs/
  15.  
  16. c       A   B   C   D   E   F   G   H   I   J   K   L   M   N
  17. c  (bl)    1   2   3   4   5   6   7   8   9  10  11  12  13  14
  18. &      65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 
  19.  
  20.  
  21. c          O   P   Q   R   S   T   U   V   W   X   Y   Z   %   @
  22. c  (bl)   15  16  17  18  19  20  21  22  23  24  25  26  27  28
  23. &      79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 37, 64,
  24.  
  25. c          &   0   1   2   3   4   5   6   7   8   9   $   `   <
  26. c  (bl)   29  30  31  32  33  34  35  36  37  38  39  40  41  42
  27. &         38, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 36, 96, 60,
  28.  
  29. c       >   (   )   ^   |   -   /   ?   !   '   '   .   =   ;
  30. c  (bl)   43  44  45  46  47  48  49  50  51  52  53  54  55  56
  31. &      62, 40, 41, 94,124, 45, 47, 63, 33, 39, 39, 46, 61, 59,
  32.  
  33. c (decim)            234 225 222 224 223 221             235 235
  34. c (octal)            352 341 336 340 337 335             353 354
  35. c       :   ,   _  th  pi  +-  sa  <-  ->   +   *   #  oc  tr
  36. c  (bl)   57  58  59  60  61  62  63  64  65  66  67  68  69  70
  37. &      58, 44, 95, 10, 34, 43,  6,  6,  6, 43, 42, 35,  1,  2,
  38.  
  39. c (decim)237 238 239
  40. c (octal)355 356 357
  41. c         di  sq  ??   a   b   c   d   e   f   g   h   i   j   k
  42. c  (bl)   71  72  73  74  75  76  77  78  79  80  81  82  83  84
  43. &       5,  0, 15, 97, 98, 99,100,101,102,103,104,105,106,107,
  44.  
  45. c          l   m   n   o   p   q   r   s   t   u   v   w   x   y
  46. c  (bl)   85  86  87  88  89  90  91  92  93  94  95  96  97  98
  47. &     108,109,110,111,112,113,114,115,116,117,118,119,120,121,
  48.  
  49. c          z   [   ]   \
  50. c  (bl)   99 100 101 102
  51. &        122, 91, 93, 92/
  52.  
  53. c ---- Set codes for '-', '"', '+', '_', '->'
  54.     data ihyph/45/, idbq/34/, iplus/43/, iundr/95/, irarw/6/
  55.  
  56. c Define statement function for rotating a symbol. ----
  57.     rotat(angin,amt) = amod((angin+amt),360.)
  58.  
  59. c ---- See if single character coming in. Probably most frequent. ----
  60.     if (ich .lt. 0 .or. ich .gt. 239) then
  61.       ic2 = ich
  62. c ---- Shift coordinates to bottom left corner.
  63.       rang = .0174533 * ang
  64.       cosa = cos (rang)
  65.       sina = sin (rang)
  66.       xx = x - ht*cosa/3. + 0.5*ht*sina
  67.       yy = y - ht*sina/3. - 0.5*ht*cosa
  68.       call symbol (xx,yy,ht,ic2,ang,1)
  69.  
  70. c ---- Must be an integer code ----
  71.     else
  72.  
  73. c ---- Get rid of the problem cases first. ----
  74.       if ( (ich.gt. 60 .and. ich.lt. 65) .or.
  75. &           (ich.gt.221 .and. ich.lt.226)) then
  76.  
  77. c ---- Special symbols that involve particular treatment:
  78. c ---- pi: construct by hyphyn with " under it.
  79.         if (ich.eq.61 .or. ich.eq.225) then
  80.           call symbol (x,y,ht,ihyph,ang,-1)
  81.           call symbol (x,y,ht,idbq,rotat(ang,180.),-1)
  82.  
  83. c ---- plus/minus: construct with overlaid '+' and '_'.
  84.         else if (ich.eq.62 .or. ich.eq.222) then
  85.           call symbol (x,y,ht,iplus,ang,-1)
  86.           call symbol (x,y,ht,iundr,ang,-1)
  87.  
  88. c ---- arrow to corner: rotate right arrow +45 degrees:
  89.         else if (ich.eq.63 .or. ich.eq.224) then
  90.           call symbol (x,y,ht,irarw,rotat(ang,45.),-1)
  91.  
  92. c ---- left arror: rotate right arrow 180 degrees:
  93.         else if (ich.eq.64 .or. ich.eq.223) then
  94.           call symbol (x,y,ht,irarw,rotat(ang,180.),-1)
  95.  
  96.         end if
  97.         
  98.  
  99. c ---- The rest can be done by table lookup:
  100.       else 
  101.         if (ich.lt.61 .or. 
  102. &           (ich.gt.64 .and. ich.lt.103)) then
  103.           ic2 =bls2hs (ich)
  104.  
  105. c ---- or by individual exceptions:
  106.         else if (ich .eq. 221) then
  107.           ic2 = 6
  108.         else if (ich .eq. 234) then
  109.           ic2 = 60
  110.         else if (ich .eq. 235) then
  111.           ic2 = 1
  112.         else if (ich .eq. 236) then
  113.           ic2 = 2
  114.         else if (ich .eq. 237) then
  115.           ic2 = 5
  116.         else if (ich .eq. 238) then
  117.           ic2 = 0
  118.         else if (ich .eq. 239) then
  119.           ic2 = 15
  120.         end if
  121.  
  122.         call symbol (x,y,ht,ic2,ang,-1)
  123.  
  124.       end if
  125.  
  126.     end if
  127.     return
  128.     end
  129.