Amusement_Program

[0] Amusement_Program 投稿者：--- 投稿日：2012年 3月 7日(水)19時02分48秒

[1] 人数が変わる絵 投稿者：SECOND 投稿日：2012年 3月 7日(水)19時05分40秒: !「人数が変わる絵」のしくみ（２）

!バリエーションが、多くなるように (位相シフト, 人数, 位相の間隔) で計算
!するよう変更した。冒頭の２つは、実際に使われている絵の定数を、探した例。
!-------------------------------
! SET bitmap SIZE 641,641
OPTION ARITHMETIC NATIVE
SET TEXT background "opaque"
SET WINDOW -1,21, -10,4
SET POINT STYLE 4
LET p4r=2/(pixely(1)-pixely(0))        !point4 pix.center-center radius
DIM fig(0 TO 3)
DATA 36, 2, 137, 1
MAT READ fig
!---
DO
!http://yaplog.jp/miszkinn/archive/115　　青少年科学館「かくれんぼ」１４～１５人
   CALL type(1, 15, 16*70/193)
   !CALL type(1, 15, 64/11)
   !---
   !http://pya.cc/pyaimg/pimg.php?imgid=1148　「何人ですか？」１２～１３人
   CALL type(0, 13, 8)
   !---
   CALL type(0, 9, 2)                  !(位相シフト, 人数, 位相の間隔)
   CALL type(1, 9, 5)                  !※位相の間隔 = 整数である必要はないが、
   CALL type(0, 9, 4)                  !　人数より小さく、1 又は整数倍が人数でない数。
   CALL type(2, 9, 1)
   CALL type(0, 9, 1)
   CALL type(1, 9, 8)
LOOP

SUB type(x,i,j)                        !(位相シフト, 人数, 位相の間隔)
   LET ss=x                            !ss= 位相シフト
   LET P=i                             ! P= 周期 (人数)
   LET n=j                             ! n= 位相間隔
   LET L=1                             ! L= 人数が減る前の、身長
   CLEAR
   DRAW grid
   !---
   SET TEXT JUSTIFY "left","bottom"
   PLOT label,AT 0.0, 2.9*L:"「人数が変わる絵」のしくみ。"
   PLOT label,AT 5.0, 2.4*L:"位相シフト="& STR$(ss)& "　周期="& STR$(P)& "　位相の間隔="& STR$(n)
   PLOT label,AT 0.5,  -7*L:"左クリック：次へ進む。　右クリック：終了。"
   !---
   DRAW cheat(-L,0,P, 15,1)
   DRAW cheat( L,0,n, 52,0)            !(±身長, 切出し始, 切出し終,  色, 注釈No.)
   DRAW cheat( L,n,P, 39,2)
   !---
   DRAW cheat(-L,0,P, 15,1) WITH SHIFT(  0, -4)
   DRAW cheat( L,0,n, 52,2) WITH SHIFT(P-n, -4)
   DRAW cheat( L,n,P, 39,0) WITH SHIFT( -n, -4)
   DO
      WAIT DELAY .05
      LET mlbak=mlb
      mouse poll x,y,mlb,mrb
      IF 0< mrb THEN STOP
   LOOP UNTIL mlbak< mlb
END SUB

PICTURE cheat( L,x1,x2, col,txt)       !(±身長, 切出し始, 切出し終,  色, 注釈No.)
   SET AREA COLOR col
   PLOT AREA: x1,0; x2,0; x2,L*1.3; x1,L*1.3
   IF txt<>1 THEN PLOT LINES: x1,0; x2,0; x2,L*1.3; x1,L*1.3; x1,0
   SET TEXT JUSTIFY "center","half"
   FOR i=0 TO P-1
      LET x=MOD((i+ss)*n, P)+.5
      IF x1< x AND x< x2 THEN
         LET y=ABS(L)/(P-1)*i+(L-ABS(L))/2
         DRAW figure
         IF 9<=i THEN SET TEXT COLOR "red"
         PLOT label,AT x+.05, L*1.53-.02: STR$(i)
         SET TEXT COLOR "black"
      END IF
   NEXT i
   SET TEXT JUSTIFY "left","half"
   IF txt=>1 THEN PLOT label,AT x2+0.2, L*1.5-.02: "← 位相番号"
   IF txt=2 THEN PLOT label,AT x2+0.2, L*.7-.02: "← 左右絵の逆置き"
END PICTURE

PICTURE figure
   IF y< 0 THEN                        !人形の、境界下部を描く。
      FOR j=-p4r TO y STEP -p4r*1.18
         LET w=(j-y)/L
         LET dx=.15*COS(PI*w*2.5)
         SET POINT COLOR fig(INT(w*3.5))
         PLOT POINTS: x+dx,j; x-dx,j
      NEXT j
   ELSEIF 0< y THEN                    !人形の、境界上部を描く。
      FOR j=p4r TO y STEP p4r*1.18
         LET w=(j+L-y)/L
         LET dx=.15*COS(PI*w*2.5)
         SET POINT COLOR fig(INT(w*3.5))
         PLOT POINTS: x+dx,j; x-dx,j
      NEXT j
   END IF
END PICTURE

END

!下図で、上部、左右絵を交換すると、左上の一人が消えて無くなっています。
!その行方は、残りの人数で均等に分けて食べられており、その身長が、少し
!高くなっています。バラバラ事件。

[2] 正多角形だけで出来る多面体１８種と展開図のアニメ－ション 投稿者：SECOND 投稿日：2012年 3月 7日(水)19時09分52秒: ! 正多角形だけで出来る多面体１８種と展開図のアニメ－ション
!----------------------------------------------------------
!　正多面体(4,6,8,12,20)、アルキメデスの多面体(8,14,14,14,26,26,32,32,32,38,62,62,92)
!
!１）回る多面体は、左ボタンで一時停止、そのままドラッグすると、重心を中心に向きを変える。
!　　離すと、僅かな間をとって、常時回転に戻る。(ｚ軸回転)
!
!２）左右ボタンを離して、画面右上、「展開図へ」にカーソルを置くと、平面展開図へ分解する。
!　　カーソル置き放しにすると、次々に展開図を連続する。
!
!３）いつでも、右クリックはプログラム終了、画像は、スナップショットとして残る。
!　　アニメ速度が、パソコンの種類で変らないよう、周期偏差でＰＩ制御。
!　　TextWindow 表示は、現在の　多面体面数、写像の探索数、周期偏差の制御秒　の順。

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 s= 7                                    !start item
LET imax=18                                 !item maxim.
DIM D3( 92+1, 0 TO 10+1, 3), D1(10+1,2)     !(面数, 面の角数+1, xyz), (面の角数+1, xy)
DIM msk(imax, 0 TO 135), cg(imax,3)         !(item数, 写像数), (item数, xyz)
DIM fla(0 TO imax, 4)
!
DIM p3(0 TO 3, 2), p4(0 TO 4, 2), p5(0 TO 5, 2), p6(0 TO 6, 2), p8(0 TO 8, 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(8, 1/2, cr8,ir8, p8)     !正８角形, 中心(0,0)底辺(-1/2,-ir8)~(1/2,-ir8)
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 cx0=x0+.85*hw                           ![展開図へ] box 中心(cx0,cy0)
LET cy0=y0+.95*hw
LET cx1=cx0-.13*hw                          ![展開図へ] box 左右(cx1,cx2)
LET cx2=cx0+.13*hw
LET cy1=cy0-.032*hw                         ![展開図へ] box 下上(cy1,cx2)
LET cy2=cy0+.04*hw
MAT READ fla
!
LET Ax=COS(PI*.93)*1.8  !PI/3               !開始のｚ軸方向( 画面垂直０度からｘ軸回転成分)
LET Ay=SIN(PI*.93)*1.8  !0                  !　　〃　〃　　( 　　　〃　〃　　ｙ軸回転成分)
LET opA=0.3                                 !多面体開度の振幅
LET opS=0.95                                !多面体開度のバイアス
LET t0=TIME
DO
   SET DRAW mode hidden
   CLEAR
   LET sq=0
   LET sq0=0
   LET item=MAX(s,1)
   CALL control_
   SELECT CASE item
   CASE 1
      CALL mat_rotx(rotx, op1*PI/4.305)        !３２面体　　残部６角～残部６角折り角
      CALL mat_rotx(rotx2, op1*PI/4.815)       !　　　　　切頭部５角～残部６角折り角
      DRAW D32 WITH SCALE(.333)*ROTATE(Az)*shxyz*Axys
   CASE 2
      CALL mat_rotx(rotx, op1*PI/4.305)        !正２０面体　３角～３角折り角
      DRAW D20 WITH ROTATE(Az)*shxyz*Axys
   CASE 3
      CALL mat_rotx(rotx, op1*PI/2.8376)       !正１２面体　５角～５角折り角
      DRAW D12 WITH SCALE(.633)*ROTATE(Az)*shxyz*Axys
   CASE 4
      CALL mat_rotx(rotx, op1*PI/2.552)        !正８面体　　３角～３角折り角
      DRAW D20 WITH SCALE(1.4)*ROTATE(Az)*shxyz*Axys
   CASE 5
      CALL mat_rotx(rotx, op1*PI/2)            !正６面体　　４角～４角折り角
      DRAW D06 WITH ROTATE(Az)*shxyz*Axys
   CASE 6
      CALL mat_rotx(rotx, op1*PI/1.644)        !正４面体　　３角～３角折り角
      DRAW D20 WITH SCALE(1.5)*ROTATE(Az)*shxyz*Axys
   CASE 7
      CALL mat_rotx(rotx, op1*PI/3.285)        !１４面体    ４角～３角折り角
      DRAW D14_3846 WITH SCALE(1)*ROTATE(Az)*shxyz*Axys
   CASE 8
      CALL mat_rotx(rotx, op1*PI/2)            !１４面体　　８角～８角折り角
      CALL mat_rotx(rotx2, op1*PI/3.285)       !　　　　　　８角～３角折り角
      DRAW D14_3886 WITH SCALE(.5)*ROTATE(Az)*shxyz*Axys
   CASE 9
      CALL mat_rotx(rotx, op1*PI/2.552)        !１４面体　　６角～６角折り角
      CALL mat_rotx(rotx2, op1*PI/3.285)       !　　　　　　６角～４角折り角
      DRAW D14_4668 WITH SCALE(.5)*ROTATE(Az)*shxyz*Axys
   CASE 10
      CALL mat_rotx(rotx, op1*PI/1.644)        !８面体　　　６角～６角折り角
      CALL mat_rotx(rotx2, op1*PI/2.552)       !　　　　　　６角～３角折り角
      DRAW D08_3464 WITH SCALE(.75)*ROTATE(Az)*shxyz*Axys
   CASE 11
      CALL mat_rotx(rotx, op1*PI/4)            !２６面体    ４角～４角折り角
      CALL mat_rotx(rotx2, op1*PI/5.100)       !　　　　　　４角～３角折り角
      DRAW D26_38418 WITH SCALE(.6)*ROTATE(Az)*shxyz*Axys
   CASE 12
      CALL mat_rotx(rotx, op1*PI/3.285)        !２６面体    ８角～６角折り角
      CALL mat_rotx(rotx2, op1*PI/4)           !　　　　　　８角～４角折り角
      DRAW D26_4126886 WITH SCALE(.4)*ROTATE(Az)*shxyz*Axys
   CASE 13
      CALL mat_rotx(rotx, op1*PI/2.8376)       !３２面体　１０角～１０角折り角
      CALL mat_rotx(rotx2, op1*PI/4.815)       !　　　　　１０角～３角折り角
      DRAW D32_3201012 WITH SCALE(.3)*ROTATE(Az)*shxyz*Axys
   CASE 14
      CALL mat_rotx(rotx, op1*PI/4.815)        !３２面体　５角～５角折り角
      DRAW D32_320512 WITH SCALE(.55)*ROTATE(Az)*shxyz*Axys
   CASE 15
      CALL mat_rotx(rotx, op1*PI/4.85)         !３８面体　４角～３角折り角
      CALL mat_rotx(rotx2, op1*PI/6.72)        !　　　　　３角～３角折り角
      DRAW D38_33246 WITH SCALE(.7)*ROTATE(Az)*shxyz*Axys
   CASE 16
      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 17
      CALL mat_rotx(rotx, op1*PI/5.675)        !６２面体　４角～１０角折り角
      CALL mat_rotx(rotx2, op1*PI/8.61)        !　　　　　６角～４角折り角
      DRAW D62_4306201012 WITH SCALE(.24)*ROTATE(Az)*shxyz*Axys
   CASE 18
      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 s=MOD(s+1,imax+1)  !debug increase s
         LET flt=0              !平面図プロセス終了
      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: 次の周期の始め＝前の周期の終り
   !--------------debug---
   IF itemb<>item THEN
      PRINT USING"## ### #.###":sq,sq0,t2     !sq:採取画数, sq0:写像_全画数, t2:制御_休止秒
      LET itemb=item
   END IF
   !---------
LOOP UNTIL mrb=1                !右クリック

DATA -.524,  -.57, -1.5  , 2.4    ! 0 (za,x0,y0,hw) !32 平面展開図セットアップ
DATA -.524,  -.57, -1.5  , 2.4    ! 1 (za,x0,y0,hw) !32 　　〃
!---
DATA  .262, -1.28, -1.98 , 2.9    ! 2 (za,x0,y0,hw) !20 　　〃
DATA  4.03, -2.06, -2.32 , 2.95   ! 3 (za,x0,y0,hw) !12 　　〃
DATA -1.84, -1.43, -1.42 , 2.3    ! 4 (za,x0,y0,hw) ! 8 　　〃
DATA -1.57, -1.5 , -1.0  , 2.1    ! 5 (za,x0,y0,hw) ! 6 　　〃
DATA -2.69,  -.91,  -.688, 1.7    ! 6 (za,x0,y0,hw) ! 4 　　〃
!---
DATA     0,  0.6 , -2.0  , 3.0    ! 7 (za,x0,y0,hw) !14 　　〃
DATA  3.14, -0.7 , -2.0  , 3.0    ! 8 (za,x0,y0,hw) !14 　　〃
DATA -1.57, -0.5 , -1.5  , 2.5    ! 9 (za,x0,y0,hw) !14 　　〃
DATA -2.36, -1.0 , -1.5  , 2.5    !10 (za,x0,y0,hw) ! 8 　　〃
DATA  3.14, -0.8 , -2.0  , 2.7    !11 (za,x0,y0,hw) !26 　　〃
DATA  2.35, -1.8 , -1.8  , 2.7    !12 (za,x0,y0,hw) !26 　　〃
DATA -2.15, -0.35, -1.2  , 2.6    !13 (za,x0,y0,hw) !32 　　〃
DATA  0.26, -1.2 , -1.9  , 3.0    !14 (za,x0,y0,hw) !32 　　〃
DATA     0, -1.6 , -1.9  , 3.0    !15 (za,x0,y0,hw) !38 　　〃
DATA -1.86, -2.5 , -1.5  , 3.2    !16 (za,x0,y0,hw) !62 　　〃
DATA  0.25, -1.75, -2.45 , 3.35   !17 (za,x0,y0,hw) !62 　　〃
DATA  0.54, -1.7 , -2.3  , 4.1    !18 (za,x0,y0,hw) !92 　　〃

SUB flatx(za,x0,y0,hw)
   IF opAbak=0 THEN
      LET opAbak=opA              !※Save Condition《１》
      LET opSbak=opS
      MAT Abak=Axys
      LET opA=.525                !平面図開度の振幅
      LET opS=.475                !平面図開度のバイアス
      MAT Axys=IDN                !平面図ドラッグ累積クリアー
      LET op1=1
      LET ss=0
   END IF
   LET flt=1                            !平面図プロセス自己保持
   LET Az=za                            !平面図方向
   SET WINDOW x0-hw,x0+hw,y0-hw,y0+hw   !平面図スケール
   DRAW grid !WITH ROTATE(Az)
   PLOT label,AT x0-.48*hw, y0+.95*hw:"左 click 一時停止。右 click 終了。"
END SUB

SUB control_
   SET WINDOW x0-hw, x0+hw, y0-hw, y0+hw                            !主画面スケール
   PLOT LINES: cx1,cy1; cx2,cy1; cx2,cy2; cx1,cy2; cx1,cy1
   IF fla(item,4)<>0 THEN PLOT label,AT cx0, cy0: "展開図へ"
   mouse poll mx,my,mlb,mrb
   IF flt=1 OR mlb=0 AND fla(item,4)<>0 AND msk(item,0)<>0 AND cx1< mx AND mx< cx2 AND cy1< my AND my< cy2 THEN
   !-----unwrap entrance---
      CALL flatx( fla(item,1),fla(item,2),fla(item,3),fla(item,4))  !平面展開図セットアップ
      EXIT SUB
   ELSEIF 0< opAbak THEN
      LET opA=opAbak              !※Restore Condition《１》
      LET opS=opSbak
      MAT Axys=Abak
      LET opAbak=0
   END IF
   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
         !-----
         IF s=1 THEN LET c=6-D3(ib,11,1) ELSE LET c=ib+1   !s=1 サッカーボール→(５角c=1, ６角c=0)
         SET AREA COLOR c                                  !各面の色。 D3(ib,11,1)は、各面の角数
         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

!Page-2 へ続く

[3] Page-2 投稿者：SECOND 投稿日：2012年 3月 7日(水)19時14分3秒: !Page-2 の始め

!---------プロット配列~配列
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 D20             !D20 =D08 =D04 共用
   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

!---------アルキメデス多面体
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 D14_3846
   DRAW getpos(4, p4)                                                 !基４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D14_3846_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左2nd.３角
   DRAW D14_3846_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI) !右2nd.３角
