|
|
ここでは球を定義しています。meshを作成し
r=f(θ,φ)と極座標系を定義しています。
極座標系では、球ならr=1(定数)と表せます。
連番vtkファイルとして書出しはしていません。
LET N=40 !'分割数
DIM XX(N*(N-1)+2),YY(N*(N-1)+2),ZZ(N*(N-1)+2)
INPUT PROMPT "MODE(0 - 39)=":MODE
FILE GETSAVENAME F$,"vtkファイル|*.vtk"
IF F$="" THEN STOP
IF POS(UCASE$(F$),".VTK")=0 THEN LET F$=F$&".vtk"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"# vtk DataFile Version 2.0"
PRINT #1:"flower sphere"
PRINT #1:"ASCII"
PRINT #1:"DATASET POLYDATA"
PRINT #1:"POINTS";N*(N-1)+2;"float"
LET ALPHA=0
LET BETA=0
LET RR=FUNC(MODE,ALPHA,BETA)
LET X=-RR*SIN(ALPHA*PI/180)*COS(BETA*PI/180)
LET Z=RR*SIN(ALPHA*PI/180)*SIN(BETA*PI/180)
LET Y=RR*COS(ALPHA*PI/180)
PRINT #1:X;Y;Z
LET K=K+1
LET XX(K)=X
LET YY(K)=Y
LET ZZ(K)=Z
FOR ALPHA=180/N TO 179 STEP 180/N
FOR BETA=0 TO 359 STEP 360/N
LET RR=FUNC(MODE,ALPHA,BETA)
LET X=-RR*SIN(ALPHA*PI/180)*COS(BETA*PI/180)
LET Z=RR*SIN(ALPHA*PI/180)*SIN(BETA*PI/180)
LET Y=RR*COS(ALPHA*PI/180)
PRINT #1:X;Y;Z
LET K=K+1
LET XX(K)=X
LET YY(K)=Y
LET ZZ(K)=Z
NEXT BETA
NEXT ALPHA
LET ALPHA=180
LET BETA=0
LET RR=FUNC(MODE,ALPHA,BETA)
LET X=-RR*SIN(ALPHA*PI/180)*COS(BETA*PI/180)
LET Z=RR*SIN(ALPHA*PI/180)*SIN(BETA*PI/180)
LET Y=RR*COS(ALPHA*PI/180)
PRINT #1:X;Y;Z
LET K=K+1
LET XX(K)=X
LET YY(K)=Y
LET ZZ(K)=Z
PRINT #1:"POLYGONS";N*N;8*N+N*(N-2)*5
FOR I=1 TO N !'meshデータ
IF I=N THEN
PRINT #1:3;1;0;N
ELSE
PRINT #1:3;0;I;I+1
END IF
NEXT I
FOR I=1 TO N*(N-2)
IF MOD(I,N)=0 THEN
PRINT #1:4;I;I+N;I+1;I-N+1
ELSE
PRINT #1:4;I;I+N;I+N+1;I+1
END IF
NEXT I
FOR I=N*(N-2)+1 TO N*(N-1)
IF I=N*(N-1) THEN
PRINT #1:3;N*(N-1);N*(N-1)+1;N*(N-2)+1
ELSE
PRINT #1:3;I;N*(N-1)+1;I+1
END IF
NEXT I
PRINT #1:"POINT_DATA";N*(N-1)+2
PRINT #1:"SCALARS height float"
PRINT #1:"LOOKUP_TABLE default"
FOR I=1 TO K
PRINT #1:ZZ(I)
NEXT I
CLOSE #1
END
EXTERNAL FUNCTION FUNC(MODE,TT,SS) !' r=f(θ,φ)
LET T=TT*PI/180
LET S=SS*PI/180
SELECT CASE MODE
CASE 0
LET FUNC=1
CASE 1
LET FUNC=SGN(COS(T))*ABS(COS(T))^.1
CASE 2
LET FUNC=ABS(COS(T))
CASE 3
LET FUNC=T*2
CASE 4
LET FUNC=T^2
CASE 5
LET FUNC=2*SIN(T)
CASE 6
LET FUNC=COS(SQR(T))
CASE 7
LET FUNC=MAX(SIN(T),ABS(COS(T)))
CASE 8
LET FUNC=MAX(SIN(T),ABS(COS(T)^8))
CASE 9
LET FUNC=MIN(SIN(T),ABS(COS(T)))
CASE 10
LET FUNC=0.8+2*SIN(T/2)+SIN(5*S)/5
CASE 11
LET FUNC=3-3*SIN(T/2)+SIN(5*S)/20
CASE 12
LET FUNC=1+(1-COS(2*T))*(1-COS(S))
CASE 13
LET FUNC=ABS(SIN(2*T)*SIN(2*S))
CASE 14
LET FUNC=2+COS(10*S)^2/10+SIN(15*T)^2/10
CASE 15
LET FUNC=2-SGN(COS(T))/5
CASE 16
LET FUNC=SGN(SIN(T)-.995)/1.1+2
CASE 17
LET FUNC=SGN(COS(T)-.975)+3
CASE 18
LET FUNC=5/6*(1-COS(10*T))*(1-COS(8*S))
CASE 19
LET FUNC=1+COS(3*S)
CASE 20
LET FUNC=3-SGN(SIN(10*T)*SIN(10*S))
CASE 21
LET FUNC=3+2*(COS(4*S)*COS(4*T))
CASE 22
LET FUNC=((1+0.5*COS(5*S))*(1-COS(5*S))+.1)*SIN(T)
CASE 23
LET FUNC=MIN(20,MAX(5,SEC(6*T)*SEC(6*S)))
CASE 24
LET FUNC=2*(SIN(5*S)+4)*SIN(T)
CASE 25
LET FUNC=ABS(SIN(5*T)*SIN(5*S))
CASE 26
LET FUNC=ABS(COS(S))
CASE 27
LET FUNC=1+COS(S)*COS(T)
CASE 28
LET FUNC=1+COS(S)
CASE 29
LET FUNC=2+SIN(3*S)*SIN(3*T)*SIN(3*S+3*T)
CASE 30
LET FUNC=2+.5*COS(50*S)*COS(25*T)
CASE 31
LET FUNC=COS(10*S)^2+SIN(15*T)^2
CASE 32
LET FUNC=4+.5*COS(25*S)*COS(50*T)
CASE 33
LET FUNC=ABS(COS(5*S)*COS(5*T))
CASE 34
LET FUNC=3+COS(20*T)/10
CASE 35
LET FUNC=COS(3*S-2*T)
CASE 36
LET FUNC=COS(2*S+3*T)
CASE 37
LET FUNC=3+COS(S*T*3)
CASE 38
LET Z=400-(SS-60*INT((SS+30)/60))^2-(TT-60*INT((TT+30)/60))^2
IF Z>0 THEN
LET FUNC=SQR(Z)+50
ELSE
LET FUNC=50
END IF
CASE 39
LET FUNC=10+S*T*(S^2-T^2)/2
END SELECT
END FUNCTION
|
|