改訂版　正多面体(4,6,8,12,20)、切頂20面体( 32面体・フラーレン・サッカーボール)

 投稿者：SECOND  投稿日：2011年10月18日(火)02時54分18秒
  !４）自己相似写像で描く、立体と展開図のアニメ－ション。　2011.10 Updated
!---------------------------------------------------------
!改訂版　正多面体(4,6,8,12,20)、切頂20面体( 32面体・フラーレン・サッカーボール)

! ＜ドラッグ応答性の改善。　回る多面体を上下左右にドラッグしてみて下さい＞
!１）どの方向へも、多面体の重心を中心に 回転し、
!２）又、その累積による応答変化も、無くした。
!３）左ボタンが離され、常時回転に戻るまでに、間を空けた。
!４）表示中の立体 → 右クリックで → その立体の平面展開図を表示する ようにした。
!　　展開図のときに、右クリック すると、プログラム終了。
!５）アニメ速度が、パソコンの種類で変らないよう、周期偏差 積分の自動制御を付けた。

! ※構文の大幅な見直しと整理、６面体の追加。

OPTION ARITHMETIC NATIVE
SET TEXT JUSTIFY "center","half"
SET WINDOW -1.5, 1.5, -1.4, 1.6
DIM rotx(4,4), rotx2(4,4), Axys(4,4), shxyz(4,4), Abak(4,4)
DIM Vi(4), Vo(4), m(4,4), D3( 32+1, 0 TO 6+1, 3), msk(6, 0 TO 60), cg(6,3), D1(7,2)
DIM p3(0 TO 3, 2), p4(0 TO 4, 2), p5(0 TO 5, 2), p6(0 TO 6, 2)
!
CALL polygon(3, 1/2, ir3, p3)               !正３角形, 中心(0,0)底辺(-1/2,-ir3)~(1/2,-ir3)
CALL polygon(4, 1/2, ir4, p4)               !正４角形, 中心(0,0)底辺(-1/2,-ir4)~(1/2,-ir4)
CALL polygon(5, 1/6, ir5, p5)               !正５角形, 中心(0,0)底辺(-1/6,-ir5)~(1/6,-ir5)
CALL polygon(6, 1/6, ir6, p6)               !正６角形, 中心(0,0)底辺(-1/6,-ir6)~(1/6,-ir6)

SUB polygon(n, s, ir, p(,))                 !n=角数, s=底辺/2, ir=内接円半径, p(,)=頂点座標
   LET a=PI/n
   LET r=s/SIN(a)
   LET ir=r*COS(a)
   FOR i=1 TO n
      LET p(i,1)=r*COS((2*i-1)*a-PI/2)
      LET p(i,2)=r*SIN((2*i-1)*a-PI/2)
   NEXT i
END SUB