END PICTURE
PICTURE D14_3846_2
   DRAW getpos(3, p3)                                                 !2nd.３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D14_3846 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir3)*ROTATE( PI/3)    !左上.基４角
   DRAW D14_3846 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3)    !右上.基４角
END PICTURE

PICTURE D14_3886
   DRAW getpos(8, p8)                                                      !基８角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir8)*ROTATE( .25*PI) !左上３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir8)*ROTATE(-.25*PI) !右上３角
   DRAW D14_3886 WITH SHIFT(0,ir8)*rotx*SHIFT(0,ir8)                       !　上８角
   DRAW D14_3886 WITH SHIFT(0,ir8)*rotx*SHIFT(0,ir8)*ROTATE( .5*PI)        !　左８角
   DRAW D14_3886 WITH SHIFT(0,ir8)*rotx*SHIFT(0,ir8)*ROTATE(-.5*PI)        !　右８角
END PICTURE

PICTURE D14_4668
   DRAW getpos(6, p6)                                                      !基６角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir6)                 !上４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir6)*ROTATE(-PI*2/3) !右下４角
   DRAW D14_4668 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(-PI/3)         !右上６角
   DRAW D14_4668 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(PI/3)          !左上６角
END PICTURE

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

PICTURE D26_38418
   DRAW getpos(4, p4)                                                    !基４角
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI) !右４角
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D26_38418_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)                  !上2nd.４角
   DRAW D26_38418_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI)   !右2nd.４角
   DRAW D26_38418_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI)   !左2nd.４角
END PICTURE
PICTURE D26_38418_2
   DRAW getpos(4, p4)                                                     !　2nd.４角
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)                 !上2nd.４角
   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 D26_38418 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)                     !上.基４角
END PICTURE

PICTURE D26_4126886
   DRAW getpos(8, p8)                                                     !　基８角
   DRAW getpos(6, p6) WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir8)*ROTATE(-PI/4)   !右上６角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(6, p6) WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir8)*ROTATE( PI/4)   !左上６角
   DRAW D26_4126886_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir8)                !上2nd.４角
   DRAW D26_4126886_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir8)*ROTATE( PI/2)  !左2nd.４角
   DRAW D26_4126886_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir8)*ROTATE(-PI/2)  !右2nd.４角
END PICTURE
PICTURE D26_4126886_2
   DRAW getpos(4, p4)                                                     !2nd.４角
   DRAW D26_4126886 WITH SHIFT(0,ir8)*rotx2*SHIFT(0,ir4)                  !上.基８角
END PICTURE

PICTURE D32_3201012
   DRAW getpos(10, p10)                                                    !基１０角
   IF sq=30 THEN DRAW getpos(10, p10) WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE(.2*PI) !左上１０角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir10)                !上３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir10)*ROTATE(.4*PI)  !左上３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir10)*ROTATE(-.8*PI) !右下３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D32_3201012 WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE(-.2*PI)     !右上１０角
   DRAW D32_3201012 WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE( .2*PI)     !左上１０角
   DRAW getpos(10, p10) WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE(-.6*PI) !右下１０角
END PICTURE

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

PICTURE D38_33246
   DRAW getpos(4, p4)                                                  !基４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D38_33246_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左2nd.３角
   DRAW D38_33246_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI) !右2nd.３角
END PICTURE
PICTURE D38_33246_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 D38_33246_3 WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE( PI/3)   !左上3rd.３角
END PICTURE
PICTURE D38_33246_3
   DRAW getpos(3, p3)                                                   !3rd.３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE(PI/3) !左上3rd.３角
   DRAW D38_33246 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3)     !右上.基４角
END PICTURE

PICTURE D62_320430512
   DRAW getpos(3, p3)                                                       !基３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir3)*ROTATE( PI/3)  !左2nd.４角
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir3)*ROTATE(-PI/3)  !右2nd.４角
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir3)*ROTATE( PI)    !下2nd.４角
END PICTURE
PICTURE D62_320430512_2
   DRAW getpos(4, p4)                                                    !2nd.４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左2nd.５角
   IF sq=61 THEN DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI) !右2nd.５角
   DRAW D62_320430512 WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir4)               !上.基３角
END PICTURE

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

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

[4] 化けるカラーボール2 投稿者：SECOND 投稿日：2013年 6月14日(金)01時26分42秒: !　化けるカラーボール2
!----------------------------
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)  ,q1(155),q2(155)
!
LET imax=4                                  !item maxim.
DIM D3( 92+1, 0 TO 10+1, 3), D1(10+1,2)     !(面数, 面の角数+1, xyz), (面の角数+1, xy)
DIM msk(imax, 0 TO 155), 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, .25, 1.5
!
LET Ax=-PI/3.2                              !開始のｚ軸方向( 画面垂直０度からｘ軸回転成分)
LET Ay=0                                    !　　〃　〃　　( 　　　〃　〃　　ｙ軸回転成分)
LET opA=0.3                                 !多面体開度の振幅
LET opS=0.95                                !多面体開度のバイアス
LET item=1                                  !開始 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
   CASE 4
      CALL mat_rotx(rotx, op1*PI/4.305)        !３２面体　　残部６角～残部６角折り角
      CALL mat_rotx(rotx2, op1*PI/4.815)       !　　　　　切頭部５角～残部６角折り角
      DRAW D32(5) WITH SCALE(.333)*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
      IF PI<=ss AND ss< PI*49/48 THEN LET item=MOD(item,imax)+1  !debug increase item
      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
      FOR i=1 TO sq
         LET q1(i)=D3(i,0,3)-3
         LET q2(i)=i
      NEXT i
      CALL Qsort00(1,sq)
      !-----real draw with priority
      FOR j=1 TO sq
         LET ib=q2(j)                       !ib= ｚ最小(奥) の配列番号。
         !-----
         LET c=ib+1
         IF sq=32 THEN LET c=6-D3(ib,11,1)  !32角のみモノクロ。
         SET AREA COLOR c                   !各面の色。
         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
      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
   LET Vi(1)=p(0,1)
   LET Vi(2)=p(0,2)
   MAT Vo=Vi*m
   LET D3(sq,0,1)=Vo(1)
   LET D3(sq,0,2)=Vo(2)
   LET D3(sq,0,3)=Vo(3)
   FOR j=1 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)
   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 D32(k)
   IF 0< k THEN
      DRAW D32(k-1) WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(-PI/3)    !右上６角
      DRAW D32(k-1) WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(PI/3)     !左上６角
      DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx2*SHIFT(0,ir6)            !　上５角
   END IF
   DRAW getpos(6, p6)                                                    !　基６角
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)                                                      !基１０角
   IF sq=5 THEN DRAW getpos(6, p6) 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.４角
   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 D92_380512_3 WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE( PI/3)  !左上3rd.３角
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE(-PI/3) !右上2nd.３角
END PICTURE
PICTURE D92_380512_3
   DRAW getpos(3, p3)                                                   !3rd.３角
   IF sq=3 THEN 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

