画面を緑色(2)の四角で埋め尽くす 1020 ECHR 1,1,0; // 左上に一つだけ穴をあける(キャラクタ番号#0をおく) 1030 FOR I=0,1000000 1040 X=(RAND%23)*2+1 1050 Y=(RAND%15)*2+1 1060 GETCHR X,Y,C 1070 IF C==0 THEN 1080 DOLOOP; // (X,Y)から掘り進める. 1090 D0=0; D1=0; D2=0; D3=0 1100 IF X<45 THEN GETCHR X+1,Y,C; GETCHR X+2,Y,CC; D0=C*CC; FI 1110 IF X> 1 THEN GETCHR X-1,Y,C; GETCHR X-2,Y,CC; D1=C*CC; FI 1120 IF Y<29 THEN GETCHR X,Y+1,C; GETCHR X,Y+2,CC; D2=C*CC; FI 1130 IF Y> 1 THEN GETCHR X,Y-1,C; GETCHR X,Y-2,CC; D3=C*CC; FI 1140 D=D0+D1+D2+D3 1150 IF D==0 GOTO SKIP; // もう掘り進められない 1160 DD=RAND%D 1170 IF D0!=0 THEN IF DD==0 THEN ECHR X+1,Y,0; X=X+2; FI; DD=DD-1; FI 1180 IF D1!=0 THEN IF DD==0 THEN ECHR X-1,Y,0; X=X-2; FI; DD=DD-1; FI 1190 IF D2!=0 THEN IF DD==0 THEN ECHR X,Y+1,0; Y=Y+2; FI; DD=DD-1; FI 1200 IF D3!=0 THEN IF DD==0 THEN ECHR X,Y-1,0; Y=Y-2; FI; DD=DD-1; FI 1210 ECHR X,Y,0 1220 ENDDO 1230 SKIP: 1240 FI 1250 NEXT
CONST INT NEW A:[61] 1010 ARY STATIC CONST INT A:[0...]="Jan13Feb40Mar33Apr62May13Jun42Jul63Aug23Sep52Oct03Nov32Dec53" 1020 Y=2020; M=0; M1=0; GETARG Y, M; IF M<1 THEN M=1; M1=12; FI 1030 M=(M-1)*5; A9=0; IF Y%400==0 THEN A9=1; FI 1040 IF Y%4==0 THEN IF Y%100!=0 THEN A9=1; FI; FI 1050 DOLOOP 1060 PRINTF "¥n %c%c%c %4d¥n¥n",A:[M],A:[M+1],A:[M+2],Y 1070 PRINTF "Sun Mon Tue Wed Thu Fri Sat¥n" 1080 W=Y; IF M<=5 THEN W=Y-1; FI 1090 W0=W/4; W1=W/100; W2=W/400; W3=A:[M+3]&7 1100 W=(W+W0-W1+W2+W3)%7 1110 IF W>0 THEN FOR D=1,W; PRINTF " "; NEXT; FI 1120 D1=A:[M+4]&7; IF M==5 THEN D1=A9; FI; D1=D1+28 1130 FOR D=1,D1 1140 PRINTF " %2d ",D 1150 W=(W+1)%7 1160 IF W==0 THEN PRINTF "¥n"; FI 1170 NEXT 1180 IF W>0 THEN PRINTF "¥n"; FI 1190 M=M+5 1200 ENDDO M1*5>M 1076バイト 1588バイト