MAT rotx=IDN
MAT rotx2=IDN
LET Vi(4)=1
!
MAT Axys=IDN
LET Ax=-PI/3                                !開始の常時回転軸( 画面垂直からのｘ軸回転)
LET opA=0.3                                 !回転体 開度の振幅
LET opS=0.95                                !回転体 開度のバイアス
LET t0=TIME
DO
   SET DRAW mode hidden
   CLEAR
   PLOT label,AT 0, 1.52:"左 click 一時停止、drag 手動回転。右 click 展開図。"
   LET sq=0
   LET sq0=0
   SELECT CASE s
   CASE 0 TO 1
      LET item=1
      CALL control_
      CALL mat_rotx(rotx, op1*PI/4.305)        !３２面体　　残部６角～残部６角 折り角
      CALL mat_rotx(rotx2, op1*PI/4.815)       !　　　　　切頭部５角～残部６角 折り角
      DRAW D32 WITH ROTATE(Az)*shxyz*Axys
      IF s=0 THEN CALL priority(2) ELSE CALL priority(7)
   CASE 2
      LET item=2
      CALL control_
      CALL mat_rotx(rotx, op1*PI/4.305)        !正２０面体　３角～３角 折り角
      DRAW D20 WITH ROTATE(Az)*shxyz*Axys
      CALL priority(2)
   CASE 3
      LET item=3
      CALL control_
      CALL mat_rotx(rotx, op1*PI/2.8376)       !正１２面体　５角～５角 折り角
      DRAW D12 WITH SCALE(1.9)*ROTATE(Az)*shxyz*Axys
      CALL priority(2)
   CASE 4
      LET item=4
      CALL control_
      CALL mat_rotx(rotx, op1*PI/2.552)        !正８面体　　３角～３角 折り角
      DRAW D20 WITH SCALE(1.4)*ROTATE(Az)*shxyz*Axys
      CALL priority(2)
   CASE 5
      LET item=5
      CALL control_
      CALL mat_rotx(rotx, op1*PI/2)            !正６面体　　４角～４角 折り角
      DRAW D06 WITH ROTATE(Az)*shxyz*Axys
      CALL priority(2)
   CASE 6
      LET item=6
      CALL control_
      CALL mat_rotx(rotx, op1*PI/1.644)        !正４面体　　３角～３角 折り角
      DRAW D20 WITH SCALE(1.5)*ROTATE(Az)*shxyz*Axys
      CALL priority(2)
   END SELECT
   SET DRAW mode explicit
   !----------------------
   IF mlb=0 AND DEL=0 THEN
      LET Az=Az-PI/64
      LET sx=sx+PI/48
      IF 2*PI<=sx THEN
         LET sx=0
         LET s=MOD(s+1, 7)
         LET flt=0
      END IF
      LET op1=MIN(MAX( opA*COS(sx)+opS ,0),1)
   ELSEIF mlb=1 THEN
      LET DEL=7              !「左 click 一時停止」解除から再開までの 遅延回数
   ELSE
      LET DEL=DEL-1
   END IF
   !--------------------
   IF msk(item,0)=0 THEN     !各item は初回、標準 折り角 op1=1 で採取画 位置を → msk(item,1~sq0)
      LET msk(item,0)=1      !← 完了マーク。以降 msk(,) を マスク にして画を取捨。
      MAT Axys=Abak
   END IF
   !-----------
   LET bmrb=mrb
   mouse poll mx,my,mlb,mrb
   !------------
   WAIT DELAY t2                !t2:制御出力の、休止秒。
   LET t1=TIME                  !t1:前の周期の終り。※TIME は 約.05秒毎の、更新。P3-500MHz 98SE
   IF t1< t0 THEN LET t0=t0-86400
   LET t2=t2+(.08-t1+t0)/20     !設定周期.08秒－検出周期(t1-t0)＝偏差 →t2( 積分 Gain=1/20 )
   ! PRINT USING"#.### #.###":t2,t1-t0         !t2:制御_休止秒, t1-t0:検出周期。---debug
   LET t0=t1                    !t0:次の周期の始め＝ 前の周期の終り
   !--------------debug---
   IF sqb<>sq THEN
      PRINT USING"## ### #.###":sq,sq0,t2      !sq:採取画数, sq0:写像_全画数, t2:制御_休止秒
      LET sqb=sq
   END IF
LOOP UNTIL opAbak>0 AND bmrb=0 AND mrb=1

SUB flatx(s0,za,x0,y0,hw)
   IF s=s0 THEN
      IF opAbak=0 THEN
         SET WINDOW x0-hw,x0+hw,y0-hw,y0+hw
         LET opAbak=opA
         LET opSbak=opS
         LET opA=.525           !平面図 開度の振幅
         LET opS=.475           !平面図 開度のバイアス
         MAT Abak=Axys
         !LET sx=0
      END IF
      MAT Axys=IDN
      LET Az=za
      DRAW grid WITH ROTATE(Az)
      PLOT label,AT x0-.48*hw, y0+.95*hw:"左 click 一時停止。右 click 終了。"
   END IF
END SUB

