プログラムは移植しましたが、私自身これがどういったものなのか理解していないため、 結果が正しいかどうかは不明です。
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
で閉じると、ダウンロードしたプログラムがプログラムリストで選択出来るようになります。