!　観賞グラフ ６２_６２_９２

 投稿者：SECOND  投稿日：2012年 3月 7日(水)07時57分47秒
  !　観賞グラフ ６２_６２_９２
!----------------------------
OPTION ARITHMETIC NATIVE
SET TEXT JUSTIFY "center","half"
DIM rotx(4,4), rotx2(4,4), Axys(4,4), shxyz(4,4), Abak(4,4)
DIM Vi(4), Vo(4), m(4,4)
!
LET imax=3                                !item maxim.
DIM D3( 92+1, 0 TO 10+1, 3), D1(10+1,2)   !(面数, 面の角数+1, xyz), (面の角数+1, xy)
DIM msk(imax, 0 TO 185), cg(imax,3)       !(item数, 写像数), (item数, xyz)
!
DIM p3(0 TO 3, 2), p4(0 TO 4, 2), p5(0 TO 5, 2), p6(0 TO 6, 2), p10(0 TO 10, 2)
!
CALL polygon(3, 1/2, cr3,ir3, p3)     !正３角形, 中心(0,0)底辺(-1/2,-ir3)~(1/2,-ir3)
CALL polygon(4, 1/2, cr4,ir4, p4)     !正４角形, 中心(0,0)底辺(-1/2,-ir4)~(1/2,-ir4)
CALL polygon(5, 1/2, cr5,ir5, p5)     !正５角形, 中心(0,0)底辺(-1/2,-ir5)~(1/2,-ir5)
CALL polygon(6, 1/2, cr6,ir6, p6)     !正６角形, 中心(0,0)底辺(-1/2,-ir6)~(1/2,-ir6)
CALL polygon(10,1/2, cr10,ir10, p10)  !正10角形, 中心(0,0)底辺(-1/2,-ir10)~(1/2,-ir10)

SUB polygon(n, s, cr,ir, p(,))        !n=角数 s=底辺/2 → cr=外接円半径 ir=内接円半径 p(,)=頂点座標
   LET a=PI/n
   LET cr=s/SIN(a)
   LET ir=cr*COS(a)
   FOR i=1 TO n                             !座標 p(0,1),p(0,2) ＝中心(0,0) ＝ｎ角形の重心。
      LET p(i,1)=cr*COS((2*i-1)*a-PI/2)
      LET p(i,2)=cr*SIN((2*i-1)*a-PI/2)
   NEXT i
END SUB

MAT Axys=IDN
MAT rotx=IDN
MAT rotx2=IDN
LET Vi(4)=1
READ x0, y0, hw                             !主画面 中心(x0,y0),縦横半幅hw
DATA  0, .1, 1.5
!
LET Ax=COS(PI*.93)*1.8                      !開始のｚ軸方向( 画面垂直０度からｘ軸回転成分)
LET Ay=SIN(PI*.93)*1.8                      !　　〃　〃　　( 　　　〃　〃　　ｙ軸回転成分)
LET opA=0.3                                 !多面体 開度の振幅
LET opS=0.95                                !多面体 開度のバイアス
LET item=3                                  !開始 item
LET t0=TIME
DO
   SET DRAW mode hidden
   CLEAR
   LET sq=0
   LET sq0=0
   CALL control_
   SELECT CASE item
   CASE 1
      CALL mat_rotx(rotx, op1*PI/5.675)        !６２面体　５角～４角 折り角
      CALL mat_rotx(rotx2, op1*PI/8.61)        !　　　　　４角～３角 折り角
      DRAW D62_320430512 WITH SCALE(.4)*ROTATE(Az)*shxyz*Axys
   CASE 2
      CALL mat_rotx(rotx, op1*PI/4.815)        !６２面体　１０角～６角 折り角
      CALL mat_rotx(rotx2, op1*PI/8.61)        !　　　　　６角～４角 折り角
      DRAW D62_4306201012 WITH SCALE(.24)*ROTATE(Az)*shxyz*Axys
   CASE 3
      CALL mat_rotx(rotx, op1*PI/6.65)         !９２面体　５角～３角 折り角
      CALL mat_rotx(rotx2, op1*PI/11.373)      !　　　　　３角～３角 折り角
      DRAW D92_380512 WITH SCALE(.5)*ROTATE(Az)*shxyz*Axys
   END SELECT
   CALL priority                               !描画
   SET DRAW mode explicit
   !--------------------
   IF msk(item,0)=0 THEN     !各item は初回、標準 折り角 op1=1 で採取画 位置を → msk(item,1~sq0)
      LET msk(item,0)=1      !← 完了マーク。以降 msk(,) を マスク にして画を取捨。
      MAT Axys=Abak          !※Restore Condition《２》
   END IF
   !----------------------
   IF mlb=0 AND DEL=0 THEN
      LET Az=Az-PI/64        !debug rotate Az
      LET ss=ss+PI/48        !debug expand ss
      IF 2*PI<=ss THEN
         LET ss=0
         LET item=MOD(item,imax)+1  !debug increase item
      END IF
      LET op1=MIN(MAX( opA*COS(ss)+opS ,0),1)
   ELSEIF mlb=1 THEN
      LET DEL=10             !「左 click 一時停止」解除から再開までの 遅延回数( *80ms)
   ELSE
      LET DEL=DEL-1
   END IF
   !------------
   WAIT DELAY t2                              !t2: 制御出力の休止秒。
   LET t1=TIME                                !t1: 前の周期の終り。※TIME は 約.05秒毎の更新。
   LET t2=MAX(0,t2+(.08-MOD(t1-t0,86400))/20) !80ms－検出周期(t1-t0)＝偏差 →t2(積分 Gain=1/20)
   LET t0=t1                                  !t0: 次の周期の始め＝ 前の周期の終り
