OXYGENHUB
◆ main openmsx / Contrib / reverse_engineering_tools / kanji / ktst31a.asc
7.0 KiB · last changed chore(): initial commit 1 month ago source blame history raw
e8555c89 Andy McCall 1 
1000 DEFINT A-Z:A=0:B=2:ON ERROR GOTO 1010:GOTO 1020
2 
1010 RESUME NEXT
3 
1020 _BC
4 
1030 _TURBO ON
5 
1040 B=1
6 
1050 '#I &HAF,&H32,B
7 
1060 _TURBO OFF
8 
1070 ON ERROR GOTO 0:IF FRE(0)<16384 THEN B=0:PRINT" Low RAM";
9 
1080 A=0:IF B<>2 THEN GOSUB 1110:GOTO 2100
10 
1090 PRINT" _TURBO";
11 
1100 _TURBO ON(A,B)
12 
1110 DIM L(7),K(7),T(7):BEEP:SCREEN 2:COLOR 15,1,1:CLS:F=0:E=&H2000:'F=(VDP(4)AND&HFC)*&H2000:E=((VDP(3)\128)+(VDP(10)*2))*&H2000
13 
1120 T$="Kanji I/O Tests":V$="v3.1":N$=" Please share screen pic+model"+CHR$(&H16)+"press a key ":Q=7:W=0:C=PEEK(&H4)+&H100*PEEK(&H5)
14 
1130 Z=0:D=0:Y=0:S$=" "+T$+" 1/9: Kanji Detection "+V$+" ":W=&HFF:GOSUB 1840:W=0:D=0
15 
1140 ' 6x8 / 8x8 BIOS
16 
1150 FOR Y=1 TO 2:S$="":IF Y=1 THEN RESTORE 1900:ELSE RESTORE 1930
17 
1160 READ K$:IF K$="" THEN GOTO 1170:ELSE K$="&H"+K$:S$=S$+CHR$(VAL(K$)):GOTO1160
18 
1170 D=0:GOSUB 1840:D=0:NEXT Y
19 
1180 ' 8x16 / 16x16 Kanji
20 
1190 Z=32:RESTORE 1950
21 
1200 READ K$:IF K$=""THEN GOTO 1290ELSE L=0:K=VAL("&H"+K$):IF K<&H100 THEN GOTO 1250:ELSE GOSUB 1780
22 
1210 IF Z MOD 32=31 THEN Z=Z+1
23 
1220 OUT &HD9+2*L,K:OUT &HD8+2*L,T
24 
1230 FOR Y=1+2*(Z\32) TO 2+2*(Z\32):FOR X=Z MOD 32 TO 1+Z MOD 32:FOR J=0 TO 7:G=INP(&HD9+2*L):GOSUB 1850:NEXT J:NEXT X:NEXT Y
25 
1240 Z=Z+2:GOTO 1200
26 
1250 IF K>=&H80 THEN K=K+8*96-&H20
27 
1260 OUT &HD9,(K-&H20)\&H40:OUT &HD8,(K-&H20)MOD&H40
28 
1270 FOR Y=1+2*(Z\32) TO 2+2*(Z\32):FOR X=Z MOD 32 TO 1+Z MOD 32:FOR J=0 TO 7:G=INP(&HD9+2*L):ON 1-(X=(Z MOD 32)) GOSUB 1870,1850:NEXT J:NEXT X:NEXT Y
29 
1280 Z=Z+1:GOTO 1200
30 
1290 ' v1.0
31 
1300 OUT &HD9,&H2:OUT &HD8,&H3C:OUT &HDB,&H2:OUT &HDA,&H3A
32 
1310 FOR L=1 TO 0 STEP -1:FOR Y=1+2*(Z\32) TO 2+2*(Z\32):FOR X=2*L+Z MOD 32 TO 2*L+1+Z MOD 32:FOR J=0 TO 7:G=INP(&HD9+2*L):GOSUB 1850:NEXT J:NEXT X:NEXT Y:NEXT L
33 
1320 Z=Z+4
34 
1330 GOSUB 1800:IF A=1 THEN GOTO 1750
35 
1340 CLS:Z=0:D=0:Y=0:S$=" "+T$+" 2/9: Interleaving A  "+V$+" ":W=&HFF:GOSUB 1840:W=0:Z=0:D=0
36 
1350 RESTORE 2040:FOR N=0 TO 7:READ K$:L=0:K=VAL("&H"+K$):GOSUB 1780:L(N)=L:K(N)=K:T(N)=T:NEXT N
37 
1360 FOR N=2 TO 7:IF L(0)<>0 OR L(N)<>L(N-2)OR L(N)=L(N-1)OR((K(N)<>K(N-2))AND(T(N)<>T(N-2)))THEN SCREEN 0:PRINT"Data does not conform":A=1:GOTO 1750:ELSE NEXT N
38 
1370 'plan 1/2/3/4
39 
1380 FOR R=0 TO 1:GOSUB 1890
40 
1390 FOR L=0 TO 1:FOR N=0 TO 7:K=K(N):T=T(N):IF L(N)<>L THEN GOTO 1440
41 
1400 IF (R MOD 2=1) AND (N<2 OR T((8+N-2)MOD 8)<>T) THEN OUT &HD8+2*L,T
42 
1410 IF N<2 OR K((8+N-2)MOD 8)<>K THEN OUT &HD9+2*L,K
43 
1420 IF (R MOD 2=0) AND (N<2 OR T((8+N-2)MOD 8)<>T) THEN OUT &HD8+2*L,T
44 
1430 FOR Y=1+2*((Z+2*N)\32) TO 4+2*((Z+2*N)\32):GOSUB 1770:NEXT Y
45 
1440 NEXT N:NEXT L:Z=Z+16:IF(Z MOD 32)<16 THEN Z=Z+32
46 
1450 NEXT R
47 
1460 'plan 5/6/7/8
48 
1470 FOR R=0 TO 3:GOSUB 1890
49 
1480 FOR N2=0 TO 7 STEP 2:FOR P=0 TO 5:L=(-(((P>=1)AND(P<=2))OR(P=4)))XOR(R MOD 2):N=N2+L:K=K(N):T=T(N)
50 
1490 IF ((R\2)MOD 2=1) AND (P<2 AND (N<2 OR T((8+N-2)MOD 8)<>T)) THEN OUT &HD8+2*L,T
51 
1500 IF P<2 AND (N<2 OR K((8+N-2)MOD 8)<>K) THEN OUT &HD9+2*L,K
52 
1510 IF ((R\2)MOD 2=0) AND (P<2 AND (N<2 OR T((8+N-2)MOD 8)<>T)) THEN OUT &HD8+2*L,T
53 
1520 IF P>=2 THEN FOR Y=1-2*(P>=4)+2*((Z+2*N)\32) TO 2-2*(P>=4)+2*((Z+2*N)\32):GOSUB 1770:NEXT Y
54 
1530 NEXT P:NEXT N2:Z=Z+16:IF(Z MOD 32)<16 THEN Z=Z+32
55 
1540 NEXT R
56 
1550 'plan 9/10/11/12
57 
1560 FOR R=0 TO 3:GOSUB 1890
58 
1570 FOR N2=0 TO 7 STEP 2:FOR P=0 TO 4+2*2*32-1:L=(P MOD 2)XOR(-(P<4))XOR(R MOD 2):N=N2+L:K=K(N):T=T(N)
59 
1580 IF ((R\2)MOD 2=1) AND (P>=2 AND P<4 AND (N<2 OR T((8+N-2)MOD 8)<>T)) THEN OUT &HD8+2*L,T
60 
1590 IF P<2 AND (N<2 OR K((8+N-2)MOD 8)<>K) THEN OUT &HD9+2*L,K
61 
1600 IF ((R\2)MOD 2=0) AND (P>=2 AND P<4 AND (N<2 OR T((8+N-2)MOD 8)<>T)) THEN OUT &HD8+2*L,T
62 
1610 IF P>=4 THEN Y=1+((P-4)\32) MOD 4+2*((Z+2*N)\32):X=((P-4)\16) MOD 2+(Z+2*N) MOD 32:J=((P-4)\2) MOD 8:G=INP(&HD9+2*L):GOSUB 1850
63 
1620 NEXT P:NEXT N2:Z=Z+16:IF(Z MOD 32)<16 THEN Z=Z+32
64 
1630 NEXT R
65 
1640 GOSUB 1800:IF A=1 THEN GOTO 1750
66 
1650 CLS:Z=0:D=0:Y=0:S$=" "+T$+" 3/9: Interleaving B  "+V$+" ":W=&HFF:GOSUB 1840:W=0:Z=0:D=0
67 
1660 'plan 13/14/15/16
68 
1670 FOR R=0 TO 3:GOSUB 1890
69 
1680 FOR N2=0 TO 7 STEP 2:FOR P=0 TO 4+4-1:L=(P MOD 2)XOR(-(P<4))XOR(R MOD 2):N=N2+L:K=K(N):T=T(N)
70 
1690 IF (P<2 AND R<2) OR (P>=2 AND P<4 AND R>=2 AND R<4) AND (N<2 OR K((8+N-2)MOD 8)<>K) THEN OUT &HD9+2*L,K
71 
1700 IF (P<2 AND R>=2 AND R<4) OR (P>=2 AND P<4 AND R<2) AND (N<2 OR T((8+N-2)MOD 8)<>T) THEN OUT &HD8+2*L,T
72 
1710 IF P>=4 THEN FOR Y=1-2*(P>=6)+2*((Z+2*N)\32) TO 2-2*(P>=6)+2*((Z+2*N)\32):GOSUB 1770:NEXT Y
73 
1720 NEXT P:NEXT N2:Z=Z+16:IF(Z MOD 32)<16 THEN Z=Z+32
74 
1730 NEXT R
75 
1740 GOSUB 1800:IF A=1 THEN GOTO 1750
76 
1750 IF A=1 THEN SCREEN 0:PRINT"Abnormal exit"
77 
1760 IF B<>2 THEN RETURN:ELSE GOTO 2090
78 
1770 FOR X=(Z+2*N) MOD 32 TO 1+(Z+2*N) MOD 32:FOR J=0 TO 7:G=INP(&HD9+2*L):GOSUB 1850:NEXT J:NEXT X:RETURN
79 
1780 T=(K MOD &H100)-&H20:K=K\&H100-&H20:IF K>=&H30 THEN K=K-&H30:L=1:ELSE IF K>&H9 AND K<&H30 THEN K=K-&H6:T=T+&H40
80 
1790 K=K*96+T:T=K MOD&H40:K=K\&H40:RETURN
81 
1800 Y=23:S$=N$:W=&HFF:GOSUB 1840:W=0
82 
1810 I$=INKEY$:IF I$=CHR$(&H3) OR I$=CHR$(&H1B) THEN SCREEN 0:A=1:GOTO 1830:ELSE:IF I$<>"" THEN GOTO 1810:ELSE BEEP
83 
1820 I$=INKEY$:IF I$="" THEN GOTO 1820:ELSE IF I$=CHR$(&H3) OR I$=CHR$(&H1B) THEN SCREEN 0:A=1:GOTO 1830
84 
1830 RETURN
85 
1840 D=0:FOR X=0 TO LEN(S$)-1:V=ASC(MID$(S$,1+X,1)):Q=7+2*(V>=&H20 AND V<&H7F):FOR J=0 TO 7:G=PEEK(C+8*V+J):GOSUB 1850:NEXT J:D=D+Q-7:NEXT X:Q=7:RETURN
86 
1850 GG=G XOR W:IF GG=0 THEN RETURN:ELSE XX=8*X+D:IF GG=&HFF THEN YY=8*Y+J:LINE(XX,YY)-(XX+Q,YY),15:RETURN:ELSE IF Q=7 AND D MOD 8=0 THEN GOTO 1880:ELSE M=&H80:YY=8*Y+J:FOR I=0 TO Q:IF (GG\M)MOD 2<>0 THEN PSET(XX+I,YY),15
87 
1860 M=M\2:NEXT I:RETURN
88 
1870 RETURN
89 
1880 O=Y*&H100+XX+J:VPOKE E+O,15*&H10:VPOKE F+O,GG:RETURN
90 
1890 IF ((Z+15)MOD 32)<15 THEN Z=((Z\32)+2)*32:RETURN:ELSE RETURN
91 
1900 DATA 42,49,4F,53,3A,01,02,03,04,05,06,07,08,09,0A,0B,0C,0D,0E,0F,1D,1E,1F
92 
1910 DATA 20,EB,F7,96,DE,E5,20,B6,C0,B6,C5
93 
1920 DATA:'End of DATA
94 
1930 DATA 20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,FF,52,6F,6D,61,6A,69,FF,83,82,81,80
95 
1940 DATA:'End of DATA
96 
1950 DATA 4C,76,31,20,3441,3B7A,2127,376E,3250,3F65,4C5A,3662,455A,467C,472F,315F,3B7E,4A2C,4943,4934,4069,4B7C,4267,4366,3E2E
97 
1960 DATA 20,2452,2469,242C,244A,20,252B,253F,252B,254A,2352,236F,236D,2361,236A,2369,20,B6,C0,B6,C5,20,52,6F,6D,61,6A,69
98 
1970 DATA 2221,217A,2227,2225
99 
1980 DATA 2347,2372,2365,2365,2374,2369,236E,2367,2373,212A,2121,2350,2355,2354,234B,2341,234E,234A,2349
100 
1990 DATA 2148,3441,3B7A,244F,3A47,3962,2447,2439,2123,2149
101 
2000 DATA 297B,297C,297A
102 
2010 DATA 4C,76,32,20,3441,3B7A,2127,5579,5378,5579,5239,5378,524C,5144,7775,776F,7773,7771
103 
2020 DATA 534C,5376,5332,5F21,665A,5127,5121,534D,5349,5353,5344,5352,5341,5357,534E,512A
104 
2030 DATA 4C,76,31,2F,4C,76,32,3A,217C,517A,2121,2121:'v1.0
105 
2040 DATA 2363,5239,236F,5241,264F,5161,264A,5144:'v2.0
106 
2050 DATA 4C,76,32,E3,4C,76,31,3A,517C,217A,2121,2121
107 
2060 DATA 5363,2239,536F,2241,564F,2161,564A,2144
108 
2070 DATA 20,2277,50,72,65,76,69,6F,75,73,20,74,65,73,74,2278,2121,2327,2121,20
109 
2080 DATA:'End of DATA
110 
2090 _TURBO OFF
111 
2100 IF A=0 THEN SCREEN 0:LOCATE 0,23:PRINT"Please wait, loading part B...";:RUN"KTST31B.ASC"
112 
2110 PRINT:PRINT"If you want to run all tests again:":PRINT:PRINT"  RUN "CHR$(&H22)"KTST31.ASC"CHR$(&H22):PRINT
113 
2120 END