Listing of file='PKDIAD' on disk='vmedia/701-2720C.wvd.zip'
# Sector 69, program filename = 'PKDIAD'
0010 REM % C O M M O N V A R I A B L E S
0020 COM G3$(G3)G6,L3$(L3)L6,L3,L5,L6,G3,G5,G6,H7$7,G4$(G3)5,L3$(L3)L6,F7,F1$(
F7)2
: COM M3,F5,C9,R9,C8,C6,D5,D6
: GOTO 3001
0050 DEFFNS(Q)=VAL(STR(F1$(Q),1,1))
0060 DEFFNL(Q)=VAL(STR(F1$(Q),2,1))
3001 DIM A1$1
3025 LOAD T"PKMAIN"3000,9999BEG 3025
5010 STR(G3$(G5+1),FNS(8),FNL(8))="+"
: GOTO 5050
5020 STR(G3$(G5+1),FNS(8),FNL(8))="-"
: GOTO 5050
5030 STR(G3$(G5+1),FNS(8),FNL(8))="x"
: GOTO 5050
5040 STR(G3$(G5+1),FNS(8),FNL(8))="/"
5050 A4=0
: PRINT AT(18,50,30);AT(19,50,30);AT(20,50,30);AT(21,50,30);AT(22,50,30);AT
(23,50,30);
: FOR I1=1TO G5
: IF STR(G3$(I1),FNS(1),6)<>"Field-"THEN 5080
: IF STR(G3$(I1),FNS(1)+6,1)<HEX(30)AND STR(G3$(I1),FNS(1)+6,1)>HEX(39)THEN
5080
: CONVERT STR(G3$(I1),FNS(1)+6,1)TO B1
: IF B1>A4THEN A4=B1
5080 NEXT I1
: STR(G3$(G5+1),FNS(1),FNL(1))="Field-"
: A4=A4+1
: CONVERT A4TO STR(G3$(G5+1),FNS(1)+6,1),(#)
5084 PRINT AT(16,0,80);AT(16,10);HEX(0E);"Please enter this new field's name:
";
: GOSUB '123(STR(G3$(G5+1),FNS(1),FNL(1)),FNL(1),16,46,2424," ",HEX(0D82)
)
: STR(G3$(G5+1),FNS(1),FNL(1))=STR(S$,1,FNL(1))
: PRINT HEX(0F);
: FOR A4=FNL(1)TO 1STEP -1
: IF STR(G3$(G5+1),FNS(1)+A4-1,1)<>" "THEN 5093
: NEXT A4
5090 IF STR(G3$(G5+1),FNS(1),FNL(1))<>" "THEN 5093
: PRINT HEX(07);
: GOTO 5084
5093 FOR I1=1TO G5
: IF STR(G3$(I1),FNS(1),FNL(1))<>STR(G3$(G5+1),FNS(1),FNL(1))THEN GOTO 5100
: IF STR(G3$(I1),FNS(8),FNL(8))="???"THEN 5130
: PRINT HEX(07);
: GOTO 5084
5100 NEXT I1
5130 PRINT AT(16,0,80);STR(G3$(G5+1),FNS(1),FNL(1));" = Operand-1 ";STR(G3$(G5
+1),FNS(8),1);" Operand-2";HEX(0E);" Is Operand-1 a constant ? ";
: GOSUB '123("N",1,16,65,2424," ",HEX(0D82))
: A1$=S$
: PRINT HEX(0F);
: IF A1$="N"THEN 5210
: IF A1$<>"Y"THEN 5130
5170 PRINT AT(16,0,80);STR(G3$(G5+1),FNS(1),FNL(1));" = Operand-1 ";STR(G3$(G5
+1),FNS(8),1);" Operand-2";HEX(0E);" What is the constant ? ";
5171 GOSUB '123(" ",11,16,60,2424," ",HEX(0D82))
: CONVERT STR(S$,1,11)TO A6
: ERRORGOTO 5171
5182 GOSUB '95(A6)
: STR(G3$(G5+1),FNS(10),FNL(10))=STR(Z1$,1,8)
: STR(G3$(G5+1),FNS(9),FNL(9))="C"
: T1=0
: A5=FNL(1)
: GOTO 5390
5210 PRINT AT(16,0,80);AT(16,10);HEX(0E);"Please choose Operand-1";HEX(0F);
: GOSUB '98(2)
: PRINT AT(R9+1,0,80);
: FOR I1=1TO G5
: IF STR(G4$(I1),FNS(14),FNL(14))="Y"THEN 5270
: NEXT I1
: GOTO 3025
5270 STR(G3$(G5+1),FNS(9),FNL(9))="F"
: STR(G3$(G5+1),FNS(10),FNL(10))=STR(G3$(I1),FNS(1),FNL(1))
: STR(G3$(G5+1),FNS(5),FNL(5))=STR(G3$(I1),FNS(5),FNL(5))
: T1=VAL(STR(G3$(I1),FNS(6),FNL(6)))
: PRINT AT(18,50,30);AT(19,50,30);AT(20,50,30);AT(21,50,30);AT(22,50,30);AT
(23,50,30);
: A5=8
5310 PRINT AT(16,0,80);STR(G3$(G5+1),FNS(1),FNL(1));
: IF STR(G3$(G5+1),FNS(9),FNL(9))="F"THEN 5315
: GOSUB '96(STR(G3$(G5+1),FNS(10),FNL(10)))
: GOSUB '100(Z1)
: PRINT " = ";STR(G3$,1,12);
: GOTO 5320
5315 PRINT " = ";STR(G3$(G5+1),FNS(10),FNL(10));" ";
5320 PRINT " ";STR(G3$(G5+1),FNS(8),1);
: PRINT " Operand-2";HEX(0E);" Is Operand-2 a constant ? ";
: GOSUB '123("N",1,16,65,2424," ",HEX(0D82))
: A1$=S$
: PRINT HEX(0F);
: IF A1$="N"THEN 5390
: PRINT AT(16,37,47);HEX(0E);" What is the constant ? ";
5360 GOSUB '123(" ",11,16,68,2424," ",HEX(0D82))
: CONVERT STR(S$,1,11)TO A6
: ERRORGOTO 5360
5362 GOSUB '95(A6)
: STR(G3$(G5+1),FNS(11),FNL(11))="C"
: STR(G3$(G5+1),FNS(12),FNL(12))=STR(Z1$,1,8)
: T2=0
: GOSUB '100(A6)
: A5=FNL(1)
: GOTO 5452
5390 PRINT AT(16,0,80);AT(16,10);HEX(0E);"Please choose Operand-2";HEX(0F);
: GOSUB '98(2)
: PRINT AT(R9+1,0,80);
: FOR I1=1TO G5
: IF STR(G4$(I1),FNS(14),FNL(14))="Y"THEN 5450
: NEXT I1
: GOTO 3025
5450 STR(G3$(G5+1),FNS(11),FNL(11))="F"
: STR(G3$(G5+1),FNS(12),FNL(12))=STR(G3$(I1),FNS(1),FNL(1))
: STR(G3$(G1+1),FNS(5),FNL(5))=STR(G3$(I1),FNS(5),FNL(5))
: T2=VAL(STR(G3$(I1),FNS(6),FNL(6)))
5452 IF T1>T2THEN STR(G3$(G5+1),FNS(6),FNL(6))=BIN(T1)
: ELSE STR(G3$(G5+1),FNS(6),FNL(6))=BIN(T2)
5455 PRINT AT(18,50,30);AT(19,50,30);AT(20,50,30);AT(21,50,30);AT(22,50,30);AT
(23,50,30);AT(16,0,80);STR(G3$(G5+1),FNS(1),FNL(1));" = ";
: GOSUB '100(A6)
: IF STR(G3$(G5+1),FNS(9),FNL(9))="F"THEN 5460
: PRINT STR(G3$,1,12);" ";
: GOTO 5465
5460 PRINT STR(G3$(G5+1),FNS(10),FNL(10));" ";
5465 PRINT STR(G3$(G5+1),FNS(8),1);" ";
: IF STR(G3$(G5+1),FNS(11),FNL(11))="F"THEN 5470
: PRINT STR(G3$,1,12);" ";
: GOTO 5475
5470 PRINT STR(G3$(G5+1),FNS(12),FNL(12));
5475 PRINT HEX(0E);" Is this okay ?";
: GOSUB '123("Y",1,16,65,2424," ",HEX(0D82))
: A1$=S$
: PRINT HEX(0F);
: IF A1$<>"Y"AND A1$<>"N"THEN 5455
: IF A1$="N"THEN 5560
: STR(G3$(G5+1),FNS(7),FNL(7))=BIN(100)
: STR(G3$(G5+1),FNS(2),FNL(2))="S"
: STR(G3$(G5+1),FNS(13),FNL(13))="Y"
: STR(G3$(G5+1),FNS(5),FNL(5))=HEX(0101010101FF)
5514 FOR I=1TO G5
: IF STR(G3$(I),FNS(1),FNL(1))=STR(G3$(G5+1),FNS(1),FNL(1))THEN 5520
: NEXT I
: STR(G3$(G5+1),FNS(3),FNL(3))=BIN(1,2)
: STR(G3$(G5+1),FNS(4),FNL(4))=BIN(12,2)
: GOTO 5550
5520 IF STR(G3$(I),FNS(8),FNL(8))<>"???"THEN STOP "PKDIAD "#
: STR(G3$(I),FNS(1),FNL(1))=" "
: STR(G3$(G5+1),FNS(3),FNL(3))=STR(G3$(I),FNS(3),FNL(3))
: STR(G3$(G5+1),FNS(4),FNL(4))=STR(G3$(I),FNS(4),FNL(4))
: STR(G3$(G5+1),FNS(5),FNL(5))=STR(G3$(I),FNS(5),FNL(5))
5550 G5=G5+1
: PRINT AT(16,0,80);AT(16,10);HEX(0E);"Regenerating Diagram ...";HEX(0F);AT
(23,50,30);HEX(06);
: LOAD T"PKREGEN"3000,9999
5560 PRINT AT(R9+1,0,80);AT(23,50,30);
: R9=1
: C9=11
: FOR A2=1TO G5
: STR(G4$(A2),FNS(14),FNL(14))="N"
: NEXT A2
: G3$(G5+1)=ALL(" ")
: GOTO 3025
8010 DEFFN'99(M1)
8020 Z1=1
: FOR A3=1TO G5
: C9=VAL(STR(G4$(A3),FNS(16),FNL(16)),2)
: R9=VAL(STR(G4$(A3),FNS(15),FNL(15)))
: T3$=STR(G3$(A3),FNS(2),FNL(2))
: T2$=STR(G3$(A3),FNS(8),FNL(8))
: T4$=STR(G3$(A3),FNS(13),FNL(13))
: T1=VAL(STR(G3$(A3),FNS(6),FNL(6)))
: C9=C9-W1(1,2)+W1(1,6)
: R9=R9-W1(1,1)+W1(1,5)
8040 IF C9<W1(1,6)OR C9>W1(1,6)+W1(1,4)-1OR R9<W1(1,5)OR R9>W1(1,5)+W1(1,3)-1T
HEN 8100
: IF T4$="N"THEN 8100
: IF T3$<>"S"AND T3$<>"U"AND M1=2THEN 8100
: IF T4$="N"THEN 8100
: IF T1=0AND M1=1THEN 8100
: IF T2$<>"NO"AND M1=1THEN 8100
: IF STR(G4$(A3),FNS(14),FNL(14))="Y"THEN PRINT AT(R9+1,C9);HEX(0202020F960
202000E);
: ELSE PRINT AT(R9+1,C9);".";
: Z1=0
8100 NEXT A3
: IF Z1=0THEN RETURN
8120 PRINT HEX(06);
: KEYIN A$,,8140
8130 PRINT HEX(07);
: GOTO 8120
8140 IF A$<>HEX(02)THEN 8170
: IF C6-C8<=80-C8THEN 8130
: C6=C6-C8
: PRINT AT(R9+1,0,80);
: GOSUB '222(1,0,C8)
: GOSUB '94
: GOTO 8020
8170 IF A$<>HEX(03)THEN 8210
: IF C6+C8>F5THEN 8130
: C6=C6+C8
: PRINT AT(R9+1,0,80);
: GOSUB '222(1,0,-1*C8)
: GOSUB '94
: GOTO 8020
8210 IF A$<>HEX(F0)AND A$<>HEX(50)THEN 8130
: Z1=1
: R9=1
: C9=11
: RETURN
8240 DEFFN'98(M3)
: PRINT AT(18,50,30);AT(19,50,30);AT(20,50,30);AT(21,50,30);AT(22,50);"Retu
rn - Select ";AT(23,50);HEX(0E);"CANCEL/EDIT - Cancel
";HEX(0F);
: GOSUB '94
: FOR I1=1TO G5
: STR(G4$(I1),FNS(14),FNL(14))="N"
: NEXT I1
: A2=1
8290 GOSUB '85
: GOSUB '99(M3)
: IF Z1=1THEN 8570
8300 R9=VAL(STR(G4$(A2),FNS(15),FNL(15)))
: R9=R9-W1(1,1)+W1(1,5)
: C9=VAL(STR(G4$(A2),FNS(16),FNL(16)),2)
: C9=C9-W1(1,2)+W1(1,6)
: T3$=STR(G3$(A2),FNS(2),FNL(2))
: T4$=STR(G3$(A2),FNS(13),FNL(13))
: IF T4$="N"THEN 8315
: IF M3=2AND T3$<>"S"AND T3$<>"U"THEN 8315
8310 IF C9>=W1(1,6)AND C9<=W1(1,6)+W1(1,4)-1AND R9>=W1(1,5)AND R9<=W1(1,5)+W1(
1,3)-1THEN 8320
8315 IF A2<G5THEN A2=A2+1
: ELSE A2=1
: GOTO 8300
8320 PRINT AT(R9+1,C9);HEX(02050F);
: KEYIN A$,,8480
: PRINT AT(R9+1,C9);".";
: IF A$<>" "THEN 8390
8370 A2=A2+1
: IF A2>G5THEN A2=1
: R9=VAL(STR(G4$(A2),FNS(15),FNL(15)))
: C9=VAL(STR(G4$(A2),FNS(16),FNL(16)),2)
: R9=R9-W1(1,1)+W1(1,5)
: C9=C9-W1(1,2)+W1(1,6)
: T3$=STR(G3$(A2),FNS(2),FNL(2))
: T4$=STR(G3$(A2),FNS(13),FNL(13))
: IF T4$="N"THEN 8370
: IF M3=2AND T3$<>"S"AND T3$<>"U"THEN 8370
8380 IF C9>=W1(1,6)AND C9<=W1(1,6)+W1(1,4)-1AND R9>=W1(1,5)AND R9<=W1(1,5)+W1(
1,3)-1THEN 8320
: GOTO 8370
8390 IF A$<>HEX(08)THEN 8420
8400 A2=A2-1
: IF A2<1THEN A2=G5
: R9=VAL(STR(G4$(A2),FNS(15),FNL(15)))
: C9=VAL(STR(G4$(A2),FNS(16),FNL(16)),2)
: R9=R9-W1(1,1)+W1(1,5)
: C9=C9-W1(1,2)+W1(1,6)
: T3$=STR(G3$(A2),FNS(2),FNL(2))
: T4$=STR(G3$(A2),FNS(13),FNL(13))
: IF T4$="N"THEN 8400
: IF M3=2AND T3$<>"S"AND T3$<>"U"THEN 8400
8410 IF C9>=W1(1,6)AND C9<=W1(1,6)+W1(1,4)-1AND R9>=W1(1,5)AND R9<=W1(1,5)+W1(
1,3)-1THEN 8320
: GOTO 8400
8420 IF A$<>HEX(0D)THEN 8460
: STR(G4$(A2),FNS(14),FNL(14))="Y"
: PRINT AT(R9+1,C9);HEX(0202020F960202000E0802050F);
: Z1=0
: RETURN
8460 PRINT HEX(07);
: GOTO 8320
8480 IF A$<>HEX(02)THEN 8510
: IF C6-C8<=80-C8THEN 8320
: C6=C6-C8
: PRINT AT(R9+1,0,80);
: GOSUB '222(1,0,C8)
: GOSUB '94
: GOTO 8290
8510 IF A$<>HEX(03)THEN 8550
: IF C6+C8>F5THEN 8320
: C6=C6+C8
: PRINT AT(R9+1,0,80);
: GOSUB '222(1,0,-1*C8)
: GOSUB '94
: GOTO 8290
8550 IF A$<>HEX(09)THEN 8560
: STR(G4$(A2),FNS(14),FNL(14))="N"
: PRINT AT(R9+1,C9);".";
: GOTO 8320
8560 IF A$<>HEX(F0)AND A$<>HEX(50)THEN 8460
8570 PRINT HEX(06);AT(R9+1,0,80);AT(23,50,30);
: R9=1
: C9=11
: FOR A2=1TO G5
: STR(G4$(A2),FNS(14),FNL(14))="N"
: NEXT A2
: G3$(G5+1)=ALL(" ")
: Z1=1
: RETURN
9001 DEFFN'100(G1)
: STR(G$,1,12)="-###########"
: CONVERT G1TO STR(G3$,1,12),(G$)
: CONVERT STR(G3$,1,12)TO G2
: IF G2=G1THEN RETURN
: FOR H3=11TO 1STEP -1
: STR(G$,H3,1)="."
: CONVERT G1TO STR(G3$,1,12),(G$)
: CONVERT STR(G3$,1,12)TO G2
: IF G2=G1THEN RETURN
: STR(G$,H3,1)="#"
: NEXT H3
: STOP "PKEX1"#
9101 DEFFN'123(S$,S1,S2,S3,S7,S5$,S6$)
9102 S5=S3
: $TRAN(S6$,HEX(FE0D))R
: S4=1
: S8$=BIN(INT(S7/1000))&BIN(MOD(INT(S7/100),10))
: PRINT AT(S2,S3);HEX(0202020F0204);STR(S8$,1,2);HEX(0E);STR(S$,1,S1);AT(S2
,S3);
9103 PRINT HEX(05);
: KEYIN S9$,,9105
: PRINT HEX(06);
: IF S9$=HEX(84)THEN 9103
: $TRAN(S9$,HEX(FE0D))R
: IF POS(HEX(82FEA1E5)=S9$)>0THEN 9106
: IF S9$=HEX(08)THEN 9121
: IF S4>S1THEN 9103
: IF POS(S5$="S")>0AND S9$=" "THEN S9$=HEX(80)
: PRINT AT(S2,S5);S9$;
: STR(S$,S4,1)=S9$
: IF POS(S5$="A")>0AND S4>=S1THEN 9104
: S5=S5+1
: S4=S4+1
: GOTO 9103
9104 S8$=BIN(MOD(INT(S7/10),10))&BIN(MOD(INT(S7),10))
: IF POS(S5$="L")>0THEN S7=LEN(S$)
: ELSE S7=S1
: PRINT AT(S2,S3);HEX(0202020F0204);STR(S8$,1,2);HEX(0E);STR(S$,1,S7);HEX(0
202000F020402000F);
: IF POS(S5$="L")>0AND LEN(S$)<S1THEN PRINT STR(S$,LEN(S$)+1,S1-LEN(S$));
: IF POS(S5$="A")>0AND S4>=S1AND POS(S6$=S9$)=0THEN S9$=HEX(FF)
: RETURN
9105 PRINT HEX(06);
: $TRAN(S9$,HEX(0A4A0A5A094909590C5C0C4C0D5D0D4DE548))R
: IF S9$=HEX(0D)THEN 9116
9106 PRINT HEX(06);
: IF POS(S6$=S9$)>0THEN 9104
: IF S9$=HEX(E5)THEN 9123
: ON VAL(S9$)-3GOTO 9107,9103,9103,9109,9110,9112,9113,9114,9115,9116,9117
: GOTO 9103
9107 IF LEN(S$)=S1THEN S4=S1
: ELSE IF S$<>" "THEN S4=LEN(S$)+1
: ELSE S4=1
: S5=S3+LEN(S$)
: IF S$=" "THEN S5=S3
: IF S5>S3+S1-1THEN S5=S3+S1-1
9108 PRINT AT(S2,S5);
: GOTO 9103
9109 S5=S3
: S4=1
: GOTO 9108
9110 STR(S$,S4)=" "
9111 PRINT AT(S2,S3);STR(S$,1,S1);AT(S2,S5);
: GOTO 9103
9112 STR(S$,S4)=STR(S$,S4+1)
: GOTO 9111
9113 FOR S6=S1TO S4+1STEP -1
: IF S6>1THEN STR(S$,S6,1)=STR(S$,S6-1,1)
: NEXT S6
: STR(S$,S4,1)=" "
: GOTO 9111
9114 S6=5
: GOTO 9118
9115 S6=1
: GOTO 9118
9116 S6=-1
: GOTO 9118
9117 S6=-5
9118 S5=S5+S6
: S4=S4+S6
: IF S4>0THEN 9119
: S4=1
: S5=S3
9119 S6=LEN(S$)
: IF S$=" "THEN S6=0
: IF S4<=S6THEN 9120
: S5=S3+S6
: S4=S6+1
9120 PRINT AT(S2,S5);
: GOTO 9103
9121 S4=S4-1
: S5=S5-1
: IF S4>0THEN 9122
: S4=1
: S5=S3
9122 IF POS(S5$="S")=0THEN STR(S$,S4,1)=" "
: ELSE STR(S$,S4,1)=HEX(80)
: GOTO 9111
9123 S$=" "
: GOTO 9102
9201 DEFFN'95(Z1)
: $PACKZ1$FROMZ1
: Z1$=STR(Z1$,4,8)&ALL(00)
: RETURN
9206 DEFFN'96(Z1$)
: Z2$=HEX(800108)&STR(Z1$,1,8)&HEX(80)
: $UNPACKZ2$TO Z1
: RETURN
9400 DEFFN'85
: RETURN
9410 KEYIN A$,9420,9420
: GOTO 9430
9420 PRINT HEX(07);
: GOTO 9410
9430 RETURN
9500 DEFFN'94
: IF C6-C8<=80-C8THEN PRINT AT(18,50,30);
: ELSE PRINT AT(18,50);"'2 - Look Right";
: IF C6+C8>F5THEN PRINT AT(19,50,30);
: ELSE PRINT AT(19,50);"'3 - Look Left";
: RETURN
9600 DEFFNR(D4)=17+D4-((INT((D4-1)/D6))*D6)
9610 DEFFNC(D4)=INT((D4-1)/D6)*D5
9701 DEFFNS(Q)=VAL(STR(F1$(Q),1,1))
9702 DEFFNL(Q)=VAL(STR(F1$(Q),2,1))
9900 DEFFN'0"\A0HEX(03);:LISTSD 9100, 9699";HEX(0D)
: ON SGOTO 5010,5020,5030,5040
9999 % SCRATCH T "PKDIAD":SAVE T ()"PKDIAD"