Listing of file='PKVSCREN' on disk='vmedia/701-2720C.wvd.zip'
# Sector 378, program filename = 'PKVSCREN'
2000 REM % PARTIAL VIRTUAL SCREEN ROUTINES
2002 COM T0$100,M6,M7,W1(2,6),Z(25),M5,S1$(S0)F6,S1$F6,B1(10,4),T1$8,F6,S0
: LOAD T"PKREGEN"3000,9999
2004 DEFFN'220(W1(M6+1,1),W1(M6+1,2),W1(M6+1,3),W1(M6+1,4),W1(M6+1,5),W1(M6+1,
6))
: M6=M6+1
: IF Z(1)=0THEN Z(1)=1
: Z(1)=Z(1)+1
: Z(Z(1))=I1
: PRINT HEX(06);
: FOR I1=W1(M6,5)TO W1(M6,5)+W1(M6,3)-1
: PRINT AT(I1,W1(M6,6),W1(M6,4))
: NEXT I1
: IF M5=0THEN 2006
: FOR I1=1TO M5
: GOSUB '227(+1,I1,M6,0,0)
: NEXT I1
2006 IF M7=0THEN 2010
: FOR I1=1TO M7
: GOSUB '228(I1,M6)
: NEXT I1
2010 I1=Z(Z(1))
: Z(1)=Z(1)-1
: RETURN
2015 DEFFN'221(N1)
: IF N1>M6THEN RETURN
: IF Z(1)=0THEN Z(1)=1
: Z(1)=Z(1)+1
: Z(Z(1))=I1
: Z(1)=Z(1)+1
: Z(Z(1))=I2
: PRINT HEX(06);
: FOR I1=W1(N1,5)TO W1(N1,5)+W1(N1,3)-1
: PRINT AT(I1,W1(N1,6),W1(N1,4))
: NEXT I1
: FOR I1=1TO M7
: GOSUB '229(I1,N1)
: NEXT I1
: FOR I1=N1TO M6-1
: FOR I2=1TO 6
: W1(I1,I2)=W1(I1+1,I2)
: NEXT I2
: NEXT I1
: FOR I1=1TO 6
: W1(M6,I1)=0
2025 NEXT I1
: M6=M6-1
: I2=Z(Z(1))
: Z(1)=Z(1)-1
: I1=Z(Z(1))
: Z(1)=Z(1)-1
: RETURN
2035 DEFFN'222(N1,D3,S1)
: IF D3=0AND S1=0THEN RETURN
: IF Z(1)=0THEN Z(1)=1
: Z(Z(1)+1)=C2
: Z(Z(1)+2)=C3
: Z(Z(1)+3)=D4
: Z(Z(1)+4)=I1
: Z(Z(1)+5)=R2
: Z(Z(1)+6)=R3
: Z(Z(1)+7)=S2
: Z(1)=Z(1)+7
: FOR I1=1TO M7
: GOSUB '229(I1,N1)
: NEXT I1
: IF D3<0THEN 2065
: IF D3>0THEN 2055
: IF S1<0THEN 2065
2055 FOR I1=1TO M5
: GOSUB '227(-1,I1,N1,0,0)
: GOSUB '227(+1,I1,N1,D3,S1)
: NEXT I1
: GOTO 2070
2065 FOR I1=M5TO 1STEP -1
: GOSUB '227(-1,I1,N1,0,0)
: GOSUB '227(+1,I1,N1,D3,S1)
: NEXT I1
2070 W1(N1,1)=W1(N1,1)+D3
: W1(N1,2)=W1(N1,2)+S1
: FOR I1=1TO M7
: GOSUB '228(I1,N1)
: NEXT I1
: Z(1)=Z(1)-7
: C2=Z(Z(1)+1)
: C3=Z(Z(1)+2)
: D4=Z(Z(1)+3)
: I1=Z(Z(1)+4)
: R2=Z(Z(1)+5)
: R3=Z(Z(1)+6)
: S2=Z(Z(1)+7)
: RETURN
2090 DEFFN'223(R0,C0,A0,T0$)
: IF Z(1)=0THEN Z(1)=1
: Z(1)=Z(1)+1
: Z(Z(1))=I1
: I1=F6-6
2092 GOSUB '231(R0,C0,A0,STR(T0$,1,8))
: IF LEN(T0$)<=8THEN 2093
: GOSUB '231(R0,C0+8,A0,STR(T0$,9,8))
: IF LEN(T0$)<=16THEN 2093
: GOSUB '231(R0,C0+16,A0,STR(T0$,17,8))
: IF LEN(T0$)<=24THEN 2093
: GOSUB '231(R0,C0+24,A0,STR(T0$,24,8))
: IF LEN(T0$)<=32THEN 2093
: GOSUB '231(R0,C0+32,A0,STR(T0$,33,8))
2093 I1=Z(Z(1))
: Z(1)=Z(1)-1
: RETURN
2095 DEFFN'224(B1(M7+1,1),B1(M7+1,2),B1(M7+1,3),B1(M7+1,4))
: IF Z(1)=0THEN Z(1)=1
: Z(1)=Z(1)+1
: Z(Z(1))=I1
: M7=M7+1
: IF M6=0THEN 2096
: FOR I1=1TO M6
: GOSUB '232(+1,M7,I1)
: NEXT I1
2096 I1=Z(Z(1))
: Z(1)=Z(1)-1
: RETURN
2100 DEFFN'225(R1,C1,H1,W1)
: IF M7=0THEN RETURN
: IF Z(1)=0THEN Z(1)=1
: Z(Z(1)+1)=I1
: Z(Z(1)+2)=I2
: Z(Z(1)+3)=N2
: Z(1)=Z(1)+3
: FOR N2=1TO M7
: IF B1(N2,1)=R1AND B1(N2,2)=C1AND B1(N2,3)=H1AND B1(N2,4)=W1THEN 2105
: NEXT N2
: GOTO 2115
2105 FOR I1=1TO M6
: GOSUB '232(-1,N2,I1)
: NEXT I1
: IF M7=1THEN 2110
: FOR I1=N2TO M7-1
: FOR I2=1TO 4
: B1(I1,I2)=B1(I1+1,I2)
: NEXT I2
: NEXT I1
2110 FOR I1=1TO 4
: B1(M7,I1)=0
: NEXT I1
: M7=M7-1
2115 Z(1)=Z(1)-3
: I1=Z(Z(1)+1)
: I2=Z(Z(1)+2)
: N2=Z(Z(1)+3)
: RETURN
2185 DEFFN'228(N2,N3)
: IF Z(1)=0THEN Z(1)=1
: Z(1)=Z(1)+1
: Z(Z(1))=I1
: IF N3=0THEN 2190
: GOSUB '232(+1,N2,N3)
: GOTO 2195
2190 FOR I1=1TO M6
: GOSUB '232(+1,N2,I1)
: NEXT I1
2195 I1=Z(Z(1))
: Z(1)=Z(1)-1
: RETURN
2200 DEFFN'229(N2,N3)
: IF Z(1)=0THEN Z(1)=1
: Z(1)=Z(1)+1
: Z(Z(1))=X1
: IF N3=0THEN 2205
: GOSUB '232(-1,N2,N3)
: GOTO 2210
2205 FOR I1=1TO M6
: GOSUB '232(-1,N2,I1)
: NEXT I1
2210 X1=Z(Z(1))
: Z(1)=Z(1)-1
: RETURN
2215 DEFFN'231(R1,C1,A1,T1$)
: IF Z(1)=0THEN Z(1)=1
: Z(1)=Z(1)+1
: Z(Z(1))=I1
: M5=M5+1
: S1$(M5)=BIN(R1,2)&BIN(C1,2)&BIN(A1,2)&STR(T1$,1,8)
: IF M6<=0THEN 2216
: FOR I1=1TO M6
: GOSUB '227(+1,M5,I1,0,0)
: NEXT I1
2216 I1=Z(Z(1))
: Z(1)=Z(1)-1
: RETURN
2220 DEFFN'232(M0,N2,N3)
: IF Z(1)=0THEN Z(1)=1
: Z(Z(1)+1)=R1
: Z(Z(1)+2)=C1
: Z(Z(1)+3)=H1
: Z(Z(1)+4)=W1
: Z(1)=Z(1)+4
: PRINT HEX(06);
: R1=B1(N2,1)
: C1=B1(N2,2)
: H1=B1(N2,3)
: W1=B1(N2,4)
: IF R1<W1(N3,1)AND C1<W1(N3,2)THEN 2225
: GOTO 2260
2225 IF W1(N3,1)<=R1+H1AND R1+H1<=W1(N3,1)+W1(N3,3)AND W1(N3,2)<=C1+W1AND C1+W
1<=W1(N3,2)+W1(N3,4)-1THEN 2230
: GOTO 2235
2230 PRINT AT(W1(N3,5),C1+W1-W1(N3,2)+W1(N3,6));BOX(M0*(R1+H1-W1(N3,1)),0);
: PRINT AT((R1+H1)-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*((C1+W1)-W1(N3,2)))
;
: GOTO 2395
2235 IF C1+W1>W1(N3,2)+W1(N3,4)-1AND W1(N3,1)+W1(N3,3)>=R1+H1AND R1+H1>=W1(N3,
1)THEN 2240
: GOTO 2245
2240 PRINT AT(R1+H1-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*(W1(N3,2)+W1(N3,4)-1-
W1(N3,2)));
: GOTO 2395
2245 IF R1+H1>W1(N3,1)+W1(N3,3)AND W1(N3,2)+W1(N3,4)-1>=C1+W1AND C1+W1>=W1(N3,
2)THEN 2250
: GOTO 2255
2250 PRINT AT(W1(N3,5),C1+W1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W1(N3,3)-W1(N
3,1)),0);
: GOTO 2395
2255 GOTO 2395
2260 IF W1(N3,1)<=R1AND R1<=W1(N3,1)+W1(N3,3)AND C1<W1(N3,2)THEN 2265
: GOTO 2305
2265 IF R1+H1>W1(N3,1)+W1(N3,3)AND W1(N3,2)+W1(N3,4)-1>=C1+W1AND C1+W1>=W1(N3,
2)THEN 2270
: GOTO 2275
2270 PRINT AT(R1-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*(C1+W1-W1(N3,2)));
: PRINT AT(R1-W1(N3,1)+W1(N3,5),C1+W1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W
1(N3,3)-R1),0);
: GOTO 2395
2275 IF R1+H1>W1(N3,1)+W1(N3,3)AND C1+W1>W1(N3,2)+W1(N3,4)-1THEN 2280
: GOTO 2285
2280 PRINT AT(R1-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*(W1(N3,2)+W1(N3,4)-1-W1(
N3,2)));
: GOTO 2395
2285 IF W1(N3,1)<R1+H1AND R1+H1<=W1(N3,1)+W1(N3,3)AND W1(N3,2)<=C1+W1AND C1+W1
<=W1(N3,2)+W1(N3,4)-1THEN 2290
: GOTO 2295
2290 PRINT AT(R1-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*(C1+W1-W1(N3,2)));
: PRINT AT(R1-W1(N3,1)+W1(N3,5),C1+W1-W1(N3,2)+W1(N3,6));BOX(M0*H1,0);
: PRINT AT(R1+H1-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*(C1+W1-W1(N3,2)));
: GOTO 2395
2295 IF W1(N3,1)+W1(N3,3)>=R1+H1AND R1+H1>W1(N3,1)AND C1+W1>W1(N3,2)+W1(N3,4)-
1THEN 2300
: GOTO 2395
2300 PRINT AT(R1-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*(W1(N3,2)+W1(N3,4)-1-W1(
N3,2)));
: PRINT AT(R1+H1-W1(N3,1)+W1(N3,5),W1(N3,6));BOX(0,M0*(W1(N3,2)+W1(N3,4)-1-
W1(N3,2)));
: GOTO 2395
2305 IF R1<W1(N3,1)AND W1(N3,2)<=C1AND C1<=W1(N3,2)+W1(N3,4)-1THEN 2310
: GOTO 2350
2310 IF W1(N3,1)+W1(N3,3)>=R1+H1AND R1+H1>=W1(N3,1)AND C1+W1>W1(N3,2)+W1(N3,4)
-1THEN 2315
: GOTO 2320
2315 PRINT AT(W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*(R1+H1-W1(N3,1)),0);
: PRINT AT(R1+H1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(0,M0*(W1(N3,2)
+W1(N3,4)-1-C1));
: GOTO 2395
2320 IF R1+H1>W1(N3,1)+W1(N3,3)AND C1+W1>W1(N3,2)+W1(N3,4)-1THEN 2325
: GOTO 2330
2325 PRINT AT(W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W1(N3,3)-W1(N3,1
)),0);
: GOTO 2395
2330 IF W1(N3,1)<=R1+H1AND R1+H1<=W1(N3,1)+W1(N3,3)AND C1+W1<=W1(N3,2)+W1(N3,4
)-1THEN 2335
: GOTO 2340
2335 PRINT AT(R1+H1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(0,M0*W1);
: PRINT AT(W1(N3,5),C1+W1-W1(N3,2)+W1(N3,6));BOX(M0*(R1+H1-W1(N3,1)),0);
: PRINT AT(W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*(R1+H1-W1(N3,1)),0);
: GOTO 2395
2340 IF R1+H1>W1(N3,1)+W1(N3,3)AND C1+W1<=W1(N3,2)+W1(N3,4)-1THEN 2345
: GOTO 2395
2345 PRINT AT(W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W1(N3,3)-W1(N3,1
)),0);
: PRINT AT(W1(N3,5),C1+W1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W1(N3,3)-W1(N
3,1)),0);
: GOTO 2395
2350 IF W1(N3,1)<=R1AND R1<=W1(N3,1)+W1(N3,3)AND W1(N3,2)<=C1AND C1<=W1(N3,2)+
W1(N3,4)-1THEN 2355
: GOTO 2395
2355 IF R1+H1>W1(N3,1)+W1(N3,3)AND C1+W1>W1(N3,2)+W1(N3,4)-1THEN 2360
: GOTO 2365
2360 PRINT AT(R1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W1(N
3,3)-R1),0);
: PRINT AT(R1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(0,M0*(W1(N3,2)+W1
(N3,4)-1-C1));
: GOTO 2395
2365 IF W1(N3,1)<R1+H1AND R1+H1<=W1(N3,1)+W1(N3,3)AND W1(N3,2)+W1(N3,4)-1<C1+W
1THEN 2370
: GOTO 2375
2370 PRINT AT(R1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*H1,0);
: PRINT AT(R1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(0,M0*(W1(N3,2)+W1
(N3,4)-1-C1));
: PRINT AT(R1+H1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(0,M0*(W1(N3,2)
+W1(N3,4)-1-C1));
: GOTO 2395
2375 IF R1+H1>W1(N3,1)+W1(N3,3)AND C1+W1<=W1(N3,2)+W1(N3,4)-1THEN 2380
: GOTO 2385
2380 PRINT AT(R1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(0,M0*W1);
: PRINT AT(R1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W1(N
3,3)-R1),0);
: PRINT AT(R1-W1(N3,1)+W1(N3,5),C1+W1-W1(N3,2)+W1(N3,6));BOX(M0*(W1(N3,1)+W
1(N3,3)-R1),0);
: GOTO 2395
2385 IF R1+H1<=W1(N3,1)+W1(N3,3)AND C1+W1<=W1(N3,2)+W1(N3,4)-1THEN 2390
: GOTO 2395
2390 PRINT AT(R1-W1(N3,1)+W1(N3,5),C1-W1(N3,2)+W1(N3,6));BOX(M0*H1,M0*W1);
2395 Z(1)=Z(1)-4
: R1=Z(Z(1)+1)
: C1=Z(Z(1)+2)
: H1=Z(Z(1)+3)
: W1=Z(Z(1)+4)
: RETURN
2400 DEFFN'227(M0,N2,N3,N4,N5)
: IF Z(1)=0THEN Z(1)=1
: Z(Z(1)+1)=R1
: Z(Z(1)+2)=C1
: Z(Z(1)+3)=W1
: Z(1)=Z(1)+3
: PRINT HEX(06);
: R1=VAL(STR(S1$(N2),1,2),2)
: C1=VAL(STR(S1$(N2),3,2),2)
: A1=VAL(STR(S1$(N2),5,2),2)
: S1$=STR(S1$(N2),7,8)
: FOR W1=8TO 1STEP -1
: IF STR(S1$,W1,1)<>" "THEN 2401
: NEXT W1
2401 IF M0=-1THEN S1$=ALL(20)
: IF M0=-1THEN A1=0
: IF W1(N3,1)+N4<=R1AND R1<=W1(N3,1)+N4+W1(N3,3)-1THEN 2402
: GOTO 2450
2402 IF A1<>00THEN 2403
: GOTO 2418
2403 IF A1<>02THEN 2404
: PRINT HEX(020400020E);
: GOTO 2418
2404 IF A1<>04THEN 2405
: PRINT HEX(020400040E);
: GOTO 2418
2405 IF A1<>08THEN 2406
: PRINT HEX(020400080E);
: GOTO 2418
2406 IF A1<>20THEN 2407
: PRINT HEX(020402000E);
: GOTO 2418
2407 IF A1<>22THEN 2408
: PRINT HEX(020402020E);
: GOTO 2418
2408 IF A1<>24THEN 2409
: PRINT HEX(020402040E);
: GOTO 2418
2409 IF A1<>28THEN 2410
: PRINT HEX(020402080E);
: GOTO 2418
2410 IF A1<>40THEN 2411
: PRINT HEX(020404000E);
: GOTO 2418
2411 IF A1<>42THEN 2412
: PRINT HEX(020404020E);
: GOTO 2418
2412 IF A1<>44THEN 2413
: PRINT HEX(020404040E);
: GOTO 2418
2413 IF A1<>48THEN 2418
: PRINT HEX(020404080E);
: GOTO 2418
2418 IF C1<W1(N3,2)+N5AND W1(N3,2)+N5<=C1+W1-1AND C1+W1-1<W1(N3,2)+N5+W1(N3,4)
-1THEN 2419
: IF C1<W1(N3,2)+N5AND W1(N3,2)+N5<=C1+W1-1AND C1+W1-1<W1(N3,2)+N5+W1(N3,4)
-1THEN 2419
: GOTO 2420
2419 PRINT AT(R1-W1(N3,1)-N4+W1(N3,5),W1(N3,6));
: $GIO/005(A000)STR(S1$,(W1(N3,2)+N5-C1+1),((C1+W1-1)-(W1(N3,2)+N5)+1))
: GOTO 2450
2420 IF W1(N3,2)+N5<=C1AND C1<=W1(N3,2)+N5+W1(N3,4)-1AND W1(N3,2)+N5+W1(N3,4)-
1<=C1+W1-1THEN 2425
: GOTO 2430
2425 PRINT AT(R1-W1(N3,1)-N4+W1(N3,5),C1-W1(N3,2)-N5+W1(N3,6));
: $GIO/005(A000)STR(S1$,1,((W1(N3,2)+N5+W1(N3,4)-1)-C1+1))
: GOTO 2450
2430 IF 0<=C1AND C1<=W1(N3,2)+N5AND W1(N3,2)+N5+W1(N3,4)-1<=C1+W1-1THEN 2435
: GOTO 2440
2435 PRINT AT(R1-W1(N3,1)-N4+W1(N3,5),W1(N3,6));
: $GIO/005(A000)STR(S1$,W1(N3,2)+N5-C1+1,W1(N3,4))
: GOTO 2450
2440 IF W1(N3,2)+N5<=C1AND C1+W1-1<W1(N3,2)+N5+W1(N3,4)-1THEN 2445
: GOTO 2450
2445 PRINT AT(R1-W1(N3,1)-N4+W1(N3,5),C1-W1(N3,2)-N5+W1(N3,6));
: $GIO/005(A000)STR(S1$,1,W1)
2450 PRINT HEX(020402000F);
: Z(1)=Z(1)-3
: R1=Z(Z(1)+1)
: C1=Z(Z(1)+2)
: W1=Z(Z(1)+3)
: RETURN
3000 %
9999 % SCRATCH T "PKVSCREN": SAVE T()"PKVSCREN"