SUB control_
   IF flt=1 THEN
      CALL flatx( 0,-PI/6,    -.57,-1.5, 2.4)   !(s0,za,x0,y0,hw) !32 平面展開図セットアップ
      CALL flatx( 1,-PI/6,    -.57,-1.5, 2.4)   !(s0,za,x0,y0,hw) !32 　　〃
      CALL flatx( 2, PI/12,  -1.28,-1.98, 2.9)  !(s0,za,x0,y0,hw) !20 　　〃
      CALL flatx( 3, PI/.78, -2.06,-2.32, 2.95) !(s0,za,x0,y0,hw) !12 　　〃
      CALL flatx( 4,-PI/1.71,-1.43,-1.42, 2.3)  !(s0,za,x0,y0,hw) ! 8 　　〃
      CALL flatx( 5,-PI/2,    -1.5,-1.0, 2.1)   !(s0,za,x0,y0,hw) ! 6 　　〃
      CALL flatx( 6,-PI/1.17, -.91,-.688, 1.7)  !(s0,za,x0,y0,hw) ! 4 　　〃
      EXIT SUB
   ELSEIF 0< opAbak THEN
      SET WINDOW -1.5, 1.5, -1.4, 1.6
      LET opA=opAbak
      LET opS=opSbak
      MAT Axys=Abak
      LET opAbak=0
   END IF
   IF msk(item,0)=0 THEN
   !-----initial setup
      MAT Abak=Axys
      MAT Axys=IDN
      MAT shxyz=IDN
      LET op1=1                                !各item 初回を、op1=1 (標準 折り角)に強制。
   ELSE
      IF bmrb=0 AND mrb=1 THEN                 !平面図の開始 (右クリックの Leading Edge.)
         LET flt=1
         LET sx=0
         EXIT SUB
      END IF
      !-----click_drag-----
      CALL mat_shxyz( cg(item,1),cg(item,2),cg(item,3))   !重心を原点へ移動する行列 shxyz 作成
      IF mlb=1 THEN
         LET Ax= -(my-mybak)*PI/2              !ドラッグ方向から、軸方向と回転量
         LET Ay= +(mx-mxbak)*PI/2
      END IF
      LET mxbak=mx
      LET mybak=my
      !-----
      LET ar0=SQR(Ax^2+Ay^2)                   !回転の角度(∝マウス・ドラッグの長さ)
      IF ar0<>0 THEN
         LET DIRar0=ANGLE(Ax,Ay)               !軸の角度
         CALL mat_rotx(rotx, ar0)
         MAT Axys=Axys*ROTATE(-DIRar0)*rotx*ROTATE(DIRar0)    !ドラッグ累積 (方向,回転)
         LET Ax=0
         LET Ay=0
      END IF                                   !with ～～*shxyz*Axys の順序で使用。
   END IF
END SUB

SUB priority( flg)                             !paint flg( 7= 5_6_mono, Others= color)
   IF msk(item,0)=0 THEN
   !-----initial setup
      CALL centerG                             !初回は、多面体 重心計算のみ、描画なし。
   ELSE
      FOR j=1 TO sq                            !z 最小(奥) から描く。
         LET z=1e9
         FOR i=1 TO sq
            IF D3(i,0,3)< z THEN
               LET z=D3(i,0,3)
               LET ib=i
            END IF
         NEXT i
         LET D3(ib,0,3)=1e9
         IF flg=7 THEN LET c=6-D3(ib,7,1) ELSE LET c=ib+1   !サッカーボール(flg=7)、５角(c=1),６角(c=0)
         SET AREA COLOR c                                   !各面の色
         ASK COLOR MIX(c) r,g,b
         IF .3*r+.59*g+.11*b< .5 THEN SET TEXT COLOR 0 ELSE SET TEXT COLOR 1  !明るさに 対比する文字色
         FOR i=1 TO D3(ib,7,1)
            LET D1(i,1)=D3(ib,i,1)
            LET D1(i,2)=D3(ib,i,2)
         NEXT i
         LET D1(i,1)=D3(ib,1,1)
         LET D1(i,2)=D3(ib,1,2)
         MAT PLOT AREA ,LIMIT i:D1
         MAT PLOT LINES ,LIMIT i:D1
         PLOT label,AT D3(ib,0,1),D3(ib,0,2):STR$(ib)
      NEXT j
      SET TEXT COLOR 1
   END IF
END SUB