!---------------------------
! Quick Sort q2() by q1()
!---------------------------
SUB Qsort00(L,R)                   !昇順にセット。
   local i,j
   LET i=L
   LET j=R
   LET w=q1((L+R)/2)
   DO
      DO WHILE q1(i)< w            ![< ]昇順　[>]降順
         LET i=i+1
      LOOP
      DO WHILE w< q1(j)            ![< ]昇順　[>]降順
         LET j=j-1
      LOOP
      IF j< i THEN EXIT DO         !等号付 j<=i は、暴走。
      SWAP q1(i),q1(j)
      SWAP q2(i),q2(j)
      LET i=i+1
      LET j=j-1
   LOOP UNTIL j< i                 !等号付 j<=i は、低速。
   IF L< j THEN CALL Qsort00(L,j)
   IF i< R THEN CALL Qsort00(i,R)
END SUB

END

[5] ジグソー・パズル２ 投稿者：SECOND 投稿日：2013年11月 2日(土)21時08分23秒: ! ピースの形に方形を止め、曲線に替えて、ベタ色ピースの対策をしてみた、、
!  http://6317.teacup.com/basic/bbs/3177
!-----------------
! ジグソー・パズル
!-----------------
!● ピースの移動方法  (周囲の何処でも、空いている所に組み立てていく)
!
!１）移動元ピースを選び左クリックする。ピースが持ち上がりカーソルＯＮ。
!　※この状態で、ピースを右クリックすると、90°刻みに右回転する。(ｙ軸↓)
!２）移動先の空所を、左クリック、その場所へピースが移動。
!
!　※移動先が、他のピース上の場合は、移動中止、移動元は復帰、
!　　その新しい場所のピースを移動元として、持ち替える。
!
!●ボタン操作
!　□Shuffle2: 乱数回転＋乱数配置　□Shuffle1: 乱数配置　□Normal: 原画配置
!　□End: プログラムの停止
!
!●リアルタイム「完成」チェックを、行なっています。
!　起動時は、原画配置状態になっているので、１つ選んで元へ戻すと反応確認可。
!-----------------------------------------------------------------
DEBUG ON
OPTION ARITHMETIC NATIVE
RANDOMIZE
OPTION BASE 0
SET TEXT JUSTIFY"center","half"
SET POINT STYLE 1
gload "sample\ZENKOUJI.JPG"          !piece の原画
!--------------------------------------------------------
!ここで、エラー停止した方は、
!ご自身の十進BASICフォルダー位置に調整して下さい、
!上のパス名は、BASIC.EXE と同フォルダーから起動の場合です。
!--------------------------------------------------------
ASK PIXEL SIZE(0,0;1,1) bmx,bmy
SET WINDOW 0,bmx-1,bmy-1,0
!
LET bgc=BVAL("002000",16)            !bgr 背景色
CALL n_bgr(bgc)
SET COLOR MIX(0) r/256,g/256,b/256   !clear color (also native mode)
SET COLOR mode"native"

SUB n_bgr(n)
   LET b=IP(n/65536)
   LET g=MOD(IP(n/256),256)
   LET r=MOD(n,256)
END SUB

!---
LET ppw=40                !原画piece x.y pix.width
LET ppe=ppw-1             !          x.y pix.end
LET gxw=CEIL(bmx/ppw)     !原画grid x width
LET gyw=CEIL(bmy/ppw)     !         y width
!---
LET sxw=IP(640/ppw)       !組立space x width( 数倍の余白 grid を含む様に決める)
LET syw=IP(480/ppw)       !          y width
LET sxpw=ppw*sxw          !          x pix.width
LET sypw=ppw*syw          !          y pix.width
LET bw=12                 !          border pix.width
!---
LET pbh= 80               !push button H pix.width
LET pbv= 30               !            V pix.width
LET pbj=sypw+bw+bw        !push button   Top  pix.position
LET pb1=sxpw-pbh          !     button 1 Left pix.position
LET pb2=pb1-(pbh+bw)      !     button 2 L    pix.position
LET pb3=pb2-(pbh+bw)      !     button 3 L    pix.position
LET pb4=pb3-(pbh+bw)      !     button 4 L    pix.position
!---
LET wa=3                              !波型罫線振幅 amplitude pix.width
DEF fx(i)=SIN( PI* 2.5*i/ppw    )*wa  !ｘ軸波型関数
DEF fy(i)=SIN( PI*(2.5*i/ppw+.5))*wa  !ｙ軸波型関数
LET zw1=2                             !piece の編集リフト・アップ pix.width
LET zw=zw1+wa+4                       !piece の編集カーソルgap pix.width
!---
DIM rot(gxw*gyw-1)                                  !各 piece_ID の回転角度
DIM id(syw-1,sxw-1)                                 !各 piece_ID の位置
DIM img(gxw*gyw-1, -wa TO ppw+wa-1,-wa TO ppw+wa-1) !各 piece_ID の image
DIM msk(gxw*gyw-1, -wa TO ppw+wa-1,-wa TO ppw+wa-1) !各 piece_ID の mask pattern
DIM bak(-zw TO ppw+zw-1, -zw TO ppw+zw-1)           !back ground の save/restore

!----画像の分割、Piece の採取と、そのID 設定( 終了まで固定 )
LET i0=(gxw*ppw-bmx)/2
LET j0=(gyw*ppw-bmy)/2
FOR y=0 TO gyw-1
   FOR x=0 TO gxw-1
      LET n=gxw*y+x
      FOR j=-wa TO ppw+wa-1
         FOR i=-wa TO ppw+wa-1
            ASK PIXEL VALUE( ppw*x+i-i0,ppw*y+j-j0 ) img(n,j,i)
         NEXT i
      NEXT j
   NEXT x
NEXT y
!----
SET LINE COLOR BVAL("000000",16)
SET bitmap SIZE wa*2+ppw+wa*2,wa*2+ppw+wa*2
SET WINDOW -wa*2,ppw+wa*2-1, ppw+wa*2-1,-wa*2
FOR y=0 TO gyw-1
   FOR x=0 TO gxw-1
      SET AREA COLOR BVAL("ffffff",16)
      PLOT AREA: -wa*2,-wa*2; ppw+wa*2,-wa*2; ppw+wa*2,ppw+wa*2; -wa*2,ppw+wa*2
      FOR u=-wa-1 TO ppe+wa+1
         LET i=x*ppw+u
         LET j=fx(i)        !y*ppw+fx(i)
         PLOT LINES: u,j;   !i,j;
      NEXT u
      PLOT LINES
      FOR u=-wa-1 TO ppe+wa+1
         LET i=x*ppw+u
         LET j=ppw+fx(i)    !(y+1)*ppw+fx(i)
         PLOT LINES: u,j;   !i,j;
      NEXT u
      PLOT LINES
      FOR v=-wa-1 TO ppe+wa+1
         LET j=y*ppw+v
         LET i=fy(j)        !x*ppw+fy(j)
         PLOT LINES: i,v;   !i,j;
      NEXT v
      PLOT LINES
      FOR v=-wa-1 TO ppe+wa+1
         LET j=y*ppw+v
         LET i=ppw+fy(j)    !(x+1)*ppw+fy(j)
         PLOT LINES: i,v;   !i,j;
      NEXT v
      PLOT LINES
      SET AREA COLOR BVAL("000000",16)
      paint -wa-1,-wa-1
      LET n=gxw*y+x
      FOR j=-wa TO ppw+wa-1
         FOR i=-wa TO ppw+wa-1
            ASK PIXEL VALUE(i,j) msk(n,j,i)
         NEXT i
      NEXT j
   NEXT x
NEXT y
!----screen
SET bitmap SIZE bw+sxpw+bw, bw+pbv+bw+1+bw+sypw+bw
SET WINDOW -bw,sxpw+bw-1, bw+pbv+bw+bw+sypw,-bw
SET TEXT font "",12
CLEAR
SET TEXT COLOR BVAL("ffffff",16)
SET LINE COLOR BVAL("ffffff",16)
PLOT LINES: -bw,pbj-bw; sxpw+bw-1,pbj-bw
CALL button( pb1, "404040","End")
CALL button( pb2, "404040","Normal")
CALL button( pb3, "404040","Shuffle1")
CALL button( pb4, "404040","Shuffle2")

SUB button(i, c$, t$)
   SET AREA COLOR BVAL(c$,16)
   PLOT AREA: i,pbj; i+pbh-1,pbj; i+pbh-1,pbj+pbv-1; i,pbj+pbv-1
   PLOT TEXT,AT i+pbh/2,pbj+pbv/2 :t$
   CALL b_edge(i,"303030","FFFFFF")
END SUB

SUB b_edge(i, c1$,c2$)
   SET LINE width 3
   SET LINE COLOR BVAL(c1$,16)
   PLOT LINES: i+pbh-1,pbj+1; i+pbh-1,pbj+pbv-1; i+1,pbj+pbv-1
   SET LINE COLOR BVAL(c2$,16)
   PLOT LINES: i+1,pbj+pbv-2; i+1,pbj+1; i+pbh-2,pbj+1
   SET LINE width 1
END SUB

SUB b_down(i)
   CALL b_edge(i,"FFFFFF","303030")
   WAIT DELAY .4
   CALL b_edge(i,"303030","FFFFFF")
END SUB

!----Piece の初期描画
SUB dpiece(m)
   MAT id=(-1)*CON
   MAT rot=ZER
   LET bak_x=-1               !bak()=空。 (bak_x,bak_y)= 背景.bak(i,j)のxy
   LET edtid=-1               !edit.ID=空
   FOR y=0 TO gyw-1
      FOR x=0 TO gxw-1
         LET n=gxw*y+x
         LET id(y,x)=n        !Piece.ID 配置( linear for debug)
      NEXT x
   NEXT y
   !----Piece.の ID.乱数配置、乱数回転
   IF 0< m THEN
      FOR y=0 TO gyw-1
         FOR x=0 TO gxw-1
            swap id(y,x),id( INT(RND*gyw),INT(RND*gxw))
            IF 1< m THEN LET rot(y*gxw+x)=INT(RND*4)*PI/2
         NEXT x
      NEXT y
   END IF
   !----描画
   SET LINE COLOR 0
   SET AREA COLOR bgc
   PLOT AREA: -bw,-bw; sxpw+bw-1,-bw; sxpw+bw-1,sypw+bw-1; -bw,sypw+bw-1
   FOR y=0 TO gyw-1
      FOR x=0 TO gxw-1
         LET n=id(y,x)
         LET i=x*ppw
         LET j=y*ppw
         DRAW plot_img(n) WITH ROTATE(rot(n))*SHIFT(ppe/2+i, ppe/2+j)
      NEXT x
   NEXT y
END SUB

