image of READY prompt

Wang2200.org

Listing of file='PKSORT' on disk='vmedia/701-2720C.wvd.zip'

# Sector 358, program filename = 'PKSORT'
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 3025
0050 DEFFNS(Q)=VAL(STR(F1$(Q),1,1))
0060 DEFFNL(Q)=VAL(STR(F1$(Q),2,1))
0070 DEFFNR(D4)=17+D4-((INT((D4-1)/D6))*D6)
0080 DEFFNC(D4)=INT((D4-1)/D6)*D5
3025 LOAD T"PKMAIN"3000,9999BEG 3025
4010 P2=0
   : FOR A2=1TO G5
   : STR(G4$(A2),FNS(14),FNL(14))="N"
   : NEXT A2
   : PRINT AT(16,0,80);AT(16,10);HEX(0E);"Sort/Group on What ?";HEX(0F);
   : PRINT AT(20,50,30);AT(21,50,30);AT(22,50);"EXEC/RUN - Finish selection  "
     ;AT(23,50);HEX(0E);"CANCEL/EDIT - Cancel      ";HEX(0F);
   : A2=1
   : P1=100
4061 GOSUB '99(1)
   : IF Z1=1THEN 4410
4070 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)
   : T2$=STR(G3$(A2),FNS(8),FNL(8))
   : T4$=STR(G3$(A2),FNS(13),FNL(13))
   : 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)-1AND T2$="NO"AND T4$="Y"THEN 4110
4081 A2=A2+1
   : IF A2>G5THEN A2=1
   : GOTO 4070
4110 PRINT AT(R9+1,C9);HEX(02050F);
   : KEYIN A$,,4320
   : IF STR(G4$(A2),FNS(14),FNL(14))="Y"THEN PRINT AT(R9+1,C9);HEX(0202020F960
     202000E);
   : ELSE PRINT AT(R9+1,C9);".";
   : IF A$<>" "THEN 4180
4160 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)
   : T2$=STR(G3$(A2),FNS(8),FNL(8))
   : T4$=STR(G3$(A2),FNS(13),FNL(13))
4170 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)-1AND T2$="NO"AND T4$="Y"THEN 4110
   : GOTO 4160
4180 IF A$<>HEX(08)THEN 4210
4190 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)
   : T2$=STR(G3$(A2),FNS(8),FNL(8))
   : T4$=STR(G3$(A2),FNS(13),FNL(13))
4200 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)-1AND T2$="NO"AND T4$="Y"THEN 4110
   : GOTO 4190
4210 IF A$<>HEX(0D)THEN 4260
   : STR(G4$(A2),FNS(14),FNL(14))="Y"
   : P1=P1+1
   : STR(G3$(A2),FNS(7),FNL(7))=BIN(P1)
   : PRINT AT(R9+1,C9);HEX(0202020F960202000E0802050F);
   : GOTO 4160
4260 IF A$<>HEX(82)THEN 4300
   : P3=99
   : FOR I1=1TO G5
   : IF STR(G4$(I1),FNS(14),FNL(14))<>"Y"THEN 4270
   : X3=VAL(STR(G3$(I1),FNS(6),FNL(6)))
   : IF X3<P3THEN P3=X3
4270 NEXT I1
   : IF P3<>99THEN 4280
   : PRINT HEX(07);
   : GOTO 4110
4280 FOR I1=1TO G5
   : X3=VAL(STR(G3$(I1),FNS(6),FNL(6)))
   : IF X3>P3THEN STR(G3$(I1),FNS(6),FNL(6))=BIN(X3+1)
   : IF X3=P3AND STR(G4$(I1),FNS(14),FNL(14))<>"Y"THEN STR(G3$(I1),FNS(6),FNL(
     6))=BIN(X3+1)
   : IF STR(G4$(I1),FNS(14),FNL(14))="Y"THEN STR(G3$(I1),FNS(6),FNL(6))=BIN(P3
     )
   : NEXT I1
   : PRINT AT(16,0,80);AT(16,10);HEX(0E);G0$;HEX(0F);AT(23,50,30);HEX(06);
4292 LOAD T"PKREGEN"3000,9999
4300 PRINT HEX(07);
   : GOTO 4110
4320 IF A$<>HEX(02)AND A$<>HEX(4C)THEN 4350
   : IF C6-C8<=80-C8THEN 4110
   : C6=C6-C8
   : PRINT AT(R9+1,0,80);
   : GOSUB '222(1,0,C8)
   : GOSUB '94
   : GOTO 4061
4350 IF A$<>HEX(03)AND A$<>HEX(4D)THEN 4390
   : IF C6+C8>F5THEN 4110
   : C6=C6+C8
   : PRINT AT(R9+1,0,80);
   : GOSUB '222(1,0,-1*C8)
   : GOSUB '94
   : GOTO 4061
4390 IF A$<>HEX(09)THEN 4400
   : STR(G4$(A2),FNS(14),FNL(14))="N"
   : PRINT AT(R9+1,C9);".";
   : GOTO 4110
4400 IF A$<>HEX(F0)AND A$<>HEX(50)THEN 4300
4410 PRINT AT(R9+1,0,80);
   : R9=1
   : C9=11
   : FOR A2=1TO G5
   : STR(G4$(A2),FNS(14),FNL(14))="N"
   : NEXT A2
   : 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$<>"N"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=13
   : RETURN
9010 DEFFN'95
9020 KEYIN A$,9030,9030
   : GOTO 9040
9030 PRINT HEX(07);
   : GOTO 9020
9040 RETURN
9060 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
9100 DEFFNR(D4)=17+D4-((INT((D4-1)/D6))*D6)
9110 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 8240,  9699";HEX(0D)
   : GOTO 4010
9999 %     SCRATCH T "PKSORT":SAVE   T ()"PKSORT"