c alfmod - draw alpha character in proper font subroutine alfmod (char,xx,yy) byte char integer xx,yy,b integer width,height,charsp,linesp,rotang,slnang integer tabsep,mrgsep,spacon,font,stdfnt,altfnt real xratio,yratio,xscale,yscale,tr(2,3) common/alfcom/width,height,charsp,linesp,rotang,slnang,tabsep, & mrgsep,spacon,font,stdfnt,altfnt,xratio,yratio,xscale,yscale,tr if(.not.(char.lt.0))goto 23000 return 23000 continue if(.not.(font.eq.11))goto 23002 call alfa11(char,xx,yy) goto 23003 c else 23002 continue call alfa0(char,xx,yy) 23003 continue return end c alfa0 - font0 subroutine alfa0 (char,xx,yy) c font0 - data defining nodes for symbols in character set integer nkhar,nnode,khar(128),node(1024) integer nod001(128) equivalence ( nod001, node( 1) ) integer nod002(128) equivalence ( nod002, node(129) ) integer nod003(128) equivalence ( nod003, node(257) ) integer nod004(128) equivalence ( nod004, node(385) ) integer nod005(128) equivalence ( nod005, node(513) ) integer nod006(128) equivalence ( nod006, node(641) ) integer nod007(128) equivalence ( nod007, node(769) ) integer nod008(128) equivalence ( nod008, node(897) ) data nkhar,nnode/128, 904/ data khar/ + 1, 3, 5, 7, 9, 11, 13, 15, + 17, 19, 21, 23, 25, 27, 29, 31, + 33, 35, 37, 39, 41, 43, 45, 47, + 49, 51, 53, 55, 57, 59, 61, 63, + 65, 67, 75, 91, 103, 126, 140, 160, + 163, 168, 173, 182, 188, 196, 199, 204, + 207, 227, 234, 247, 258, 263, 270, 281, + 289, 297, 308, 318, 335, 339, 345, 349, + 365, 386, 393, 407, 418, 430, 438, 445, + 458, 467, 476, 482, 491, 495, 501, 506, + 520, 528, 545, 556, 570, 576, 583, 587, + 593, 599, 606, 611, 616, 619, 624, 628, + 631, 634, 642, 650, 655, 663, 677, 686, + 697, 706, 714, 725, 734, 737, 752, 761, + 771, 779, 787, 795, 815, 821, 830, 834, + 840, 846, 855, 860, 876, 879, 895, 903/ data nod001/ + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 4479, -255, 32639, -255, 32515, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255,-28225,-28271, -255,-28283, -250, + 360,-28289, -255,-29776, -250, 28,-28996, -250, + 360,-30532, -255,-26704, -250, 28,-25924, -250, + 360,-27460, -255,-28993,-31361, -255,-25153,-27521, + -255, 32661,-24427, -255,-32087,-23639, -255,-23635, + -250, 60,-31823, -250, 128,-31836, -250, 28, +-28256, -250, -28,-24420, -250, -128,-24433, -250, + -60, 32659, -255,-28225,-28289, -255,-30275, -250/ data nod002/ + 360,-30295, -250, 40,-23363, 32639, -255,-25985, + -250, 360,-25965, -255,-23660, -250, 88,-25202, + -250, -180, 32654, -250, -88,-28253, -250, 168, +-28229, -250, 92,-30801, -250, 20,-23425, -255, +-29783,-26689, -255,-26689, -250, 72,-26753, -255, +-29761, -250, -72,-29825, -255,-28239,-28275, -255, +-24152,-32362, -255,-32600,-24170, -255, 32671,-23649, + -255,-28239,-28275, -255,-28298, -250, 24,-27518, + -250, 360,-29054, -255, 32671,-23649, -255,-29054, + -250, 360,-27518, -255, 32639,-23617, -255,-30332, + -250, -40, 32671, -250, -40,-30278, -250, -110, +-25670, -250, -40,-23137, -250, -40,-25724, -250, + -110,-30332, -255,-29825,-26753, -255,-28289,-28225, +-29767, -255, 32685, -250, -180,-23635, -250, -60, +-25695,-28261, -250, 60, 32639,-23681, -255,-31817, + -250, -248,-28767,-30303, -255,-28767, -250, -260/ data nod003/ +-32373, -255,-25217,-25153, 32659,-23405, -255,-24641, +-31809, 32671, -250, -288, 32647, -255,-24649, -250, + 128,-31819, -250, 24, 32657, -250, 360,-23663, + -255, 32703,-23617,-23625,-26719, -250, 28,-28289, + -255,-28253, -250, 360,-28289, -250, 360,-28225, + -255,-31865, -250, 128,-24695, -250, 28,-23635, + -250, 360, 32685, -255,-28247, -250, 360,-28253, + -255,-28283, -250, 360,-28289, -255,-28247, -250, + 360,-28253, -255,-28283, -255,-27518, -255,-28298, + -250, 28,-27518, -250, 360,-29054, -255,-23621, + 32671,-23677, -255, 32661,-23659, -255, 32681,-23639, + -255, 32699,-23649, 32643, -255,-30789, -250, -144, +-23639, -250, -60,-25697, -250, 68,-28271, -255, +-28283, -250, 360,-28289, -255,-26753, -250, -90, + 32663, 32679, -250, -180,-20569,-20585, -250, -180, +-24681,-24665, -250, 180,-28761,-28777, -250, 180/ data nod004/ +-24681, -255, 32639,-28225,-23681, -255,-31341,-25197, + -255, 32639, 32703,-28225, -250, -180,-28255, 32673, + -255,-28255, -250, -180,-28289, 32639, -255,-23629, + -250, 140,-31049, -250, 60,-31097, -250, 140, +-23669, -255, 32703,-30529, -250, -90,-23644,-23654, + -250, -90,-30593, 32639, 32703, -255,-23617, 32703, + 32639,-23681, -255, 32674,-26206, -255, 32639, 32703, +-23617, -255, 32674,-26206, -255,-23627, -250, 128, +-31307, -250, 60,-31351, -250, 128,-23671,-23653, +-27237, -255, 32639, 32703, -255, 32671,-23649, -255, +-23681,-23617, -255,-30273,-26689, -255,-28225,-28289, + -255,-30337,-26753, -255,-23617,-23663, -250, -180, + 32657, -255, 32703, 32639, -255,-23617, 32660, -255, +-29019,-23681, -255, 32703, 32639,-23681, -255, 32639, + 32703,-28273,-23617,-23681, -255, 32639, 32703,-23681, +-23617, -255,-32077, -250, -156,-24397, -250, -32/ data nod005/ +-24437, -250, -152,-32117, -250, -32,-32077, -255, + 32639, 32703,-27713, -250, -180,-27745, 32671, -255, +-32077, -250, -156,-24397, -250, -28,-24437, -250, + -156,-32117, -250, -32,-32077, -255,-23681,-28271, + -255, 32639, 32703,-27713, -250, -180,-27745, 32671, + -255,-27745,-23681, -255,-24395, -250, 148, 32688, + -250, 84,-29021, -250, -116,-23666, -250, -156, + 32654, -255, 32703,-23617, -255,-28225,-28289, -255, + 32703, 32657, -250, 180,-23663,-23617, -255, 32703, +-28289,-23617, -255, 32703,-30593,-28241,-25985,-23617, + -255, 32639,-23617, -255, 32703,-23681, -255,-28289, +-28253, -255, 32703,-28253,-23617, -255, 32703,-23617, + 32639,-23681, -255,-28225, 32703, 32639,-28289, -255, + 32703,-23681, -255,-28225,-23617,-23681,-28289, -255, + 32685,-28225,-23635, -255, 32623,-18833, -255,-29761, +-26711, -255,-23646, -250, 276,-23674, -255,-23639/ data nod006/ +-23681, -255, 32674, -250, -276, 32646, -255, 32703, + 32639, -255,-23646, -250, 276,-23674, -255,-23646, + -250, 276,-23674, -255,-23617,-23681, -255, 32660, +-23660,-23657, -250, 180, 32663, 32657, -250, 90, +-28289, -250, 40,-23675, -255,-25157, -250, 148, +-30287,-30337, -255, 32681,-26711, -255,-23646, -250, + 276,-23674, -255,-23639,-23684, -250, -156,-31629, + -255, 32639, 32703, -255, 32663, -250, -180,-23657, +-23681, -255,-28289,-28247, -255,-28739, -250, 360, +-27715, -255,-24133, -250, 360,-24129, -255,-24151, +-24193, -250, -180, 32639, -255, 32639, 32703, -255, + 32659,-23639, -255,-29798,-23681, -255,-28289,-28225, + -255, 32639, 32681, -255, 32672, -250, -180,-28256, +-28289, -255,-28256, -250, -180,-23648,-23681, -255, + 32639, 32681, -255, 32663, -250, -180,-23657,-23681, + -255, 32663, -250, -180,-23657,-23663, -250, -180/ data nod007/ + 32657, 32663, -255, 32674, -250, -276, 32646, -255, + 32681, 32618, -255,-23646, -250, 276,-23674, -255, +-23639,-23702, -255, 32681, 32639, -255, 32669, -250, + -128,-23649, -255,-24159, -250, 88,-31835, -250, + 112,-31848, -250, 28,-28268, -250, -28,-24688, + -250, -112,-24701, -250, -80, 32647, -255,-28225, +-28289, -255,-31319,-25175, -255, 32681, 32657, -250, + 180,-23663, -255,-23639,-23681, -255, 32681,-28289, +-23639, -255, 32681,-30337,-27735,-25217,-22615, -255, + 32639,-23639, -255, 32681,-23681, -255, 32681,-28289, + -255,-23639,-29839, -250, -64, 32618, -255, 32681, +-23639, 32639,-23681, -255,-23617, -250, 88,-26701, +-26711, -250, -60,-29281, -250, -60,-26731,-26741, + -250, 88,-23681, -255,-28217,-28297, -255, 32703, + -250, -88,-29773,-29783, -250, 60,-26977, -250, + 60,-29803,-29813, -250, -88, 32639, -255, 32694/ data nod008/ + -250, -120,-28234, -250, 120,-23626, -255, 32639, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0/ integer width,height,charsp,linesp,rotang,slnang integer tabsep,mrgsep,spacon,font,stdfnt,altfnt real xratio,yratio,xscale,yscale,tr(2,3) common/alfcom/width,height,charsp,linesp,rotang,slnang,tabsep, & mrgsep,spacon,font,stdfnt,altfnt,xratio,yratio,xscale,yscale,tr byte char integer b,lastx,lasty integer x,y,xx,yy,ahgt,awidth,arot,asln,xl,yl,fnode,lnode b=char tr(1,3)=xx tr(2,3)=yy c Index for first node fnode = khar(b+1) if(.not.(b+1.lt.nkhar))goto 23004 c Index for last node lnode=khar(b+2)-1 goto 23005 c else 23004 continue lnode=nnode 23005 continue c Process nodes until we finish the symbol or character c for j=fnode 23006 if(.not.(j.le.lnode))goto 23008 lx=nx ly=ny call nunode(node(j),nx,ny) if(.not.(nx .eq. 128))goto 23009 if(.not.(ny .eq. -126))goto 23011 c move call nunode(node(j+1),nx,ny) call nuxy(nx,ny,tr,x,y) call tmove(x,y) j=j+1 goto 23012 c else 23011 continue if(.not.(ny .eq. -121))goto 23013 c arc ia=node(j+1) call nunode(node(j+2),nx,ny) call alfarc(lx,ly,nx,ny,ia,tr) j=j+2 goto 23014 c else 23013 continue type *,' special code: nx,ny =',nx,ny 23014 continue 23012 continue goto 23010 c else 23009 continue c draw call nuxy(nx,ny,tr,x,y) call tdraw(x,y) 23010 continue j=j+1 goto 23006 c endfor 23008 continue c All done. Find xx and yy of next character. xx=tr(1,3)+tr(1,1)*55 yy=tr(2,3)+tr(2,1)*55 call tmove(xx,yy) return end c alfa11 - font #11 subroutine alfa11(char,xx,yy) c font11 - data defining nodes for symbols in character set integer nkhar,nnode,khar(128),node(1024) integer nod001(128) equivalence ( nod001, node( 1) ) integer nod002(128) equivalence ( nod002, node(129) ) integer nod003(128) equivalence ( nod003, node(257) ) integer nod004(128) equivalence ( nod004, node(385) ) integer nod005(128) equivalence ( nod005, node(513) ) integer nod006(128) equivalence ( nod006, node(641) ) integer nod007(128) equivalence ( nod007, node(769) ) integer nod008(128) equivalence ( nod008, node(897) ) data nkhar,nnode/128,1002/ data khar/ + 1, 3, 5, 7, 9, 11, 13, 15, + 17, 19, 21, 23, 25, 27, 29, 31, + 33, 35, 37, 39, 41, 43, 45, 47, + 49, 51, 53, 55, 57, 59, 61, 63, + 65, 67, 75, 83, 90, 97, 103, 109, + 121, 137, 146, 160, 166, 172, 178, 183, + 196, 201, 210, 225, 233, 242, 249, 256, + 263, 273, 278, 288, 297, 304, 313, 320, + 330, 339, 346, 360, 376, 381, 389, 397, + 402, 411, 420, 429, 438, 442, 448, 453, + 463, 468, 473, 481, 487, 493, 506, 519, + 525, 531, 546, 551, 556, 565, 570, 577, + 580, 587, 607, 624, 638, 652, 666, 683, + 697, 709, 715, 730, 745, 757, 771, 783, + 801, 813, 816, 833, 850, 859, 876, 892, + 903, 921, 933, 954, 971, 986, 993, 1001/ data nod001/ + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255, 32639, -255, 32639, -255, 32639, + -255, 32639, -255,-28225,-28273, -255,-28283, -250, + 360,-28289, -255, 32639, -255, 32653, 32689,-23631, +-23667, 32653, -255, 32639, -255, 32671, -250, 360, +-23649, -255, 32639, -255, 32655,-28241,-23665, 32655, + -255, 32671,-23649, -255,-28239,-28275, -255, 32671, +-28241,-23649,-28273, 32671, -255, 32639, -255, 32653, + 32689,-23631,-23667, 32653,-23631, -255, 32689,-23667, + -255, 32653,-30825,-30809, -255, 32689,-30809,-25689/ data nod002/ + -255,-23631,-25689,-25705, -255,-23667,-25705,-30825, + -255, 32671, -250, 360,-23649,-23649, -255,-28239, +-28275, -255, 32639, -255, 32653, 32689,-23631,-23667, + 32653, -255, 32671,-23649, -255,-28239,-28275, -255, + 32671,-23649, -255,-28239,-28275, -255, 32639,-23681, + -255,-28225,-28289, -255,-29844,-29720, -255,-26648, +-26772, -255,-28289, -250, 360,-28283, -255, 32671, +-23649, -255,-27735, -250, 360,-27729, -255,-27755, + -250, 360,-27761, -255,-28249, -250, 360,-28225, + -255, 32628, -250, 172,-29324,-27190, -250, -172, +-23606, -255, 32659, -250, 360,-31341, -255,-25197, + -250, 360,-23661, -255,-27477, -250, 360,-29013, + -255, 32639,-23681,-23617, 32703, -255,-29281,-23649, + -255, 32639, -255,-23667,-28275, -250, -180,-28239, +-23631, -255, 32689, 32671, -250, 180,-23649,-23631, + -255, 32653,-28275, -250, 180,-28239, 32689, -255/ data nod003/ + 32653, 32671, -250, -180,-23649,-23667, -255,-27997, + -250, -308,-28005,-28509, -250, 308,-28517,-27997, + -255, 32681,-23639,-28289, 32681, -255,-28277, -250, + 360,-28271, -255,-28253, -250, 360,-28247, -255, + 32660,-23660, -255,-23639, 32681, -255,-23617, 32639, + -255, 32651,-23925, -255,-23917, 32675,-23629, -255, + 32655,-23665, -255,-23649, 32671, -255, 32687,-23633, + -255, 32651,-23669, -255, 32659,-23645, 32691, -255, +-26721, -250, 360, 32671, -255,-23637, -250, 180, +-23661, -255,-22585, -250, -240,-21053, -250, 52, +-22597,-20037, -255, 32639,-28225,-23681, -255,-31341, +-25197, -255, 32639, 32703,-28225, -250, -180,-28255, + 32673, -255,-28255, -250, -180,-28289, 32639, -255, + 32681, -250, -80,-30813,-30313, -250, 170,-26217, +-25693, -250, -80,-23639, -255,-28225,-28289, -255, + 32639,-28225,-23681, 32639, -255,-23681, 32639, 32703/ data nod004/ +-23617, -255, 32671,-26721, -255, 32663, -250, 360, +-23657, -255,-27201,-29063, -255, 32639, 32703,-23617, +-23621, -255, 32639, 32703, -255, 32671,-23649, -255, +-23617,-23681, -255,-28289,-28225, -255,-29761,-26689, + -255,-29825,-26753, -255, 32639,-23681, -255,-25697, +-30817, -255, 32703,-23617, -255, 32639, 32703, -255, +-23617, 32667, -255,-31841,-23681, -255, 32639,-28225, +-23681, -255, 32639, 32703,-28257,-23617,-23681, -255, + 32639, 32703,-23681,-23617, -255, 32657, 32685, -250, + -180,-23635,-23663, -250, -180, 32657, -255, 32639, + 32703,-23617,-23681, -255, 32681,-29837,-23585,-18721, + -255, 32639, 32703,-28225, -250, -180,-28261, 32667, + -255,-23617, 32703,-28257, 32639,-23681, -255, 32703, +-23617, -255,-28225,-28289, -255, 32657, 32685, -250, + -180,-23635,-23663, -250, -180, 32657, -255,-29793, +-26721, -255, 32639,-29825, -250, -30, 32685, -250/ data nod005/ + -180,-23635, -250, -30,-26753,-23681, -255, 32703, +-30849,-28257,-25729,-23617, -255, 32639,-23617, -255, + 32703,-23681, -255, 32681, 32695, -250, -180,-28745, +-28247,-27721, -250, -180,-23625,-23639, -255,-28247, +-28289, -255, 32703,-23617, 32639,-23681, -255,-27777, + 32639, 32703,-27713, -255, 32651,-23669, -255,-23641, + 32679, -255,-28229,-28269, -255,-28801,-23681,-23617, +-28737, -255, 32685,-28225,-23635, -255,-28225,-28289, + -255, 32627,-23693, -255,-26689,-25153, -255,-23369, +-23353,-23869, -255,-23639, -250, -36,-26749, -250, + -92,-31869, -250, -92,-29786, -250, -92,-25691, + -250, -44,-24680, -250, 20,-23681, -255, 32627, + -250, -16,-29769, -250, -144,-24137, -250, -116, +-29789, -250, -88,-23669, -250, -128,-32120, -255, + 32681, -250, -56,-30825, -250, 164,-24169, -250, + -8,-23639, -255,-26433,-28295, -255,-25187, -250/ data nod006/ + 360,-31612, -250, 40,-29785, -250, -168,-28225, + -250, -40,-24647, -255,-23639, -250, 56,-32104, + -250, 68,-32372, -250, 52,-23681, -255,-32620, +-23660, -255,-30801, -250, 103,-30833, -250, 73, +-26737, -250, 86,-24657, -250, 166,-27217, -250, + 0,-30089, -255, 32675, -250, -140,-28765, -250, + -48,-28799, -250, -200,-29566, -250, -40,-23639, + -255, 32679, -250, -124,-29796,-30849, -255,-29796, + -250, -188,-23653,-25231, -255,-28247,-29313, -250, + 156,-26753, -255,-26681, -250, 140,-25921,-24386, + -250, 220,-25181, -250, 210,-25985, -250, -180, +-26765, -255,-31831, 32639, -255,-32371,-25178, -250, + -40,-23639, -255,-29288,-25214, -250, 40,-23681, + -255, 32703, -250, -48,-28753,-24701, -250, 56, +-23681, -255,-27993, 32639, -255, 32627,-30039, -255, +-31604, -250, 180,-25461, -255,-23895,-25723, -250/ data nod007/ + 164,-23678, -255, 32681,-31831, -250, -88,-30811, + -250, -20,-31361, -250, 60,-23639, -255,-28545, + -255,-28545, -255,-30811, -250, 96,-31099, -250, + 96,-25212, -250, 76,-24924, -250, 88,-30811, + -255, 32673, -250, -88,-30807,-23639, -255,-29783, +-30849, -255,-25687,-26753, -255, 32735,-18721, -255, +-30811, -250, 64,-31099, -250, 96,-25212, -250, + 64,-24924, -250, 80,-30811, -255,-32105, 32621, + -255,-27481, -250, -144,-27519, -250, -20,-29055, + -250, -152,-29017, -250, -20,-27481, -250, 12, +-23385, -255, 32673, -250, -88,-30807,-23639, -255, +-27223,-28289, -255,-30021, -250, -116,-24905, -250, + -64,-26493, -250, -112,-31609, -250, -68,-30021, + -255, 32671,-23649, -255,-31831, -250, 20, 32648, + -250, 180,-28280,-28271,-28280, -250, 180,-23672, + -250, 20,-24663, -255,-24409, -250, 174,-29278/ data nod008/ + -250, 39,-26478, -250, -87,-25718, -255, 32703, + -250, -56,-30793,-25721, -250, 64,-23681, -255, +-23617, -250, -28,-24137,-32377, -250, 8, 32639, + -255, 32681, -250, -100,-30817,-31349, -250, 152, +-26749, -250, 60,-24151, -255,-30529, -250, 156, +-28746,-24897, -250, 64, 32654, -250, 76,-30334, + -250, 4,-25473, -250, -156,-24712, -250, -56, +-29320, -255, 32639, -250, 52,-30333, -250, 32, +-26696, -250, 180,-29767, -250, 40,-28282, -250, + 116,-23677, -255,-24168, -250, 180, 32664, 32656, + -250, 152,-24695, -250, 36,-24653, -250, 96, +-30787, -255, 32657,-28289,-23663, -255,-28289,-28225, + -255, 32694, -250, -120,-28234, -250, 120,-23626, + -255, 32639, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0/ integer width,height,charsp,linesp,rotang,slnang integer tabsep,mrgsep,spacon,font,stdfnt,altfnt real xratio,yratio,xscale,yscale,tr(2,3) common/alfcom/width,height,charsp,linesp,rotang,slnang,tabsep, & mrgsep,spacon,font,stdfnt,altfnt,xratio,yratio,xscale,yscale,tr byte char integer b,lastx,lasty integer x,y,xx,yy,ahgt,awidth,arot,asln,xl,yl,fnode,lnode b=char tr(1,3)=xx tr(2,3)=yy c Index for first node fnode = khar(b+1) if(.not.(b+1.lt.nkhar))goto 23015 c Index for last node lnode=khar(b+2)-1 goto 23016 c else 23015 continue lnode=nnode 23016 continue c Process nodes until we finish the symbol or character c for j=fnode 23017 if(.not.(j.le.lnode))goto 23019 lx=nx ly=ny call nunode(node(j),nx,ny) if(.not.(nx .eq. 128))goto 23020 if(.not.(ny .eq. -126))goto 23022 c move call nunode(node(j+1),nx,ny) call nuxy(nx,ny,tr,x,y) call tmove(x,y) j=j+1 goto 23023 c else 23022 continue if(.not.(ny .eq. -121))goto 23024 c arc ia=node(j+1) call nunode(node(j+2),nx,ny) call alfarc(lx,ly,nx,ny,ia,tr) j=j+2 goto 23025 c else 23024 continue type *,' special code: nx,ny =',nx,ny 23025 continue 23023 continue goto 23021 c else 23020 continue c draw call nuxy(nx,ny,tr,x,y) call tdraw(x,y) 23021 continue j=j+1 goto 23017 c endfor 23019 continue c All done. Find xx and yy of next character. xx=tr(1,3)+tr(1,1)*55 yy=tr(2,3)+tr(2,1)*55 call tmove(xx,yy) return end c alfarc - draw an arc of an circle from the (nx,ny) to (mx,my) subroutine alfarc(lx,ly,nx,ny,ia,tr) integer mx,my,nx,ny,x,y logical sensw real tr(2,3) real arcsmo,segmin common/arccom/arcsmo,segmin data pi/3.1415927/ tpi=2.*pi ixdif=(nx-lx) iydif=(ny-ly) dx=iabs(ixdif) dy=iabs(iydif) dxy=sqrt(dx*dx+dy*dy) if(.not.(dxy.ge.1.))goto 23026 ixret=lx iyret=ly angnxt=atan2(float(iydif),float(ixdif)) if(.not.( iabs(ia) .ge. 360 ))goto 23028 c complete circle radius=dxy/2. cenang=angnxt+pi angarc=tpi nx=lx ny=ly goto 23029 c else 23028 continue c part of circle angarc=ia*pi/180. sinang=sin(abs(angarc/2.)) if(.not.(sinang.lt..01))goto 23030 call tdraw(x,y) return 23030 continue radius=(dxy/2.)/sinang if(.not.(ia .gt. 0 .and. ia .le. 180))goto 23032 cenang=(3.*pi-angarc)/2.+angnxt goto 23033 c else 23032 continue if(.not.(ia .gt. 180 .and. ia .lt. 360))goto 23034 cenang=(-pi-angarc)/2.+angnxt goto 23035 c else 23034 continue if(.not.(ia .lt. 0 .and. ia .ge. -180))goto 23036 cenang=(-3.*pi-angarc)/2.+angnxt goto 23037 c else 23036 continue if(.not.(ia .lt. -180 .and. ia .gt. -360))goto 2303 & 8 cenang=(pi-angarc)/2.+angnxt 23038 continue 23037 continue 23035 continue 23033 continue 23029 continue rad=radius*sqrt(tr(1,1)*tr(2,2)-tr(1,2)*tr(2,1)) if(.not.(rad.gt.segmin))goto 23040 np=abs(angarc)/amax1(.25*pi*arcsmo,segmin/rad)+.5 goto 23041 c else 23040 continue np=8.*(abs(angarc)/tpi) 23041 continue cn=cos(cenang) sn=sin(cenang) a11=( tr(1,1)*cn+tr(1,2)*sn)*radius a12=(-tr(1,1)*sn+tr(1,2)*cn)*radius a21=( tr(2,1)*cn+tr(2,2)*sn)*radius a22=(-tr(2,1)*sn+tr(2,2)*cn)*radius b1=tr(1,1)*ixret+tr(1,2)*iyret+tr(1,3)-a11 b2=tr(2,1)*ixret+tr(2,2)*iyret+tr(2,3)-a21 if(.not.(np.gt.0))goto 23042 units=angarc/np c for ip=1 23044 if(.not.(ip.lt.np))goto 23046 ang=units*ip ca=cos(ang) sa=sin(ang) ixx=a11*ca+a12*sa+b1+.5 iyy=a21*ca+a22*sa+b2+.5 call tdraw(ixx,iyy) ip=ip+1 goto 23044 c endfor 23046 continue 23042 continue 23026 continue call nuxy(nx,ny,tr,x,y) call tdraw(x,y) return end c nuxy - new x and y subroutine nuxy(ix,iy,tr,x,y) integer ix,iy,x,y real tr(2,3) x=tr(1,1)*ix+tr(1,2)*iy+tr(1,3) y=tr(2,1)*ix+tr(2,2)*iy+tr(2,3) return end c nunode - unpack coordinate bytes (nx,ny) from node subroutine nunode(node,nx,ny) integer node,nx,ny,msk,t byte b(2) equivalence (t,b) data msk/"377/ t=node ny = (b(1) .and. msk) - 127 nx = (b(2) .and. msk) - 127 return end