!--------------+
! Main Program |
!--------------+
CALL dpiece(0)
DO
   DO
      LET i=mlb+mrb
      mouse poll mx,my,mlb,mrb
      WAIT DELAY 0
   LOOP UNTIL i=0 AND (0< mlb OR 0< mrb)
   LET x=INT(mx/ppw)
   LET y=INT(my/ppw)
   IF 0<=x AND x< sxw AND 0<=y AND y< syw THEN
      IF mlb=1 THEN
         CALL edit00
      ELSEIF mrb=1 AND bak_x=x AND bak_y=y THEN
         CALL restore_bak2
         LET i=x*ppw
         LET j=y*ppw
         LET rot(edtid)=MOD( rot(edtid)+PI/2, 2*PI)
         DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i-zw1,ppe/2+j-zw1)
         PLOT LINES: i-zw,j-zw; i+ppe+zw,j-zw; i+ppe+zw,j+ppe+zw; i-zw,j+ppe+zw; i-zw,j-zw
      END IF
   ELSEIF pbj<=my AND my< pbj+pbv AND mlb=1 THEN
      IF pb1<=mx AND mx< pb1+pbh THEN             !終了
         CALL b_down(pb1)
         STOP
      ELSEIF pb2<=mx AND mx< pb2+pbh THEN         !ノーマル
         CALL b_down(pb2)
         CALL dpiece(0)
      ELSEIF pb3<=mx AND mx< pb3+pbh THEN         !シャッフル1
         CALL b_down(pb3)
         CALL dpiece(1)
      ELSEIF pb4<=mx AND mx< pb4+pbh THEN         !シャッフル2
         CALL b_down(pb4)
         CALL dpiece(2)
      END IF
   END IF
LOOP

!---------------
SUB edit00
!---------------
   IF 0<=id(y,x) THEN
   !---pick piece on screen
      IF 0<=edtid THEN
         LET id(bak_y,bak_x)=edtid           !編集中断
         LET i=bak_x*ppw
         LET j=bak_y*ppw
         CALL restore_bak
         DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i,ppe/2+j)
      END IF
      LET i=x*ppw
      LET j=y*ppw
      LET edtid=id(y,x)                      !0<=edtid  編集始まり
      LET id(y,x)=-1
      !---erase before lift up
      DRAW era_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i,ppe/2+j)
      SET DRAW mode hidden
      FOR v=y-1 TO y+1
         FOR u=x-1 TO x+1
            IF 0<=u AND u< sxw AND 0<=v AND v< syw THEN
               LET n=id(v,u)
               IF 0<=n THEN DRAW plot_img(n) WITH ROTATE(rot(n))*SHIFT(ppe/2+u*ppw,ppe/2+v*ppw)
            END IF
         NEXT u
      NEXT v
      SET DRAW mode explicit
      CALL save_bak(i,j)
      !---write lift up picec
      DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i-zw1,ppe/2+j-zw1)
      SET LINE COLOR "green"
      PLOT LINES: i-zw,j-zw; i+ppe+zw,j-zw; i+ppe+zw,j+ppe+zw; i-zw,j+ppe+zw; i-zw,j-zw
   ELSEIF 0<=edtid THEN
   !---put piece on screen
      CALL restore_bak
      !---
      LET id(y,x)=edtid
      LET i=ppw*x
      LET j=ppw*y
      CALL checker                        !完成検査
      !---put piece on destination
      WAIT DELAY .2
      DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i,ppe/2+j)
      LET edtid=-1                        !edtid< 0  編集終わり
   END IF
END SUB

SUB checker
   FOR y=0 TO syw-gyw
      FOR x=0 TO sxw-gxw
         IF id(y,x)=0 THEN EXIT FOR
      NEXT x
      IF x<=sxw-gxw THEN EXIT FOR
   NEXT y
   IF sxw-gxw< y THEN EXIT SUB                      !err.on
   LET n=0
   FOR v=y TO y+gyw-1
      FOR u=x TO x+gxw-1
         IF id(v,u)<>n OR 0< rot(n) THEN EXIT SUB   !err.on
         LET n=n+1
      NEXT u
   NEXT v
   PLOT TEXT,AT i+ppe/2, j+ppe/2 :"完成"
   beep
END SUB

!----------------
SUB save_bak(i,j)                 !(i,j) = 背景.xy の左上端.pix
   CALL restore_bak
   LET bak_i=i-zw
   LET bak_j=j-zw
   ASK PIXEL ARRAY(bak_i,bak_j) bak
   LET bak_x=x
   LET bak_y=y
END SUB

SUB restore_bak                   !(bak_i,bak_j) = 画像grid の左上端.pix
   IF bak_x< 0 THEN EXIT SUB
   MAT PLOT CELLS,IN bak_i,bak_j; bak_i+ppe+zw+zw,bak_j+ppe+zw+zw :bak
   LET bak_x=-1
   LET bak_y=-1
END SUB

SUB restore_bak2                  !(bak_i,bak_j) = 画像grid の左上端.pix
   IF bak_x< 0 THEN EXIT SUB
   MAT PLOT CELLS,IN bak_i,bak_j; bak_i+ppe+zw+zw,bak_j+ppe+zw+zw :bak
END SUB

!-----------------
PICTURE plot_img(n)               !(0,0) = 画像img()の中心
   FOR j_=-wa TO ppe+wa
      FOR i_=-wa TO ppe+wa
         IF 0< msk(n,j_,i_) THEN
            SET POINT COLOR img(n,j_,i_)
            PLOT POINTS: i_-ppe/2,j_-ppe/2
         END IF
      NEXT i_
   NEXT j_
END PICTURE

PICTURE era_img(n)                !(0,0) = mask msk()の中心
   SET POINT COLOR bgc
   FOR j_=-wa TO ppe+wa
      FOR i_=-wa TO ppe+wa
         IF 0< msk(n,j_,i_) THEN PLOT POINTS: i_-ppe/2,j_-ppe/2
      NEXT i_
   NEXT j_
END PICTURE

END

[6] 多重版４つの振り子 投稿者：SECOND 投稿日：2014年 6月22日(日)04時22分17秒: !----振子のカオス(Chaos)
!多重版４つの振り子

LET m_x=4                         !振子の多重最大数
DIM m(m_x), L(m_x), r(m_x)
DIM mm(m_x,m_x), b(m_x)
!
DIM oa1(m_x), oa2(m_x), oa3(m_x), oa4(m_x), ia(m_x), ww(m_x)
DIM ow1(m_x), ow2(m_x), ow3(m_x), ow4(m_x), iw(m_x)
!
DIM Aa(2), Ba(1), Ca(3), Da(4)    !角度　：配列サイズが、振子の重数
DIM Aw(2), Bw(1), Cw(3), Dw(4)    !角速度：配列サイズが、振子の重数
!
LET g= 9.8     !m/s^2
LET dt=0.051   !sec.＝計算ピッチ。数理的な設定値。0.02 位が良( 0.051は、Pentium３ 500MHz)
!　　　　　　  　　　実行の余り( 画面右上表示) 0=< ピッチ毎に、入っている Wait 時間。
!　　　　　            　　  　　               0 > 負数は、余裕無く、遅れた積算時間。
!----init.
MAT Aa=( PI*0.95 )*CON            !初期角度
MAT Ba=(-PI*0.951)*CON
MAT Ca=( PI*0.777)*CON
MAT Da=(-PI*0.888)*CON
!---
MAT m=0.1*CON                     !kg( n番目のおもり。A B C D 共通)
MAT L= 4 *CON                     !m ( n番目の腕長さ。A B C D 共通)
FOR n=1 TO m_x
   LET r(n)=SQR(m(n))             !m ( n番目のおもり描画半径。A B C D 共通)
NEXT n

!---------------------------------------------------------------------------------------
!ラグランジュの運動方程式 ( 多重振子全体エネルギーと、k番目の振子の式 )
! {d(∂(T-U)/∂ωk)/dt}-{∂(T-U)/∂θk}=0   //T=全運動エネルギー U=全位置エネルギー
!max      n
!Σm(n)*[Σ{L(j)*cos(θ(k)-θ(j))*dω(j)/dt +L(j)*ω(j)^2*sin(θ(k)-θ(j))} +g*sin(θ(k))]=0
!n=k     j=1
!---------------------------------------------------------------------------------------
SUB Dwa( da(),dw(), a(),w())      !・・( dθ()/dt, dω()/dt, θ(),ω())
   MAT mm=ZER( SIZE(a),SIZE(a))
   MAT b=ZER( SIZE(a))
   FOR k=1 TO SIZE(a)
      FOR n=k TO SIZE(a)
         FOR j=1 TO n
            LET mm(k,j)=mm(k,j)+m(n)*L(j)*COS(a(k)-a(j))
            LET  b(k)  =b(k)   -m(n)*L(j)*w(j)^2*SIN(a(k)-a(j))
         NEXT j
         LET b(k)=b(k)-m(n)*g*SIN(a(k))
      NEXT n
   NEXT k
   MAT mm=INV(mm)
   MAT dw=mm*b
   MAT da=w
END SUB

SUB RungeKutta(a(),w())
   CALL Dwa( oa1,ow1, a, w )
   MAT ww=(dt/2)*oa1
   MAT ia=a+ww
   MAT ww=(dt/2)*ow1
   MAT iw=w+ww
   CALL Dwa( oa2,ow2, ia,iw )
   MAT ww=(dt/2)*oa2
   MAT ia=a+ww
   MAT ww=(dt/2)*ow2
   MAT iw=w+ww
   CALL Dwa( oa3,ow3, ia,iw )
   MAT ww=dt*oa3
   MAT ia=a+ww
   MAT ww=dt*ow3
   MAT iw=w+ww
   CALL Dwa( oa4,ow4, ia,iw )
   !--
   MAT ww=oa2+oa3
   MAT ww=2*ww
   MAT ww=ww+oa1
   MAT ww=ww+oa4
   MAT ww=(dt/6)*ww
   MAT a=a+ww
   !--
   MAT ww=ow2+ow3
   MAT ww=2*ww
   MAT ww=ww+ow1
   MAT ww=ww+ow4
   MAT ww=(dt/6)*ww
   MAT w=w+ww
END SUB

!------------- main ---------------
LET xm=+1.0
LET ym=-1.0
LET h=14
SET LINE COLOR 2
SET LINE width 2
LET t0=TIME
DO
   SET DRAW mode hidden                !画像加工始め、表示更新を一時停止 (Abnormal)
   CLEAR
   SET WINDOW -h,+h,-h,+h
   PLOT TEXT,AT h*0.25,h*0.9:"マウス右ボタンで、終了。"
   PLOT TEXT,AT h*0.4 ,h*0.76,USING"計算ピッチ=#.### 秒":dt
   PLOT TEXT,AT h*0.4 ,h*0.69,USING"実行の余り=#.### 秒":t2
   SET WINDOW xm-h,xm+h, ym-h,ym+h
   SET AREA COLOR 15
   DRAW disk WITH SCALE(3.3, 3.9)
   DRAW circle WITH SCALE( 0.3)*SHIFT(-2.5, 2.5)
   DRAW circle WITH SCALE( 0.3)*SHIFT( 2.5, 2.5)
   DRAW circle WITH SCALE( 0.3)*SHIFT(-2.5,-2.5)
   DRAW circle WITH SCALE( 0.3)*SHIFT( 2.5,-2.5)
   SET AREA COLOR 1
   DRAW Pendulum0( 1,Aa) WITH ROTATE( Aa(1))*SHIFT(-2.5, 2.5)
   DRAW Pendulum0( 1,Ba) WITH ROTATE( Ba(1))*SHIFT( 2.5, 2.5)
   DRAW Pendulum0( 1,Ca) WITH ROTATE( Ca(1))*SHIFT(-2.5,-2.5)
   DRAW Pendulum0( 1,Da) WITH ROTATE( Da(1))*SHIFT( 2.5,-2.5)
   CALL RungeKutta( Aa,Aw)
   CALL RungeKutta( Ba,Bw)
   CALL RungeKutta( Ca,Cw)
   CALL RungeKutta( Da,Dw)
   SET DRAW mode explicit              !画像加工終り、表示の常時更新 (Normal)
   MOUSE POLL mx,my,mlb,mrb            !マウスの状態取得。
   !------------
   IF 0< t2 THEN WAIT DELAY t2         !t2: 制御出力の休止秒。
   LET t1=TIME                         !t1: 前の周期の終り。※TIME は約.05秒毎の更新。
   LET t2=t2+(dt-MOD(t1-t0,86400))/20  !dt－検出周期(t1-t0)＝偏差 →t2(積分 Gain=1/20)
   LET t0=t1                           !t0: 次の周期の始め＝前の周期の終り
