image of READY prompt

Wang2200.org

Listing of file='IDS2PU08' on disk='vmedia/701-2715B.wvd.zip'

# Sector 619, program filename = 'IDS2PU08'
1000 REM "IDS2PU08" - Convert TC file to IDEAS2 file - MOD 2 - 10/19/81
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : F6$(11)="N"
   : DIM D$(1992)1,D1$(4)62,D2$(16)16
   : GOSUB 1390
1030 IF D3>=C5THEN 1400
   : DATA LOAD DA T#6,(D3,D3)D1$()
   : IF STR(D1$(),,1)<>HEX(F0)THEN 1030
   : D5=D3-C2
   : D3=D3-1
   : IF C1=1THEN 1150
   : D7=VAL(STR(D1$(),3))
   : IF D7=0THEN 1040
   : J4=1+INT((C4-1)/D7)
   : D2=(VAL(STR(D1$(),2))-3)/(D7+1)
   : D2=D2+(D5-1)*INT(246/(D7+1))
   : D4=D2/J4
   : GOTO 1270
1040 GOSUB '38(81," ")
   : KEYIN E6$
   : GOTO 1400
1150 IF VAL(STR(D1$(),2,1))>84THEN 1160
   : D4=INT((3*(D5-1)*80+VAL(STR(D1$(),2,1))-4)/C4)
   : GOTO 1180
1160 IF VAL(STR(D1$(),2,1))>165THEN 1170
   : D4=INT((3*(D5-1)*80+VAL(STR(D1$(),2,1))-5)/C4)
   : GOTO 1180
1170 D4=INT((3*(D5-1)*80+VAL(STR(D1$(),2,1))-6)/C4)
1180 J6=1
   : J1=1
   : J8=C4
   : GOSUB 1280
1190 J5=J7
   : IF 81-J5>=J8THEN J3=J8
   : ELSE J3=81-J5
   : PRINT HEX(0E);AT(23,24);J1;" of";D4;HEX(0F);
   : D1=D1+1
   : ON D1GOTO 1200,1210,1220
1200 STR(F$(),J6,J3)=STR(D1$(),3+J5,J3)
   : J9=J9+J3
   : IF 3+J5+J3-1=83THEN 1240
   : D1=0
   : GOTO 1240
1210 STR(F$(),J6,J3)=STR(D1$(),84+J5,J3)
   : J9=J9+J3
   : IF 84+J5+J3-1=164THEN 1240
   : D1=1
   : GOTO 1240
1220 STR(F$(),J6,J3)=STR(D1$(),165+J5,J3)
   : J9=J9+J3
   : IF 165+J5+J3-1=245THEN 1230
   : D1=2
   : GOTO 1240
1230 D1=0
1240 J6=J6+J3
   : J8=C4-J6+1
   : IF J8<>0THEN 1250
   : GOSUB 1290
   : J1=J1+1
   : IF J1>D4THEN 1400
   : J8=C4
   : F$()=ALL(00)
   : J6=1
1250 IF J9<>241THEN 1260
   : GOSUB 1280
   : J9=1
1260 J7=MOD(J9-1,80)+1
   : GOTO 1190
1270 FOR J1=1TO D4
   : PRINT HEX(0E);AT(23,24);J1;HEX(0F);" of";D4
   : FOR J2=0TO J4-1
   : IF D1=0THEN GOSUB 1280
   : D1=D1+1
   : STR(F$(),1+J2*D7)=STR(D1$(),4+(D1-1)*(D7+1),D7)
   : IF D1=INT(246/(D7+1))THEN D1=0
   : NEXT J2
   : GOSUB 1290
   : F$()=ALL(00)
   : NEXT J1
   : GOTO 1400
1280 DATA LOAD DA T#6,(C2,C2)D1$()
   : RETURN
