プログラムは移植しましたが、私自身これがどういったものなのか理解していないため、 結果が正しいかどうかは不明です。
progloaderで「8QUEEN」をダウンロードすると、
8QUEEN.bas
が追加されます。

このプログラムのオリジナルはここにあったMZ-80/1200用ですが、元ネタはWikipediaにもある通り、別のところにあります。
// ライフゲーム // Oh!X 1988-6 // // 宣言 //WORK $9888; (≪ for MZ-88/1268 ≫) CONST XX=40-1, YY=25-1, X =XX-1, Y =YY-1; ARRAY BYTE A[YY][XX], BYTE B[YY][XX]; VAR GEN; // // メイン処理 // MAIN() BEGIN WIDTH(48); intset(); // 初期画面SET PRINT("\C"); // 画面を消す FOR GEN=0 TO 100 [ HYOUJ(); // 画面表示 COPY(); // 配列コピー KOUTAI(); // 世代交代 KEY(); // キー入力 ] END; // // 画面表示 // HYOUJ() VAR I,J; BEGIN LOCATE(0,0); PRINT("GEN:",DECI$(GEN)); FOR I=1 TO Y [ LOCATE(1,I); FOR J=1 TO X [ IF A[I][J]==FALSE [ PRINT(" "); ] ELSE [ PRINT("*"); ] ] ] END; // // 配列コピー // COPY() VAR I,J; BEGIN FOR I=1 TO Y [ FOR J=1 TO X [ B[I][J]=A[I][J]; ] ] END; // // 世代交代 // KOUTAI() VAR I,J; BEGIN FOR I=1 TO Y [ FOR J=1 TO X [ CASE JOUTAI(I,J) [ 0,1 : A[I][J]=FALSE; 2 : [] 3 : A[I][J]=TRUE; OTHERS: A[I][J]=FALSE; ] ] ] END; // // 状態 // JOUTAI(I,J) BEGIN END( B[I-1][J-1]+B[I-1][J]+B[I-1][J+1] +B[I ][J-1] +B[I ][J+1] +B[I+1][J-1]+B[I+1][J]+B[I+1][J+1] ) ; // // 初期画面SET // INTSET() VAR I,J,KEY; CONST MSG= [ "START-[CR] RESET-[SPC] SET-[S]",0 ]; BEGIN PRINT( "\C" ); LOCATE( 8, 8); PRINT( MSX$(MSG) ); LOCATE(16,13); WHILE TRUE [ CASE (KEY=INKEY(1)) [ $1B: STOP() $0D: EXIT; $21 TO $FF: PRINT("*"); OTHERS: PRINT(CHR$(KEY)); ] 1 FOR I=0 TO YY [ FOR J=0 TO XX [ A[I][J]=FALSE; ] ] FOR I=1 TO Y [ FOR J=1 TO X [ IF SCREEN(J,I)=='*' [ A[I][J]=TRUE; ] ] ] END; // // キー入力 // KEY() BEGIN WHILE TRUE [ CASE INKEY(0) [ // $00 : EXIT; $1B : STOP(); : [ BEEP(); WHILE INKEY(1)==' ' [] ] OTHERS: EXIT; ] ] END; // //END
; TICBAN ; FOR Tiny Tiny Compiler ; PROGRAMED BY J.YAMADA ; Oh!X 1989-7 .R=0 WIDCH 40 7 'C' LOCATE 28,2 "* TICBAN *" LOCATE 28,20 "FOR TTC" LOCATE 28,22 "BY J.YAMADA" .S=0 .C=0 .M=1 GOSUB 880 10 LOCATE 27,17 "PUSH ANY KEY!" LOCATE 27,17 " " .A=(G IF A=0,10 IF A<'0,1 IF A>'9,1 .A=A-$30 .R=A GOSUB 880 ; MAIN ROUTINE 1 REPEAT .W=5 REPEAT GOSUB 870 .A=(G IF A=$1B,9 GOSUB 994 DEC W UNTIL W=0 GOSUB 500 IF A=0,6 GOSUB 880 6 IF F#8,5 GOSUB 700 ;ROUND CLEAR 5 UNTIL M=0 ; GAME OVER LOCATE 6,13 " * GAME OVER * " LOCATE 28,14 "RETRY(Y/N)?" 8 .A=(F IF A=' ,7 IF A='Y,7 IF A#'N,8 CHR A 9 RETURN ; BALL MAIN ROUTINE ; BALL MOVE 500 LOCATE N,O CHR $7B .H=N .I=O IF P=1,501 IF P=2,502 IF P=3,503 IF P=4,504 499 .N=H .O=I LOCATE N,I CHR 'O .C=C+1 ADC S GOSUB 803 .A=0 RETURN ; UP MOVE 501 GOSUB 505 IF A=0,499 ;UP CHECK GOSUB 506 .P=2 IF A=0,499 ;RIGHT CHECK GOSUB 507 .P=4 IF A=0,499 ;LEFT CHECK GOTO 510 ;MISS !! ; RIGHT MOVE 502 GOSUB 506 IF A=0,499 GOSUB 508 .P=3 IF A=0,499 GOSUB 505 .P=1 IF A=0,499 GOTO 510 ; DOWN MOVE 503 GOSUB 508 IF A=0,499 GOSUB 506 .P=2 IF A=0,499 GOSUB 507 .P=4 IF A=0,499 GOTO 510 ; LEFT MOVE 504 GOSUB 507 IF A=0,499 GOSUB 508 .P=3 IF A=0,499 GOSUB 505 .P=1 IF A=0,499 GOTO 510 ; MISS !! 510 LOCATE N,O CHR '* DEC M LOCATE 8,11 " MISS ! " BELL 1 GOSUB 804 511 IF M=0,512 IF (G#' ,511 .A=$50 RETURN 512 .A=0 RETURN ; UP CHECK 505 .I=I-1 GOTO 509 ; RIGHT CHECK 506 .H=H+1 GOTO 509 ; LEFT CHECK 507 .H=H-1 GOTO 509 ; DOWN CHECK 508 .I=I+1 509 GOSUB 550 GOSUB 560 RETURN ; SCRN CALL $9FF8 550 LOCATE H,I .A=$9F .B=$F8 CALL A,B GETA D RETURN ; CHR CHECK 560 IF D=$7B,561 IF D='-,562 IF D='I,562 IF D=' ,562 IF D='+,562 IF G#D,563 BELL 1 INC F GOSUB 600 .A=G-$30*10 .C=C+A ADC S GOSUB 803 563 .G=D 561 .A=0 RETURN 562 .A=$F0 .H=N .I=O RETURN ; GATE SUB 600 IF G='1,601 IF G='2,602 IF G='3,603 IF G='4,604 IF G='5,605 IF G='6,606 IF G='7,607 IF G='8,608 RETURN 601 .A=6 .B=0 GOTO 609 602 .A=18 .B=0 GOTO 609 603 .A=24 .B=6 GOTO 609 604 .A=24 .B=15 GOTO 609 605 .A=18 .B=21 GOTO 609 606 .A=6 .B=21 GOTO 609 607 .A=0 .B=15 GOTO 609 608 .A=0 .B=6 609 LOCATE A,B .Z=1 GOSUB 1011 RETURN ; ROUND CLEAR 700 LOCATE 6,10 " ROUND CLEAR! " BELL 1 INC R IF R#11,701 .R=0 701 IF (G#' ,701 GOSUB 880 RETURN ; BLOCK MAIN ROUTINE 870 .A=(G IF A=0,878 IF A='J,874 IF A='L,873 IF A='M,876 IF A='I,875 878 RETURN ; RIGHT MOVE 6 873 IF X=3,810 .L=X .X=X-3 GOSUB 888 .T=A LOCATE L,Y .Z=A GOSUB 1011 .U=3 .V=0 GOTO 872 ; LEFT MOVE 4 874 IF X=21,810 .L=X .X=X+3 GOSUB 888 .T=A LOCATE L,Y .Z=A GOSUB 1011 .U=253 .V=0 872 .K=X .X=L GOSUB 889 .X=K GOTO 877 ; UP MOVE 8 875 IF Y=18,810 .L=Y .Y=Y+3 GOSUB 888 .T=A LOCATE X,L .Z=A GOSUB 1011 .U=0 .V=253 GOTO 871 ; DOWN MOVE 2 876 IF Y=3,810 .L=Y .Y=Y-3 GOSUB 888 .T=A LOCATE X,L .Z=A GOSUB 1011 .U=0 .V=3 871 .K=Y .Y=L GOSUB 889 .Y=K 877 IF N-X>2,879 IF O-Y>2,879 .N=N+U .O=O+V LOCATE N,O CHR 'O 879 .T=0 GOSUB 889 .Z=0 GOSUB 1000 810 RETURN ; MEN DATA TO KVRAM DATA TENSOU 802 GOSUB 995 .A=$9F .B=00 WIND2 A,B .K=0 REPEAT .]=[ .E=E+1 ADC D WIND1 D,E .B=B+1 ADC A WIND2 A,B INC K UNTIL K=42 RETURN ; SHOKIKA 880 GOSUB 802 GOSUB 990 GOSUB 997 GOSUB 800 .X=12 .Y=9 .Z=0 GOSUB 1000 GOSUB 1015 .T=0 GOSUB 889 .N=4 .O=4 LOCATE N,O CHR 'O .P=2 GOSUB 803 GOSUB 804 .G=0 .F=0 RETURN ; ROUND PRINT 800 LOCATE 28,12 "ROUND" PRT1 R RETURN ; SCORE PRINT 803 LOCATE 28,7 "SCORE " PRT2 S,C RETURN ; BALL PRINT 804 LOCATE 28,9 "BALL " PRT1 M RETURN ; BLOCK NO. ADDRESS 886 .D=$9F .E=00 .A=X-3/3 .E=E+A ADC D IF Y=3,887 .B=Y-3/3 REPEAT .E=E+7 ADC D DEC B UNTIL B=0 887 WIND1 D,E RETURN ; BLOCK NO. READ 888 GOSUB 886 .A=[ RETURN ; BLOCK NO. WRITE 889 GOSUB 886 .[=T RETRUN ; WAKU PRINT 990 .X=0 .Y=0 GOSUB 991 GOSUB 991 .Z=1 GOSUB 1000 .Y=Y+3 GOSUB 992 GOSUB 992 .X=0 GOSUB 993 GOSUB 993 .Z=1 GOSUB 1000 RETURN 991 .Z=1 GOSUB 1000 .X=X+3 .Z=8 GOSUB 1000 .X=X+3 .Z=3 GOSUB 1000 .X=X+3 .Z=7 GOSUB 1000 .X=X+3 RETURN 992 .X=0 .Z=8 GOSUB 1000 .X=X+24 .Z=7 GOSUB 1000 .Y=Y+3 .X=0 .Z=2 GOSUB 1000 .X=X+24 GOSUB 1000 .Y=Y+3 .X=0 .Z=5 GOSUB 1000 .X=X+24 .Z=6 GOSUB 1000 .Y=Y+3 RETURN 993 .Z=1 GOSUB 1000 .X=X+3 .Z=5 GOSUB 1000 .X=X+3 .Z=3 GOSUB 1000 .X=X+3 .Z=6 GOSUB 1000 .X=X+3 RETURN ; WAIT 994 .A=15 REPEAT .B=0 REPEAT INC B UNTIL B=0 DEC A UNTIL A=0 RETURN ; MEN ADDRESS MEN DATA $A000 995 .D=$A0 .E=00 .A=R IF A#0,996 WIND1 D,E RETURN 996 REPEAT .E=E+42 ADC D DEC A UNTIL A=0 WIND1 D,E RETURN ; MEN PRINT KVRAM AREA $9F00 997 .D=$9F .E=00 WIND1 D,E .G=3 REPEAT .H=3 REPEAT .Z=[ .E=E+1 ADC D WIND1 D,E LOCATE H,G GOSUB 1011 .H=H+3 UNTIL H=24 .G=G+3 UNTIL G=21 RETURN ; BLOCK PRINT ROUTINE 1000 LOCATE X,Y 1011 IF Z=0,1001 IF Z=1,1002 IF Z=2,1003 IF Z=3,1004 IF Z=4,1005 IF Z=5,1006 IF Z=6,1007 IF Z=7,1008 IF Z=8,1009 RETURN 1001 " " 'DLLL' " " 'DLLL' " " RETURN 1002 "+-+" 'DLLL' "I+I" 'DLLL' "+-+" RETURN 1003 "+" CHR $7B "+" 'DLLL' "I" CHR $7B "I" 'DLLL' "+" CHR $7B "+" RETURN 1004 "+-+" 'DLLL' CHR $7B CHR $7B CHR $7B 'DLLL' "+-+" RETURN 1005 "+" CHR $7B "+" 'DLLL' CHR $7B CHR $7B CHR $7B 'DLLL' "+" CHR $7B "+" RETURN 1006 "+" CHR $7B "+" 'DLLL' "I" CHR $7B CHR $7B 'DLLL' "+-+" RETURN 1007 "+" CHR $7B "+" 'DLLL' CHR $7B CHR $7B "I" 'DLLL' "+-+" RETURN 1008 "+-+" 'DLLL' CHR $7B CHR $7B "I" 'DLLL' "+" CHR $7B "+" RETURN 1009 "+-+" 'DLLL' "I" CHR $7B CHR $7B 'DLLL' "+" CHR $7B "+" RETURN ; GATE NO. PRINT 1015 .A=4 .B=2 .K='1 GOSUB 1016 .A=A+6 .K='2 GOSUB 1016 .A=4 .B=21 .K='6 GOSUB 1016 .A=A+6 .K='5 GOSUB 1016 .A=24 .B=4 .K='3 GOSUB 1017 .B=B+3 .K='4 GOSUB 1017 .A=2 .B=4 .K='8 GOSUB 1017 .B=B+3 .K='7 GOSUB 1017 RETURN 1016 LOCATE A,B CHR K .A=A+6 LOCATE A,B CHR K RETURN 1017 LOCATE A,B CHR K .B=B+6 LOCATE A,B CHR K RETURN END
文字 | length | UTF8 | UTF16 |
♣ | 1 | E2 99 A3 | 26 63 |
▒ | 1 | E2 96 92 | 25 92 |
🐓 | 2 | F0 9F 90 93 | D8 3D DC 13 |
🍅 | 2 | F0 9F 8D 85 | D8 3C DF 45 |
fractalGraphics.bas |
TREE.bas |
1000 'program Fractal graphics 1005 ' for MZ-2500 BASIC-M25 ; 4096色パレット版 1010 INIT "CRT2:640,400,16":CLS 3 1020 ' 1030 DEFINT I-K,P,X-Z 1040 DIM X(2200),Y(2200),Z(2200),C$(9) 1050 DEF FNMAXIM(N) = N* ( N+1 )/2 1060 DEF FNMIN(N)=FNMAXIM(N-1)+1 1070 FOR I=1 to 14:COLOR=(I,I+1,I+1,I+1):NEXT 1080 ' 1090 ' 1100 PAL=15 'How many colors ? 1110 LX=.57735027:LY=.57735027:LZ=-.57735027 1120 ' 1130 X(1)=320 :Y(1)=30 :Z(1)=0 1140 X(2)=50 :Y(2)=350 :Z(2)=300 1150 X(3)=590 :Y(3)=350 :Z(3)=300 1160 ' 1170 NDIM=2:GOSUB 1700 '*LDRAW 1180 ' *MAIN 1190 FOR LEVEL=1 TO 6 1200 NDIM=NDIM*2-1:GOSUB 1290 '*CALC 1210 CLS 2 1220 LOCATE 0,2 :PRINT "level";LEVEL 1230 GOSUB 1700 '*LDRAW 1240 NEXT 1250 GOSUB 1800 '*PAINT 1260 END 1270 ' 1280 ' 1290 '*CALC 'calculate 1300 FOR I=NDIM TO 3 STEP -2 1310 FOR K=FNMIN(I) TO FNMAXIM(I) STEP 2 1320 PT1=FNMIN((I+1)/2) :PT2=FNMIN(I) 1330 X(K)=X(PT1+(K-PT2)/2) 1340 Y(K)=Y(PT1+(K-PT2)/2) 1350 Z(K)=Z(PT1+(K-PT2)/2) 1360 NEXT K 1370 FOR K=FNMIN(I)+1 TO FNMAXIM(I)-1 STEP 2 1380 X1=X(K-1) :X2=X(K+1) 1390 Y1=Y(K-1) :Y2=Y(K+1) 1400 Z1=Z(K-1) :Z2=Z(K+1) 1410 GOSUB 1610 '*FRAC_FUNC 1420 X(K)=X:Y(K)=Y:Z(K)=Z 1430 NEXT K 1440 NEXT I 1450 FOR I=NDIM-1 TO 2 STEP -2 1460 FOR K=FNMIN(I) TO FNMAXIM(I)-1 1470 X1=X(K+I) :X2=X(K-I+1) 1480 Y1=Y(K+I) :Y2=Y(K-I+1) 1490 Z1=Z(K+I) :Z2=Z(K-I+1) 1500 GOSUB 1610 '*FRAC_FUNC 1510 X(K)=X :Y(K)=Y :Z(K)=Z 1520 NEXT K 1530 X1=X(K+I+1) :X2=X(K-I) 1540 Y1=Y(K+I+1) :Y2=Y(K-I) 1550 Z1=Z(K+I+1) :Z2=Z(K-I) 1560 GOSUB 1610 '*FHAC_FUNC 1570 PT1=FNMAXIM(I):X(PT1)=X:Y(PT1)=Y:Z(PT1)=Z 1580 NEXT I 1590 RETURN 1600 ' 1610 '*FRAC_FUNC ' X,Y < X1.Y1-X2,Y2 1620 DX=ABS(X1-X2) 1630 DY=ABS(Y1-Y2) 1640 DZ=ABS(Z1-Z2) 1650 X=(X1+X2)/2+DX*.3*(RND-.5) 1660 Y=(Y1+Y2)/2+DY*.7*(RND-.5) 1670 Z=(Z1+Z2)/2+DZ*.4*(RND-.5) 1680 RETURN 1690 ' 1700 ' *LDRAW LINE DRAW 1710 FOR I=1 TO NDIM-1 1720 FOR K=FNMIN(I) TO FNMAXIM(I) 1730 LINE (X(K) ,Y(K)) -(X(K+I) ,Y(K+I )) 1740 LINE (X(K) ,Y(K)) -(X(K+I+1),Y(K+I+1)) 1750 LINE (X(K+I),Y(K+I))-(X(K+1+I),Y(K+1+I)) 1760 NEXT K 1770 NEXT I 1780 RETURN 1790 ' 1800 ' PAINT 1810 FOR I=1 TO NDIM-1 1820 FOR K=FNMIN(I) TO FNMAXIM(I) 1830 X1=X(K) :Y1=Y(K) :Z1=Z(K) :X2=X(K+I):Y2=Y(K+I):Z2=Z(K+I) 1835 X3=X(K+I+1):Y3=Y(K+I+1):Z3=Z(K+I+1) 1840 GOSUB 1920 1850 IF K=FNMAXIM(I) THEN 1880 'next 1860 X1=X(K) :Y1=Y(K) :Z1=Z(K) :X2=X(K+I+1) :Y2=Y(K+I+1) :Z2=Z(K+I+1) 1865 X3=X(K+1):Y3=Y(K+1):Z3=Z(K+1) 1870 GOSUB 1920 1880 NEXT K 1890 NEXT I 1900 RETURN 1910 ' 1920 '*TRIANGLE 1930 X=(X1+X2+X3)/3:Y=(Y1+Y2+Y3)/3:Z=(Z1+Z2+Z3)/3 1940 S = ABS(X1*(Y2-Y3)+X2*(Y3-Y1)+X3*(Y1-Y2))/2:IF S<3 THEN 2060 1950 LINE (X1,Y1)-(X2,Y2),15 1960 LINE (X2,Y2)-(X3,Y3),15 1970 LINE (X3,Y3)-(X1,Y1),15 1980 ' brightness calc. 1990 DAX=X2-X1:DAY=Y2-Y1:DAZ=Z2-Z1:DBX=X3-X1:DBY=Y3-Y1:DBZ=Z3-Z1 2000 VX=DAY*DBZ-DAZ*DBY:VY=DAZ*DBX-DAX*DBZ:VZ=DAX*DBY-DAY*DBX 2010 VNRM=SQR(VX*VX+VY*VY+VZ*VZ):NX!=VX/VNRM:NY!=VY/VNRM:NZ!=VZ/VNRM 2020 BR=LX*NX+LY*NY+LZ*NZ:COL=INT(BR*PAL) 2030 IF COL<0 THEN COL=0 ELSE IF COL>PAL-1 THEN COL=PAL-1 2040 PAINT (X,Y),15,15 2050 PAINT (X,Y),COL,NOT 15:'時々ここでNO MEMORYエラーが出るが、その時は図形が複雑すぎるということで、re-runして 2060 RETURN 2990' 3000 ' *DEF_pattern 3010 RESTORE 3100 3020 FOR I=0 TO 8 3030 FOR K=1 TO 6 3040 READ D$ 3050 C$(I)=C$(I)+CHR$(VAL("&H"+D$) ) 3060 NEXT K 3070 NEXT I 3080 RETURN 3090 ' Tile Pattern Data 3100 DATA 00,00,00,00,00,00 3110 DATA 88,00,00,22,00,22 3120 DATA AA,00,00,55,00,55 3130 DATA 88,00,88,22,00,22 3140 DATA AA,00,AA,55,00,55 3150 DATA 77,00,77,DD,00,DD 3160 DATA FF,AA,FF,FF,55,FF 3170 DATA FF,77,FF,FF,DD,FF 3180 DATA FF,FF,FF,FF,FF,FF