home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / fchek284.zip / test / t208d.f < prev    next >
Text File  |  1994-11-06  |  52KB  |  1,536 lines
  1.       SUBROUTINE  SYMSF (FONT,SWCHAR)
  2. C     (Select Font)
  3. C     Select  one  of  the  Hershey  fonts  for  subsequent  text
  4. C     plotting.  Up to five fonts may  be in effect at one  time.
  5. C     The last selected is  the default one.   If more than  five
  6. C     fonts are requested, the sixth will replace the first,  the
  7. C     seventh the second, and  so on in  a cyclic fashion.   This
  8. C     restriction  is  purely  dimensional,  and  may  easily  be
  9. C     changed  if  required.   The  case  switch  characters  are
  10. C     initialized to  "<"  and  ">"  for  to-upper  and  to-lower
  11. C     respectively.    The   backspace   character   switch    is
  12. C     initialized to 0, suppressing the backspace facility.   The
  13. C     arguments are:
  14. C
  15. C     FONT(*).....5-character string selecting font (see below).
  16. C     SWCHAR(*)...Single  character (e.g. 1H=)  used  as a switch
  17. C                 character to return to this font from  another.
  18. C                 It will be interpreted as a switch character if
  19. C                 it occurs only  once.  However, two  successive
  20. C                 switch characters  for a  single font  will  be
  21. C                 collapsed to a single character and will not be
  22. C                 interpreted as a font switch.  A blank or  zero
  23. C                 value indicates  that  no switch  character  is
  24. C                 selected.
  25. C
  26. C     The fonts are selected by  a five-character string made  up
  27. C     of a  2-character case  specification, a  2-character  type
  28. C     specification, and a 1-character variant specification,  as
  29. C     follows:
  30. C
  31. C     Case: UC - Upper Case
  32. C           LC - Lower Case
  33. C
  34. C     Type: KR - Cartographic Roman (9)
  35. C           KG - Cartographic Greek (9)
  36. C           IR - Indexical Roman (13)
  37. C           II - Indexical Roman Italic (13)
  38. C           IG - Indexical Greek (13)
  39. C           SA - Simplex ASCII (15)
  40. C           BA - Block ASCII (15)
  41. C           SR - Simplex Roman (21)
  42. C           SS - Simplex Roman Script (21)
  43. C           SG - Simplex Greek (21)
  44. C           CR - Complex Normal Roman (21)
  45. C           CI - Complex Normal Roman Italic (21)
  46. C           CG - Complex Normal Greek (21)
  47. C           CS - Complex Script (21)
  48. C           DR - Duplex Roman (21)
  49. C           TR - Triplex Roman (21)
  50. C           GE - Gothic English (21)
  51. C           GI - Gothic Italian (21)
  52. C           GG - Gothic German (21)
  53. C           CC - Complex Cyrillic (21)
  54. C
  55. C     Variant: 1 - Principal
  56. C              2 - Secondary
  57. C              3 - Tertiary
  58. C              4 - Quaternary
  59. C
  60. C     Selector letters may be  either upper- or lower-case.   The
  61. C     case specification is arranged  such that if upper-case  is
  62. C     requested, upper-case text will be mapped into  upper-case,
  63. C     and  lower-case   into   lower-case.   If   lower-case   is
  64. C     requested, both upper-  and lower-case  letters are  mapped
  65. C     into lower case.  The four  variants are provided to  allow
  66. C     representation of  special  characters within  the  limited
  67. C     FORTRAN set.  The Gothic and  Cyrillic fonts have only  two
  68. C     variants available.  Requests for variants  3 or 4 will  be
  69. C     reduced to  variant  2.   The ASCII  fonts  have  only  one
  70. C     variant, and  requests for  variants  2, 3,  or 4  will  be
  71. C     reduced to variant 1.
  72. C
  73. C     The numbers (9),  (13), (15), and  (21) following the  type
  74. C     indicate the height of the characters in raster units.  The
  75. C     spacing between lines of text is conventionally measured by
  76. C     the printer's  unit  "em",  giving the  distance  from  the
  77. C     bottom of one line of type to the bottom of the next  line.
  78. C     It should be  21 raster  units for indexical  size, and  32
  79. C     raster units for normal size.
  80. C
  81. C     If any of the three parts  of the font specification is  in
  82. C     error, a message  will be  issued, and a  default for  that
  83. C     part will be assumed.  The default corresponds to  "UCTR1".
  84. C     (01-APR-83)
  85. C  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  86. C
  87. C     EXTERNAL REFERENCES (FUNCTION,SUBROUTINE,COMMON)
  88. C
  89. C     EXTERNAL REFS       ERRAT,       ERRCK,       ERRMS,       KARASC
  90. C     EXTERNAL REFS       KARCM2,      KARUC,       KARUPK,      MIN0
  91. C     EXTERNAL REFS       MOD
  92. C
  93. C  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  94. C
  95. C     EXTERNAL FUNCTIONS AND SUBROUTINES
  96. C
  97.       INTEGER             KARASC,      KARCM2,      KARUC
  98. C  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  99. C
  100. C     INTRINSIC FUNCTIONS
  101. C
  102.       INTEGER             MIN0,        MOD
  103. C  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  104. C
  105. C     Working variables
  106. C
  107.       INTEGER             FCASE,       FONT(1),     FTYPE,       FVAR
  108.       INTEGER             I,           IDIG,        ILC,         IUC
  109.       INTEGER             LOC0,        LOC0SV,      LOCLC,       LOCUC
  110.       INTEGER             NOCHAR,      NUL,         SWCHAR(1)
  111.       LOGICAL             ERROR
  112. C
  113. C     Font type case selectors
  114. C
  115.       INTEGER             BA
  116.       INTEGER             CC,          CG,          CI,          CR
  117.       INTEGER             CS,          DR,          GE,          GG
  118.       INTEGER             GI,          IG,          II,          IR
  119.       INTEGER             KG,          KR,          SA,          SG
  120.       INTEGER             SR,          SS,          TR
  121. C
  122. C     Roman alphabet symbols in upper-case ASCII.
  123. C
  124.       INTEGER             UCA,         UCB,         UCC,         UCD
  125.       INTEGER             UCE,         UCF,         UCG,         UCH
  126.       INTEGER             UCI,         UCJ,         UCK,         UCL
  127.       INTEGER             UCM,         UCN,         UCO,         UCP
  128.       INTEGER             UCQ,         UCR,         UCS,         UCT
  129.       INTEGER             UCU,         UCV,         UCW,         UCX
  130.       INTEGER             UCY,         UCZ
  131. C
  132. C     Roman alphabet symbols in lower-case ASCII.
  133. C
  134.       INTEGER             LCA,         LCB,         LCC,         LCD
  135.       INTEGER             LCE,         LCF,         LCG,         LCH
  136.       INTEGER             LCI,         LCJ,         LCK,         LCL
  137.       INTEGER             LCM,         LCN,         LCO,         LCP
  138.       INTEGER             LCQ,         LCR,         LCS,         LCT
  139.       INTEGER             LCU,         LCV,         LCW,         LCX
  140.       INTEGER             LCY,         LCZ
  141. C
  142. C     Greek alphabet symbols ordered relative to first letter.
  143. C
  144.       INTEGER             ALPHA,       BETA,        CHI,         DELTA
  145.       INTEGER             EPSLON,      ETA,         GAMMA,       IOTA
  146.       INTEGER             KAPPA,       LAMBDA,      MU,          NU
  147.       INTEGER             OMCRON,      OMEGA,       PHI,         PI
  148.       INTEGER             PSI,         RHO,         SIGMA,       TAU
  149.       INTEGER             THETA,       UPSLON,      XI,          ZETA
  150. C
  151. C     Cyrillic alphabet ordered relative to first letter.
  152. C
  153.       INTEGER             CYA,         CYB,         CYCHE,       CYD
  154.       INTEGER             CYE,         CYEE,        CYEEK,       CYF
  155.       INTEGER             CYG,         CYK,         CYKHA,       CYL
  156.       INTEGER             CYM,         CYMZNK,      CYN,         CYO
  157.       INTEGER             CYOO,        CYP,         CYR,         CYS
  158.       INTEGER             CYSH,        CYSHCH,      CYT,         CYTSE
  159.       INTEGER             CYTZNK,      CYV,         CYYA,        CYYE
  160.       INTEGER             CYYIRI,      CYYOO,       CYZ,         CYZHE
  161. C
  162. C     ASCII special characters
  163. C
  164.       INTEGER             ACCENT,      AMPSND,      AT,          CARET
  165.       INTEGER             COLON,       COMMA,       DEL,         DOLLAR
  166.       INTEGER             DQUOTE,      EQUALS,      EXCLPT,      LANGLE
  167.       INTEGER             LBRACE,      LBRAKT,      LPAREN,      MINUS
  168.       INTEGER             NUMBER,      PERCNT,      PERIOD,      PLUS
  169.       INTEGER             QUERY,       RANGLE,      RBRACE,      RBRAKT
  170.       INTEGER             RPAREN,      RSLANT,      SCOLON,      SLASH
  171.       INTEGER             SPACE,       SQUOTE,      STAR,        TILDE
  172.       INTEGER             USCORE,      VBAR
  173. C
  174. C     COMMON declarations
  175. C
  176. C ----------------------------------------------------------------------
  177. C          C O R E   G R A P H I C S   S Y S T E M   T E X T
  178. C            C U R R E N T   F O N T   P A R A M E T E R S
  179. C                       C O M M O N   B L O C K
  180. C
  181. C     CASESW:        Current temporary font case (1=UC, 2=LC)
  182. C     KFONT:         Current font table index
  183. C     MAXFNT:        Maximum font index
  184. C     NFONT:         Index of most recent font table established
  185. C     NFUSED:        Maximum number of font tables in use
  186. C
  187.       INTEGER          CASESW,      KFONT,       MAXFNT,      NFONT
  188.       INTEGER          NFUSED
  189.       COMMON /SYM02 /  CASESW,      KFONT,       MAXFNT,      NFONT
  190.       COMMON /SYM02 /  NFUSED
  191. C ----------------------------------------------------------------------
  192. C          C O R E   G R A P H I C S   S Y S T E M   T E X T
  193. C                          F O N T   D A T A
  194. C                       C O M M O N   B L O C K
  195. C
  196. C     ASCII(*,*):    Table of Hershey characters assigned to
  197. C                    ASCII values
  198. C     BSWTCH(*):     Backspace switch ASCII character numbers for
  199. C                    each font
  200. C     FONTID(*):     Packed integer font identification for each font
  201. C     FONTNM(*,*):   Unpacked Hollerith font name for each font
  202. C     FSWTCH(*):     Font switch ASCII character numbers for each
  203. C                    font
  204. C     LSWTCH(*):     Lower-case switch ASCII character numbers
  205. C                    for each font
  206. C     USWTCH(*):     Upper-case switch ASCII character numbers
  207. C                    for each font
  208. C
  209.       INTEGER          ASCII,       BSWTCH,      FONTID,      FONTNM
  210.       INTEGER          FSWTCH,      LSWTCH,      USWTCH
  211.       COMMON /SYM03 /  ASCII(96,5), BSWTCH(5),   FONTID(5)
  212.       COMMON /SYM03 /  FONTNM(5,5), FSWTCH(5),   LSWTCH(5),   USWTCH(5)
  213. C
  214. C     Roman alphabet symbols in upper-case ASCII.
  215. C
  216.       DATA UCA,UCB,UCC,UCD,UCE,UCF,UCG,UCH,UCI,UCJ,UCK,UCL,UCM,UCN,
  217.      XUCO,UCP,UCQ,UCR,UCS,UCT,UCU,UCV,UCW,UCX,UCY,UCZ/
  218.      X65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78,
  219.      X79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90/
  220. C
  221. C     Roman alphabet symbols in lower-case ASCII.
  222. C
  223.       DATA LCA,LCB,LCC,LCD,LCE,LCF,LCG,LCH,LCI,LCJ,LCK,LCL,LCM,LCN,
  224.      XLCO,LCP,LCQ,LCR,LCS,LCT,LCU,LCV,LCW,LCX,LCY,LCZ/
  225.      X97, 98, 99,100,101,102,103,104,105,106,107,108,109,110,          1
  226.      X11,112,113,114,115,116,117,118,119,120,121,122/
  227. C
  228. C     Greek alphabet symbols ordered relative to first letter.
  229. C
  230.       DATA ALPHA,BETA,GAMMA,DELTA,EPSLON,ZETA,ETA,THETA,IOTA,KAPPA,
  231.      XLAMBDA,MU,NU,XI,OMCRON,PI,RHO,SIGMA,TAU,UPSLON,PHI,CHI,PSI,
  232.      XOMEGA/
  233.      X0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
  234.      X23/
  235. C
  236. C     Cyrillic alphabet symbols ordered relative to first letter.
  237. C
  238.       DATA CYA,CYB,CYV,CYG,CYD,CYYE,CYZHE,CYZ,CYEE,CYEEK,CYK,
  239.      XCYL,CYM,CYN,CYO,CYP,CYR,CYS,CYT,CYOO,CYF,CYKHA,
  240.      XCYTSE,CYCHE,CYSH,CYSHCH,CYTZNK,CYYIRI,CYMZNK,CYE,CYYOO,CYYA/
  241.      X0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
  242.      X23,24,25,26,27,28,29,30,31/
  243. C
  244. C     ASCII special characters
  245. C
  246.       DATA SPACE,EXCLPT,DQUOTE,NUMBER,DOLLAR,PERCNT,AMPSND,
  247.      XSQUOTE,LPAREN,RPAREN,STAR,PLUS,COMMA,MINUS,PERIOD,
  248.      XSLASH,COLON,SCOLON,LANGLE,EQUALS,RANGLE,QUERY,AT,
  249.      XLBRAKT,RSLANT,RBRAKT,CARET,USCORE,ACCENT,LBRACE,
  250.      XVBAR,RBRACE,TILDE,DEL/
  251.      X32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
  252.      X58,59,60,61,62,63,64,
  253.      X91,92,93,94,95,
  254.      X96,123,124,125,126,127/
  255.       DATA NUL/0/
  256. C
  257. C     Font type case switch values.
  258. C
  259.       DATA KR/1/, KG/2/, IR/3/, II/4/, IG/5/, SR/6/, SS/7/, SG/8/
  260.       DATA CR/9/, CI/10/, CG/11/, CS/12/, DR/13/, TR/14/, GE/15/
  261.       DATA GI/16/, GG/17/, CC/18/, SA/19/, BA/20/
  262. C
  263.       ASSIGN 20001 TO NPR001
  264.       GO TO 30001
  265. 20001 ASSIGN 20002 TO NPR002
  266.       GO TO 30002
  267. 20002 ASSIGN 20003 TO NPR003
  268.       GO TO 30003
  269. 20003 ASSIGN 20004 TO NPR004
  270.       GO TO 30004
  271. 20004 IF (.NOT.(ERROR)) GO TO 20005
  272.       ASSIGN 20005 TO NPR005
  273.       GO TO 30005
  274. 20005 ASSIGN 20006 TO NPR006
  275.       GO TO 30006
  276. C
  277. 20006 RETURN
  278. C
  279. C-----------------------------------------------------------------------
  280. C---- PROCEDURE (Alphanumerics)
  281. 30007 IF (FCASE .EQ. 2) LOCUC = LOCLC
  282.       I =1
  283.       GO TO 20008
  284. 20007 I =I +1
  285. 20008 IF ((26-I ).LT.0) GO TO 20009
  286.       IUC = I + 64 - 31
  287.       ASCII(IUC,NFONT) = LOCUC + I - 1
  288.       ILC = I + 96 - 31
  289.       ASCII(ILC,NFONT) = LOCLC + I - 1
  290.       GO TO 20007
  291. 20009 ASSIGN 20011 TO NPR008
  292.       GO TO 30008
  293. 20011 GO TO NPR007, (20039,20055,20058,20077,20085,20088,20094,20131,201
  294.      X53,20168,20249,20252,20255)
  295. C
  296. C-----------------------------------------------------------------------
  297. C---- PROCEDURE (BA - Block ASCII)
  298. 30009 LOCUC = 1765
  299.       LOCLC = 1797
  300.       I =32
  301.       GO TO 20013
  302. 20012 I =I +1
  303. 20013 IF ((127-I ).LT.0) GO TO 20014
  304.       ASCII(I-31,NFONT) = 1700 + I
  305.       GO TO 20012
  306. 20014 IF (.NOT.(FCASE .EQ. 2)) GO TO 20016
  307.       I =65
  308.       GO TO 20020
  309. 20019 I =I +1
  310. 20020 IF ((90-I ).LT.0) GO TO 20021
  311.       ASCII(I-31,NFONT) = 1700 + I + 32
  312.       GO TO 20019
  313. 20021 CONTINUE
  314. 20016 GO TO 20225
  315. C
  316. C-----------------------------------------------------------------------
  317. C---- PROCEDURE (Cartographic Special Characters)
  318. 30010 NOCHAR = LOC0 - 1
  319.       ASSIGN 20023 TO NPR011
  320.       GO TO 30011
  321. 20023 ASCII(SPACE -31,NFONT) = LOC0 - 1
  322.       ASCII(EXCLPT-31,NFONT) = LOC0 + 14
  323.       ASCII(DQUOTE-31,NFONT) = LOC0 + 17
  324.       ASCII(NUMBER-31,NFONT) = LOC0 + 33
  325.       ASCII(AMPSND-31,NFONT) = LOC0 + 34
  326.       ASCII(SQUOTE-31,NFONT) = LOC0 + 16
  327.       ASCII(COLON -31,NFONT) = LOC0 + 12
  328.       ASCII(SCOLON-31,NFONT) = LOC0 + 13
  329.       ASCII(QUERY -31,NFONT) = LOC0 + 15
  330.       ASCII(VBAR  -31,NFONT) = LOC0 + 23
  331.       GO TO NPR010, (20163,20166,20239)
  332. C
  333. C-----------------------------------------------------------------------
  334. C---- PROCEDURE (Cartographic Standard Signs)
  335. 30012 NX0028=FVAR
  336.       IF (NX0028.LT.1.OR.NX0028.GT.4) GO TO 20028
  337.       GO TO (20024,20025,20026,20027), NX0028
  338. 20024 ASCII(COMMA -31,NFONT) =  211
  339.       ASCII(PERIOD-31,NFONT) =  210
  340.       ASCII(LPAREN-31,NFONT) =  221
  341.       ASCII(RPAREN-31,NFONT) =  222
  342.       ASCII(MINUS -31,NFONT) =  224
  343.       ASCII(PLUS  -31,NFONT) =  225
  344.       ASCII(STAR  -31,NFONT) =  228
  345.       ASCII(SLASH -31,NFONT) =  220
  346.       ASCII(EQUALS-31,NFONT) =  226
  347.       ASCII(DOLLAR-31,NFONT) =  219
  348.       ASCII(AT    -31,NFONT) = 1273
  349.       GO TO 20029
  350. 20025 ASCII(COMMA -31,NFONT) =  213
  351.       ASCII(PERIOD-31,NFONT) =  215
  352.       ASCII(LPAREN-31,NFONT) =  221
  353.       ASCII(RPAREN-31,NFONT) =  222
  354.       ASCII(MINUS -31,NFONT) =  224
  355.       ASCII(PLUS  -31,NFONT) =  225
  356.       ASCII(STAR  -31,NFONT) =  229
  357.       ASCII(SLASH -31,NFONT) =  220
  358.       ASCII(EQUALS-31,NFONT) =  226
  359.       ASCII(DOLLAR-31,NFONT) =  233
  360.       ASCII(AT    -31,NFONT) =  232
  361.       GO TO 20029
  362. 20026 ASCII(COMMA -31,NFONT) =  212
  363.       ASCII(PERIOD-31,NFONT) =  214
  364.       ASCII(LPAREN-31,NFONT) =  221
  365.       ASCII(RPAREN-31,NFONT) =  222
  366.       ASCII(MINUS -31,NFONT) =  224
  367.       ASCII(PLUS  -31,NFONT) =  225
  368.       ASCII(STAR  -31,NFONT) =  227
  369.       ASCII(SLASH -31,NFONT) =  220
  370.       ASCII(EQUALS-31,NFONT) =  226
  371.       ASCII(DOLLAR-31,NFONT) =  223
  372.       ASCII(AT    -31,NFONT) =  230
  373.       GO TO 20029
  374. 20027 ASCII(COMMA -31,NFONT) =  216
  375.       ASCII(PERIOD-31,NFONT) =  217
  376.       ASCII(LPAREN-31,NFONT) =  221
  377.       ASCII(RPAREN-31,NFONT) =  222
  378.       ASCII(MINUS -31,NFONT) =  224
  379.       ASCII(PLUS  -31,NFONT) =  225
  380.       ASCII(STAR  -31,NFONT) =  218
  381.       ASCII(SLASH -31,NFONT) =  220
  382.       ASCII(EQUALS-31,NFONT) =  226
  383.       ASCII(DOLLAR-31,NFONT) =  235
  384.       ASCII(AT    -31,NFONT) =  231
  385.       GO TO 20029
  386. 20028 ASSIGN 20030 TO NPR013
  387.       GO TO 30013
  388. 20030 CONTINUE
  389. 20029 GO TO NPR012, (20164,20167)
  390. C
  391. C-----------------------------------------------------------------------
  392. C---- PROCEDURE (CC - Complex Cyrillic)
  393. 30014 FVAR = MIN0(FVAR,2)
  394.       LOCUC = 2801
  395.       LOCLC = 2901
  396.       LOC0 = 2200
  397.       ASSIGN 20031 TO NPR015
  398.       GO TO 30015
  399. 20031 ASSIGN 20032 TO NPR016
  400.       GO TO 30016
  401. 20032 ASSIGN 20033 TO NPR017
  402.       GO TO 30017
  403. 20033 GO TO 20223
  404. C
  405. C-----------------------------------------------------------------------
  406. C---- PROCEDURE (CG - Complex Greek)
  407. 30018 LOCUC = 2027
  408.       LOCLC = 2127
  409.       LOC0 = 2200
  410.       ASSIGN 20034 TO NPR015
  411.       GO TO 30015
  412. 20034 ASSIGN 20035 TO NPR016
  413.       GO TO 30016
  414. 20035 ASSIGN 20036 TO NPR019
  415.       GO TO 30019
  416. 20036 GO TO 20216
  417. C
  418. C-----------------------------------------------------------------------
  419. C---- PROCEDURE (CI - Complex Italic)
  420. 30020 LOCUC = 2051
  421.       LOCLC = 2151
  422.       LOC0 = 2750
  423.       ASSIGN 20037 TO NPR015
  424.       GO TO 30015
  425. 20037 ASSIGN 20038 TO NPR016
  426.       GO TO 30016
  427. 20038 ASSIGN 20039 TO NPR007
  428.       GO TO 30007
  429. 20039 GO TO 20215
  430. C
  431. C-----------------------------------------------------------------------
  432. C---- PROCEDURE (Complex Script Special Characters)
  433. 30021 LOC0SV = LOC0
  434.       LOC0 = 2200
  435.       ASSIGN 20040 TO NPR015
  436.       GO TO 30015
  437. 20040 LOC0 = LOC0SV
  438.       ASCII(SPACE -31,NFONT) = LOC0 - 1
  439.       ASCII(EXCLPT-31,NFONT) = LOC0 + 14
  440.       ASCII(DQUOTE-31,NFONT) = LOC0 + 28
  441.       ASCII(AMPSND-31,NFONT) = LOC0 + 18
  442.       ASCII(SQUOTE-31,NFONT) = LOC0 + 27
  443.       ASCII(COLON -31,NFONT) = LOC0 + 12
  444.       ASCII(SCOLON-31,NFONT) = LOC0 + 13
  445.       ASCII(QUERY -31,NFONT) = LOC0 + 15
  446.       GO TO 20056
  447. C
  448. C-----------------------------------------------------------------------
  449. C---- PROCEDURE (Complex Special Characters)
  450. 30015 NOCHAR = LOC0 - 1
  451.       ASSIGN 20041 TO NPR011
  452.       GO TO 30011
  453. 20041 ASCII(SPACE -31,NFONT) = LOC0 - 1
  454.       ASCII(EXCLPT-31,NFONT) = LOC0 + 14
  455.       ASCII(DQUOTE-31,NFONT) = LOC0 + 17
  456.       ASCII(NUMBER-31,NFONT) = LOC0 + 75
  457.       ASCII(PERCNT-31,NFONT) = LOC0 + 71
  458.       ASCII(AMPSND-31,NFONT) = LOC0 + 72
  459.       ASCII(SQUOTE-31,NFONT) = LOC0 + 16
  460.       ASCII(COLON -31,NFONT) = LOC0 + 12
  461.       ASCII(SCOLON-31,NFONT) = LOC0 + 13
  462.       ASCII(LANGLE-31,NFONT) = LOC0 + 41
  463.       ASCII(RANGLE-31,NFONT) = LOC0 + 42
  464.       ASCII(QUERY -31,NFONT) = LOC0 + 15
  465.       ASCII(LBRAKT-31,NFONT) = LOC0 + 23
  466.       ASCII(RBRAKT-31,NFONT) = LOC0 + 24
  467.       ASCII(CARET -31,NFONT) = LOC0 + 47
  468.       ASCII(ACCENT-31,NFONT) = LOC0 + 49
  469.       ASCII(LBRACE-31,NFONT) = LOC0 + 25
  470.       ASCII(VBAR  -31,NFONT) = LOC0 + 29
  471.       ASCII(RBRACE-31,NFONT) = LOC0 + 26
  472.       ASCII(TILDE -31,NFONT) = LOC0 + 46
  473.       GO TO NPR015, (20031,20034,20037,20040,20053,20078,20095,20132,202
  474.      X56)
  475. C
  476. C-----------------------------------------------------------------------
  477. C---- PROCEDURE (Complex Standard Signs)
  478. 30016 I = (FVAR-1)*2 + FCASE
  479.       NX0050=I
  480.       IF (NX0050.LT.1.OR.NX0050.GT.8) GO TO 20050
  481.       GO TO (20042,20043,20044,20045,20046,20047,20048,20049), NX0050
  482. 20042 ASCII(COMMA -31,NFONT) = 2211
  483.       ASCII(PERIOD-31,NFONT) = 2210
  484.       ASCII(LPAREN-31,NFONT) = 2221
  485.       ASCII(RPAREN-31,NFONT) = 2222
  486.       ASCII(MINUS -31,NFONT) = 2231
  487.       ASCII(PLUS  -31,NFONT) = 2232
  488.       ASCII(STAR  -31,NFONT) = 2219
  489.       ASCII(SLASH -31,NFONT) = 2220
  490.       ASCII(EQUALS-31,NFONT) = 2238
  491.       ASCII(DOLLAR-31,NFONT) = 2274
  492.       ASCII(AT    -31,NFONT) = 2273
  493.       GO TO 20051
  494. 20043 ASCII(COMMA -31,NFONT) = 2211
  495.       ASCII(PERIOD-31,NFONT) = 2210
  496.       ASCII(LPAREN-31,NFONT) = 2221
  497.       ASCII(RPAREN-31,NFONT) = 2222
  498.       ASCII(MINUS -31,NFONT) = 2231
  499.       ASCII(PLUS  -31,NFONT) = 2232
  500.       ASCII(STAR  -31,NFONT) = 2219
  501.       ASCII(SLASH -31,NFONT) = 2220
  502.       ASCII(EQUALS-31,NFONT) = 2238
  503.       ASCII(DOLLAR-31,NFONT) = 2274
  504.       ASCII(AT    -31,NFONT) = 2273
  505.       GO TO 20051
  506. 20044 ASCII(COMMA -31,NFONT) = 2213
  507.       ASCII(PERIOD-31,NFONT) = 2215
  508.       ASCII(LPAREN-31,NFONT) = 2405
  509.       ASCII(RPAREN-31,NFONT) = 2406
  510.       ASCII(MINUS -31,NFONT) = 2256
  511.       ASCII(PLUS  -31,NFONT) = 2257
  512.       ASCII(STAR  -31,NFONT) = 2259
  513.       ASCII(SLASH -31,NFONT) = 2258
  514.       ASCII(EQUALS-31,NFONT) = 2260
  515.       ASCII(DOLLAR-31,NFONT) = 2279
  516.       ASCII(AT    -31,NFONT) = 2276
  517.       GO TO 20051
  518. 20045 ASCII(COMMA -31,NFONT) = 2213
  519.       ASCII(PERIOD-31,NFONT) = 2215
  520.       ASCII(LPAREN-31,NFONT) = 2223
  521.       ASCII(RPAREN-31,NFONT) = 2224
  522.       ASCII(MINUS -31,NFONT) = 2246
  523.       ASCII(PLUS  -31,NFONT) = 2272
  524.       ASCII(STAR  -31,NFONT) = 2245
  525.       ASCII(SLASH -31,NFONT) = 2271
  526.       ASCII(EQUALS-31,NFONT) = 2239
  527.       ASCII(DOLLAR-31,NFONT) = 2275
  528.       ASCII(AT    -31,NFONT) = 2216
  529.       GO TO 20051
  530. 20046 ASCII(COMMA -31,NFONT) = 2212
  531.       ASCII(PERIOD-31,NFONT) = 2214
  532.       ASCII(LPAREN-31,NFONT) = 2403
  533.       ASCII(RPAREN-31,NFONT) = 2404
  534.       ASCII(MINUS -31,NFONT) = 2231
  535.       ASCII(PLUS  -31,NFONT) = 2232
  536.       ASCII(STAR  -31,NFONT) = 2235
  537.       ASCII(SLASH -31,NFONT) = 2230
  538.       ASCII(EQUALS-31,NFONT) = 2238
  539.       ASCII(DOLLAR-31,NFONT) = 2411
  540.       ASCII(AT    -31,NFONT) = 2277
  541.       GO TO 20051
  542. 20047 ASCII(COMMA -31,NFONT) = 2212
  543.       ASCII(PERIOD-31,NFONT) = 2214
  544.       ASCII(LPAREN-31,NFONT) = 2221
  545.       ASCII(RPAREN-31,NFONT) = 2222
  546.       ASCII(MINUS -31,NFONT) = 2231
  547.       ASCII(PLUS  -31,NFONT) = 2232
  548.       ASCII(STAR  -31,NFONT) = 2236
  549.       ASCII(SLASH -31,NFONT) = 2229
  550.       ASCII(EQUALS-31,NFONT) = 2238
  551.       ASCII(DOLLAR-31,NFONT) = 2267
  552.       ASCII(AT    -31,NFONT) = 2217
  553.       GO TO 20051
  554. 20048 ASCII(COMMA -31,NFONT) = 2251
  555.       ASCII(PERIOD-31,NFONT) = 2252
  556.       ASCII(LPAREN-31,NFONT) = 2407
  557.       ASCII(RPAREN-31,NFONT) = 2408
  558.       ASCII(MINUS -31,NFONT) = 2261
  559.       ASCII(PLUS  -31,NFONT) = 2233
  560.       ASCII(STAR  -31,NFONT) = 2242
  561.       ASCII(SLASH -31,NFONT) = 2228
  562.       ASCII(EQUALS-31,NFONT) = 2244
  563.       ASCII(DOLLAR-31,NFONT) = 2412
  564.       ASCII(AT    -31,NFONT) = 2270
  565.       GO TO 20051
  566. 20049 ASCII(COMMA -31,NFONT) = 2251
  567.       ASCII(PERIOD-31,NFONT) = 2252
  568.       ASCII(LPAREN-31,NFONT) = 2225
  569.       ASCII(RPAREN-31,NFONT) = 2226
  570.       ASCII(MINUS -31,NFONT) = 2263
  571.       ASCII(PLUS  -31,NFONT) = 2234
  572.       ASCII(STAR  -31,NFONT) = 2241
  573.       ASCII(SLASH -31,NFONT) = 2227
  574.       ASCII(EQUALS-31,NFONT) = 2243
  575.       ASCII(DOLLAR-31,NFONT) = 2268
  576.       ASCII(AT    -31,NFONT) = 2218
  577.       GO TO 20051
  578. 20050 ASSIGN 20052 TO NPR013
  579.       GO TO 30013
  580. 20052 CONTINUE
  581. 20051 GO TO NPR016, (20032,20035,20038,20054,20057,20076,20254)
  582. C
  583. C-----------------------------------------------------------------------
  584. C---- PROCEDURE (CR - Complex Roman)
  585. 30022 LOCUC = 2001
  586.       LOCLC = 2101
  587.       LOC0 = 2200
  588.       ASSIGN 20053 TO NPR015
  589.       GO TO 30015
  590. 20053 ASSIGN 20054 TO NPR016
  591.       GO TO 30016
  592. 20054 ASSIGN 20055 TO NPR007
  593.       GO TO 30007
  594. 20055 GO TO 20214
  595. C
  596. C-----------------------------------------------------------------------
  597. C---- PROCEDURE (CS - Complex Script)
  598. 30023 LOCUC = 2551
  599.       LOCLC = 2651
  600.       LOC0 = 2750
  601.       ASSIGN 20056 TO NPR021
  602.       GO TO 30021
  603. 20056 ASSIGN 20057 TO NPR016
  604.       GO TO 30016
  605. 20057 ASSIGN 20058 TO NPR007
  606.       GO TO 30007
  607. 20058 GO TO 20217
  608. C
  609. C-----------------------------------------------------------------------
  610. C---- PROCEDURE (Cyrillic Alphanumerics)
  611. 30017 IF (FCASE .EQ. 2) LOCUC = LOCLC
  612.       NX0061=FVAR
  613.       IF (NX0061.LT.1.OR.NX0061.GT.2) GO TO 20061
  614.       GO TO (20059,20060), NX0061
  615. 20059 ASCII(UCA-31,NFONT) = LOCUC + CYA
  616.       ASCII(UCB-31,NFONT) = LOCUC + CYB
  617.       ASCII(UCV-31,NFONT) = LOCUC + CYV
  618.       ASCII(UCG-31,NFONT) = LOCUC + CYG
  619.       ASCII(UCD-31,NFONT) = LOCUC + CYD
  620.       ASCII(UCE-31,NFONT) = LOCUC + CYYE
  621.       ASCII(UCC-31,NFONT) = LOCUC + CYZHE
  622.       ASCII(UCZ-31,NFONT) = LOCUC + CYZ
  623.       ASCII(UCI-31,NFONT) = LOCUC + CYEE
  624.       ASCII(UCK-31,NFONT) = LOCUC + CYK
  625.       ASCII(UCL-31,NFONT) = LOCUC + CYL
  626.       ASCII(UCM-31,NFONT) = LOCUC + CYM
  627.       ASCII(UCN-31,NFONT) = LOCUC + CYN
  628.       ASCII(UCO-31,NFONT) = LOCUC + CYO
  629.       ASCII(UCP-31,NFONT) = LOCUC + CYP
  630.       ASCII(UCR-31,NFONT) = LOCUC + CYR
  631.       ASCII(UCS-31,NFONT) = LOCUC + CYS
  632.       ASCII(UCT-31,NFONT) = LOCUC + CYT
  633.       ASCII(UCU-31,NFONT) = LOCUC + CYOO
  634.       ASCII(UCF-31,NFONT) = LOCUC + CYF
  635.       ASCII(UCX-31,NFONT) = LOCUC + CYKHA
  636.       ASCII(UCH-31,NFONT) = LOCUC + CYTSE
  637.       ASCII(UCJ-31,NFONT) = LOCUC + CYCHE
  638.       ASCII(UCQ-31,NFONT) = LOCUC + CYSH
  639.       ASCII(UCW-31,NFONT) = LOCUC + CYSHCH
  640.       ASCII(UCY-31,NFONT) = LOCUC + CYYIRI
  641.       ASCII(LBRAKT-31,NFONT) = LOCUC + CYYOO
  642.       ASCII(RSLANT-31,NFONT) = LOCUC + CYYA
  643.       ASCII(RBRAKT-31,NFONT) = LOCUC + CYMZNK
  644.       ASCII(STAR  -31,NFONT) = LOCUC + CYMZNK
  645.       GO TO 20062
  646. 20060 ASCII(UCA-31,NFONT) = LOCUC + CYA
  647.       ASCII(UCB-31,NFONT) = LOCUC + CYB
  648.       ASCII(UCV-31,NFONT) = LOCUC + CYV
  649.       ASCII(UCG-31,NFONT) = LOCUC + CYG
  650.       ASCII(UCD-31,NFONT) = LOCUC + CYD
  651.       ASCII(UCE-31,NFONT) = LOCUC + CYE
  652.       ASCII(UCC-31,NFONT) = LOCUC + CYZ
  653.       ASCII(UCZ-31,NFONT) = LOCUC + CYZ
  654.       ASCII(UCI-31,NFONT) = LOCUC + CYEEK
  655.       ASCII(UCK-31,NFONT) = LOCUC + CYK
  656.       ASCII(UCL-31,NFONT) = LOCUC + CYL
  657.       ASCII(UCM-31,NFONT) = LOCUC + CYM
  658.       ASCII(UCN-31,NFONT) = LOCUC + CYN
  659.       ASCII(UCO-31,NFONT) = LOCUC + CYO
  660.       ASCII(UCP-31,NFONT) = LOCUC + CYP
  661.       ASCII(UCR-31,NFONT) = LOCUC + CYR
  662.       ASCII(UCS-31,NFONT) = LOCUC + CYS
  663.       ASCII(UCT-31,NFONT) = LOCUC + CYT
  664.       ASCII(UCU-31,NFONT) = LOCUC + CYOO
  665.       ASCII(UCF-31,NFONT) = LOCUC + CYF
  666.       ASCII(UCX-31,NFONT) = LOCUC + CYK
  667.       ASCII(UCH-31,NFONT) = NOCHAR
  668.       ASCII(UCJ-31,NFONT) = LOCUC + CYCHE
  669.       ASCII(UCQ-31,NFONT) = LOCUC + CYSH
  670.       ASCII(UCW-31,NFONT) = NOCHAR
  671.       ASCII(UCY-31,NFONT) = LOCUC + CYYIRI
  672.       ASCII(LBRAKT-31,NFONT) = NOCHAR
  673.       ASCII(RSLANT-31,NFONT) = NOCHAR
  674.       ASCII(RBRAKT-31,NFONT) = LOCUC + CYTZNK
  675.       ASCII(STAR  -31,NFONT) = LOCUC + CYTZNK
  676. 20061 CONTINUE
  677. 20062 I =1
  678.       GO TO 20064
  679. 20063 I =I +1
  680. 20064 IF ((29-I ).LT.0) GO TO 20065
  681.       IUC = I + 64 - 31
  682.       ILC = IUC + 32
  683.       IF (.NOT.(ASCII(IUC,NFONT) .NE. NOCHAR)) GO TO 20067
  684.       ASCII(ILC,NFONT) = ASCII(IUC,NFONT) + LOCLC - LOCUC
  685.       GO TO 20068
  686. 20067 ASCII(ILC,NFONT) = NOCHAR
  687. 20068 GO TO 20063
  688. 20065 ASSIGN 20070 TO NPR008
  689.       GO TO 30008
  690. 20070 GO TO 20033
  691. C
  692. C-----------------------------------------------------------------------
  693. C---- PROCEDURE (Digits)
  694. 30008 I =0
  695.       GO TO 20072
  696. 20071 I =I +1
  697. 20072 IF ((9-I ).LT.0) GO TO 20073
  698.       IDIG = I + 48 - 31
  699.       ASCII(IDIG,NFONT) = LOC0 + I
  700.       GO TO 20071
  701. 20073 GO TO NPR008, (20011,20070,20109)
  702. C
  703. C-----------------------------------------------------------------------
  704. C---- PROCEDURE (DR - Duplex Roman)
  705. 30024 LOCUC = 2501
  706.       LOCLC = 2601
  707.       LOC0 = 2700
  708.       ASSIGN 20075 TO NPR025
  709.       GO TO 30025
  710. 20075 ASSIGN 20076 TO NPR016
  711.       GO TO 30016
  712. 20076 ASSIGN 20077 TO NPR007
  713.       GO TO 30007
  714. 20077 GO TO 20218
  715. C
  716. C-----------------------------------------------------------------------
  717. C---- PROCEDURE (Duplex Special Characters)
  718. 30025 LOC0SV = LOC0
  719.       LOC0 = 2200
  720.       ASSIGN 20078 TO NPR015
  721.       GO TO 30015
  722. 20078 LOC0 = LOC0SV
  723.       ASCII(SPACE -31,NFONT) = LOC0 - 1
  724.       ASCII(EXCLPT-31,NFONT) = LOC0 + 14
  725.       ASCII(DQUOTE-31,NFONT) = LOC0 + 28
  726.       ASCII(AMPSND-31,NFONT) = LOC0 + 18
  727.       ASCII(SQUOTE-31,NFONT) = LOC0 + 27
  728.       ASCII(COLON -31,NFONT) = LOC0 + 12
  729.       ASCII(SCOLON-31,NFONT) = LOC0 + 13
  730.       ASCII(QUERY -31,NFONT) = LOC0 + 15
  731.       GO TO 20075
  732. C
  733. C-----------------------------------------------------------------------
  734. C---- PROCEDURE (Fill Font with Symbol for Unsupported Character)
  735. 30011 I =32
  736.       GO TO 20080
  737. 20079 I =I +1
  738. 20080 IF ((127-I ).LT.0) GO TO 20081
  739.       ASCII(I-31,NFONT) = NOCHAR
  740.       GO TO 20079
  741. 20081 GO TO NPR011, (20023,20041)
  742. C
  743. C-----------------------------------------------------------------------
  744. C---- PROCEDURE (GE - Gothic English)
  745. 30026 FVAR = MIN0(FVAR,2)
  746.       LOCUC = 3501
  747.       LOCLC = 3601
  748.       LOC0 = 3700
  749.       ASSIGN 20083 TO NPR027
  750.       GO TO 30027
  751. 20083 ASSIGN 20084 TO NPR028
  752.       GO TO 30028
  753. 20084 ASSIGN 20085 TO NPR007
  754.       GO TO 30007
  755. 20085 GO TO 20220
  756. C
  757. C-----------------------------------------------------------------------
  758. C---- PROCEDURE (GG - Gothic German)
  759. 30029 FVAR = MIN0(FVAR,2)
  760.       LOCUC = 3301
  761.       LOCLC = 3401
  762.       LOC0 = 3700
  763.       ASSIGN 20086 TO NPR027
  764.       GO TO 30027
  765. 20086 ASSIGN 20087 TO NPR028
  766.       GO TO 30028
  767. 20087 ASSIGN 20088 TO NPR007
  768.       GO TO 30007
  769. 20088 IF (.NOT.(FVAR .EQ. 2)) GO TO 20089
  770.       I = UCS + 32
  771.       ASCII(I-31,NFONT) = LOCLC + 26
  772. 20089 ASCII(LBRAKT-31,NFONT) = LOCUC + 29
  773.       ASCII(RSLANT-31,NFONT) = LOCUC + 30
  774.       ASCII(RBRAKT-31,NFONT) = LOCUC + 31
  775.       ASCII(LBRACE-31,NFONT) = LOCLC + 29
  776.       ASCII(VBAR  -31,NFONT) = LOCLC + 30
  777.       ASCII(RBRACE-31,NFONT) = LOCLC + 31
  778.       GO TO 20222
  779. C
  780. C-----------------------------------------------------------------------
  781. C---- PROCEDURE (GI - Gothic Italian)
  782. 30030 FVAR = MIN0(FVAR,2)
  783.       LOCUC = 3801
  784.       LOCLC = 3901
  785.       LOC0 = 3700
  786.       ASSIGN 20092 TO NPR027
  787.       GO TO 30027
  788. 20092 ASSIGN 20093 TO NPR028
  789.       GO TO 30028
  790. 20093 ASSIGN 20094 TO NPR007
  791.       GO TO 30007
  792. 20094 GO TO 20221
  793. C
  794. C-----------------------------------------------------------------------
  795. C---- PROCEDURE (Gothic Special Characters)
  796. 30027 LOC0SV = LOC0
  797.       LOC0 = 2200
  798.       ASSIGN 20095 TO NPR015
  799.       GO TO 30015
  800. 20095 LOC0 = LOC0SV
  801.       ASCII(SPACE -31,NFONT) = LOC0 - 1
  802.       ASCII(EXCLPT-31,NFONT) = LOC0 + 14
  803.       ASCII(DQUOTE-31,NFONT) = LOC0 + 28
  804.       ASCII(AMPSND-31,NFONT) = LOC0 + 18
  805.       ASCII(SQUOTE-31,NFONT) = LOC0 + 27
  806.       ASCII(COLON -31,NFONT) = LOC0 + 12
  807.       ASCII(SCOLON-31,NFONT) = LOC0 + 13
  808.       ASCII(QUERY -31,NFONT) = LOC0 + 15
  809.       GO TO NPR027, (20083,20086,20092)
  810. C
  811. C-----------------------------------------------------------------------
  812. C---- PROCEDURE (Gothic Standard Signs)
  813. 30028 ASCII(COMMA -31,NFONT) = 3711
  814.       ASCII(PERIOD-31,NFONT) = 3710
  815.       ASCII(LPAREN-31,NFONT) = 3721
  816.       ASCII(RPAREN-31,NFONT) = 3722
  817.       ASCII(MINUS -31,NFONT) = 3724
  818.       ASCII(PLUS  -31,NFONT) = 3725
  819.       ASCII(STAR  -31,NFONT) = 3723
  820.       ASCII(SLASH -31,NFONT) = 3720
  821.       ASCII(EQUALS-31,NFONT) = 3726
  822.       ASCII(DOLLAR-31,NFONT) = 3719
  823.       ASCII(AT    -31,NFONT) = 2273
  824.       GO TO NPR028, (20084,20087,20093)
  825. C
  826. C-----------------------------------------------------------------------
  827. C---- PROCEDURE (Greek Alphanumerics)
  828. 30019 IF (FCASE .EQ. 2) LOCUC = LOCLC
  829.       NX0100=FVAR
  830.       IF (NX0100.LT.1.OR.NX0100.GT.4) GO TO 20100
  831.       GO TO (20096,20097,20098,20099), NX0100
  832. 20096 ASCII(UCA-31,NFONT) = LOCUC + ALPHA
  833.       ASCII(UCB-31,NFONT) = LOCUC + BETA
  834.       ASCII(UCG-31,NFONT) = LOCUC + GAMMA
  835.       ASCII(UCD-31,NFONT) = LOCUC + DELTA
  836.       ASCII(UCE-31,NFONT) = LOCUC + EPSLON
  837.       ASCII(UCZ-31,NFONT) = LOCUC + ZETA
  838.       ASCII(UCQ-31,NFONT) = LOCUC + THETA
  839.       ASCII(UCI-31,NFONT) = LOCUC + IOTA
  840.       ASCII(UCK-31,NFONT) = LOCUC + KAPPA
  841.       ASCII(UCL-31,NFONT) = LOCUC + LAMBDA
  842.       ASCII(UCM-31,NFONT) = LOCUC + MU
  843.       ASCII(UCN-31,NFONT) = LOCUC + NU
  844.       ASCII(UCX-31,NFONT) = LOCUC + XI
  845.       ASCII(UCO-31,NFONT) = LOCUC + OMCRON
  846.       ASCII(UCP-31,NFONT) = LOCUC + PI
  847.       ASCII(UCR-31,NFONT) = LOCUC + RHO
  848.       ASCII(UCS-31,NFONT) = LOCUC + SIGMA
  849.       ASCII(UCT-31,NFONT) = LOCUC + TAU
  850.       ASCII(UCU-31,NFONT) = LOCUC + UPSLON
  851.       ASCII(UCY-31,NFONT) = LOCUC + UPSLON
  852.       ASCII(UCF-31,NFONT) = LOCUC + PHI
  853.       ASCII(UCC-31,NFONT) = LOCUC + CHI
  854.       ASCII(UCW-31,NFONT) = LOCUC + PSI
  855.       ASCII(UCH-31,NFONT) = NOCHAR
  856.       ASCII(UCJ-31,NFONT) = NOCHAR
  857.       ASCII(UCV-31,NFONT) = NOCHAR
  858.       GO TO 20101
  859. 20097 ASCII(UCA-31,NFONT) = LOCUC + ALPHA
  860.       ASCII(UCB-31,NFONT) = LOCUC + BETA
  861.       ASCII(UCG-31,NFONT) = LOCUC + GAMMA
  862.       ASCII(UCD-31,NFONT) = LOCUC + DELTA
  863.       ASCII(UCE-31,NFONT) = LOCUC + ETA
  864.       ASCII(UCZ-31,NFONT) = LOCUC + ZETA
  865.       ASCII(UCQ-31,NFONT) = LOCUC + TAU
  866.       ASCII(UCI-31,NFONT) = LOCUC + IOTA
  867.       ASCII(UCK-31,NFONT) = LOCUC + KAPPA
  868.       ASCII(UCL-31,NFONT) = LOCUC + LAMBDA
  869.       ASCII(UCM-31,NFONT) = LOCUC + MU
  870.       ASCII(UCN-31,NFONT) = LOCUC + NU
  871.       ASCII(UCX-31,NFONT) = LOCUC + XI
  872.       ASCII(UCO-31,NFONT) = LOCUC + OMEGA
  873.       ASCII(UCP-31,NFONT) = LOCUC + PI
  874.       ASCII(UCR-31,NFONT) = LOCUC + RHO
  875.       ASCII(UCS-31,NFONT) = LOCUC + SIGMA
  876.       ASCII(UCT-31,NFONT) = LOCUC + TAU
  877.       ASCII(UCU-31,NFONT) = LOCUC + UPSLON
  878.       ASCII(UCY-31,NFONT) = LOCUC + UPSLON
  879.       ASCII(UCF-31,NFONT) = LOCUC + PI
  880.       ASCII(UCC-31,NFONT) = LOCUC + CHI
  881.       ASCII(UCW-31,NFONT) = NOCHAR
  882.       ASCII(UCH-31,NFONT) = NOCHAR
  883.       ASCII(UCJ-31,NFONT) = NOCHAR
  884.       ASCII(UCV-31,NFONT) = NOCHAR
  885.       GO TO 20101
  886. 20098 ASCII(UCA-31,NFONT) = LOCUC + ALPHA
  887.       ASCII(UCB-31,NFONT) = LOCUC + BETA
  888.       ASCII(UCG-31,NFONT) = LOCUC + GAMMA
  889.       ASCII(UCD-31,NFONT) = LOCUC + DELTA
  890.       ASCII(UCE-31,NFONT) = LOCUC + EPSLON
  891.       ASCII(UCZ-31,NFONT) = LOCUC + ZETA
  892.       ASCII(UCH-31,NFONT) = LOCUC + ETA
  893.       ASCII(UCQ-31,NFONT) = LOCUC + THETA
  894.       ASCII(UCI-31,NFONT) = LOCUC + IOTA
  895.       ASCII(UCK-31,NFONT) = LOCUC + KAPPA
  896.       ASCII(UCL-31,NFONT) = LOCUC + LAMBDA
  897.       ASCII(UCM-31,NFONT) = LOCUC + MU
  898.       ASCII(UCN-31,NFONT) = LOCUC + NU
  899.       ASCII(UCX-31,NFONT) = LOCUC + XI
  900.       ASCII(UCO-31,NFONT) = LOCUC + OMCRON
  901.       ASCII(UCP-31,NFONT) = LOCUC + PI
  902.       ASCII(UCR-31,NFONT) = LOCUC + RHO
  903.       ASCII(UCS-31,NFONT) = LOCUC + SIGMA
  904.       ASCII(UCT-31,NFONT) = LOCUC + TAU
  905.       ASCII(UCU-31,NFONT) = LOCUC + UPSLON
  906.       ASCII(UCF-31,NFONT) = LOCUC + PHI
  907.       ASCII(UCC-31,NFONT) = LOCUC + CHI
  908.       ASCII(UCY-31,NFONT) = LOCUC + PSI
  909.       ASCII(UCW-31,NFONT) = LOCUC + OMEGA
  910.       ASCII(UCJ-31,NFONT) = NOCHAR
  911.       ASCII(UCV-31,NFONT) = NOCHAR
  912.       GO TO 20101
  913. 20099 ASCII(UCA-31,NFONT) = LOCUC + ALPHA
  914.       ASCII(UCB-31,NFONT) = LOCUC + BETA
  915.       ASCII(UCG-31,NFONT) = LOCUC + GAMMA
  916.       ASCII(UCD-31,NFONT) = LOCUC + DELTA
  917.       ASCII(UCE-31,NFONT) = LOCUC + EPSLON
  918.       ASCII(UCZ-31,NFONT) = LOCUC + ZETA
  919.       ASCII(UCH-31,NFONT) = LOCUC + ETA
  920.       ASCII(UCQ-31,NFONT) = LOCUC + THETA
  921.       ASCII(UCI-31,NFONT) = LOCUC + IOTA
  922.       ASCII(UCK-31,NFONT) = LOCUC + KAPPA
  923.       ASCII(UCL-31,NFONT) = LOCUC + LAMBDA
  924.       ASCII(UCM-31,NFONT) = LOCUC + MU
  925.       ASCII(UCN-31,NFONT) = LOCUC + NU
  926.       ASCII(UCX-31,NFONT) = LOCUC + XI
  927.       ASCII(UCO-31,NFONT) = LOCUC + OMCRON
  928.       ASCII(UCP-31,NFONT) = LOCUC + PI
  929.       ASCII(UCR-31,NFONT) = LOCUC + RHO
  930.       ASCII(UCS-31,NFONT) = LOCUC + SIGMA
  931.       ASCII(UCT-31,NFONT) = LOCUC + TAU
  932.       ASCII(UCU-31,NFONT) = LOCUC + UPSLON
  933.       ASCII(UCF-31,NFONT) = LOCUC + PHI
  934.       ASCII(UCC-31,NFONT) = LOCUC + CHI
  935.       ASCII(UCY-31,NFONT) = LOCUC + PSI
  936.       ASCII(UCW-31,NFONT) = LOCUC + OMEGA
  937.       ASCII(UCJ-31,NFONT) = NOCHAR
  938.       ASCII(UCV-31,NFONT) = NOCHAR
  939. 20100 CONTINUE
  940. 20101 I =1
  941.       GO TO 20103
  942. 20102 I =I +1
  943. 20103 IF ((26-I ).LT.0) GO TO 20104
  944.       IUC = I + 64 - 31
  945.       ILC = IUC + 32
  946.       IF (.NOT.(ASCII(IUC,NFONT) .NE. NOCHAR)) GO TO 20106
  947.       ASCII(ILC,NFONT) = ASCII(IUC,NFONT) + LOCLC - LOCUC
  948.       GO TO 20107
  949. 20106 ASCII(ILC,NFONT) = NOCHAR
  950. 20107 GO TO 20102
  951. 20104 ASSIGN 20109 TO NPR008
  952.       GO TO 30008
  953. 20109 NX0114=FVAR
  954.       IF (NX0114.LT.1.OR.NX0114.GT.4) GO TO 20114
  955.       GO TO (20110,20111,20112,20113), NX0114
  956. 20110 GO TO 20115
  957. 20111 IF (.NOT.(FTYPE .NE. KG)) GO TO 20116
  958.       ASCII(LCS-31,NFONT) = LOCLC + 60
  959. 20116 GO TO 20115
  960. 20112 GO TO 20115
  961. 20113 IF (.NOT.(FTYPE .NE. KG)) GO TO 20119
  962.       ASCII(LCE-31,NFONT) = LOCLC + 57
  963.       ASCII(LCQ-31,NFONT) = LOCLC + 58
  964.       ASCII(LCF-31,NFONT) = LOCLC + 59
  965.       IF (.NOT.(FTYPE .EQ. SG)) GO TO 20122
  966.       ASCII(LCD-31,NFONT) = LOCLC + 56
  967.       GO TO 20123
  968. 20122 ASCII(LCD-31,NFONT) = LOCLC + 138
  969. 20123 CONTINUE
  970. 20119 GO TO 20115
  971. 20114 ASSIGN 20125 TO NPR013
  972.       GO TO 30013
  973. 20125 CONTINUE
  974. 20115 GO TO NPR019, (20036,20128,20165,20238)
  975. C
  976. C-----------------------------------------------------------------------
  977. C---- PROCEDURE (IG - Indexical Greek)
  978. 30031 LOCUC = 1027
  979.       LOCLC = 1127
  980.       LOC0 = 1200
  981.       ASSIGN 20126 TO NPR032
  982.       GO TO 30032
  983. 20126 ASSIGN 20127 TO NPR033
  984.       GO TO 30033
  985. 20127 ASSIGN 20128 TO NPR019
  986.       GO TO 30019
  987. 20128 GO TO 20210
  988. C
  989. C-----------------------------------------------------------------------
  990. C---- PROCEDURE (II - Indexical Italic)
  991. 30034 LOCUC = 1051
  992.       LOCLC = 1151
  993.       LOC0 = 2750
  994.       ASSIGN 20129 TO NPR032
  995.       GO TO 30032
  996. 20129 ASSIGN 20130 TO NPR033
  997.       GO TO 30033
  998. 20130 ASSIGN 20131 TO NPR007
  999.       GO TO 30007
  1000. 20131 GO TO 20209
  1001. C
  1002. C-----------------------------------------------------------------------
  1003. C---- PROCEDURE (Indexical Special Characters)
  1004. 30032 ASSIGN 20132 TO NPR015
  1005.       GO TO 30015
  1006. 20132 GO TO NPR032, (20126,20129,20151)
  1007. C
  1008. C-----------------------------------------------------------------------
  1009. C---- PROCEDURE (Indexical Standard Signs)
  1010. 30033 I = (FVAR-1)*2 + FCASE
  1011.       NX0141=I
  1012.       IF (NX0141.LT.1.OR.NX0141.GT.8) GO TO 20141
  1013.       GO TO (20133,20134,20135,20136,20137,20138,20139,20140), NX0141
  1014. 20133 ASCII(COMMA -31,NFONT) = 1211
  1015.       ASCII(PERIOD-31,NFONT) = 1210
  1016.       ASCII(LPAREN-31,NFONT) = 1221
  1017.       ASCII(RPAREN-31,NFONT) = 1222
  1018.       ASCII(MINUS -31,NFONT) = 1231
  1019.       ASCII(PLUS  -31,NFONT) = 1232
  1020.       ASCII(STAR  -31,NFONT) = 1219
  1021.       ASCII(SLASH -31,NFONT) = 1220
  1022.       ASCII(EQUALS-31,NFONT) = 1238
  1023.       ASCII(DOLLAR-31,NFONT) = 1274
  1024.       ASCII(AT    -31,NFONT) = 1273
  1025.       GO TO 20142
  1026. 20134 ASCII(COMMA -31,NFONT) = 1211
  1027.       ASCII(PERIOD-31,NFONT) = 1210
  1028.       ASCII(LPAREN-31,NFONT) = 1221
  1029.       ASCII(RPAREN-31,NFONT) = 1222
  1030.       ASCII(MINUS -31,NFONT) = 1231
  1031.       ASCII(PLUS  -31,NFONT) = 1232
  1032.       ASCII(STAR  -31,NFONT) = 1219
  1033.       ASCII(SLASH -31,NFONT) = 1220
  1034.       ASCII(EQUALS-31,NFONT) = 1238
  1035.       ASCII(DOLLAR-31,NFONT) = 1274
  1036.       ASCII(AT    -31,NFONT) = 1273
  1037.       GO TO 20142
  1038. 20135 ASCII(COMMA -31,NFONT) = 1213
  1039.       ASCII(PERIOD-31,NFONT) = 1215
  1040.       ASCII(LPAREN-31,NFONT) = 1405
  1041.       ASCII(RPAREN-31,NFONT) = 1406
  1042.       ASCII(MINUS -31,NFONT) = 1256
  1043.       ASCII(PLUS  -31,NFONT) = 1257
  1044.       ASCII(STAR  -31,NFONT) = 1259
  1045.       ASCII(SLASH -31,NFONT) = 1258
  1046.       ASCII(EQUALS-31,NFONT) = 1260
  1047.       ASCII(DOLLAR-31,NFONT) = 1279
  1048.       ASCII(AT    -31,NFONT) = 1276
  1049.       GO TO 20142
  1050. 20136 ASCII(COMMA -31,NFONT) = 1213
  1051.       ASCII(PERIOD-31,NFONT) = 1215
  1052.       ASCII(LPAREN-31,NFONT) = 1223
  1053.       ASCII(RPAREN-31,NFONT) = 1224
  1054.       ASCII(MINUS -31,NFONT) = 1246
  1055.       ASCII(PLUS  -31,NFONT) = 1272
  1056.       ASCII(STAR  -31,NFONT) = 1245
  1057.       ASCII(SLASH -31,NFONT) = 1271
  1058.       ASCII(EQUALS-31,NFONT) = 1239
  1059.       ASCII(DOLLAR-31,NFONT) = 1275
  1060.       ASCII(AT    -31,NFONT) = 1216
  1061.       GO TO 20142
  1062. 20137 ASCII(COMMA -31,NFONT) = 1212
  1063.       ASCII(PERIOD-31,NFONT) = 1214
  1064.       ASCII(LPAREN-31,NFONT) = 1403
  1065.       ASCII(RPAREN-31,NFONT) = 1404
  1066.       ASCII(MINUS -31,NFONT) = 1231
  1067.       ASCII(PLUS  -31,NFONT) = 1232
  1068.       ASCII(STAR  -31,NFONT) = 1235
  1069.       ASCII(SLASH -31,NFONT) = 1230
  1070.       ASCII(EQUALS-31,NFONT) = 1238
  1071.       ASCII(DOLLAR-31,NFONT) = 1411
  1072.       ASCII(AT    -31,NFONT) = 1277
  1073.       GO TO 20142
  1074. 20138 ASCII(COMMA -31,NFONT) = 1212
  1075.       ASCII(PERIOD-31,NFONT) = 1214
  1076.       ASCII(LPAREN-31,NFONT) = 1221
  1077.       ASCII(RPAREN-31,NFONT) = 1222
  1078.       ASCII(MINUS -31,NFONT) = 1231
  1079.       ASCII(PLUS  -31,NFONT) = 1232
  1080.       ASCII(STAR  -31,NFONT) = 1236
  1081.       ASCII(SLASH -31,NFONT) = 1229
  1082.       ASCII(EQUALS-31,NFONT) = 1238
  1083.       ASCII(DOLLAR-31,NFONT) = 1267
  1084.       ASCII(AT    -31,NFONT) = 1217
  1085.       GO TO 20142
  1086. 20139 ASCII(COMMA -31,NFONT) = 1251
  1087.       ASCII(PERIOD-31,NFONT) = 1252
  1088.       ASCII(LPAREN-31,NFONT) = 1407
  1089.       ASCII(RPAREN-31,NFONT) = 1408
  1090.       ASCII(MINUS -31,NFONT) = 1261
  1091.       ASCII(PLUS  -31,NFONT) = 1233
  1092.       ASCII(STAR  -31,NFONT) = 1242
  1093.       ASCII(SLASH -31,NFONT) = 1228
  1094.       ASCII(EQUALS-31,NFONT) = 1244
  1095.       ASCII(DOLLAR-31,NFONT) = 1412
  1096.       ASCII(AT    -31,NFONT) = 1270
  1097.       GO TO 20142
  1098. 20140 ASCII(COMMA -31,NFONT) = 1251
  1099.       ASCII(PERIOD-31,NFONT) = 1252
  1100.       ASCII(LPAREN-31,NFONT) = 1225
  1101.       ASCII(RPAREN-31,NFONT) = 1226
  1102.       ASCII(MINUS -31,NFONT) = 1263
  1103.       ASCII(PLUS  -31,NFONT) = 1234
  1104.       ASCII(STAR  -31,NFONT) = 1241
  1105.       ASCII(SLASH -31,NFONT) = 1227
  1106.       ASCII(EQUALS-31,NFONT) = 1243
  1107.       ASCII(DOLLAR-31,NFONT) = 1268
  1108.       ASCII(AT    -31,NFONT) = 1218
  1109.       GO TO 20142
  1110. 20141 ASSIGN 20143 TO NPR013
  1111.       GO TO 30013
  1112. 20143 CONTINUE
  1113. 20142 GO TO NPR033, (20127,20130,20152)
  1114. C
  1115. C-----------------------------------------------------------------------
  1116. C---- PROCEDURE (Initialize for New Font)
  1117. 30001 IF (.NOT.(NFUSED .LE. 0)) GO TO 20144
  1118.       I =1
  1119.       N20147=MAXFNT
  1120.       GO TO 20148
  1121. 20147 I =I +1
  1122. 20148 IF ((N20147-I ).LT.0) GO TO 20149
  1123.       FSWTCH(I) = NUL
  1124.       USWTCH(I) = NUL
  1125.       LSWTCH(I) = NUL
  1126.       GO TO 20147
  1127. 20149 NFUSED = 0
  1128. 20144 ERROR = .FALSE.
  1129.       NFONT = MOD(NFONT,MAXFNT) + 1
  1130.       KFONT = NFONT
  1131.       NFUSED = MIN0(NFUSED+1,MAXFNT)
  1132.       FSWTCH(NFONT) = KARASC(SWCHAR(1))
  1133.       IF (KARCM2(SWCHAR,1,1H ,1,1) .EQ. 0) FSWTCH(NFONT) = NUL
  1134.       USWTCH(NFONT) = LANGLE
  1135.       LSWTCH(NFONT) = RANGLE
  1136.       BSWTCH(NFONT) = NUL
  1137.       GO TO 20001
  1138. C
  1139. C-----------------------------------------------------------------------
  1140. C---- PROCEDURE (Internal Error)
  1141. 30013 CALL ERRMS (6HSYMSF ,12,14HInternal error,14)
  1142.       CALL ERRCK
  1143.       ERROR = .TRUE.
  1144.       IF (ERROR) STOP
  1145.       GO TO NPR013, (20030,20052,20125,20143,20226,20246)
  1146. C
  1147. C-----------------------------------------------------------------------
  1148. C---- PROCEDURE (IR - Indexical Roman)
  1149. 30035 LOCUC = 1001
  1150.       LOCLC = 1101
  1151.       LOC0 = 1200
  1152.       ASSIGN 20151 TO NPR032
  1153.       GO TO 30032
  1154. 20151 ASSIGN 20152 TO NPR033
  1155.       GO TO 30033
  1156. 20152 ASSIGN 20153 TO NPR007
  1157.       GO TO 30007
  1158. 20153 GO TO 20208
  1159. C
  1160. C-----------------------------------------------------------------------
  1161. C---- PROCEDURE (Issue Error Messages and Supply Defaults)
  1162. 30005 IF (.NOT.(FCASE .EQ. 0)) GO TO 20154
  1163.       CALL ERRMS (6HSYMSF ,8,
  1164.      X38HInvalid font case - Upper-Case assumed,38)
  1165.       CALL ERRAT (6HFONT  ,1,FONT,5)
  1166.       FCASE = 1
  1167. 20154 IF (.NOT.(FTYPE .EQ. 0)) GO TO 20157
  1168.       CALL ERRMS (6HSYMSF ,8,
  1169.      X41HInvalid font type - Triplex Roman assumed,41)
  1170.       CALL ERRAT (6HFONT  ,1,FONT,5)
  1171.       FCASE = TR
  1172. 20157 IF (.NOT.(FVAR .EQ. 0)) GO TO 20160
  1173.       CALL ERRMS (6HSYMSF ,8,
  1174.      X32HInvalid font variant - 1 assumed,32)
  1175.       CALL ERRAT (6HFONT  ,1,FONT,5)
  1176.       FVAR = 1
  1177. 20160 CALL ERRCK
  1178.       GO TO 20005
  1179. C
  1180. C-----------------------------------------------------------------------
  1181. C---- PROCEDURE (KG - Cartographic Greek)
  1182. 30036 LOCUC = 27
  1183.       LOCLC = 27
  1184.       LOC0 = 200
  1185.       ASSIGN 20163 TO NPR010
  1186.       GO TO 30010
  1187. 20163 ASSIGN 20164 TO NPR012
  1188.       GO TO 30012
  1189. 20164 ASSIGN 20165 TO NPR019
  1190.       GO TO 30019
  1191. 20165 GO TO 20207
  1192. C
  1193. C-----------------------------------------------------------------------
  1194. C---- PROCEDURE (KR - Cartographic Roman)
  1195. 30037 LOCUC = 1
  1196.       LOCLC = 1
  1197.       LOC0 = 200
  1198.       ASSIGN 20166 TO NPR010
  1199.       GO TO 30010
  1200. 20166 ASSIGN 20167 TO NPR012
  1201.       GO TO 30012
  1202. 20167 ASSIGN 20168 TO NPR007
  1203.       GO TO 30007
  1204. 20168 GO TO 20206
  1205. C
  1206. C-----------------------------------------------------------------------
  1207. C---- PROCEDURE (SA - Simplex ASCII)
  1208. 30038 LOCUC = 1565
  1209.       LOCLC = 1597
  1210.       I =32
  1211.       GO TO 20170
  1212. 20169 I =I +1
  1213. 20170 IF ((127-I ).LT.0) GO TO 20171
  1214.       ASCII(I-31,NFONT) = 1500 + I
  1215.       GO TO 20169
  1216. 20171 IF (.NOT.(FCASE .EQ. 2)) GO TO 20173
  1217.       I =65
  1218.       GO TO 20177
  1219. 20176 I =I +1
  1220. 20177 IF ((90-I ).LT.0) GO TO 20178
  1221.       ASCII(I-31,NFONT) = 1500 + I + 32
  1222.       GO TO 20176
  1223. 20178 CONTINUE
  1224. 20173 GO TO 20224
  1225. C
  1226. C-----------------------------------------------------------------------
  1227. C---- PROCEDURE (Set Complete Font Specifications)
  1228. 30006 FONTID(NFONT) = (FCASE-1)*256 + (FTYPE-1)*8 + FVAR - 1
  1229.       CALL KARUPK (FONTNM(1,NFONT),FONT,1,5)
  1230.       I =1
  1231.       GO TO 20181
  1232. 20180 I =I +1
  1233. 20181 IF ((5-I ).LT.0) GO TO 20182
  1234.       FONTNM(I,NFONT) = KARUC(FONTNM(I,NFONT))
  1235.       GO TO 20180
  1236. 20182 NX0204=FTYPE
  1237.       IF (NX0204.LT.1.OR.NX0204.GT.20) GO TO 20204
  1238.       GO TO (20184,20185,20186,20187,20188,20189,20190,20191,20192,20193
  1239.      X,20194,20195,20196,20197,20198,20199,20200,20201,20202,20203), NX0
  1240.      X204
  1241. 20184 ASSIGN 20206 TO NPR037
  1242.       GO TO 30037
  1243. 20206 GO TO 20205
  1244. 20185 ASSIGN 20207 TO NPR036
  1245.       GO TO 30036
  1246. 20207 GO TO 20205
  1247. 20186 ASSIGN 20208 TO NPR035
  1248.       GO TO 30035
  1249. 20208 GO TO 20205
  1250. 20187 ASSIGN 20209 TO NPR034
  1251.       GO TO 30034
  1252. 20209 GO TO 20205
  1253. 20188 ASSIGN 20210 TO NPR031
  1254.       GO TO 30031
  1255. 20210 GO TO 20205
  1256. 20189 ASSIGN 20211 TO NPR039
  1257.       GO TO 30039
  1258. 20211 GO TO 20205
  1259. 20190 ASSIGN 20212 TO NPR040
  1260.       GO TO 30040
  1261. 20212 GO TO 20205
  1262. 20191 ASSIGN 20213 TO NPR041
  1263.       GO TO 30041
  1264. 20213 GO TO 20205
  1265. 20192 ASSIGN 20214 TO NPR022
  1266.       GO TO 30022
  1267. 20214 GO TO 20205
  1268. 20193 ASSIGN 20215 TO NPR020
  1269.       GO TO 30020
  1270. 20215 GO TO 20205
  1271. 20194 ASSIGN 20216 TO NPR018
  1272.       GO TO 30018
  1273. 20216 GO TO 20205
  1274. 20195 ASSIGN 20217 TO NPR023
  1275.       GO TO 30023
  1276. 20217 GO TO 20205
  1277. 20196 ASSIGN 20218 TO NPR024
  1278.       GO TO 30024
  1279. 20218 GO TO 20205
  1280. 20197 ASSIGN 20219 TO NPR042
  1281.       GO TO 30042
  1282. 20219 GO TO 20205
  1283. 20198 ASSIGN 20220 TO NPR026
  1284.       GO TO 30026
  1285. 20220 GO TO 20205
  1286. 20199 ASSIGN 20221 TO NPR030
  1287.       GO TO 30030
  1288. 20221 GO TO 20205
  1289. 20200 ASSIGN 20222 TO NPR029
  1290.       GO TO 30029
  1291. 20222 GO TO 20205
  1292. 20201 ASSIGN 20223 TO NPR014
  1293.       GO TO 30014
  1294. 20223 GO TO 20205
  1295. 20202 ASSIGN 20224 TO NPR038
  1296.       GO TO 30038
  1297. 20224 GO TO 20205
  1298. 20203 ASSIGN 20225 TO NPR009
  1299.       GO TO 30009
  1300. 20225 GO TO 20205
  1301. 20204 ASSIGN 20226 TO NPR013
  1302.       GO TO 30013
  1303. 20226 CONTINUE
  1304. 20205 GO TO 20006
  1305. C
  1306. C-----------------------------------------------------------------------
  1307. C---- PROCEDURE (Set Font Case)
  1308. 30002 IF (.NOT.(KARCM2(FONT,1,2HUC,1,2) .EQ. 0)) GO TO 20227
  1309.       FCASE = 1
  1310.       GO TO 20228
  1311. 20227 IF (.NOT.(KARCM2(FONT,1,2HLC,1,2) .EQ. 0)) GO TO 10001
  1312.       FCASE = 2
  1313.       GO TO 20228
  1314. 10001 FCASE = 0
  1315.       ERROR = .TRUE.
  1316. 20228 GO TO 20002
  1317. C
  1318. C-----------------------------------------------------------------------
  1319. C---- PROCEDURE (Set Font Type)
  1320. 30003 IF (.NOT.(KARCM2(FONT,3,2HKR,1,2) .EQ. 0)) GO TO 20230
  1321.       FTYPE = KR
  1322.       GO TO 20231
  1323. 20230 IF (.NOT.(KARCM2(FONT,3,2HKG,1,2) .EQ. 0)) GO TO 10002
  1324.       FTYPE = KG
  1325.       GO TO 20231
  1326. 10002 IF (.NOT.(KARCM2(FONT,3,2HIR,1,2) .EQ. 0)) GO TO 10003
  1327.       FTYPE = IR
  1328.       GO TO 20231
  1329. 10003 IF (.NOT.(KARCM2(FONT,3,2HII,1,2) .EQ. 0)) GO TO 10004
  1330.       FTYPE = II
  1331.       GO TO 20231
  1332. 10004 IF (.NOT.(KARCM2(FONT,3,2HIG,1,2) .EQ. 0)) GO TO 10005
  1333.       FTYPE = IG
  1334.       GO TO 20231
  1335. 10005 IF (.NOT.(KARCM2(FONT,3,2HSR,1,2) .EQ. 0)) GO TO 10006
  1336.       FTYPE = SR
  1337.       GO TO 20231
  1338. 10006 IF (.NOT.(KARCM2(FONT,3,2HSS,1,2) .EQ. 0)) GO TO 10007
  1339.       FTYPE = SS
  1340.       GO TO 20231
  1341. 10007 IF (.NOT.(KARCM2(FONT,3,2HSG,1,2) .EQ. 0)) GO TO 10008
  1342.       FTYPE = SG
  1343.       GO TO 20231
  1344. 10008 IF (.NOT.(KARCM2(FONT,3,2HCR,1,2) .EQ. 0)) GO TO 10009
  1345.       FTYPE = CR
  1346.       GO TO 20231
  1347. 10009 IF (.NOT.(KARCM2(FONT,3,2HCI,1,2) .EQ. 0)) GO TO 10010
  1348.       FTYPE = CI
  1349.       GO TO 20231
  1350. 10010 IF (.NOT.(KARCM2(FONT,3,2HCG,1,2) .EQ. 0)) GO TO 10011
  1351.       FTYPE = CG
  1352.       GO TO 20231
  1353. 10011 IF (.NOT.(KARCM2(FONT,3,2HCS,1,2) .EQ. 0)) GO TO 10012
  1354.       FTYPE = CS
  1355.       GO TO 20231
  1356. 10012 IF (.NOT.(KARCM2(FONT,3,2HDR,1,2) .EQ. 0)) GO TO 10013
  1357.       FTYPE = DR
  1358.       GO TO 20231
  1359. 10013 IF (.NOT.(KARCM2(FONT,3,2HTR,1,2) .EQ. 0)) GO TO 10014
  1360.       FTYPE = TR
  1361.       GO TO 20231
  1362. 10014 IF (.NOT.(KARCM2(FONT,3,2HGE,1,2) .EQ. 0)) GO TO 10015
  1363.       FTYPE = GE
  1364.       GO TO 20231
  1365. 10015 IF (.NOT.(KARCM2(FONT,3,2HGI,1,2) .EQ. 0)) GO TO 10016
  1366.       FTYPE = GI
  1367.       GO TO 20231
  1368. 10016 IF (.NOT.(KARCM2(FONT,3,2HGG,1,2) .EQ. 0)) GO TO 10017
  1369.       FTYPE = GG
  1370.       GO TO 20231
  1371. 10017 IF (.NOT.(KARCM2(FONT,3,2HCC,1,2) .EQ. 0)) GO TO 10018
  1372.       FTYPE = CC
  1373.       GO TO 20231
  1374. 10018 IF (.NOT.(KARCM2(FONT,3,2HSA,1,2) .EQ. 0)) GO TO 10019
  1375.       FTYPE = SA
  1376.       GO TO 20231
  1377. 10019 IF (.NOT.(KARCM2(FONT,3,2HBA,1,2) .EQ. 0)) GO TO 10020
  1378.       FTYPE = BA
  1379.       GO TO 20231
  1380. 10020 FTYPE = 0
  1381.       ERROR = .TRUE.
  1382. 20231 GO TO 20003
  1383. C
  1384. C-----------------------------------------------------------------------
  1385. C---- PROCEDURE (Set Font Variant)
  1386. 30004 IF (.NOT.(KARCM2(FONT,5,1H1,1,1) .EQ. 0)) GO TO 20233
  1387.       FVAR = 1
  1388.       GO TO 20234
  1389. 20233 IF (.NOT.(KARCM2(FONT,5,1H2,1,1) .EQ. 0)) GO TO 10021
  1390.       FVAR = 2
  1391.       GO TO 20234
  1392. 10021 IF (.NOT.(KARCM2(FONT,5,1H3,1,1) .EQ. 0)) GO TO 10022
  1393.       FVAR = 3
  1394.       GO TO 20234
  1395. 10022 IF (.NOT.(KARCM2(FONT,5,1H4,1,1) .EQ. 0)) GO TO 10023
  1396.       FVAR = 4
  1397.       GO TO 20234
  1398. 10023 FVAR = 0
  1399.       ERROR = .TRUE.
  1400. 20234 GO TO 20004
  1401. C
  1402. C-----------------------------------------------------------------------
  1403. C---- PROCEDURE (SG - Simplex Greek)
  1404. 30041 LOCUC = 527
  1405.       LOCLC = 627
  1406.       LOC0 = 700
  1407.       ASSIGN 20236 TO NPR043
  1408.       GO TO 30043
  1409. 20236 ASSIGN 20237 TO NPR044
  1410.       GO TO 30044
  1411. 20237 ASSIGN 20238 TO NPR019
  1412.       GO TO 30019
  1413. 20238 GO TO 20213
  1414. C
  1415. C-----------------------------------------------------------------------
  1416. C---- PROCEDURE (Simplex Special Characters)
  1417. 30043 ASSIGN 20239 TO NPR010
  1418.       GO TO 30010
  1419. 20239 GO TO NPR043, (20236,20247,20250)
  1420. C
  1421. C-----------------------------------------------------------------------
  1422. C---- PROCEDURE (Simplex Standard Signs)
  1423. 30044 NX0244=FVAR
  1424.       IF (NX0244.LT.1.OR.NX0244.GT.4) GO TO 20244
  1425.       GO TO (20240,20241,20242,20243), NX0244
  1426. 20240 ASCII(COMMA -31,NFONT) =  711
  1427.       ASCII(PERIOD-31,NFONT) =  710
  1428.       ASCII(LPAREN-31,NFONT) =  721
  1429.       ASCII(RPAREN-31,NFONT) =  722
  1430.       ASCII(MINUS -31,NFONT) =  724
  1431.       ASCII(PLUS  -31,NFONT) =  725
  1432.       ASCII(STAR  -31,NFONT) =  728
  1433.       ASCII(SLASH -31,NFONT) =  720
  1434.       ASCII(EQUALS-31,NFONT) =  726
  1435.       ASCII(DOLLAR-31,NFONT) =  719
  1436.       ASCII(AT    -31,NFONT) = 1273
  1437.       GO TO 20245
  1438. 20241 ASCII(COMMA -31,NFONT) =  713
  1439.       ASCII(PERIOD-31,NFONT) =  715
  1440.       ASCII(LPAREN-31,NFONT) =  721
  1441.       ASCII(RPAREN-31,NFONT) =  722
  1442.       ASCII(MINUS -31,NFONT) =  724
  1443.       ASCII(PLUS  -31,NFONT) =  725
  1444.       ASCII(STAR  -31,NFONT) =  729
  1445.       ASCII(SLASH -31,NFONT) =  720
  1446.       ASCII(EQUALS-31,NFONT) =  726
  1447.       ASCII(DOLLAR-31,NFONT) =  733
  1448.       ASCII(AT    -31,NFONT) =  732
  1449.       GO TO 20245
  1450. 20242 ASCII(COMMA -31,NFONT) =  712
  1451.       ASCII(PERIOD-31,NFONT) =  714
  1452.       ASCII(LPAREN-31,NFONT) =  721
  1453.       ASCII(RPAREN-31,NFONT) =  722
  1454.       ASCII(MINUS -31,NFONT) =  724
  1455.       ASCII(PLUS  -31,NFONT) =  725
  1456.       ASCII(STAR  -31,NFONT) =  727
  1457.       ASCII(SLASH -31,NFONT) =  720
  1458.       ASCII(EQUALS-31,NFONT) =  726
  1459.       ASCII(DOLLAR-31,NFONT) =  723
  1460.       ASCII(AT    -31,NFONT) =  730
  1461.       GO TO 20245
  1462. 20243 ASCII(COMMA -31,NFONT) =  716
  1463.       ASCII(PERIOD-31,NFONT) =  717
  1464.       ASCII(LPAREN-31,NFONT) =  721
  1465.       ASCII(RPAREN-31,NFONT) =  722
  1466.       ASCII(MINUS -31,NFONT) =  724
  1467.       ASCII(PLUS  -31,NFONT) =  725
  1468.       ASCII(STAR  -31,NFONT) =  718
  1469.       ASCII(SLASH -31,NFONT) =  720
  1470.       ASCII(EQUALS-31,NFONT) =  726
  1471.       ASCII(DOLLAR-31,NFONT) =  735
  1472.       ASCII(AT    -31,NFONT) =  731
  1473.       GO TO 20245
  1474. 20244 ASSIGN 20246 TO NPR013
  1475.       GO TO 30013
  1476. 20246 CONTINUE
  1477. 20245 GO TO NPR044, (20237,20248,20251)
  1478. C
  1479. C-----------------------------------------------------------------------
  1480. C---- PROCEDURE (SR - Simplex Roman)
  1481. 30039 LOCUC = 501
  1482.       LOCLC = 601
  1483.       LOC0 = 700
  1484.       ASSIGN 20247 TO NPR043
  1485.       GO TO 30043
  1486. 20247 ASSIGN 20248 TO NPR044
  1487.       GO TO 30044
  1488. 20248 ASSIGN 20249 TO NPR007
  1489.       GO TO 30007
  1490. 20249 GO TO 20211
  1491. C
  1492. C-----------------------------------------------------------------------
  1493. C---- PROCEDURE (SS - Simplex Script)
  1494. 30040 LOCUC = 551
  1495.       LOCLC = 651
  1496.       LOC0 = 700
  1497.       ASSIGN 20250 TO NPR043
  1498.       GO TO 30043
  1499. 20250 ASSIGN 20251 TO NPR044
  1500.       GO TO 30044
  1501. 20251 ASSIGN 20252 TO NPR007
  1502.       GO TO 30007
  1503. 20252 GO TO 20212
  1504. C
  1505. C-----------------------------------------------------------------------
  1506. C---- PROCEDURE (TR - Triplex Roman)
  1507. 30042 LOCUC = 3001
  1508.       LOCLC = 3101
  1509.       LOC0 = 3200
  1510.       ASSIGN 20253 TO NPR045
  1511.       GO TO 30045
  1512. 20253 ASSIGN 20254 TO NPR016
  1513.       GO TO 30016
  1514. 20254 ASSIGN 20255 TO NPR007
  1515.       GO TO 30007
  1516. 20255 GO TO 20219
  1517. C
  1518. C-----------------------------------------------------------------------
  1519. C---- PROCEDURE (Triplex Special Characters)
  1520. 30045 LOC0SV = LOC0
  1521.       LOC0 = 2200
  1522.       ASSIGN 20256 TO NPR015
  1523.       GO TO 30015
  1524. 20256 LOC0 = LOC0SV
  1525.       ASCII(SPACE -31,NFONT) = LOC0 - 1
  1526.       ASCII(EXCLPT-31,NFONT) = LOC0 + 14
  1527.       ASCII(DQUOTE-31,NFONT) = LOC0 + 28
  1528.       ASCII(AMPSND-31,NFONT) = LOC0 + 18
  1529.       ASCII(SQUOTE-31,NFONT) = LOC0 + 27
  1530.       ASCII(COLON -31,NFONT) = LOC0 + 12
  1531.       ASCII(SCOLON-31,NFONT) = LOC0 + 13
  1532.       ASCII(QUERY -31,NFONT) = LOC0 + 15
  1533.       GO TO 20253
  1534. C
  1535.       END
  1536.