1290 STR(D$(),,C4)=STR(F$(),,C4)
   : GOSUB 1300
   : F6$(14)="N"
   : GOSUB '41(C1$,D2$(),.5)
   : F=0
   : IF Q>0THEN GOSUB 1320
   : IF F=1THEN RETURN
   : STR(F$(),,C4)=STR(D$(),,C4)
   : GOSUB '42(C1$,0)
   : RETURN
1300 W=1
   : FOR C=28TO 40STEP 3
   : IF STR(E1$(C3),C,2)=HEX(0000)THEN 1310
   : STR(D2$(),W)=STR(F$(),MOD(VAL(STR(E1$(C3),C),2),32768))
   : W=W+VAL(STR(E1$(C3),C+2))
1310 NEXT C
   : RETURN
1320 IF F6$(22)="1"AND F6$(23)="3"THEN RETURN
   : IF F6$(22)="3"AND F6$(23)="3"THEN 1380
   : D6=D6+1
   : IF F6$(22)="2"OR F6$(23)="2"THEN GOSUB 1330
   : IF F6$(23)="1"THEN GOSUB 1360
   : SELECT PRINT 205
   : RETURN
1330 SELECT PRINT 005
   : IF MOD(D6,20)=1THEN PRINT HEX(03010F06);"MOVING RECORDS FROM TC FILE TO I
     DEAS2 FILE"
   : F6$(14)="Y"
   : GOSUB '38(82," ")
   : PRINT HEX(0E);AT(23,24);J1;HEX(0F);" of";D4;
   : PRINT AT(2+MOD(D6-1,20),0);STR(F$(),,MIN(C4,75));
   : IF F6$(22)="2"THEN GOSUB 1340
   : RETURN
1340 PRINT HEX(0E);AT(23,40);"Overwrite (Y/N)?";HEX(0F);
   : KEYIN E6$
   : IF POS("YN1yn0"=E6$)=0THEN 1350
   : PRINT AT(23,40,);
   : IF POS("Nn0"=E6$)>0THEN F=1
   : RETURN
1350 GOSUB '38(9," ")
   : GOTO 1340
1360 IF F6$(22)="3"THEN F=1
   : IF D6=1THEN $OPEN #1
   : IF MOD(D6,58)=1THEN GOSUB 1370
   : GOSUB '48(0,STR(F$(),,MIN(C4,75)),0)
   : IF F=0THEN GOSUB '48(77,"(O)",0)
   : GOSUB '49(0)
   : RETURN
1370 GOSUB '48(0,HEX(0C),0)
   : GOSUB '49(0)
   : GOSUB '48(13,"DUPLICATE RECORDS - ('O' means record was overwritten)",0)
   : GOSUB '49(0)
   : GOSUB '49(0)
   : RETURN
1380 F=1
   : RETURN
1390 F6$(14)="Y"
   : D1,D4,D6=0
   : J9,J7=1
   : F$(),D$(),D1$()=ALL(00)
   : D3=C2
   : GOSUB '38(82," ")
   : RETURN
1400 $CLOSE#1
   : COM CLEAR C1
   : IF C2$<>" "THEN SELECT #6<C2$>
   : IF F6$(20)="Z"THEN R3$()=STR(R3$(),19)
   : F6$(20)=" "
   : IF F6$(21)="C"THEN 1410
   : R3$()=STR(R3$(),10)
   : P=2
   : IF F6$(53)="Y"AND STR(R3$(),,4)<>"IDS2"THEN P=4
   : LOAD T#P,R3$(1)1000,
1410 STR(F6$(),21,3)=" "
   : STR(R3$(),,9)=STR(R3$(),10)
   : E$="IDS2P001IDS2P004"
   : H=2
   : E=21
   : G=500
   : COM CLEAR E1$()
   : IF F6$(17)<>HEX(60)THEN LOAD T#2,<2>E$1000,
   : COM CLEAR E()
   : LOAD T#2,"IDEAS2"
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PU08"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"