LOOP UNTIL mrb=1             !右クリック

SUB control_
   SET WINDOW x0-hw, x0+hw, y0-hw, y0+hw       !主画面スケール
   mouse poll mx,my,mlb,mrb
   IF msk(item,0)=0 THEN
   !-----initial setup            !各item 初回、op1=1 (標準 折り角)に強制。
      MAT Abak=Axys               !※Save Condition《２》
      MAT Axys=IDN
      MAT shxyz=IDN
      LET op1=1
   ELSE
      PLOT label,AT x0-.2*hw, y0+.95*hw:"左 click 一時停止、drag 手動回転。右 click 終了。"
      !-----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
   IF msk(item,0)=0 THEN
   !-----initial setup
      CALL centerG                             !初回は、多面体 重心計算のみ、描画なし。
   ELSE
   !-----real draw with priority
      FOR j=1 TO sq
         LET z=1e9
         FOR i=1 TO sq
            IF D3(i,0,3)< z THEN
               LET z=D3(i,0,3)
               LET ib=i                        !ib= ｚ最小(奥) の配列番号。
            END IF
         NEXT i
         LET D3(ib,0,3)=2e9                    !済み。zone out
         !-----
         LET c=ib+1
         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,11,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,11,1)=n                           !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 D62_320430512
   DRAW getpos(5, p5)                                                      !基５角
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir5)*ROTATE(-.2*PI) !右上2nd.４角
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir5)*ROTATE( .2*PI) !左上2nd.４角
END PICTURE
PICTURE D62_320430512_2
   DRAW getpos(4, p4)                                                     !2nd.４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D62_320430512 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir4)                 !上.基５角
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir4)*ROTATE(-.5*PI) !右2nd.３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir4)*ROTATE( .5*PI) !左2nd.３角
END PICTURE

PICTURE D62_4306201012
   DRAW getpos(10, p10)                                                      !基１０角
   DRAW D62_4306201012_2 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir10)*ROTATE(-.2*PI) !右上2nd.６角
   DRAW D62_4306201012_2 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir10)*ROTATE( .2*PI) !左上2nd.６角
END PICTURE
PICTURE D62_4306201012_2
   DRAW getpos(6, p6)                                                      !2nd.６角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D62_4306201012 WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir6)*ROTATE( PI/3)  !右上.基１０角
   DRAW D62_4306201012 WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir6)*ROTATE(-PI/3)  !左上.基１０角
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir6)                 !上2nd.４角
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir6)*ROTATE(-2/3*PI) !左2nd.４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir6)*ROTATE(2/3*PI)  !右2nd.４角
END PICTURE

PICTURE D92_380512
   DRAW getpos(5, p5)                                                   !基５角
   DRAW D92_380512_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir5)*ROTATE( .2*PI) !左上2nd.３角
   DRAW D92_380512_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir5)*ROTATE(-.2*PI) !右上2nd.３角
END PICTURE
PICTURE D92_380512_2
   DRAW getpos(3, p3)                                                    !2nd.３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE(-PI/3) !右上2nd.３角
   DRAW D92_380512_3 WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE( PI/3)  !左上3rd.３角
END PICTURE
PICTURE D92_380512_3
   DRAW getpos(3, p3)                                                   !3rd.３角
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE(PI/3) !左上3rd.３角
   DRAW D92_380512 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3)    !右上.基５角
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
 

戻る