home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / 14 / symbol.f < prev    next >
Encoding:
Text File  |  1990-07-13  |  9.9 KB  |  360 lines
  1.     subroutine symbol( xin, yin, ht, strin, ang, nchin)
  2.     real               xin, yin, ht,        ang
  3.     integer*4                        strin(256),  nchin
  4. C
  5. C   Symbol subroutine conforming to
  6. C    "Programming CalComp Electromechanical Plotters", 1976
  7. C   For PostScript printers, using Adobe Courier font and font metrics
  8. C
  9. C   Rex Sanders, USGS, 3/87
  10. C
  11.  
  12.     common /cqpbnf/ xold, yold, fac, ires
  13.     save   /cqpbnf/
  14.     real            xold, yold, fac
  15.     integer                          ires
  16.  
  17.     real    x,    y,    dum1,    dum2
  18.     real    cosang,    sinang
  19.     integer    nch,    nfwd,    i,    ic,    intang
  20.  
  21. C        cfudge - Courier font fudge factor to get proper height
  22.     real    cfudge
  23.     save    cfudge
  24.  
  25. C        xoff - X offset for centered chars
  26. C        yoff - Y offset for centered chars
  27.     real    xoff(32:126),    yoff(32:126)
  28.     save    xoff        ,    yoff
  29.  
  30. C        ctable - centered char conversion table
  31.     integer    ctable(0:127)
  32.     save    ctable
  33.  
  34.     character*1024    cstr
  35.     integer*4    istr(256)
  36.     equivalence    (cstr, istr)
  37.  
  38.  
  39. C        htold - saved previous height
  40.     real    htold
  41.     save    htold
  42.     data    htold /0.0/
  43.  
  44.     data    cfudge /1.66666666/
  45. C
  46. C   Offsets for centered symbols - derived from Adobe Courier.AFM file
  47. C
  48.     data xoff(32), yoff(32) /-0.0000, -0.0000/
  49.     data xoff(33), yoff(33) /-0.3000, -0.3170/
  50.     data xoff(34), yoff(34) /-0.3000, -0.4585/
  51.     data xoff(35), yoff(35) /-0.3000, -0.2915/
  52.     data xoff(36), yoff(36) /-0.3000, -0.2810/
  53.     data xoff(37), yoff(37) /-0.3000, -0.3020/
  54.     data xoff(38), yoff(38) /-0.2915, -0.2525/
  55.     data xoff(39), yoff(39) /-0.2375, -0.4585/
  56.     data xoff(40), yoff(40) /-0.3760, -0.2395/
  57.     data xoff(41), yoff(41) /-0.2290, -0.2395/
  58.     data xoff(42), yoff(42) /-0.3000, -0.4170/
  59.     data xoff(43), yoff(43) /-0.3000, -0.2810/
  60.     data xoff(44), yoff(44) /-0.2375, -0.0000/
  61.     data xoff(45), yoff(45) /-0.3000, -0.2810/
  62.     data xoff(46), yoff(46) /-0.3000, -0.0500/
  63.     data xoff(47), yoff(47) /-0.3000, -0.2915/
  64.     data xoff(48), yoff(48) /-0.3000, -0.3020/
  65.     data xoff(49), yoff(49) /-0.3000, -0.3020/
  66.     data xoff(50), yoff(50) /-0.2810, -0.3095/
  67.     data xoff(51), yoff(51) /-0.2975, -0.3020/
  68.     data xoff(52), yoff(52) /-0.2915, -0.3020/
  69.     data xoff(53), yoff(53) /-0.2975, -0.2945/
  70.     data xoff(54), yoff(54) /-0.3230, -0.3020/
  71.     data xoff(55), yoff(55) /-0.2915, -0.3020/
  72.     data xoff(56), yoff(56) /-0.3000, -0.3020/
  73.     data xoff(57), yoff(57) /-0.3230, -0.3020/
  74.     data xoff(58), yoff(58) /-0.3000, -0.2010/
  75.     data xoff(59), yoff(59) /-0.2445, -0.1380/
  76.     data xoff(60), yoff(60) /-0.3000, -0.2810/
  77.     data xoff(61), yoff(61) /-0.3000, -0.2810/
  78.     data xoff(62), yoff(62) /-0.3000, -0.2810/
  79.     data xoff(63), yoff(63) /-0.3105, -0.2965/
  80.     data xoff(64), yoff(64) /-0.2915, -0.2810/
  81.     data xoff(65), yoff(65) /-0.3000, -0.2815/
  82.     data xoff(66), yoff(66) /-0.2920, -0.2815/
  83.     data xoff(67), yoff(67) /-0.2985, -0.2815/
  84.     data xoff(68), yoff(68) /-0.2815, -0.2815/
  85.     data xoff(69), yoff(69) /-0.2815, -0.2815/
  86.     data xoff(70), yoff(70) /-0.2815, -0.2815/
  87.     data xoff(71), yoff(71) /-0.3125, -0.2815/
  88.     data xoff(72), yoff(72) /-0.3020, -0.2815/
  89.     data xoff(73), yoff(73) /-0.3000, -0.2815/
  90.     data xoff(74), yoff(74) /-0.3335, -0.2740/
  91.     data xoff(75), yoff(75) /-0.3075, -0.2815/
  92.     data xoff(76), yoff(76) /-0.3020, -0.2815/
  93.     data xoff(77), yoff(77) /-0.3020, -0.2815/
  94.     data xoff(78), yoff(78) /-0.2920, -0.2815/
  95.     data xoff(79), yoff(79) /-0.3000, -0.2815/
  96.     data xoff(80), yoff(80) /-0.2710, -0.2815/
  97.     data xoff(81), yoff(81) /-0.3000, -0.2310/
  98.     data xoff(82), yoff(82) /-0.3160, -0.2815/
  99.     data xoff(83), yoff(83) /-0.3000, -0.2815/
  100.     data xoff(84), yoff(84) /-0.3000, -0.2815/
  101.     data xoff(85), yoff(85) /-0.3000, -0.2740/
  102.     data xoff(86), yoff(86) /-0.3000, -0.2815/
  103.     data xoff(87), yoff(87) /-0.3000, -0.2815/
  104.     data xoff(88), yoff(88) /-0.3000, -0.2815/
  105.     data xoff(89), yoff(89) /-0.3000, -0.2815/
  106.     data xoff(90), yoff(90) /-0.3000, -0.2815/
  107.     data xoff(91), yoff(91) /-0.3625, -0.2400/
  108.     data xoff(92), yoff(92) /-0.3000, -0.2915/
  109.     data xoff(93), yoff(93) /-0.2375, -0.2400/
  110.     data xoff(94), yoff(94) /-0.3000, -0.4795/
  111.     data xoff(95), yoff(95) /-0.3000, +0.2500/
  112.     data xoff(96), yoff(96) /-0.3625, -0.4585/
  113.     data xoff(97), yoff(97) /-0.3065, -0.2085/
  114.     data xoff(98), yoff(98) /-0.2815, -0.2945/
  115.     data xoff(99), yoff(99) /-0.3095, -0.2085/
  116.     data xoff(100), yoff(100) /-0.3230, -0.2945/
  117.     data xoff(101), yoff(101) /-0.2915, -0.2085/
  118.     data xoff(102), yoff(102) /-0.3230, -0.3020/
  119.     data xoff(103), yoff(103) /-0.3125, -0.1225/
  120.     data xoff(104), yoff(104) /-0.2970, -0.3020/
  121.     data xoff(105), yoff(105) /-0.3000, -0.3225/
  122.     data xoff(106), yoff(106) /-0.3025, -0.2290/
  123.     data xoff(107), yoff(107) /-0.3020, -0.3020/
  124.     data xoff(108), yoff(108) /-0.3000, -0.3020/
  125.     data xoff(109), yoff(109) /-0.3020, -0.2160/
  126.     data xoff(110), yoff(110) /-0.2970, -0.2160/
  127.     data xoff(111), yoff(111) /-0.3000, -0.2085/
  128.     data xoff(112), yoff(112) /-0.2815, -0.1225/
  129.     data xoff(113), yoff(113) /-0.3230, -0.1225/
  130.     data xoff(114), yoff(114) /-0.3125, -0.2140/
  131.     data xoff(115), yoff(115) /-0.3000, -0.2085/
  132.     data xoff(116), yoff(116) /-0.2710, -0.2735/
  133.     data xoff(117), yoff(117) /-0.2920, -0.2010/
  134.     data xoff(118), yoff(118) /-0.3000, -0.2085/
  135.     data xoff(119), yoff(119) /-0.3000, -0.2085/
  136.     data xoff(120), yoff(120) /-0.3000, -0.2085/
  137.     data xoff(121), yoff(121) /-0.3000, -0.1150/
  138.     data xoff(122), yoff(122) /-0.3020, -0.2085/
  139.     data xoff(123), yoff(123) /-0.3000, -0.2400/
  140.     data xoff(124), yoff(124) /-0.3000, -0.2400/
  141.     data xoff(125), yoff(125) /-0.3000, -0.2400/
  142.     data xoff(126), yoff(126) /-0.3000, -0.2810/
  143. C
  144. C   Character translation table for centered characters
  145. C
  146.     data (ctable(i), i =   0,  3) / 35,111, 73, 43/
  147.     data (ctable(i), i =   4,  7) / 88, 72, 94,126/
  148.     data (ctable(i), i =   8, 11) / 90, 89, 36, 42/
  149.     data (ctable(i), i =  12, 15) / 56,124, 37, 43/
  150.     data (ctable(i), i =  16, 19) / 43, 43, 43, 43/
  151.     data (ctable(i), i =  20, 23) / 43, 43, 43, 43/
  152.     data (ctable(i), i =  24, 27) / 43, 43, 43, 43/
  153.     data (ctable(i), i =  28, 31) / 43, 43, 43, 43/
  154.     data (ctable(i), i =  32, 35) / 32, 33, 34, 35/
  155.     data (ctable(i), i =  36, 39) / 36, 37, 38, 39/
  156.     data (ctable(i), i =  40, 43) / 40, 41, 42, 43/
  157.     data (ctable(i), i =  44, 47) / 44, 45, 46, 47/
  158.     data (ctable(i), i =  48, 51) / 48, 49, 50, 51/
  159.     data (ctable(i), i =  52, 55) / 52, 53, 54, 55/
  160.     data (ctable(i), i =  56, 59) / 56, 57, 58, 59/
  161.     data (ctable(i), i =  60, 63) / 60, 61, 62, 63/
  162.     data (ctable(i), i =  64, 67) / 64, 65, 66, 67/
  163.     data (ctable(i), i =  68, 71) / 68, 69, 70, 71/
  164.     data (ctable(i), i =  72, 75) / 72, 73, 74, 75/
  165.     data (ctable(i), i =  76, 79) / 76, 77, 78, 79/
  166.     data (ctable(i), i =  80, 83) / 80, 81, 82, 83/
  167.     data (ctable(i), i =  84, 87) / 84, 85, 86, 87/
  168.     data (ctable(i), i =  88, 91) / 88, 89, 90, 91/
  169.     data (ctable(i), i =  92, 95) / 92, 93, 94, 95/
  170.     data (ctable(i), i =  96, 99) / 96, 97, 98, 99/
  171.     data (ctable(i), i = 100,103) /100,101,102,103/
  172.     data (ctable(i), i = 104,107) /104,105,106,107/
  173.     data (ctable(i), i = 108,111) /108,109,110,111/
  174.     data (ctable(i), i = 112,115) /112,113,114,115/
  175.     data (ctable(i), i = 116,119) /116,117,118,119/
  176.     data (ctable(i), i = 120,123) /120,121,122,123/
  177.     data (ctable(i), i = 124,127) /124,125,126, 43/
  178. C
  179. C   Bad input check
  180. C
  181.     if (nchin .lt. -2 .or. ht .le. 0.0) return
  182.  
  183. C
  184. C   Initialise lots of stuff
  185. C
  186.     x = xin
  187.     y = yin
  188.     nch = nchin
  189.     if (x .eq. 999.) call where(x, dum1, dum2)
  190.     if (y .eq. 999.) call where(dum1, y, dum2)
  191.  
  192.     if (nchin .ne. -2) then
  193.         call plot (x, y, 3)
  194.     else
  195.         call plot (x, y, 2)
  196.     endif
  197.  
  198. C
  199. C   Round angle to integer - good to 1 degree
  200. C
  201.     intang = nint(ang)
  202.     cosang = cos(float(intang) * 0.017453292519)
  203.     sinang = sin(float(intang) * 0.017453292519)
  204.  
  205. C
  206. C   Set char height
  207. C
  208.     if (ht .ne. htold) then
  209.         call pliout (nint (ht * cfudge * fac * ires))
  210.         call plsout (" H ")
  211.         htold = ht
  212.     endif
  213.  
  214.  
  215. C
  216. C   Plot a string of characters
  217. C
  218.     if (nch .gt. 0) then
  219. C
  220. C    Set char angle
  221. C
  222.         if (intang .ne. 0) then
  223.         call pliout (intang)
  224.         call plsout (" RS ")
  225.         end if
  226.  
  227. C
  228. C    Transfer chars into holding area
  229. C
  230.         nfwd = nch/4
  231.         if (mod (nch, 4) .ne. 0) nfwd = nfwd + 1
  232.  
  233.         do 10 i = 1, nfwd
  234.         istr(i) = strin(i)
  235. 10        continue
  236.  
  237. C
  238. C    Output "(string) S ", escape ( ) \
  239. C
  240.         call plcout(40)
  241.  
  242.         do 20 i = 1, nch
  243.         ic = mod(ichar(cstr(i:i)), 127)
  244.         if    (ic .eq. 40) then
  245.             call plsout ("\\050")
  246.         else if    (ic .eq. 41) then
  247.             call plsout ("\\051")
  248.         else if    (ic .eq. 92) then
  249.             call plsout ("\\134")
  250.         else
  251.             call plcout(ic)
  252.         end if
  253. 20        continue
  254.  
  255.         call plsout(") S ")
  256.  
  257. C
  258. C       Update our idea of where the pen is.
  259. C
  260.         xold = x + (nch * ht * fac * cosang)
  261.         yold = y + (nch * ht * fac * sinang)
  262. C
  263. C    Undo character angle
  264. C
  265.         if (intang .ne. 0) then
  266.         call plsout ("RE\n")
  267.         else
  268.         call plcout (10)
  269.         endif
  270.  
  271. C
  272. C   Plot one char in strin
  273. C
  274.     else if (nch .eq. 0) then
  275. C
  276. C    Set char angle
  277. C
  278.         if (intang .ne. 0) then
  279.         call pliout (intang)
  280.         call plsout (" RS ")
  281.         end if
  282.  
  283. C
  284. C    Output "(c) S ", escape "(" and ")" and "\"
  285. C
  286.         call plcout (40)
  287.         ic = mod(ichar(char(strin(1))), 127)
  288.         if      (ic .eq. 40) then
  289.         call plsout ("\\050")
  290.         else if (ic .eq. 41) then
  291.         call plsout ("\\051")
  292.         else if (ic .eq. 92) then
  293.         call plsout ("\\134")
  294.         else
  295.         call plcout(ic)
  296.         end if
  297.         call plsout (") S ")
  298.  
  299. C
  300. C   Update our idea of where the pen is.
  301. C
  302.         xold = x + (ht * fac * cosang)
  303.         yold = y + (ht * fac * sinang)
  304. C
  305. C    Undo character angle
  306. C
  307.         if (intang .ne. 0) then
  308.         call plsout ("RE\n")
  309.         else
  310.         call plcout (10)
  311.         endif
  312.  
  313. C
  314. C   Plot special centered symbols
  315. C
  316.     else if (nch .eq. -1 .or. nch .eq. -2) then
  317. C
  318. C    Set char angle
  319. C
  320.         call pliout (intang)
  321.         call plsout (" RS ")
  322.  
  323. C
  324. C    Look up character
  325. C
  326.         ic = ctable(mod(ichar(char(strin(1))), 127))
  327.  
  328. C
  329. C    Plot centered character -
  330. C      output "xoff yoff RM (c) S ", escape ( ) \
  331. C
  332.         call pliout (nint (xoff(ic) * ht * cfudge * fac * ires))
  333.         call plcout (32)
  334.         call pliout (nint (yoff(ic) * ht * cfudge * fac * ires))
  335.         call plsout (" RM (")
  336.         if      (ic .eq. 40) then
  337.         call plsout ("\\050")
  338.         else if (ic .eq. 41) then
  339.         call plsout ("\\051")
  340.         else if (ic .eq. 92) then
  341.         call plsout ("\\134")
  342.         else
  343.         call plcout(ic)
  344.         end if
  345.         call plsout (") S ")
  346. C
  347. C    Update our idea of where the pen is
  348. C
  349.         xold = x
  350.         yold = y
  351. C
  352. C     Undo character angle
  353. C
  354.         call plsout ("RE\n")
  355.  
  356.     end if
  357.  
  358.     return
  359.     end
  360.