10 ' SAVE"BALL4.BAS",A 'QQBAS ボール反射プログラム改良・3次元風味(笑)・Zバッファ付き
20 CLEAR SYSTEM:PALETTE CLEAR:DEFSNG A-Z
30 SIZX=80:SIZY=24
40 WIDTH SIZX,SIZY:SCREEN 3,5:CLS 3
50 DIM PT%(25,((51+1)*(51+1))\4)
60 '
70 FOR J=0 TO 25
80 PALETTE J+100,(J*10+5,J*10+5,J*10+5)
90 NEXT J
100 PALETTE 0,(64,0,96)
110 '
120 FOR K=0 TO 25:CLS 2
130 FOR J=K TO 25
140 CIRCLE(25,25),25-J,(J-K)+100:PAINT(25,25),(J-K)+100,(J-K)+100
150 NEXT J
160 GET @3,(0,0)-STEP(51,51),PT%(K,0)
170 NEXT K
180 '
190 N=128
200 DIM X(N-1),Y(N-1),Z(N-1),SX(N-1),SY(N-1),SZ(N-1)
210 FOR J=0 TO N-1
220 X(J)=RND(SIZX*8):Y(J)=RND(SIZY*16):Z(J)=RND(25+1)
230 SX(J)=(RND*1.5)+0.25:SY(J)=(RND*1.5)+0.25:SZ(J)=(RND/10)+0.1
240 NEXT J
250 '
260 INTERVAL ON,(1000\60):ON INTERVAL GOSUB 570
270 '
280 IF TSYNC=0 THEN 280
290 TSYNC=0
300 LINE(0,0)-(SIZX*8-1,SIZY*16-1),0,BF 'CLS 3
310 FOR J=0 TO N-1
320 X(J)=X(J)+SX(J):Y(J)=Y(J)+SY(J):Z(J)=Z(J)+SZ(J)
330 IF X(J)< 0 THEN X(J)= 0:SX(J)= ABS(SX(J))
340 IF X(J)> (SIZX*8)-50 THEN X(J)= (SIZX*8)-50:SX(J)=-ABS(SX(J))
350 IF Y(J)< 0 THEN Y(J)= 0:SY(J)= ABS(SY(J))
360 IF Y(J)>(SIZY*16)-50 THEN Y(J)=(SIZY*16)-50:SY(J)=-ABS(SY(J))
370 IF Z(J)< 1 THEN Z(J)= 1:SZ(J)= ABS(SZ(J))
380 IF Z(J)> 25 THEN Z(J)= 25:SZ(J)=-ABS(SZ(J))
390 NEXT J
400 '
410 ZF=0
420 FOR J=0 TO (N-1)-1
430 IF Z(J)=>Z(J+1) THEN 480 'SKIP
440 SWAP X(J), X(J+1):SWAP Y(J), Y(J+1):SWAP Z(J), Z(J+1)
450 SWAP SX(J),SX(J+1):SWAP SY(J),SY(J+1):SWAP SZ(J),SZ(J+1)
460 ZF=1
470 'SKIP
480 NEXT J
490 IF ZF=1 THEN 410
500 '
510 FOR J=0 TO N-1
520 PUT@(X(J)/(((Z(J)/25)+1))+(25.6*Z(J))/4,Y(J)/(((Z(J)/25)+1))+(16*Z(J))/4),PT%(Z(J),0)
530 NEXT J
540 SCREEN
550 GOTO 280
560 '
570 INTERVAL OFF:TSYNC=1:INTERVAL ON:RETURN