LOOP UNTIL mrb=1

PICTURE Pendulum0( k,a())
   PLOT LINES: 0,0; 0,-L(k)
   DRAW disk WITH SCALE(r(k))*SHIFT( 0,-L(k))
   IF k< SIZE(a) THEN DRAW Pendulum0( k+1,a) WITH ROTATE( a(k+1)-a(k))*SHIFT( 0,-L(k))
END PICTURE

END

[7] 新４つの振り子メーター付 投稿者：SECOND 投稿日：2014年 6月28日(土)00時51分24秒: !４つの振り子メーター付

!過去2008年頃に、投稿した「４つの振り子」の改訂版、２重振子だけであるが、
!動きは、この方が。　多重版でもＡＢＣＤ配列サイズを２に揃えれば、同じになるが、
!こちらは、２重固定でもあり、計算量の少ない方法で、MAT 文を使用していない。

!----２重振子のカオス(Chaos)
LET g= 9.8     !m/s^2  重力加速度
LET m1=0.1     !kg     錘
LET m2=0.1     !kg
LET L1= 5      !m      腕
LET L2= 5      !m
LET r1=SQR(m1)
LET r2=SQR(m2)
LET dt=0.050   !sec.＝計算ピッチ。数理的な設定値。0.02 位が良( 0.050は、Pentium３ 500MHz)
!　　　　　　  　　　実行の余り( 画面右上表示) 0=< ピッチ毎に、入っている Wait 時間。
!　　　　　            　　  　　               0 > 負数は、余裕無く、遅れた積算時間。
!--------------------------------------------------------------------
!http://www.aihara.co.jp/~taiji/pendula-equations/present-node5.html
!ラグランジュの運動方程式 ( 多重振子全体エネルギーと、k番目の振子の式 )
!
! : ＼
! :θ1＼L1     dθ1/dt=ω1
!       ●m1
!       : ＼
!       :θ2＼L2     dθ2/dt=ω2
!             ●m2       (
!             : ＼         )
!                         dθmax/dt=ωmax
!
!  d{∂(T-U)/∂ωk)}/dt - ∂(T-U)/∂θk =0   //T=全運動エネルギー U=全位置エネルギー
!max      n
!Σm(n)*[Σ{L(j)*cos(θ(k)-θ(j))*dω(j)/dt +L(j)*ω(j)^2*sin(θ(k)-θ(j))} +g*sin(θ(k))]=0
!n=k     j=1
!
!２重振子の場合、max=2 k=1 k=2 で、上式を２回計算し２組のラグランジュ運動方程式を得る。
! dω1/dt, dω2/dt について解くため、その係数と、残りの項を、以下の様に並び替える。
!
! |L1*μ            L2*cos(θ1-θ2)||dω1/dt|=|-L2*(ω2)^2*sin(θ1-θ2)-μ*g*sin(θ1)|
! |L1*cos(θ1-θ2)  L2             ||dω2/dt| | L1*(ω1)^2*sin(θ1-θ2)   -g*sin(θ2)|
!
! dθ1/dt=ω1       μ=(m1+m2)/m2
! dθ2/dt=ω2
!
!次文 SUB Dwa(,,,) は上式のΣ計算を、「多重版４つの振り子」のような、直接実数による
!行列作成に用いず、上の様な手計算でのΣ計算、代数型の行列を用い、単変数での逆行列
!乗算などで、dω1/dt, dω2/dt の値を得ている。
!--------------------------------------------------------------------
LET u=(m1+m2)/m2

SUB Dwa( da1,da2,dw1,dw2, a1,a2,w1,w2)
   LET b1=-L2*w2^2*SIN(a1-a2)-u*g*SIN(a1)              !右行列の要素
   LET b2= L1*w1^2*SIN(a1-a2)  -g*SIN(a2)
   LET D= u-COS(a1-a2)^2                               !左行列の det./( L1*L2)
   LET dw1=(             b1 -COS(a1-a2)*b2 ) /L1/D     !dω1/dt=..
   LET dw2=( -COS(a1-a2)*b1 +         u*b2 ) /L2/D     !dω2/dt=.. 左逆行列 * 右行列
   LET da1=w1                                          !dθ1/dt=ω1
   LET da2=w2                                          !dθ2/dt=ω2
END SUB

SUB RungeKutta(a1,a2,w1,w2)
   CALL Dwa( da11,da21,dw11,dw21, a1,a2,w1,w2 )
   CALL Dwa( da12,da22,dw12,dw22, a1+da11*dt/2,a2+da21*dt/2,w1+dw11*dt/2,w2+dw21*dt/2 )
   CALL Dwa( da13,da23,dw13,dw23, a1+da12*dt/2,a2+da22*dt/2,w1+dw12*dt/2,w2+dw22*dt/2 )
   CALL Dwa( da14,da24,dw14,dw24, a1+da13*dt  ,a2+da23*dt  ,w1+dw13*dt  ,w2+dw23*dt )
   LET a1=a1+( da11+2*da12+2*da13+da14 )*dt/6
   LET a2=a2+( da21+2*da22+2*da23+da24 )*dt/6
   LET w1=w1+( dw11+2*dw12+2*dw13+dw14 )*dt/6
   LET w2=w2+( dw21+2*dw22+2*dw23+dw24 )*dt/6
END SUB

!----init.
LET Aa1=PI*0.8  !初期角度１
LET Aa2=PI*0.9  !　　～　２
LET Aw1=0       !初期角速度１
LET Aw2=0       !　　～　　２
!
LET Ba1=-Aa1+0.001
LET Ba2=-Aa2
LET Bw1=0
LET Bw2=0
!
LET Ca1=Aa1
LET Ca2=Aa2+0.002
LET Cw1=0
LET Cw2=0
!
LET Da1=-Aa1
LET Da2=-Aa2+0.003
LET Dw1=0
LET Dw2=0
!
!----Ａ振子(左上)おもりの、位置のエネルギーと運動エネルギー・メーター
DEF ep1=m1*g*L1*(1-COS(Aa1))                                       !位置１
DEF em1=(L1*Aw1)^2*m1/2                                            !運動１
DEF ep2=m2*g*(L1*(1-COS(Aa1))+L2*(1-COS(Aa2)))                     !位置２
DEF em2=((L1*Aw1)^2+(L2*Aw2)^2+2*L1*Aw1*L2*Aw2*COS(Aa1-Aa2))*m2/2  !運動２
!
!----run
LET xm=-0.5
LET ym=+0.5
LET h=14
SET LINE COLOR 2
SET LINE width 2
LET t0=TIME
DO
   SET DRAW mode hidden                !画像加工始め、表示更新を一時停止 (Abnormal)
   CLEAR
   SET WINDOW -h,+h,-h,+h
   PLOT TEXT,AT h*0.25,h*0.9:"マウス右ボタンで、終了。"
   PLOT TEXT,AT h*0.4 ,h*0.76,USING"計算ピッチ=#.### 秒":dt
   PLOT TEXT,AT h*0.4 ,h*0.69,USING"実行の余り=#.### 秒":t2
   PLOT TEXT,AT -h*0.97,h*0.9:"Ａ振子(左上) おもりのエネルギー[J]"
   PLOT TEXT,AT -h*0.92,h*0.83:"位置１　運動１　位置２　運動２"
   PLOT TEXT,AT -h*0.95,h*0.76,USING"##.#### ##.####　##.#### ##.####":ep1,em1,ep2,em2
   PLOT TEXT,AT -h*0.85,h*0.69,USING"##.####　　　　　##.####":ep1+em1,ep2+em2
   PLOT TEXT,AT -h*0.61,h*0.62,USING"##.####":ep1+em1+ep2+em2
   SET WINDOW xm-h,xm+h, ym-h,ym+h
   SET AREA COLOR 15
   DRAW disk WITH SCALE(3.3, 3.9)
   SET AREA COLOR 1
   DRAW Pendulum0( Aa2-Aa1,"1","2") WITH ROTATE( Aa1)*SHIFT(-2.5, 2.5)
   DRAW Pendulum0( Ba2-Ba1, "", "") WITH ROTATE( Ba1)*SHIFT( 2.5, 2.5)
   DRAW Pendulum0( Ca2-Ca1, "", "") WITH ROTATE( Ca1)*SHIFT(-2.5,-2.5)
   DRAW Pendulum0( Da2-Da1, "", "") WITH ROTATE( Da1)*SHIFT( 2.5,-2.5)
   CALL RungeKutta( Aa1,Aa2,Aw1,Aw2)
   CALL RungeKutta( Ba1,Ba2,Bw1,Bw2)
   CALL RungeKutta( Ca1,Ca2,Cw1,Cw2)
   CALL RungeKutta( Da1,Da2,Dw1,Dw2)
   SET DRAW mode explicit              !画像加工終り、表示の常時更新 (Normal)
   MOUSE POLL mx,my,mlb,mrb            !マウスの状態取得。
   !------------
   IF 0< t2 THEN WAIT DELAY t2         !t2: 制御出力の休止秒。
   LET t1=TIME                         !t1: 前の周期の終り。※TIME は約.05秒毎の更新。
   LET t2=t2+(dt-MOD(t1-t0,86400))/20  !dt－検出周期(t1-t0)＝偏差 →t2(積分 Gain=1/20)
   LET t0=t1                           !t0: 次の周期の始め＝前の周期の終り
LOOP UNTIL mrb=1

PICTURE Pendulum0( a, p$, s$)
   DRAW circle WITH SCALE( 0.3)
   DRAW Pendulum1( L1, r1, p$)
   DRAW Pendulum1( L2, r2, s$) WITH ROTATE( a )*SHIFT( 0, -L1)
END PICTURE

PICTURE Pendulum1( L, r, w$)
   PLOT LINES: 0,0; 0,-L
   DRAW disk WITH SCALE( r )*SHIFT( 0,-L)
   PLOT TEXT,AT r, r-L :w$
END PICTURE

END

[8] マンデルブロ集合の外周で、散歩 投稿者：SECOND 投稿日：2014年 9月16日(火)15時57分11秒: !
! マンデルブロ集合の外周で、散歩
!
! 画像の拡大したい個所を、左ボタンで擦り「選択枠」を決め、指を放す。
!
! 選択枠の始点位置に失敗した場合、
!１）指を放す前なら、枠を「線分」状に閉じれば、やり直せる。
!２）指を放した後なら、描画終了まで待ってから、
!　　画像の外側( 白地)を、左クリック。１段ずつバックする。
!
!※下の、LET q=1  !開始画像の段数を、q=2 にすると、
!　添付画像と同じ位置を、１回選択した状態に、HOT スタートします。
!
!※座標が、限界を超えて微細化すると、for~next 文の step が止まり、
!　無限ループへ落ちるので、"拡大の限界" の表示と入力制限を、追加。
!-----------------------------------------------------------------------
OPTION ARITHMETIC COMPLEX
SET POINT STYLE 1
DIM x1(100),x2(100),y1(100),y2(100)
! SET bitmap SIZE 401,401
! SET TEXT font "ＭＳＰゴシック",10         !bitmap SIZE 401x401 に使用
ASK PIXEL SIZE px0,py0                     !画面両端間、終端を含まない画素数
!
!---カラー・パレット準備                   !CLEAR use (n=0)WHITE
FOR n=1 TO 51
   SET COLOR MIX(    n) 0   ,0     ,n/51   !BLACK < < BLUE
   SET COLOR MIX( 51+n) 0   ,n/51  ,1      !BLUE  < < CYAN
   SET COLOR MIX(102+n) 0   ,1     ,1-n/51 !CYAN  < < GREEN
   SET COLOR MIX(153+n) n/51,1     ,0      !GREEN < < YELLOW
   SET COLOR MIX(204+n) 1   ,1-n/51,n/51   !YELLOW< < MAGENTA
