image of READY prompt

Wang2200.org

Listing of file='IDS2PU24' on disk='vmedia/701-2724B.wvd.zip'

# Sector 858, program filename = 'IDS2PU24'
1000 REM - IDS2PU24 - Data Record File Dump Part 5 - Print Functions
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM J5$90
   : PRINT AT(23,0,80);AT(8,29);BOX(-16,0)
   : E3$()=E$()
   : GOSUB '32("IDS2sU14")
   : F6$(11)="N"
   : GOSUB '55(1,J3)
   : GOSUB '55(2,C3)
   : GOSUB '55(3,J4)
   : GOSUB '55(4,C4)
   : GOSUB '55(5,0)
   : GOSUB '55(6,D0)
   : GOSUB '55(7,D1)
   : GOSUB '55(8,D0)
1080 GOSUB '63("Touch EDIT to Ch","ange Parameters, EXEC to Accept, '31 to Can
     cel"," ")
   : GOSUB '34(250)
   : ON Q-30GOTO 1110,1215,1125
   : PRINT HEX(07);
   : GOTO 1080
1110 PRINT HEX(060F);AT(11,6);BOX(-4,-32);AT(18,6);BOX(-2,-66);AT(11,43);BOX(-
     4,-29);AT(8,29);BOX(16,0);AT(8,1);"KIE # Byte Pointer V Record#";AT(9,0,8
     0);" ----- ---- ------- - -------";AT(11,0,80);" ----- ---- ------- - ---
     ----"
   : LOAD T#2,"IDS2PU20"1000,
1125 FOR F=1TO 3STEP 2
1130 GOSUB '34(F)
   : IF F=1AND Q<C3THEN 1150
   : ELSE IF F=3AND Q<C4THEN 1150
   : GOSUB '35("Value must be less then maximum. Please Re-enter")
   : GOTO 1130
1150 NEXT F
1155 GOSUB '34(5)
   : IF Q<D0THEN 1175
   : GOSUB '35("1st print byte must be less then maximum. Please Re-enter.")
   : GOTO 1155
1175 C5=Q
   : GOSUB '34(6)
   : IF Q>=C5AND Q<=D0THEN 1200
   : GOSUB '35("Last print byte must be >= 1st print byte, <= maximum.")
   : GOTO 1155
1200 D5=Q
   : GOTO 1080
1215 GOSUB 2110
   : GOSUB '43(1)
   : A,B=Q
   : IF Q<>0THEN 1240
   : A=1
   : B=C3
1240 GOSUB '43(3)
   : J8=Q
   : C7=0
   : D7=1
   : J0=J3
   : J1=J4
   : J2=J5
   : GOSUB '43(5)
   : C5=Q
   : GOSUB '43(6)
   : D5=Q
   : IF C5<>0THEN 1290
   : C5=1
   : D5=D0
1290 FOR J3=ATO B
   : IF J8=0THEN FOR J4=1TO C4
   : ELSE FOR J4=J8TO J8
   : GOSUB '76(J4)
   : C9=(VAL(STR(E3$(),4),2)-10)/C1+1
   : GOSUB 3180
   : FOR J5=1TO C9
   : IF D7>60OR D7+3+INT(J5-C5)/80>63THEN GOSUB 3180
   : GOSUB 2200
   : J5$=ALL("-")
   : STR(J5$,18,MIN(65,D5))=F$()
   : GOSUB '77(J5)
   : PRINT AT(19,7);HEX(0F);"KIE Element ";STR(D1$,2)
   : IF POS(STR(E4$(),,C0)<FF)<>0THEN 1340
1330 GOSUB '48(1,STR(D1$,2),0)
   : GOSUB '49(0)
   : D7=D7+1
   : J9=0
   : GOTO 1445
1340 IF J9=1THEN 1360
   : GOSUB '48(0,J5$,0)
   : GOSUB '49(0)
   : D7=D7+1
1360 J9=1
   : GOSUB '48(1,STR(D1$,2),0)
   : GOSUB '49(0)
   : D7=D7+1
   : GOSUB '48(1,"KEY",0)
   : GOSUB '48(5,STR(E2$(),,D1),0)
   : GOSUB '49(0)
   : D7=D7+1
   : FOR X=C5TO D5STEP 65
   : KEYIN E6$,1405,1390
