100 SCREEN 0
  110 '
  120 ' 背景の描画の準備
  130 '
  140 T = 170: '<-- 地平線の高さ
  150 FOR I=0 TO T:W=(T-I)/T*32:PSET (0,I),RGBADD(RGB(4,4,31),W,W,W):NEXT
  160 FOR I=T+1 TO 223:W=25-(I-T)/(224-T)*25:PSET (0,I),RGBADD(RGB(4,28,4),W,W,W):NEXT
  170 GCOPY (0,0)-(0,223) TO BG$
  180 R=24:                               '<-- 球の半径
  190 OX=0:OY=0:OZ=1:                     '<-- 視線ベクトル
  200 FOR E=0 TO 16:LX=XCOS((E+9)/64):LY=.2:LZ=XSIN((E+9)/64):'<-- 光源のベクトル
  210 LOCATE 0,0:PRINT E;"/16"
  220 '
  230 ' テクスチャ計算
  240 '
  250 FOR Y=-R TO R:FOR X=-R TO R
  260   U=R*R-X*X-Y*Y
  270   IF U<0 THEN *LOOPEND:       '<-- 球の表面かどうかのチェック
  280   Z=-XSQR(U AND! &H1FFFF.FFE):'<-- X,Y,Z:その場所の球の法線ベクトル
  290   ' 
  300   ' ▼ 環境マッピング
  310   N=2*(X*OX+Y*OY+Z*OZ)/(X*X+Y*Y+Z*Z)
  320   UX=OX-2*N*X:UY=OY-2*N*Y:UZ=OZ-2*N*Z:'<-- 球に当たって反射した視線ベクトル 
  330   YY=112+111*UY/XDIST(UX,UY,UZ):      '<-- 視線の先にある背景を貼り付ける
  340   P=POINT(0,YY+K):PR=(P AND 31):PG=(P*&H0.08)AND 31:PB=(P*&H0.004)AND 31
  350   CE = RGBADD(0,PR/2,PG/2,PB/2):      '<-- 明るさを 1/2 にする
  360   '
  370   ' ▼ 光源計算
  380   N=X*LX+Y*LY+Z*LZ
  390   UX=X-2*LX*N:UY=Y-2*LY*N:UZ=Z-2*LZ*N:'<-- 光が球にあたって反射したベクトル
  400   N=OX*UX+OY*UY+OZ*UZ:                '<-- 反射したベクトルと視線ベクトルの内積
  410   IF N<0 THEN CL=0:GOTO *PUTPIXEL
  420   G=XDIST(OX,OY,OZ)*XDIST(UX,UY,UZ)
  430   IF G=0 THEN CC=1 ELSE CC=N/G:'CC: 反射したベクトルと視線ベクトルのなす角のcosθ
  440   IF CC<0 THEN CC=0
  450   CL = 31*(CC^15):'<-- 15 照り具合(^^;
  460   '
  470   ' ▼ 計算結果を出力
  480 *PUTPIXEL
  490   PSET (X+128,Y+96),RGBADD(CE,CL,CL,CL)
  500 *LOOPEND
  510 NEXT X,Y
  520 '
  530 ' 作成した絵をテクスチャにはりつけ
  540 '
  550 GCOPY (128-R,96-R)-(128+R-1,96+R-1) TO I$:I$=RIGHT$(I$,LEN(I$)-4)
  560 SETTEX E,R*2,R*2,32768,I$:SETATR E,1,(0,1,1,E,0,0):NEXT
  570 '
  580 ' 背景描画
  590 '
  600 CLS :FOR I=0 TO 311:GCOPY BG$ TO (I,0):NEXT
  610 Q=1:FOR I=-2 TO 2:FOR J=-2 TO 2
  620 SETPFONT Q,1,(R*2/32,R*2/32,0,0,0,0),,e-1:setatr e-1,1,(0,1,1,e-1,0,0)
  630 OBJ(Q,@XP)=I*128,-R,J*128:Q=Q+1:NEXT J,I
  640 '
  650 ' 似非球の回転
  660 '
  670 *MAIN
  680 A=A+&H0.01:CAMERA (XSIN(A)*500,-10,XCOS(A)*500) TO (0,0,0)
  690 ' VSYNC:GOTO *MAIN:' <= 一番最初の ' を消すと (^^;
  700 XR=-OBJ(0,@XR):YR=-OBJ(0,@YR):ZR=-OBJ(0,@ZR)
  710 FOR I=1 TO 25:OBJ(I,@XR)=XR,YR,ZR:W=INT(-YR*32):OBJ(I,@ATR)=16+W*(W<17):NEXT :VSYNC :GOTO *MAIN