NEXT n
!
LET q=1           !開始画像の段数
!
!---標準枠
LET x1(1)=-2.1
LET y1(1)=-1.4
LET x2(1)=  .8
LET y2(1)= 1.4
!---サンプル枠
LET x1(2)=-.734905054472112
LET y1(2)= .2099321564967
LET x2(2)=-.734886801875
LET y2(2)= .20995043125
!
PRINT "履歴データー"
DO
   LET XL=x1(q)
   LET YL=y1(q)
   LET XH=x2(q)
   LET YH=y2(q)
   PRINT q;"段目: XL=";XL;"YL=";YL;"XH=";XH;"YH=";YH
   CLEAR
   LET xm=(XL+XH)/2                                !中心座標ｘ
   LET ym=(YL+YH)/2                                !　〃　　ｙ
   LET w=MAX( XH-XL, YH-YL)/2 *1.25                !縦横、幅の大きい方
   SET WINDOW xm-w,xm+w, ym-.96*w,ym+1.04*w        !画面左,右,下,上、問題座標
   LET ds=2*w/px0                                  !問題座標幅／１画素
   LET t$=STR$(COMPLEX(XH,YH))
   PLOT TEXT,AT xm+w-ds*7*LEN(t$),YH+.01*w: t$     !右上の座標表示
   PLOT TEXT,AT xm-w,YL-.08*w: STR$(COMPLEX(XL,YL))!左下の座標表示
   PLOT LINES:XL,YL;XH,YL;XH,YH;XL,YH;XL,YL        !描画枠
   !
   !---
   CALL mandel                                     !マンデルブロ集合(内側白色部)
   !
   PLOT TEXT,AT xm-w*.9,ym+.96*w:"左クリックで、領域を、選択します。　右クリック終了"
   PLOT TEXT,AT xm-w*.9,ym+.89*w:"選択枠の始点をやり直すには枠を「線分」に閉めてから放す"
   PLOT TEXT,AT xm-w*.9,ym-.95*w:"画像の外(白地)を、左クリックすると、前の画像にバックします。"
   !
   !--- 領域の選択
   DO
      beep
      IF q< 1 THEN LET q=1
      LET q=q+1
      SET DRAW MODE NOTXOR                         !２度書きで消える NOTXOR モード
      CALL box( x1(q),y1(q), x2(q),y2(q))
      SET DRAW MODE overwrite                      !通常の上書きモードへ戻す
      IF 0< mlb THEN LET q=q-2                     !ＬボタンON, 画像のバック
   LOOP UNTIL 1<=q                                 !１段目からのバックで、２度書き防止
LOOP

SUB box(x,y,i,j)
   DO
      DO
         DO
            mouse poll x,y, mlb,mrb
            IF 0< mrb THEN STOP
            WAIT DELAY .05                            !フルクロック防止、省電力
         LOOP UNTIL 0< mlb                            !左ボタンON
         IF x< XL OR XH< x OR y< YL OR YH< y THEN EXIT SUB    !画像の外(白地)左クリック
         DO
            mouse poll i,j, mlb,mrb
            IF 0< mrb THEN STOP
            PLOT LINES:x,y;i,y;i,j;x,j;x,y            !方形　描画
            WAIT DELAY .05                            !表示の duty time 確保 & 省電力
            PLOT LINES:x,y;i,y;i,j;x,j;x,y            !方形　消去
         LOOP UNTIL mlb=0                             !左ボタンOFF
         ASK PIXEL SIZE (x,y;i,j) px,py               !領域の画素数(両端を含む)
      LOOP UNTIL 2< px AND 2< py                      !小さすぎる領域枠は、やり直し
      IF i< x THEN swap x,i
      IF j< y THEN swap y,j
      !---
      LET ds=MAX( i-x, j-y)*1.25/px0                  !縦横大きい方の数値幅／その画素数
      IF 5e-15<=ds THEN EXIT SUB                      !通常リターン
      beep
      PLOT TEXT,AT xm,ym:"拡大の限界"                 !問題座標の最小値限界。バックの促し
   LOOP
END SUB

SUB mandel
   FOR x=XL+ds TO XH-ds/2 STEP ds
      FOR y=YL+.9*ds TO YH-ds/2 STEP ds
         LET z=0
         FOR n=0 TO 63
            LET z=z^2+COMPLEX(x,y)
            IF 2< ABS(z) THEN EXIT FOR        !2< |z| → ∞ 発散の確定
         NEXT n
         IF 63< n THEN
            FOR n=n TO 255 STEP 4             !速度を上げるため、n の分解能を、途中変更
               LET z=z^2+COMPLEX(x,y)         !15sec.→12sec.程度
               LET z=z^2+COMPLEX(x,y)
               LET z=z^2+COMPLEX(x,y)
               LET z=z^2+COMPLEX(x,y)
               IF 2< ABS(z) THEN EXIT FOR     !2< |z| → ∞ 発散の確定
            NEXT n
         END IF
         IF n<=255 THEN                       !255< n で 2< |z| になる x,y の漏れは、妥協
            SET POINT COLOR MOD(n*4,255)+1    !集合の外 (z が発散する x,y) を、n で色付け
            PLOT POINTS :x,y
         END IF
      NEXT y
   NEXT x
END SUB

END

[9] クレイジーダイヤモンド錯視 投稿者：SECOND 投稿日：2015年12月13日(日)00時14分26秒: ! DEBUG ON
!------------------------------------------------------
! クレイジーダイヤモンド錯視 (陰影付きダイヤモンド錯覚)
!
!　並んでいるひし形は、全て同一の配色であるが、違った明るさに見える。
!
!１）それを確かめられる様、どれか１つを、マウスの左ボタンで
!　　ドラッグして、何処へでも、移動、比較、出来るようにした。
!
!２）液晶画面の影響も確かめられる様、ボタンが押されていない間は、
!　　３秒毎に全体が、90度ステップ左回転する。
!
!--------------------------------------------------------
SET bitmap SIZE 501,501             !画面は、正方形に設定
!
! SET bitmap SIZE 400,400           !投稿時の添付画像は、横幅 400pix を越えると、
! SET TEXT font "ＭＳゴシック",8   !縮尺されて、ボケるので、この設定で作成。
!
OPTION ARITHMETIC NATIVE
SET COLOR MODE "NATIVE"
ASK PIXEL SIZE (0,0;1,1) x,y
LET fs=y-1
LET hs=fs/2
SET WINDOW -hs,hs,-hs,hs
!-----------------------------------------  Ver.767 以前の起動時文字サイズ
SET TEXT font "ＭＳゴシック",10           !400x400 では外す
SET TEXT HEIGHT ABS(worldy(11)-worldy(0))  !400x400 では外す
!--------------------------------------------------
!
LET pix=1-EPS(hs)  !座標幅／ピクセル(縦横同じ)　　※正確な画素幅は１だが、連続プロットの際、画素境界
!                   　　　　　　　　　　　　　　　　での誤差の振れで、描画抜けを生ずる為、少し小さめ。
DIM bg(x,y), mt(4,4), vi(4), vo(4)
LET vo(4)=1        !画素ベクトル vo() のシステム予約要素=1 固定 (4x4行列変換用)
!
LET a=1/2.5        !ひし形の長軸ｙに対する輪郭傾斜勾配
LET vw=CEIL(fs/4)  !ひし形の長軸の長さ
LET hw=a*vw        !ひし形の短軸の長さ( 縦に比例、相似形になる)
!
LET v2=vw/2
LET h2=hw/2
!
LET b0=.5          !ひし形の長軸ｙに対するグラデーション中心輝度
LET g=.6/vw        !ひし形の長軸ｙに対するグラデーション輝度勾配
!---
SET AREA COLOR BVAL("ffff00",16)       !"BGR"
LET Ag=0                               !全体の回転角
LET t1=TIME
DO
   LET t0=t1                           !t0: 周期の始め ← t1: 前の周期の終り
   IF mlb=1 THEN                       !左ボタンＯＮ
      IF act=1 THEN                       !act=１、持回りひし形有り
         SET DRAW mode hidden
         MAT PLOT CELLS ,IN -hs,hs; hs,-hs :bg       !ひし形１つ抜けた全体再生
         DRAW diamond WITH ROTATE(Ag)*SHIFT(mx,my)   !ドラッグされるひし形上書き
         SET DRAW mode explicit
      ELSE                                !act=０、持回りひし形無し
         CALL sense                                  !カーソル位置のひし形探索
      END IF
   ELSE                                !左ボタンＯＦＦ
      LET act=0                           !リセット・フラグ act=０
      SET DRAW mode hidden                !全てのひし形描画
      paint 0,0
      PLOT TEXT,AT -.95*hs,.9*hs :"全て同色のひし形。左ボタン:ドラッグ移動で確かめる。右クリック: 終了"
      FOR v=-hs+vw TO hs-vw+1 STEP v2
         IF MOD(v+hs-vw+.001,vw)< .002 THEN LET u0=-hs+hw+h2 ELSE LET u0=-hs+hw+hw
         FOR u=u0 TO hs-hw-h2+1 STEP hw
            DRAW diamond WITH SHIFT(u,v)*ROTATE(Ag)
         NEXT u
      NEXT v
      SET DRAW mode explicit
   END IF
   CALL periodic_wait
LOOP

SUB periodic_wait
   DO
      LET t1=TIME                      !※TIME は約.05秒毎の更新。
      mouse poll mx,my,mlb,mrb
      IF mrb=1 THEN STOP               !右クリック停止
      IF mlb=1 OR act=1 THEN EXIT SUB
      WAIT DELAY .01
   LOOP UNTIL 3< MOD(t1-t0, 86400)     !周期が３秒になる様待つ
   LET Ag=Ag+PI/2                      !全体を、+90°回す
END SUB

SUB sense                              !カーソル位置の走査
   FOR v=-hs+vw TO hs-vw+1 STEP v2
      IF MOD(v+hs-vw+.001,vw)< .002 THEN LET u0=-hs+hw+h2 ELSE LET u0=-hs+hw+hw
      FOR u=u0 TO hs-hw-h2+1 STEP hw
         DRAW pick_diamond WITH SHIFT(u,v)*ROTATE(Ag)
         IF act=1 THEN EXIT SUB
      NEXT u
   NEXT v
END SUB

PICTURE pick_diamond
   MAT mt=TRANSFORM                    !原点→操作位置へ移動する行列の取得 TRANSFORM で、
   MAT mt=INV(mt)                      !逆の、操作位置→原点へ移動する行列 mt を得る。
   LET vo(1)=mx
   LET vo(2)=my                        !カーソル位置 mx,my から、
   MAT vi=vo*mt                        !原点中心のひし形に相対するカーソル位置 vi() を得る。
   IF ABS(vi(1))< h2 THEN
      IF ABS(vi(2))*a< h2-ABS(vi(1)) THEN      !カーソル位置 vi() が、ひし形内にあれば、
         PLOT AREA: 0,-v2; -h2,0; 0,v2; h2,0   !そのひし形を、背景色で塗消し、
         ASK PIXEL ARRAY (-hs,hs) bg           !画面全体を bg(,) に保存。
         DRAW diamond WITH SHIFT(vi(1),vi(2))  !カーソル位置に、新しくひし形を上書き。
         LET act=1                             !セット・フラグ act=１、持回りひし形有り。
      END IF
   END IF
END PICTURE

PICTURE diamond                        !原点中心に、ひし形１個の描画。全てのひし形は、ここで同色一様に。
   FOR y=-v2 TO v2 STEP pix
      LET b=b0+g*y
      SET LINE COLOR ColorIndex(b,b,b)
      LET x=a*(v2-ABS(y))
      PLOT LINES: -x,y; x,y
   NEXT y
END PICTURE

END

[10] 文字が食み出す場合 投稿者：SECOND 投稿日：2015年12月20日(日)00時15分0秒: 以上のプログラムで、文字が食み出す場合

投稿者：SECOND のプログラムは、ここに限らず、
十進BASIC Ver.7.6.7 までの起動時文字サイズの環境で合せていたため、
十進BASIC Ver.7.7.0 以降の起動時文字では桁幅が大きく、食み出るものがあります。
殆んど１年を越え、編集できない為、

