16x16x16のボクセルモデルを作って楽しむプログラムです。You can create 16x16x16 voxel model with this program.
| AX,AY,AZ | 光線追跡時の基準座標 |
| BE | 各種ボタンの状態(押された瞬間) |
| BT | 各種ボタンの状態 |
| BU | 以前の各種ボタンの状態 |
| BX,BY | スライドパッドの状態 |
| C1,C2,C3 | ボクセルレンダリング時の面の明るさ |
| CL%[,,] | ボクセル色情報 |
| CS | 選択されたカラーパレットの番号 |
| CW%[] | グレースケール色情報 |
| CX,CY | 選択されたカラーパレットの位置とか |
| DA | 視点の方位角 |
| DE | 視点の仰角 |
| DX,DY | 各ボクセル描画時の座標 |
| F$[] | ファイル一覧取得用 |
| FC | 現在フォーカス中のファイルの番号 |
| FM | ファイルマネージャーのモード(0:ロード, 1:セーブ) |
| FT | 選択したファイルの番号 |
| GC%[] | ボクセル描画時のカラーパレット |
| GQ%[] | ボクセルの画像データ |
| IS,IE,ID | ビュー描画時のZ方向の開始位置/終了位置/変化量 |
| JS,JE,JD | ビュー描画時のY方向の開始位置/終了位置/変化量 |
| KS,KE,KD | ビュー描画時のX方向の開始位置/終了位置/変化量 |
| LE | レイヤーモードか |
| LP | メインループカウンタ |
| LZ | レイヤーモードでの現在のZ方向位置 |
| M0~M9 | 回転計算用行列値 |
| Q[,,] | ボクセルモデル全体の状態 |
| Q$ | ファイルマネージャーで選択されたファイル名 |
| QA | ボクセルの総個数 |
| QC[,] | X方向に対するボクセルの個数(XY平面に対するボクセルの個数) |
| QD%[] | ファイル読み込み／書き出し用バッファ |
| QJ | タッチの結果、ボクセルを操作するか |
| QP | 操作するボクセルの色 |
| QU%[] | アンドゥ情報 |
| QX,QY,QZ | 操作するボクセルの位置 |
| RM | ビュー描画状態(0:開始, 1:途中, 2:完了) |
| RR | ビューの再描画リクエスト |
| RV | ボクセルがレンダリング済みか |
| T$ | 現在編集中のモデルのファイル名 |
| TF | タッチした際の機能(0:付け足す, 1:削る, 2:回転, 3:色変え) |
| TR | タッチによる回転操作中 |
| TS | タッチ状態 |
| TX,TY | タッチ座標 |
| US | 以前のタッチ状態 |
| UX,UY | 以前のタッチ座標 |
| VX,VY,VZ | 視線方向ベクトル |
' ' TXT:VOXEL_ED Programmed by OBONO ' DIM Q[16,16,16],QC[17,16],QD%[1024],QU%[0] DIM GQ%[400],GC%[16],CW%[9],CL%[12,3,16] DIM F$[0]:GOSUB @IN ' MAIN LOOP @LP STICK OUT BX,BY:TOUCH OUT TS,TX,TY BT=BUTTON():BE=BT AND 4095-BU:TR=TR && TS IF TS && !US THEN E=SPHITRC(TX,TY,1,1) IF E>=0 && E<9 THEN BE=BE OR 1<<E IF TX>=40 && TX<280 && TF==2 THEN TR=1:UX=TX:UY=TY ELSEIF TX>280 && TY>8 && TY<165 THEN CX=(TX-281)DIV 13:CY=(TY-9)DIV 13 BEEP 48,(CX-1)*1200+CY*100 CS=CX+CY*3+1 SPOFS 9,279+CX*13,7+CY*13 ENDIF ENDIF IF !LE && (TR || BX || BY) THEN E=(!HARDWARE*SQR(QA)+16)/256 DA=DA-BX*E-(TX-UX)*TR/96 DE=DE-BY*E+(TY-UY)*TR/96 E=PI()/4:DE=MIN(MAX(DE,-E),E) RV=0:GOSUB @MT:GOSUB @RA ELSE RR=!RV:E=-1 FOR I=0 TO 8 IF BE==POW(2,I) THEN E=I:BREAK NEXT IF E>=0 && E<4 THEN IF TF!=E THEN TF=E:BEEP 28:GOSUB @TF ELSEIF E>3 && E<8 THEN IF RM>1 && !RR THEN ON E-4 GOSUB @QS,@QU,@QR,@QL BT=BT OR 240:TS=1 ENDIF ELSEIF E==8 THEN LE=!LE:BEEP 112:GOSUB @TF:RR=1 ELSE IF TS && (!US || LE) THEN GOSUB @TC ENDIF ON LE GOSUB @RM,@RG ENDIF US=TS:UX=TX:UY=TY:BU=BT:VSYNC:GOTO @LP @TC ' HANDLE TOUCH QJ=0:ON LE GOSUB @TJ,@TN:E=0 IF QJ THEN IF TF==0 THEN QX=QX-SGN(VX)*(QJ==1):E= QX>=0&&QX<16 QY=QY-SGN(VY)*(QJ==2):E=E&&QY>=0&&QY<16 QZ=QZ-SGN(VZ)*(QJ==3):E=E&&QZ>=0&&QZ<16 BEEP 51-E*22 ENDIF IF TF==1 THEN E=(QA>1):BEEP 51+E*44 IF TF==3 THEN E=1:BEEP 27 IF E THEN P=Q[QX,QY,QZ]:QP=CS*(TF!=1) IF P!=QP THEN PUSH QU%,P*4096+QX*256+QY*16+QZ IF LEN(QU%)>64 THEN E=SHIFT(QU%) GOSUB @QP:LZ=QZ:RR=1 ENDIF:ENDIF:ENDIF:RETURN @TJ ' TRACE TOUCHED VOXEL X=TX-160:Y=120-TY:Z=-199:GOSUB @MA S=12:R=6:M=399 FOR I=0 TO 15:E=(I-7.5)*S IF VX THEN T=(E-SGN(VX)*R-AX)/VX:GOSUB @MK Y=FLOOR(Y/S)+8:Z=FLOOR(Z/S)+8 IF M>T&&Y>=0&&Y<16&&Z>=0&&Z<16 THEN IF Q[I,Y,Z] THEN M=T:QX=I:QY=Y:QZ=Z:QJ=1 ENDIF:ENDIF IF VY THEN T=(E-SGN(VY)*R-AY)/VY:GOSUB @MK X=FLOOR(X/S)+8:Z=FLOOR(Z/S)+8 IF M>T&&X>=0&&X<16&&Z>=0&&Z<16 THEN IF Q[X,I,Z] THEN M=T:QX=X:QY=I:QZ=Z:QJ=2 ENDIF:ENDIF IF VZ THEN T=(E-SGN(VZ)*R-AZ)/VZ:GOSUB @MK X=FLOOR(X/S)+8:Y=FLOOR(Y/S)+8 IF M>T&&X>=0&&X<16&&Y>=0&&Y<16 THEN IF Q[X,Y,I] THEN M=T:QX=X:QY=Y:QZ=I:QJ=3 ENDIF:ENDIF NEXT:RETURN @TN ' LAYER MODE QX=FLOOR((TX-80)/12):QY=FLOOR((215-TY)/12) IF QX>=0&&QX<16&&QY>=0&&QY<16 THEN QZ=LZ:P=Q[QX,QY,QZ]:E=TF==0&&P!=CS QJ=(E||TF==1&&P||TF==3&&P&&P!=CS)*4 ELSEIF TX>46&&TX<72&&QY>=0&&QY<16 THEN IF LZ!=QY THEN LZ=QY:BEEP 47,800-LZ*50:RR=1 ENDIF:RETURN @TF ' HIGHLIGHT ICONS FOR I=0 TO 3:SPCOLOR I,CW%[2+(I==TF)*6] NEXT:SPCOLOR 8,CW%[2+LE*6]:RETURN @TT ' DISPLAY TITLE E$=T$+" "*8:FOR I=0 TO 7 BGPUT 0,I,0,ASC(MID$(E$,I,1)) NEXT:RETURN ' DRAW MODEL @RA ' ALL AT ONCE GOSUB @RH:GOSUB @RC FOR I=IS TO IE STEP ID:GOSUB @RL:NEXT GCLIP 1:GOSUB @RF:RETURN @RM ' STEP BY STEP IF RM>1 THEN IF RR THEN RR=0:RM=0 ELSE RETURN E=MAINCNT:IF !RV THEN GOSUB @RV GOSUB @RH:IF !RM THEN GOSUB @RC:RZ=IS-ID REPEAT:RZ=RZ+ID:I=RZ:GOSUB @RL UNTIL RZ==IE || MAINCNT>E+3:GCLIP 1 IF RZ==IE THEN GOSUB @RF RETURN @RG ' GRID VIEW IF RM>1 && !RR THEN RETURN GOSUB @RC:GCOLOR CW%[2] FOR I=0 TO 16 GLINE I*12+39,263,I*12+39,455 GLINE 39,I*12+263,231,I*12+263 NEXT:GBOX 7,263,31,455 GFILL 8,444-LZ*12,30,454-LZ*12:GCOLOR CW%[6] GPUTCHR 12,255,"おく":GPUTCHR 8,457,"てまえ" FOR I=0 TO 15:C=CW%[2+(I==LZ)*6] GPUTCHR 16-(I>9)*4,446-I*12,STR$(I),1,1,C FOR J=0 TO 15:P=Q[J,I,LZ]:IF P THEN X=J*12+40:Y=444-I*12:P=P-1 GFILL X,Y,X+10,Y+10,CL%[P DIV 3,P MOD 3,12] ENDIF:NEXT NEXT:GOSUB @RF:RR=0:RETURN @RH ' MASK CANVAS GCLIP 1,0,240,239,479:RETURN @RC ' CLEAR CANVAS GFILL 0,240,239,479,0 IF !LE && VY<=0 THEN GOSUB @RB:GCOLOR CW%[1] FOR I=-1 TO 1 STEP 2 GTRI DX+T,DY+U,DX-T,DY-U,DX+V*I,DY+W*I NEXT:GLINE DX-T,DY-U,DX-V,DY-W,CW%[2] ENDIF:RM=1:RETURN @RF ' FINALIZE CANVAS IF !LE && VY>0 THEN GOSUB @RB FOR I=-1 TO 1 STEP 2:FOR J=-1 TO 1 STEP 2 C=CW%[1+(I+J<0)] GLINE DX+T*J,DY+U*J,DX+V*I,DY+W*I,C NEXT:NEXT ENDIF:GCOPY 0,240,239,479,40,0,1:RM=2:RETURN @RB ' COORDS OF FOUNDATION X=96:Y=0:Z=96:GOSUB @MD:T=DX:U=-DY X=-96 :GOSUB @MD:V=DX:W=-DY X=0:Y=-96:Z=0:GOSUB @MD:DX=DX+120:DY=360-DY RETURN @RL ' DRAW A LAYER IF !QC[16,I] THEN RETURN FOR J=JS TO JE STEP JD IF !QC[J,I] THEN CONTINUE FOR K=KS TO KE STEP KD P=Q[K,J,I]:IF !P THEN CONTINUE F=I!=IE && J!=JE && K!=KE F=F&&Q[K,J,I+ID]&&Q[K,J+JD,I]&&Q[K+KD,J,I] IF F THEN CONTINUE S=12:X=(K-7.5)*S:Y=(J-7.5)*S:Z=(I-7.5)*S GOSUB @MD:DX=DX+120:DY=360-DY P=P-1:CX=P MOD 3:CY=P DIV 3 IF RV THEN CX=260+CX*20:CY=240+CY*20 GCOPY CX,CY,CX+19,CY+19,DX-10,DY-10,0 ELSE GFILL DX-1,DY-1,DX+1,DY+1,CL%[CY,CX,12] ENDIF NEXT:NEXT:RETURN @RV ' RENDER A VOXEL C1=MIN(15,ABS(VX*18)+4) C2=MIN(15,ABS(VY*18)+4) C3=MIN(15,ABS(VZ*18)+4):R=6.25 FOR I=0 TO 19:FOR J=0 TO 19 X=J-9.5:Y=9.5-I:Z=-R*2:GOSUB @MA:C=0:M=99 IF VX THEN T=(-SGN(VX)*R-AX)/VX:GOSUB @MK U=MAX(ABS(Y),ABS(Z))/R IF U<1 && M>T THEN M=T:C=C1-U*U*3 ENDIF IF VY THEN T=(-SGN(VY)*R-AY)/VY:GOSUB @MK U=MAX(ABS(X),ABS(Z))/R IF U<1 && M>T THEN M=T:C=C2-U*U*3 ENDIF IF VZ THEN T=(-SGN(VZ)*R-AZ)/VZ:GOSUB @MK U=MAX(ABS(X),ABS(Y))/R IF U<1 && M>T THEN M=T:C=C3-U*U*3 ENDIF GQ%[I*20+J]=FLOOR(C) NEXT:NEXT FOR I=0 TO 11:FOR J=0 TO 2 COPY GC%,0,CL%,I*48+J*16,16 GLOAD 260+J*20,240+I*20,20,20,GQ%,GC%,1 NEXT:NEXT:RV=1:RETURN ' CONTROL MODEL @QP ' PUT/REMOVE A VOXEL P=Q[QX,QY,QZ]:IF !P!=!QP THEN IF QP THEN INC QC[QY,QZ]:INC QC[16,QZ]:INC QA ELSE DEC QC[QY,QZ]:DEC QC[16,QZ]:DEC QA ENDIF:ENDIF:Q[QX,QY,QZ]=QP:RETURN @QU ' UNDO IF !LEN(QU%) THEN BEEP 51:RETURN BEEP 40:E=POP(QU%):QP=E>>12 QX=(E>>8)MOD 16:QY=(E>>4)MOD 16:QZ=E MOD 16 GOSUB @QP:LZ=QZ:RR=1:RETURN @QR ' RESET E$=CHR$(&H521D)+CHR$(&H671F)+CHR$(&H5316) BEEP 117:E=DIALOG(E$+"しますか?",1,E$) IF E==1 THEN BEEP 37 ELSE RETURN @QI:T$="":GOSUB @TT:GOSUB @QV FOR QZ=0 TO 15:FOR QY=0 TO 15:FOR QX=0 TO 15 QP=(QX==7||QX==8)&&(QY==7||QY==8) QP=(QP&&(QZ==7||QZ==8))*36:GOSUB @QP NEXT:NEXT:NEXT:RETURN @QL ' LOAD FM=0:GOSUB @FM:IF Q$=="" THEN RETURN LOAD "DAT:"+Q$+".VXL",QD% IF RESULT!=1 THEN RETURN T$=Q$:GOSUB @TT:GOSUB @QV:I=0 FOR QZ=0 TO 15:FOR QY=0 TO 15:FOR QX=0 TO 15 QP=QD%[I]>>(QX MOD 4)*8 AND 255:GOSUB @QP I=I+(QX MOD 4==3):NEXT:NEXT:NEXT:RETURN @QS ' SAVE FM=1:GOSUB @FM:I=-1:IF Q$=="" THEN RETURN FOR Z=0 TO 15:FOR Y=0 TO 15:FOR X=0 TO 15 IF X MOD 4==0 THEN I=I+1:QD%[I]=0 INC QD%[I],Q[X,Y,Z]<<(X MOD 4)*8 NEXT:NEXT:NEXT:SAVE "DAT:"+Q$+".VXL",QD% IF RESULT==1 THEN T$=Q$:GOSUB @TT RETURN @QV ' RESET VIEW GFILL 40,0,279,239,0:LE=0:LZ=7:GOSUB @TF DA=3/8:DE=1/4:RV=0:RR=1:GOSUB @MT: WHILE LEN(QU%):E=POP(QU%):WEND:RETURN ' MATRIX CALCULATION @MT ' SET UP T=COS(DA):U=SIN(DA):V=COS(DE):W=SIN(DE) M0=T :M1=0 :M2=U :M3=-U*W:M4=V M5=T*W :M6=-U*V:M7=-U :M8=T*V :M9=-W VX=-U*V:VY=-W :VZ=T*V IS=0:IE=15:ID=1:IF VZ>0 THEN IS=15:IE=0:ID=-1 JS=0:JE=15:JD=1:IF VY>0 THEN JS=15:JE=0:JD=-1 KS=0:KE=15:KD=1:IF VX>0 THEN KS=15:KE=0:KD=-1 RETURN @MA ' ROTATE 3D COORD AX=X*M0+Y*M3+Z*M6:AY=X*M1+Y*M4+Z*M9 AZ=X*M2+Y*M5+Z*M8:RETURN @MD ' MAP COORD (3D2D) DX=X*M0+Y*M1+Z*M2:DY=X*M3+Y*M4+Z*M5:RETURN @MK ' CALC A+Vt X=AX+VX*T:Y=AY+VY*T:Z=AZ+VZ*T:RETURN ' FILE MANAGER @FM ' CHECK FILES BEEP 116:FILES "DAT:",F$:L=LEN(F$):N=0:FC=-1 FOR I=0 TO L-1 E$=F$[I]:E=LEN(E$) IF E>5 && E<14 && RIGHT$(E$,4)==".VXL" THEN E$=MID$(E$,1,E-5):IF E$==T$ THEN FC=N F$[I]=E$:N=N+1 ELSE F$[I]="~" ENDIF NEXT IF LEN(F$)>0 && N<L THEN SORT F$ IF FM THEN PUSH F$,"":F$[N]="*しんきさくせい":N=N+1 N=MIN(N,48):FT=FM-1:IF FC<0 THEN FC=(N-1)*FM IF N>FM THEN SPSHOW 10:COLOR 15:LOCATE 32,1,-1:? "キャンセル" COLOR 13-FM*6:LOCATE 1,1 ? "ロード"*!FM;"セーブ"*FM;"する ファイル を せんたく" ? ""*40:LOCATE 0,(N+3) DIV 4*2+4:? ""*40 GOSUB @FC:COLOR ,0:CLS:SPHIDE 10 ENDIF IF FT<0 THEN Q$="":RETURN Q$=F$[FT]:IF LEFT$(Q$,1)=="*" THEN E$="ファイル"+CHR$(&H540D)+"(8もじまで)" Q$=DIALOG(T$,E$,8):IF RESULT!=1 THEN Q$="" ENDIF:RETURN @FC ' CHOOSE A FILE FOR I=0 TO N-1 C=(I==FC):COLOR 5+C*10,C*4 LOCATE I MOD 4*10+1,I DIV 4*2+4:? F$[I] NEXT @FL FT=-1:US=TS:UX=TX:UY=TY:BU=BT:VSYNC STICK OUT BX,BY:TOUCH OUT TS,TX,TY BT=(BUTTON(1) AND 15) OR (BUTTON(2) AND 48) V= (BT AND 8)/8-(BT AND 4)/4 V=V+(BT AND 2)*2-(BT AND 1)*4 IF V && FC+V>=0 && FC+V<N THEN FT=FC+V IF BT AND 16 THEN FT=FC IF BT AND 32 THEN FT=-2 IF TS && !US THEN T=TX DIV 80+FLOOR((TY-28)/16)*4 IF T>=0 && T<N THEN FT=T IF TX>=256 && TY<24 THEN FT=-2 ENDIF IF FT!=-1 THEN IF FT<0 || FT==FC THEN BEEP 3+(FT<0):RETURN FC=FT:BEEP 9:GOTO @FC ENDIF:GOTO @FL ' INITIALIZE @IN ' SCREEN ACLS:XSCREEN 3 FOR I=12 TO 14 READ E$:LOCATE 10,I*2:? E$ NEXT DISPLAY 1:GPAGE 1,1:GCLS HSV(0,0,1/4) ' COLORS FOR I=0 TO 11:FOR J=0 TO 2:FOR K=1 TO 15 H=I/11:S=1-(J==2)/2:L=(K+5)*(2-!J)/40 IF I==11 THEN S=0:L=(K+5)*(1+J*2)/100 CL%[I,J,K]=HSV(H,S,L) NEXT:X=281+J*13:Y=9+I*13 GFILL X,Y,X+11,Y+11,CL%[I,J,12] NEXT:NEXT FOR I=0 TO 8:CW%[I]=HSV(0,0,I/8):NEXT ' SPRITES FOR I=0 TO 10 READ S,X,Y:SPSET I,S:SPOFS I,X,Y SPCOL I,0,0,16+(I>3 && I<8)*24,16 NEXT:GOSUB @TF:CS=36 SPHIDE 10:SPSCALE 10,23,15:SPCOLOR 10,13<<28 ' EXPLANATION GCOLOR CW%[8] FOR I=3 TO 20 READ E$:GPUTCHR 0,I*8,E$ NEXT FOR I=11 TO 14 READ E$:GPUTCHR 280,I*16,E$ NEXT ' MODEL & VIEW GOSUB @QI:RETURN ' FUNCTIONS DEF HSV(_H,_S,_V) DIM _I,_F,_P,_Q,_T:_I=FLOOR(_H*6) _F=_H*6-_I:_V=_V*255:_P=_V*(1-_S) _Q=_V*(1-_F*_S):_T=_V*(1-(1-_F)*_S) IF _I==0 THEN RETURN RGB(_V,_T,_P) IF _I==1 THEN RETURN RGB(_Q,_V,_P) IF _I==2 THEN RETURN RGB(_P,_V,_T) IF _I==3 THEN RETURN RGB(_P,_Q,_V) IF _I==4 THEN RETURN RGB(_T,_P,_V) RETURN RGB(_V,_P,_Q) END ' DATA DATA "<< VOXEL EDITOR version 1.0 >>" DATA "2015.6.17 Programmed by OBONO" DATA " http://d.hatena.ne.jp/OBONO/" DATA 208,12,192 ,212,12,216, 219,0,204 DATA 213,24,204 ,32,280,204, 32,280,220 DATA 32,280,172 ,32,280,188, 9,0,176 DATA 298,305,150,243,-24,0 DATA "" ," かいてん","",""," つけたす","" DATA "","いろかえる","",""," けずる","" DATA "","タッチで"," かいてん","","レイヤー"," モード" DATA "しょきか","ロード","セーブ","アンドゥ" ' EOF