1390 IF E6$<>HEX(1F)THEN 1405
   : X,J5,J4,J3=10^99
   : GOTO 1425
1405 D1$="Bytes ####-####"&ALL(".")
   : CONVERT XTO STR(D1$,7,4),(####)
   : CONVERT -(MIN(X+MIN(65,D0-X),D5))TO STR(D1$,12,4),(####)
   : GOSUB '48(1,D1$,0)
   : GOSUB '48(18,STR(E2$(),D1+X),MIN(D5-C5+1,65,D0-X))
   : GOSUB '49(0)
   : D7=D7+1
1425 NEXT X
   : GOSUB '48(0,J5$,0)
   : GOSUB '49(0)
   : D7=D7+1
1445 NEXT J5,J4,J3
   : $CLOSE#1
   : J3=J0
   : J4=J1
   : J5=J2
   : J0,J1,J2=0
   : GOTO 1110
1460 DEFFN'76(Z)
   : P=VAL(STR(E1$(D4),9))
   : MAT REDIM E3$(24)83
   : DATA LOAD DA T#P,(VAL(STR(E1$(D4),55),2)+C2*(J3-1)+8*(Z-1))E3$()
   : MAT REDIM E3$(249)8
   : RETURN
1480 DEFFN'77(D6)
   : E4$()=STR(E3$(),(D6-1)*C1+10,C0+C6)
   : D1$=" "
   : IF VAL(E3$())=C4-1AND D6<VAL(E3$())+2THEN V=D6
   : ELSE V=D6-VAL(E3$())+INT(1983/C1)*(J4-1)-J4
   : CONVERT VTO STR(D1$,3,5),(#####)
   : GOSUB 2150
   : CONVERT (D6-1)*C1+10TO STR(D1$,9,4),(####)
   : GOSUB 2150
   : V=1
   : IF C6=0THEN 1610
   : D0$=STR(E4$(),C0+1,C6)
   : HEXUNPACKSTR(E4$(),C0+1,C6)TO STR(D1$,15)
1580 C=VAL(D0$,2)
   : IF C6=2THEN 1600
   : E6$=STR(D0$,3)
   : C=C+MOD(VAL(E6$),32)*65536
   : V=INT(VAL(E6$)/32)+1
1600 CONVERT VTO STR(D1$,22),(#)
   : CONVERT CTO STR(D1$,24),(#######)
   : GOSUB 2150
   : IF STR(D1$,24,7)="0000000"THEN STR(D1$,24,6)=" "
1610 IF POS(STR(E4$(),,C0)<FF)>0THEN 1630
   : STR(D1$,32)="(available KIE element)"
   : GOTO 1980
1630 STR(E4$(),C0+1)=ALL(00)
   : IF J6=0THEN 1680
   : MAT COPY -E4$()<,C0>TO -E4$()<1+J6,C0>
   : HEXUNPACKSTR(E4$(),1+J6,J6)TO STR(E4$(),,J6*2)
   : $TRAN(E4$()<,J6*2>,@F$<33,>)R
1680 IF J7=0THEN 1700
   : FOR P=J6*2+1TO J6*2+J7
   : ROTATEC(STR(E4$(),P,J6*2+J7+1-P),-2)
   : NEXT P
1700 W=1
   : FOR P=1TO 5
   : IF STR(D4$,P,1)>HEX(7F)THEN XOR (STR(E4$(),W,VAL(D1$(P))),FF)
   : W=W+VAL(D1$(P))
   : NEXT P
   : IF J6+J7>0THEN AND (STR(E4$(),,J6+J6+J7),3F)
   : IF J6>0THEN OR (STR(E4$(),,J6*2),30)
   : IF J6>0THEN $TRAN(E4$()<,J6*2>,@F$<53,>)R
   : IF J7>0THEN ADD(STR(E4$(),J6*2+1,J7),20)
   : IF STR(E1$(D4),12,1)=HEX(01)OR STR(E1$(D4),12,1)=HEX(04)THEN 1860
1800 GOSUB '67(D4,STR(D0$,,C6),-1)
   : MAT REDIM E2$(3*B)83
   : DATA LOAD DA T#D,(U)E2$()
   : GOTO 1870
1860 C=(D6-1)*C1+10+C0
1870 MAT REDIM F$(E9)1,E2$(249)8,E3$(249)8
   : UNPACK(####)STR(E1$(D4),15,2)TO X
   : IF POS(HEX(0104)=STR(E1$(D4),12,1))=0THEN STR(F$(),X+1)=STR(E2$(),C+1)
   : ELSE STR(F$(),X+1)=STR(E3$(),C+1)
   : T=VAL(STR(E1$(D4),12))
   : GOSUB '66(D4,0)
   : E2$()=STR(E4$(),,POS(-E4$()<>00))&F$()
1920 $TRAN(E2$(),HEX(8020400240034004400540064007400840094001400A4000400B400C4
     00D400E400F))R
   : IF J0=0THEN 1970
   : $TRAN(E2$(),HEX(2080))R
   : STR(E2$(),D0+D1+1)=" "
   : GOTO 1980
1970 GOSUB 2010
1980 IF (D6-1)*C1+10<VAL(STR(E3$(),3))THEN STR(D1$,3,3)="(C)"
   : RETURN
2010 A=0
   : FOR B=1TO D3+4
   : IF D1$(B)=HEX(00)THEN 2070
   : A=A+VAL(D1$(B))+1
   : MAT COPY -E2$()<A,D0+D1+D2+D3-A>TO -E2$()<A+1,D0+D1+D2+D3-A>
   : STR(E2$(),A,1)=" "
2070 NEXT B
   : STR(E2$(),D0+D1+D2+D3)=" "
   : RETURN
2110 E4$()=ALL(00)
   : I=0
   : $OPEN 2130,#1
   : ERRORGOTO 2130
2120 $OPEN #1
   : RETURN
2130 $CLOSE#1
   : GOSUB '63("Printer is not a","vailable.  Touch EXECUTE to continue, or CA
     NCEL","!")
   : GOSUB '34(250)
   : IF Q=31THEN 1110
   : IF Q=32THEN 2110
   : GOTO 2130
2150 Y=LEN(D1$)
   : Z=POS(-STR(D1$,,Y)=20)
   : IF POS(STR(D1$,Z,Y-Z)=30)<POS(STR(D1$,Z,Y-Z+1)>30)THEN STR(D1$,Z,POS(STR(
     D1$,Z)>30)-1)=" "
   : RETURN
2200 INIT("=")STR(F$(),,MAX(D1,D0))
   : IF D1<10AND D0<10THEN 2250
   : FOR I=1TO MAX(INT(D1/10),INT(D0/10))
   : CONVERT MOD(I,10)TO STR(F$(),I*10,1),(#)
   : NEXT I
2250 IF J0<>0THEN RETURN
   : E2$()=STR(F$(),,D1)
   : $TRAN(F$(),"-=")R
   : E2$()=E2$()&STR(F$(),,D0)
   : GOSUB 2010
   : RETURN
3180 C7=C7+1
   : J5$=HEX(0C0A0A)&"Key Dump of "&D3$&" - "&D2$&"    Date :"&STR(R2$,,2)&"/"
     &STR(R2$,3,2)&"/"&STR(R2$,5,2)
   : GOSUB '48(0,J5$,0)
   : GOSUB '49(0)
   : J5$=HEX(0000)
   : PRINTUSING TO J5$,"Bucket##### of#####  Block#### of####  Record Bytes ##
     ## - ####  Page ###",J3,C3,J4,C4,C5,D5,C7;
3240 PRINT AT(19,7,70);AT(18,7,70);HEX(0F06);
   : PRINTUSING "Now Printing    Bucket #####    Block ####    Page ###",J3,J4
     ,C7
   : GOSUB '48(0,STR(J5$,3),0)
   : GOSUB '49(0)
   : INIT("-")J5$
   : GOSUB '48(0,J5$,0)
   : GOSUB '49(0)
   : GOSUB '48(0," KIE # Byte Pointer V Record#",0)
   : GOSUB '49(0)
   : D7=7
   : RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PU24"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"