　Ver.7.7.0 ～Ver.7.7.7　で文字が食み出す場合、以下で、お願いします。

●プログラム中の、SET WINDOW -,-,-,-　行の次に、以下の１行を挿入する。(複数ある場合も全て)

!---------------------------------------- Ver.767 以前の、起動時文字サイズ設定
SET TEXT HEIGHT ABS(worldy(11)-worldy(0))
!----------------------------------------

●プログラムには、何もしない方法。
　Ver.7.6.7 より小さい文字になりますが、起動時文字サイズを、11→10 に変更する。

　編集メニューバー
「オプション」→「グラフィックス」→「画面用フォント設定」→【ＭＳゴシック・標準・11→10 】

　・・以上の措置をしても、不具合の残るもの・・

▲"万華鏡" のような、再帰型プログラムで、文字が異常に大きい小さい場合、
　プログラム中の、SET TEXT font "フォント名", フォントサイズ　行の次に、
　以下の１行を挿入する。　(複数ある場合も全て)

!---------------------------------------------------- Ver.767 以前の、動作時文字サイズ設定
SET TEXT HEIGHT ABS(worldy(フォントサイズ)-worldy(0))
!----------------------------------------------------

　※もし、SET TEXT font "フォント名"
　　の様な書式で、フォントサイズが書かれていない場合は、対象外。

[11] ひし形１２面体を追加しました。 投稿者：SECOND 投稿日：2022年 2月11日(金)18時13分56秒: ! 正多角形だけで出来る多面体１８種＋ひし形１２面体と、展開図のアニメ－ション
!----------------------------------------------------------
!　正多面体(4,6,8,12,20)、アルキメデスの多面体(8,14,14,14,26,26,32,32,32,38,62,62,92)
!　ひし形１２面体 (2022.2.11追加）
!
!１）回る多面体は、左ボタンで一時停止、そのままドラッグすると、重心を中心に向きを変える。
!　　離すと、僅かな間をとって、常時回転に戻る。(ｚ軸回転)
!
!２）左右ボタンを離して、画面右上、「展開図へ」にカーソルを置くと、平面展開図へ分解する。
!　　カーソル置き放しにすると、次々に展開図を連続する。
!
!３）いつでも、右クリックはプログラム終了、画像は、スナップショットとして残る。
!　　アニメ速度が、パソコンの種類で変らないよう、周期偏差でＰＩ制御。
!　　TextWindow 表示は、現在の　多面体番号、面数、写像の探索数、周期偏差の制御秒　の順。

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 s=18      !●開始多面体番号　start item
LET incs=1    !● 0 にすると、開始番号を繰返す。
LET imax=19                                 !item maxim.
DIM D3( 92+1, 0 TO 10+1, 3), D1(10+1,2)     !(面数, 面の角数+1, xyz), (面の角数+1, xy)
DIM msk(imax, 0 TO 135), cg(imax,3)         !(item数, 写像数), (item数, xyz)
DIM fla(0 TO imax, 4), q1(135),q2(135)
!
DIM p3(0 TO 3, 2), p4(0 TO 4, 2), p5(0 TO 5, 2), p6(0 TO 6, 2), p8(0 TO 8, 2), p10(0 TO 10, 2)
DIM px12(0 TO 4, 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(8, 1/2, cr8,ir8, p8)     !正８角形, 中心(0,0)底辺(-1/2,-ir8)~(1/2,-ir8)
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

LET w=.5
LET wsq2=w*SQR(2)
LET px12(1,1)=w
LET px12(1,2)=0
LET px12(2,1)=0
LET px12(2,2)=wsq2
LET px12(3,1)=-w
LET px12(3,2)=0
LET px12(4,1)=0
LET px12(4,2)=-wsq2
LET aa12=ATN(1/SQR(2))+PI/2
LET ab12=ATN(SQR(2))
!
MAT Axys=IDN
MAT rotx=IDN
MAT rotx2=IDN
LET Vi(4)=1
READ x0, y0, hw
DATA  0, .2, 1.5                            !主画面中心(x0,y0), 縦横半幅hw (展開図に影響なし)
!DATA  0, .2, 3                            !主画面中心(x0,y0), 縦横半幅hw (展開図に影響なし)
LET cx0=x0+.85*hw                           ![展開図へ] box 中心(cx0,cy0)
LET cy0=y0+.95*hw
LET cx1=cx0-.13*hw                          ![展開図へ] box 左右(cx1,cx2)
LET cx2=cx0+.13*hw
LET cy1=cy0-.032*hw                         ![展開図へ] box 下上(cy1,cx2)
LET cy2=cy0+.04*hw
MAT READ fla                                !平面展開図回転za,中心(x0,y0), 縦横半幅hw のセットアップ
!
LET Ax=-PI/3.5                              !開始のｚ軸方向( 画面垂直０度からｘ軸回転成分)
LET Ay=0                                    !　　〃　〃　　( 　　　〃　〃　　ｙ軸回転成分)
LET opA=0.3                                 !多面体閉度 cosine 曲線の振幅    ( 別途 0~1 制限付)
LET opS=0.95                                !　　〃　〃　cosine 曲線のバイアス( 別途 0~1 制限付)
LET t0=TIME
DO
   SET DRAW mode hidden
   CLEAR
   LET sq=0
   LET sq0=0
   LET item=MAX(s,1)
   CALL control_
   SELECT CASE item
   CASE 1
      CALL mat_rotx(rotx, op1*PI/4.305)        !３２面体　　残部６角～残部６角折り角
      CALL mat_rotx(rotx2, op1*PI/4.815)       !　　　　　切頭部５角～残部６角折り角
      DRAW D32 WITH SCALE(.333)*ROTATE(Az)*shxyz*Axys
   CASE 2
      CALL mat_rotx(rotx, op1*PI/4.305)        !正２０面体　３角～３角折り角
      DRAW D20 WITH ROTATE(Az)*shxyz*Axys
   CASE 3
      CALL mat_rotx(rotx, op1*PI/2.8376)       !正１２面体　５角～５角折り角
      DRAW D12 WITH SCALE(.633)*ROTATE(Az)*shxyz*Axys
   CASE 4
      CALL mat_rotx(rotx, op1*PI/2.552)        !正８面体　　３角～３角折り角
      DRAW D20 WITH SCALE(1.4)*ROTATE(Az)*shxyz*Axys
   CASE 5
      CALL mat_rotx(rotx, op1*PI/2)            !正６面体　　４角～４角折り角
      DRAW D06 WITH ROTATE(Az)*shxyz*Axys
   CASE 6
      CALL mat_rotx(rotx, op1*PI/1.644)        !正４面体　　３角～３角折り角
      DRAW D20 WITH SCALE(1.5)*ROTATE(Az)*shxyz*Axys
   CASE 7
      CALL mat_rotx(rotx, op1*PI/3.285)        !１４面体    ４角～３角折り角
      DRAW D14_3846 WITH SCALE(1)*ROTATE(Az)*shxyz*Axys
   CASE 8
      CALL mat_rotx(rotx, op1*PI/2)            !１４面体　　８角～８角折り角
      CALL mat_rotx(rotx2, op1*PI/3.285)       !　　　　　　８角～３角折り角
      DRAW D14_3886 WITH SCALE(.5)*ROTATE(Az)*shxyz*Axys
   CASE 9
      CALL mat_rotx(rotx, op1*PI/2.552)        !１４面体　　６角～６角折り角
      CALL mat_rotx(rotx2, op1*PI/3.285)       !　　　　　　６角～４角折り角
      DRAW D14_4668 WITH SCALE(.5)*ROTATE(Az)*shxyz*Axys
   CASE 10
      CALL mat_rotx(rotx, op1*PI/1.644)        !８面体　　　６角～６角折り角
      CALL mat_rotx(rotx2, op1*PI/2.552)       !　　　　　　６角～３角折り角
      DRAW D08_3464 WITH SCALE(.75)*ROTATE(Az)*shxyz*Axys
   CASE 11
      CALL mat_rotx(rotx, op1*PI/4)            !２６面体    ４角～４角折り角
      CALL mat_rotx(rotx2, op1*PI/5.100)       !　　　　　　４角～３角折り角
      DRAW D26_38418 WITH SCALE(.6)*ROTATE(Az)*shxyz*Axys
   CASE 12
      CALL mat_rotx(rotx, op1*PI/3.285)        !２６面体    ８角～６角折り角
      CALL mat_rotx(rotx2, op1*PI/4)           !　　　　　　８角～４角折り角
      DRAW D26_4126886 WITH SCALE(.4)*ROTATE(Az)*shxyz*Axys
   CASE 13
      CALL mat_rotx(rotx, op1*PI/2.8376)       !３２面体　１０角～１０角折り角
      CALL mat_rotx(rotx2, op1*PI/4.815)       !　　　　　１０角～３角折り角
      DRAW D32_3201012 WITH SCALE(.3)*ROTATE(Az)*shxyz*Axys
   CASE 14
      CALL mat_rotx(rotx, op1*PI/4.815)        !３２面体　　５角～５角折り角
      DRAW D32_320512 WITH SCALE(.55)*ROTATE(Az)*shxyz*Axys
   CASE 15
      CALL mat_rotx(rotx, op1*PI/4.85)         !３８面体　　４角～３角折り角
      CALL mat_rotx(rotx2, op1*PI/6.72)        !　　　　　　３角～３角折り角
      DRAW D38_33246 WITH SCALE(.7)*ROTATE(Az)*shxyz*Axys
   CASE 16
      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 17
      CALL mat_rotx(rotx, op1*PI/5.675)        !６２面体　　４角～１０角折り角
      CALL mat_rotx(rotx2, op1*PI/8.61)        !　　　　　　６角～４角折り角
      DRAW D62_4306201012 WITH SCALE(.24)*ROTATE(Az)*shxyz*Axys
   CASE 18
      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
   CASE 19
      CALL mat_rotx(rotx, op1*PI/3)         !ひし形１２面体４角～４角折り角
      DRAW DX12 WITH 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 s=MOD(s+incs,imax+1) !debug increase s
         LET flt=0                !平面図プロセス終了
      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: 次の周期の始め＝前の周期の終り
   !--------------debug---
   IF itemb<>item THEN
      PRINT USING"##) ## ### #.###":item,sq,sq0,t2 !item:多面体番号, sq:採取画数, sq0:写像_全画数, t2:制御_休止秒
      LET itemb=item
   END IF
   !---------
LOOP UNTIL mrb=1                !右クリック

DATA -.524,  -.57, -1.5  , 2.4    ! 0 (za,x0,y0,hw) !32 平面展開図セットアップ
DATA -.524,  -.57, -1.5  , 2.4    ! 1 (za,x0,y0,hw) !32 　　　〃
!---
DATA  .262, -1.28, -1.98 , 2.9    ! 2 (za,x0,y0,hw) !20 　　　〃
DATA  4.03, -2.06, -2.32 , 2.95   ! 3 (za,x0,y0,hw) !12 　　　〃
DATA -1.84, -1.43, -1.42 , 2.3    ! 4 (za,x0,y0,hw) ! 8 　　　〃
DATA -1.57, -1.5 , -1.0  , 2.1    ! 5 (za,x0,y0,hw) ! 6 　　　〃
DATA -2.69,  -.91,  -.688, 1.7    ! 6 (za,x0,y0,hw) ! 4 　　　〃
!---
DATA -1.57, -0.2 , -1.5  , 3.0    ! 7 (za,x0,y0,hw) !14 　　　〃
DATA  3.14, -0.7 , -2.0  , 3.0    ! 8 (za,x0,y0,hw) !14 　　　〃
DATA -1.57, -0.5 , -1.5  , 2.5    ! 9 (za,x0,y0,hw) !14 　　　〃
DATA -2.36, -1.0 , -1.5  , 2.5    !10 (za,x0,y0,hw) ! 8 　　　〃
DATA  3.14, -0.1 , -2.0  , 2.7    !11 (za,x0,y0,hw) !26 　　　〃
DATA  2.35, -1.8 , -1.8  , 2.7    !12 (za,x0,y0,hw) !26 　　　〃
DATA -2.15, -0.35, -1.2  , 2.6    !13 (za,x0,y0,hw) !32 　　　〃
DATA -0.05, -2.1 , -1.0  , 3.1    !14 (za,x0,y0,hw) !32 　　　〃
DATA     0, -1.6 , -1.9  , 3.0    !15 (za,x0,y0,hw) !38 　　　〃
DATA -1.86, -2.5 , -1.5  , 3.2    !16 (za,x0,y0,hw) !62 　　　〃
DATA  0.25, -1.75, -2.45 , 3.35   !17 (za,x0,y0,hw) !62 　　　〃
DATA  0.54, -1.7 , -2.3  , 4.1    !18 (za,x0,y0,hw) !92 　　　〃
!---
DATA -1.25,  -1.1,  -1.85, 2.5    !19 (za,x0,y0,hw) !ひし形12 〃

SUB flatx(za,x0,y0,hw)
   IF opAbak=0 THEN
      LET opAbak=opA              !※Save Condition《１》
      LET opSbak=opS
      MAT Abak=Axys               !※Save Condition《３》
      MAT Axys=IDN                !平面図ドラッグ累積クリアー
      LET opA=.525                !平面図閉度 cosine 曲線の振幅   ( 別途 0~1 制限付)
      LET opS=.475                !　　〃　〃　cosine 曲線のバイアス( 別途 0~1 制限付)
      LET ss=0                    !スタート閉度 cosine 角度
      LET op1=1                   !スタート閉度１( 標準折り角)
   END IF
   LET flt=1                            !平面図プロセス自己保持
   LET Az=za                            !平面図方向回転
   SET WINDOW x0-hw,x0+hw,y0-hw,y0+hw   !平面図スケール
   DRAW grid WITH ROTATE(Az)            !平面図スケール描画 (方向回転付き)
   PLOT label,AT x0-.48*hw, y0+.95*hw:"左 click 一時停止。右 click 終了。"
END SUB

SUB control_
   SET WINDOW x0-hw, x0+hw, y0-hw, y0+hw                            !主画面スケール
   PLOT LINES: cx1,cy1; cx2,cy1; cx2,cy2; cx1,cy2; cx1,cy1
   IF fla(item,4)<>0 THEN PLOT label,AT cx0, cy0: "展開図へ"
   mouse poll mx,my,mlb,mrb
   IF flt=1 OR mlb=0 AND fla(item,4)<>0 AND msk(item,0)<>0 AND cx1< mx AND mx< cx2 AND cy1< my AND my< cy2 THEN
   !-----unwrap entrance---
      CALL flatx( fla(item,1),fla(item,2),fla(item,3),fla(item,4))  !平面展開図セットアップ
      EXIT SUB
   ELSEIF 0< opAbak THEN
      LET opA=opAbak              !※Restore Condition《１》
      LET opS=opSbak
      MAT Axys=Abak               !※Restore Condition《３》
      LET opAbak=0
   END IF
   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
      FOR i=1 TO sq
         LET q1(i)=D3(i,0,3)
         LET q2(i)=i
      NEXT i
      CALL Qsort00(1,sq)
      !-----real draw with priority
      FOR j=1 TO sq
         LET ib=q2(j)                          !ib= ｚ最小(奥) の配列番号。
         !-----
         IF s=1 THEN LET c=6-D3(ib,11,1) ELSE LET c=ib+1   !s=1 サッカーボール→(５角c=1, ６角c=0)
         SET AREA COLOR c                                  !各面の色。 D3(ib,11,1)は、各面の角数
         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

!Page-2 へ続く

[12] 「ひし形１２面体を追加…」の、Page-2 投稿者：SECOND 投稿日：2022年 2月11日(金)18時20分36秒: !Page-2 の始め

!---------プロット配列~配列
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

!---------ひし形 12面体
PICTURE DX12
   DRAW getpos(4, px12)                                                                 !基ひし形
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   IF sq=2 THEN DRAW DX12 WITH SHIFT(0,wsq2)*ROTATE(ab12)*rotx*ROTATE(-aa12)*SHIFT(0,-wsq2) !右下ひし形
   DRAW DX12 WITH SHIFT(0,wsq2)*ROTATE(-ab12)*rotx*ROTATE(-ab12)*SHIFT(0,wsq2)          !右上ひし形
   DRAW DX12 WITH SHIFT(0,wsq2)*ROTATE( ab12)*rotx*ROTATE( ab12)*SHIFT(0,wsq2)          !左上ひし形
END PICTURE

!---------正多面体
PICTURE D20             !D20 =D08 =D04 共用
   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
   IF sq=2 THEN DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir5)*ROTATE(-.6*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( .2*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

!---------アルキメデス多面体
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
   IF sq=2 THEN 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 D14_3846
   DRAW getpos(4, p4)                                                 !基４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D14_3846_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI)    !右2nd.３角
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左３角
   IF sq=12 THEN DRAW D14_3846_3 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左3rd.
END PICTURE
PICTURE D14_3846_2
   DRAW getpos(3, p3)                                                   !2nd.３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D14_3846 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir3)*ROTATE( PI/3)      !左上.基４角
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3) !右上2nd.４角
END PICTURE
PICTURE D14_3846_3
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3) !右上3rd.４角
END PICTURE

