00013 {
00014     /* Initialized data */
00015 
00016     static integer ia[128] = { 473,473,473,473,473,473,473,473,473,473,473,
00017             473,473,473,473,473,473,473,473,473,473,473,473,473,473,473,473,
00018             473,473,473,473,473,473,473,473,473,473,473,473,473,448,456,429,
00019             414,476,423,486,444,143,286,296,308,326,339,352,368,378,398,473,
00020             473,473,464,473,473,473,1,13,28,40,49,60,68,82,92,104,113,123,130,
00021             137,273,157,166,182,194,210,219,229,236,245,252,262,448,473,456,
00022             473,474,473,1,13,28,40,49,60,68,82,92,104,113,123,130,137,273,157,
00023             166,182,194,210,219,229,236,245,252,262,473,473,473,473,473 };
00024     static integer ku[494] = { 0,4,7,0,0,1,3,4,4,7,6,7,0,3,4,4,3,0,7,3,4,4,3,
00025             0,7,6,7,7,4,3,1,0,0,1,3,4,7,6,7,0,3,4,4,3,0,7,6,7,0,4,7,3,0,7,0,4,
00026             7,6,7,0,4,7,0,3,7,6,7,7,4,3,1,0,0,1,3,4,4,3,7,6,7,0,7,0,4,7,4,4,7,
00027             6,7,7,1,3,7,2,2,7,1,3,7,6,7,7,0,1,3,4,4,7,6,7,0,7,0,4,7,2,4,7,6,7,
00028             7,0,0,4,7,6,7,0,2,4,4,7,6,7,0,4,4,7,6,7,4,7,4,4,3,1,0,0,1,3,4,7,6,
00029             7,0,3,4,4,3,0,7,6,7,7,0,0,1,3,4,4,3,1,0,7,2,4,7,6,7,0,3,4,4,3,0,7,
00030             2,4,7,6,7,7,0,1,3,4,4,3,1,0,0,1,3,4,7,6,7,7,0,4,7,2,2,7,6,7,7,0,0,
00031             1,3,4,4,7,6,7,7,0,2,4,7,6,7,7,0,0,2,4,4,7,6,7,4,7,0,4,7,6,7,7,0,2,
00032             4,7,2,2,7,6,7,7,3,1,7,0,4,0,4,7,6,7,7,4,3,1,0,0,1,3,4,4,7,6,7,7,1,
00033             2,2,7,1,3,7,6,7,7,0,1,3,4,4,0,0,4,7,6,7,7,0,1,3,4,4,3,1,7,3,4,4,3,
00034             1,0,7,6,7,7,3,3,2,0,0,4,7,2,4,7,6,7,7,0,1,3,4,4,3,0,0,4,7,6,7,7,4,
00035             3,1,0,0,1,3,4,4,3,1,0,7,6,7,7,0,0,4,4,2,2,7,6,7,7,2,0,0,1,3,4,4,2,
00036             2,0,0,1,3,4,4,2,7,6,7,7,0,1,3,4,4,3,1,0,0,1,3,4,7,6,7,7,0,4,7,2,2,
00037             7,6,7,7,0,4,7,6,7,7,0,4,7,2,2,7,4,0,7,0,4,7,6,7,4,7,6,7,7,3,2,2,3,
00038             7,6,7,7,1,2,2,1,7,6,7,7,4,0,7,0,4,7,6,7,7,6,7,7,1,2,2,1,1,2,7,6,7,
00039             7,2,1,1,2,2,7,6,7 };
00040     static integer kv[494] = { 3,3,0,3,6,7,7,6,0,0,0,7,7,7,6,5,4,4,0,4,3,1,0,
00041             0,0,0,7,0,6,7,7,6,1,0,0,1,0,0,7,7,7,6,1,0,0,0,0,7,7,7,0,4,4,0,0,0,
00042             0,0,7,7,7,0,4,4,0,0,7,0,6,7,7,6,1,0,0,1,3,3,0,0,7,7,0,4,4,0,7,0,0,
00043             0,7,0,7,7,0,7,0,0,0,0,0,0,7,0,1,0,0,1,7,0,0,7,7,0,3,7,0,5,0,0,0,7,
00044             0,7,0,0,0,0,7,7,3,7,0,0,0,7,7,0,7,0,0,7,7,0,1,6,7,7,6,1,0,0,1,0,0,
00045             7,7,7,6,5,4,4,0,0,7,0,1,6,7,7,6,1,0,0,1,0,2,0,0,0,7,7,7,6,5,4,4,0,
00046             4,0,0,0,7,0,1,0,0,1,3,4,4,5,6,7,7,6,0,0,7,0,7,7,0,7,0,0,0,7,0,7,1,
00047             0,0,1,7,0,0,7,0,7,0,7,0,0,7,0,7,0,4,0,7,0,0,7,7,0,7,0,0,0,7,0,7,4,
00048             7,0,4,0,0,0,7,0,4,4,0,7,7,0,0,0,0,7,0,1,0,0,1,6,7,7,6,1,0,0,7,0,6,
00049             7,0,0,0,0,0,0,7,0,6,7,7,6,5,1,0,0,0,0,7,0,7,7,7,6,5,4,4,0,4,3,1,0,
00050             0,1,0,0,7,0,0,7,7,4,3,3,0,0,0,0,0,7,0,1,0,0,1,3,4,4,7,7,0,0,7,0,7,
00051             7,7,6,1,0,0,1,3,4,4,3,0,0,7,0,6,7,7,6,1,0,0,0,7,0,4,5,6,7,7,6,5,4,
00052             4,2,1,0,0,1,2,4,0,0,7,0,1,0,0,1,6,7,7,6,4,3,3,4,0,0,7,0,3,3,0,5,1,
00053             0,0,7,0,3,3,0,0,7,0,1,5,0,5,1,0,3,3,0,5,1,0,0,7,7,0,0,7,1,7,6,1,0,
00054             0,0,7,0,7,6,1,0,0,0,7,0,5,5,0,2,2,0,0,7,0,0,7,0,0,1,2,2,1,1,0,0,7,
00055             0,0,0,1,1,0,0,0,7 };
00056 
00057     static real xold, yold, xnew, ynew;
00058     static integer nu, nv, ipoint;
00059     extern /* Subroutine */ int zzline_(real *, real *, real *, real *);
00060     static real ctl, stl;
00061 
00062 
00063 /*  Plot one character in CH with lower left corner at XP,YP physical */
00064 /*  coordinates, with CT and ST the cosine and sine scaling/rotation */
00065 /*  factors. */
00066 
00067 /* .......................................................................
00068  */
00069 /*  The following digitization stuff is stolen from the NCAR metacode */
00070 /*  interpreter MCVAX.  Various minor changes have been made.  Most */
00071 /*  notable of these is the interchange of the '0' and 'O' characters -- 
00072 */
00073 /*  I just couldn't stand the slash going through the 'O' as the CDC */
00074 /*  custom has it. */
00075 
00076 
00077 /*  The following pointers relate standard FORTRAN characters to their */
00078 /*  digitizations.  Note the plethora of 473's.  That location does */
00079 /*  nothing. */
00080 
00081 /*  <control characters> */
00082 /*  <ctrls> */
00083 /*  <ctrls> */
00084 /*  <ctrls> */
00085 /*  <ctrls> */
00086 /*  <ctrls> */
00087 /*  <ctrl><ctrl><space>!" */
00088 /*  #$%&' */
00089 /*  ()*+, */
00090 /*  -./01 */
00091 /*  23456 */
00092 /*  789:; */
00093 /*  <=>?@ */
00094 /*  ABCDE */
00095 /*  FGHIJ */
00096 /*  KLMNO */
00097 /*  PQRST */
00098 /*  UVWXY */
00099 /*  Z[\]^ */
00100 /*  _` */
00101 /*  abcde */
00102 /*  fghij */
00103 /*  klmno */
00104 /*  pqrst */
00105 /*  uvwxy */
00106 /*  z */
00107 /*  {| */
00108 /*  }~<DEL> */
00109 
00110 /*  The following DATA statements contain the digitizations of the */
00111 /*  characters.  The characters are digitized on a box 6 units wide and */
00112 /*  7 units tall.  This includes 2 units of white space to the right of */
00113 /*  each character.  If KU=7, KV is a flag: */
00114 /*     KV=0 ==> the next KU and KV are a pen up move */
00115 /*              (normal coordinates are pen down moves) */
00116 /*     KV=7 ==> the end of the digitization for a particular character */
00117 /*              has been reached. */
00118 
00119 /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00120  */
00121 /*  Select digitization for this character. */
00122 
00123     xold = *xp;
00124     yold = *yp;
00125     ipoint = ia[*(unsigned char *)ch];
00126 
00127 /*  Scale lower case letters to be slightly smaller */
00128 
00129     if (*(unsigned char *)ch >= 'a' && *(unsigned char *)ch <= 'z') {
00130         ctl = *ct * .8f;
00131         stl = *st * .8f;
00132     } else {
00133         ctl = *ct;
00134         stl = *st;
00135     }
00136 
00137 L100:
00138     nu = ku[ipoint - 1];
00139     nv = kv[ipoint - 1];
00140     ++ipoint;
00141 /* .......................................................................
00142  */
00143 /*  Test for op-code stored in NV.  This is flagged by a 7 in NU. */
00144 
00145     if (nu == 7) {
00146 
00147 /*  Op-codes are: NV = 7             ==> end of character */
00148 /*                     anything else ==> pen up move to next location 
00149 */
00150 
00151         if (nv == 7) {
00152             return 0;
00153         } else {
00154             xold = *xp + ctl * ku[ipoint - 1] - stl * kv[ipoint - 1];
00155             yold = *yp + stl * ku[ipoint - 1] + ctl * kv[ipoint - 1];
00156             ++ipoint;
00157         }
00158 /* ...................................................................
00159 .... */
00160 /*  Here, plot the next stroke. */
00161 
00162     } else {
00163         xnew = *xp + ctl * nu - stl * nv;
00164         ynew = *yp + stl * nu + ctl * nv;
00165         zzline_(&xold, &yold, &xnew, &ynew);
00166         xold = xnew;
00167         yold = ynew;
00168     }
00169 /* .......................................................................
00170  */
00171 /*  Loopback to get next plotting order from KU, KV. */
00172 
00173     goto L100;
00174 } /* zzchar_ */