SUBROUTINE WRTSTR( STR, LEN, IROT, ISIZE ) BYTE STR(LEN), MES(5), XL, XH, YL, YH INTEGER POSIT(96), BLOCK(693) LOGICAL VISUAL, DONE COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA N, YL, YH, XL, XH / 693, 96, 32, 64, 32 / DATA POSIT / 1,2,173,26,34,48,71,177,94,98,86,106,183,102,189,200, . 602,611,616,624,637,641,650,662,666,682,163,152,194,110,197,202, . 6,217,222,234,242,249,255,260,270,276,282,287,292,295,300,304, . 313,320,331,340,352,356,362,365,370,374,379,126,213,130, 68,104, . 120,383,393,403,411,421,431,438,451,458,468,479,486,491,502,509, . 518,528,538,544,556,563,570,573,584,588,598,134,215,143,114, 1/ DATA BLOCK / . 2192,156,1173,146,3216,208,1104,1042,1050,1116,1244,1306,1300, . 1267,1235,1204,1208,183,1176,1144,1111,1110,1141,1173,3254,92, . 1104,220,1232,24,1304,20,3348,51,1106,1234,1267,1269,1238,1110, . 1079,1081,1114,1242,1273,156,3216,60,1051,1050,1081,1113,1146, . 1147,1116,1084,284,1040,240,1297,1298,1267,1235,1202,1201,1232, . 3312,20,1176,3348,276,1236,1203,1201,1168,1072,1041,1044,1176, . 1178,1148,1116,1082,1080,3345,26,1298,18,1306,22,1302,154,3218, . 188,1146,1138,3248,124,1210,1202,3184,22,3350,12,3468,154,1170, . 22,3350,24,1304,20,3348,22,1079,1143,1205,1269,3350,123,1179, . 1180,1148,1147,3257,188,1148,1136,3248,124,1212,1200,3184,252, . 1212,1179,1176,1110,1172,1169,1200,3312,60,1148,1179,1176,1238, . 1172,1169,1136,3120,181,1206,1238,1237,1205,208,1200,1201,1233, . 1232,3214,117,1142,1174,1173,1141,112,1137,1169,1168,3184,92, . 1114,220,3290,219,1211,1212,1244,1243,3225,208,1200,1201,1233, . 1232,3214,112,1137,1169,1168,3184,284,1046,3344,28,1302,3088,218, . 3088,59,1116,1244,1275,1272,1239,1207,1174,1173,146,3216,26,3280, . 156,3216,16,1180,1296,51,3315,16,1052,1244,1306,1304,1238,1046, . 214,1300,1298,1232,3088,282,1244,1116,1050,1042,1104,1232,3346, . 16,1052,1244,1306,1298,1232,3088,284,1052,1040,1296,22,3222,284, . 1052,1040,22,3222,282,1244,1116,1050,1042,1104,1232,1298,1301, . 3221,16,1052,22,1302,284,3344,28,1308,156,1168,16,3344,284,1298, . 1232,1104,3090,16,1052,284,1046,3344,28,1040,3344,16,1052,1168, . 1308,3344,16,1052,1296,3356,208,1104,1042,1050,1116,1244,1306, . 1298,3280,16,1052,1244,1306,1304,1238,3094,208,1104,1042,1050, . 1116,1244,1306,1298,1232,210,3344,16,1052,1244,1306,1304,1238, . 1046,214,3344,18,1104,1232,1298,1300,1238,1110,1048,1050,1116, . 1244,3354,28,1308,156,3216,28,1042,1104,1232,1298,3356,28,1168, . 3356,28,1040,1174,1296,3356,28,1296,16,3356,28,1174,1308,150, . 3216,28,1308,1040,3344,244,1206,1110,1044,1042,1104,1200,1266, . 246,3312,26,1040,18,1104,1200,1266,1268,1206,1110,3092,213,1206, . 1110,1044,1042,1104,1200,3281,244,1238,1110,1044,1042,1104,1200, . 1266,250,3312,19,1267,1269,1206,1110,1044,1042,1104,1200,3312, . 249,1242,1178,1144,1136,21,3285,212,1174,1110,1044,1042,1104, . 1168,1234,214,1229,1196,1068,3085,26,1040,20,1110,1206,1268,3312, . 122,1178,1177,1145,1146,118,1174,1168,80,3280,154,1210,1209,1177, . 1178,150,1206,1197,1164,1068,3085,26,1040,214,1107,1043,83,3280, . 122,1178,1168,112,3248,16,1045,1078,1142,1173,1168,1173,1206, . 1270,1301,3344,22,1040,20,1110,1206,1268,3312,242,1200,1104,1042, . 1044,1110,1206,1268,3314,22,1036,18,1104,1200,1266,1268,1206, . 1110,3092,244,1206,1110,1044,1042,1104,1200,1266,246,3308,22, . 1040,20,1110,1206,3285,17,1072,1200,1233,1234,1203,1075,1044, . 1045,1078,1206,3285,122,1137,1168,1200,1233,54,3254,22,1042,1104, . 1200,1266,246,3312,22,1136,3286,22,1041,1072,1136,1169,1171,145, . 1200,1264,1297,3350,22,1232,16,3286,22,1042,1104,1168,1234,214, . 1229,1196,1068,3085,22,1238,1040,3280,210,1168,1104,1042,1050, . 1116,1180,1242,3282,90,1180,1168,80,3280,27,1084,1212,1243,1240, . 1042,1040,3280,27,1084,1212,1243,1240,1174,1110,150,1236,1233, . 1200,1072,3089,208,1244,1044,3348,220,1052,1046,1206,1237,1233, . 1200,1072,3089,219,1212,1084,1051,1041,1072,1200,1233,1237,1206, . 1078,3093,28,1244,1242,3088,86,1048,1051,1084,1212,1243,1240, . 1174,1110,1044,1041,1072,1200,1233,1236,3222,17,1072,1200,1233, . 1243,1212,1084,1051,1047,1078,1206,3287 / IF(.NOT.( VISUAL )) GO TO 32759 CALL PENDWN MES(2) = MOD( IYCUR, 32 ) .OR. YL MES(1) = ( IYCUR / 32 ) .OR. YH MES(4) = MOD( IXCUR, 32 ) .OR. XL MES(3) = ( IXCUR / 32 ) .OR. XH MES(5) = 31 CALL WRITCH( MES, 5 ) 32759 ISZ = MIN0( MAX0( ISIZE, 1 ), 5 ) IRT = MOD( IROT - 1, 4 ) + 1 ISX = IABS( IRT - 3 ) - 1 ISY = IABS( IRT - 2 ) - 1 IXC = IXCUR IYC = IYCUR DO 32758 I = 1, LEN JCHR = STR(I) - 31 IF(.NOT.( JCHR .GT. 0 )) GO TO 32757 J = POSIT(JCHR) JWID = ICHW(ISZ) DONE = .FALSE. 32756 IF(.NOT.( .NOT. DONE )) GO TO 32755 IXP = MOD( BLOCK(J), 1024 ) IUD = 0 IF( MOD( BLOCK(J), 2048 ) .GE. 1024 ) IUD = 1 IYP = MOD( IXP , 32 ) - 12 IYP = ( ICHH(ISZ) * IYP ) / 12. + .5 IXP = IXP / 32 IXP = ( ICHW(ISZ) * IXP ) / 12. + .5 IX = IXC + IXP * ISX - ISY * IYP IY = IYC + IXP * ISY + ISX * IYP CALL PLOT( IX, IY, IUD ) IF( BLOCK(J) .GE. 2048 ) DONE = .TRUE. J = J + 1 GO TO 32756 32755 IXC = IXC + JWID * ISX IYC = IYC + JWID * ISY 32757 CONTINUE 32758 CONTINUE IXCUR = IXC IYCUR = IYC RETURN END