SUB centerG                                    !cg(item,1~3) …各多面体の重心座標(x,y,z)
   LET cg(item,1)=0
   LET cg(item,2)=0
   LET cg(item,3)=0
   FOR i=1 TO sq
      LET cg(item,1)=cg(item,1)+D3(i,0,1)      !D3(i,0,1~3) …各面の重心座標(x,y,z)
      LET cg(item,2)=cg(item,2)+D3(i,0,2)
      LET cg(item,3)=cg(item,3)+D3(i,0,3)
   NEXT i
   LET cg(item,1)=cg(item,1)/sq
   LET cg(item,2)=cg(item,2)/sq
   LET cg(item,3)=cg(item,3)/sq
END SUB

PICTURE getpos(n, p(,))         !return with ･･･ 採取画 msk(item,sq0)=1,  重複画 msk(item,sq0)=0
   LET sq0=sq0+1                !呼出し 順番
   IF msk(item,0)=1 AND msk(item,sq0)=0 THEN EXIT PICTURE
   LET sq=sq+1                  !採取画 順番
   MAT m=TRANSFORM
   FOR j=0 TO n                 !各面の、0=重心 1~n=頂点
      LET Vi(1)=p(j,1)
      LET Vi(2)=p(j,2)
      MAT Vo=Vi*m
      LET D3(sq,j,1)=Vo(1)
      LET D3(sq,j,2)=Vo(2)
      LET D3(sq,j,3)=Vo(3)
   NEXT j
   LET D3(sq,7,1)=n
   IF msk(item,0)=1 THEN EXIT PICTURE
   FOR i=1 TO sq-1
      IF (D3(i,0,1)-D3(sq,0,1))^2+(D3(i,0,2)-D3(sq,0,2))^2+(D3(i,0,3)-D3(sq,0,3))^2< .05 THEN EXIT FOR
   NEXT i
   IF sq<=i THEN LET msk(item,sq0)=1 ELSE LET sq=sq-1  !採取画 位置の記憶と、重複画の除去
END PICTURE

PICTURE D32
   DRAW getpos(6, p6)                                                      !　基６角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx2*SHIFT(0,ir6)                 !　上５角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx2*SHIFT(0,ir6)*ROTATE(-PI*2/3) !右下５角
   DRAW D32 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(-PI/3)              !右上６角
   DRAW D32 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(PI/3)               !左上６角
END PICTURE

PICTURE D20
   DRAW getpos(3, p3)                                          !　基３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D20 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3)  !右上３角
   DRAW D20 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir3)*ROTATE(PI/3)   !左上３角
END PICTURE

PICTURE D12
   DRAW getpos(5, p5)                                           !　基５角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D12 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir5)*ROTATE(-.2*PI)  !右上５角
   DRAW D12 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir5)*ROTATE(.2*PI)   !左上５角
   DRAW D12 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir5)*ROTATE(-.6*PI)  !右下５角
END PICTURE

PICTURE D06
   DRAW getpos(4, p4)                                           !　基４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D06 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)*ROTATE(-PI/2)   !　右４角
   DRAW D06 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)                 !　上４角
END PICTURE

!---------------------------------
! ｘ軸で 回転する行列 → 配列引数
!(x,y,z,1)| 1,      0,      0, 0 |
!         | 0, cos(a), sin(a), 0 |
!         | 0,-sin(a), cos(a), 0 |
!         | 0,      0,      0, 1 |
!---------------------------------
SUB mat_rotx(m(,), a)
   LET m(2,2)=COS(a)
   LET m(3,2)=-SIN(a)
   LET m(2,3)=SIN(a)
   LET m(3,3)=COS(a)     !他の要素は、呼出し側で管理
END SUB

!-----------------------------
! 平行移動。(sx,sy,sz) → 原点
!(x,y,z,1)|   1,  0,  0, 0 |
!         |   0,  1,  0, 0 |
!         |   0,  0,  1, 0 |
!         | -sx,-sy,-sz, 1 |
!-----------------------------
SUB mat_shxyz( sx,sy,sz)
   LET shxyz(4,1)=-sx
   LET shxyz(4,2)=-sy
   LET shxyz(4,3)=-sz    !他の要素は、呼出し側で管理
END SUB

END
 

戻る