PICTURE D14_3886
   DRAW getpos(8, p8)                                                      !基８角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir8)*ROTATE( .25*PI) !左上３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir8)*ROTATE(-.25*PI) !右上３角
   DRAW D14_3886 WITH SHIFT(0,ir8)*rotx*SHIFT(0,ir8)                       !　上８角
   DRAW D14_3886 WITH SHIFT(0,ir8)*rotx*SHIFT(0,ir8)*ROTATE( .5*PI)        !　左８角
   DRAW D14_3886 WITH SHIFT(0,ir8)*rotx*SHIFT(0,ir8)*ROTATE(-.5*PI)        !　右８角
END PICTURE

PICTURE D14_4668
   DRAW getpos(6, p6)                                                      !基６角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir6)                 !上４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(4, p4) WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir6)*ROTATE(-PI*2/3) !右下４角
   DRAW D14_4668 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(-PI/3)         !右上６角
   DRAW D14_4668 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(PI/3)          !左上６角
END PICTURE

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

PICTURE D26_38418
   DRAW getpos(4, p4)                                                    !基４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D26_38418_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)                  !上2nd.４角
   DRAW D26_38418_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI)   !右2nd.４角
   DRAW D26_38418_2 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI)   !左2nd.４角
END PICTURE
PICTURE D26_38418_2
   DRAW getpos(4, p4)                                                     !　2nd.４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   IF sq=13 THEN DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir4)*ROTATE(-.5*PI) !右2nd.３角
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir4)*ROTATE( .5*PI) !左2nd.３角
   DRAW D26_38418 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir4)                     !上.基４角
END PICTURE

PICTURE D26_4126886
   DRAW getpos(8, p8)                                                     !　基８角
   DRAW getpos(6, p6) WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir8)*ROTATE(-PI/4)   !右上６角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(6, p6) WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir8)*ROTATE( PI/4)   !左上６角
   DRAW D26_4126886_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir8)                !上2nd.４角
   DRAW D26_4126886_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir8)*ROTATE( PI/2)  !左2nd.４角
   DRAW D26_4126886_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir8)*ROTATE(-PI/2)  !右2nd.４角
END PICTURE
PICTURE D26_4126886_2
   DRAW getpos(4, p4)                                                     !2nd.４角
   DRAW D26_4126886 WITH SHIFT(0,ir8)*rotx2*SHIFT(0,ir4)                  !上.基８角
END PICTURE

PICTURE D32_3201012
   DRAW getpos(10, p10)                                                    !基１０角
   IF sq=30 THEN DRAW getpos(10, p10) WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE(.2*PI) !左上１０角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir10)                !上３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir10)*ROTATE(.4*PI)  !左上３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir10)*ROTATE(-.8*PI) !右下３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D32_3201012 WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE(-.2*PI)     !右上１０角
   DRAW D32_3201012 WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE( .2*PI)     !左上１０角
   DRAW getpos(10, p10) WITH SHIFT(0,ir10)*rotx*SHIFT(0,ir10)*ROTATE(-.6*PI) !右下１０角
END PICTURE

PICTURE D32_320512
   DRAW getpos(3, p3)                                                  !基３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   IF sq=1 THEN DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir3)*ROTATE( PI/3) !左上５角
   DRAW D32_320512_2 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3) !右上2nd.５角
END PICTURE
PICTURE D32_320512_2
   DRAW getpos(5, p5)                                                  !2nd.５角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   IF sq=28 THEN DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir5)*ROTATE(-.6*PI)  !右下３角
   IF sq=29 THEN DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir5)*ROTATE(-.2*PI)  !右上３角
   DRAW D32_320512 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir5)*ROTATE( .6*PI)  !左下.基３角
   DRAW D32_320512 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir5)*ROTATE( .2*PI)  !左上.基３角
END PICTURE

PICTURE D38_33246
   DRAW getpos(4, p4)                                                  !基４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D38_33246_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左2nd.３角
   DRAW D38_33246_2 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI) !右2nd.３角
END PICTURE
PICTURE D38_33246_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 D38_33246_3 WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE( PI/3)   !左上3rd.３角
END PICTURE
PICTURE D38_33246_3
   DRAW getpos(3, p3)                                                   !3rd.３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(3, p3) WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir3)*ROTATE(PI/3) !左上3rd.３角
   DRAW D38_33246 WITH SHIFT(0,ir4)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3)     !右上.基４角
END PICTURE

PICTURE D62_320430512
   DRAW getpos(3, p3)                                                       !基３角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir3)*ROTATE( PI/3)  !左2nd.４角
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir3)*ROTATE(-PI/3)  !右2nd.４角
   DRAW D62_320430512_2 WITH SHIFT(0,ir4)*rotx2*SHIFT(0,ir3)*ROTATE( PI)    !下2nd.４角
END PICTURE
PICTURE D62_320430512_2
   DRAW getpos(4, p4)                                                    !2nd.４角
   IF msk(item,sq0)=0 THEN EXIT PICTURE
   DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir4)*ROTATE( .5*PI) !左2nd.５角
   IF sq=61 THEN DRAW getpos(5, p5) WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir4)*ROTATE(-.5*PI) !右2nd.５角
   DRAW D62_320430512 WITH SHIFT(0,ir3)*rotx2*SHIFT(0,ir4)               !上.基３角
END PICTURE

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

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

!---------------------------
! Quick Sort q2() by q1()
!---------------------------
SUB Qsort00(L,R)                   !昇順にセット。
   local i,j
   LET i=L
   LET j=R
   LET w=q1((L+R)/2)
   DO
      DO WHILE q1(i)< w            ![< ]昇順　[>]降順
         LET i=i+1
      LOOP
      DO WHILE w< q1(j)            ![< ]昇順　[>]降順
         LET j=j-1
      LOOP
      IF j< i THEN EXIT DO         !等号付 j<=i は、暴走。
      SWAP q1(i),q1(j)
      SWAP q2(i),q2(j)
      LET i=i+1
      LET j=j-1
   LOOP UNTIL j< i                 !等号付 j<=i は、低速。
   IF L< j THEN CALL Qsort00(L,j)
   IF i< R THEN CALL Qsort00(i,R)
END SUB

END

Amusement_Program

Amusement_Program

人数が変わる絵

正多角形だけで出来る 多面体１８種と展開図のアニメ－ション

Page-2

化けるカラーボール2

ジグソー・パズル２

多重版 ４つの振り子

新 ４つの振り子メーター付

マンデルブロ集合の外周で、散歩

クレイジーダイヤモンド錯視

文字が食み出す場合

ひし形１２面体を追加しました。

「ひし形１２面体を追加…」の、Page-2

正多角形だけで出来る多面体１８種と展開図のアニメ－ション

多重版４つの振り子

新４つの振り子メーター付