新しく発言する EXIT インデックスへ
続、凹凸Ｎ角形を描く
　　続、凹凸Ｎ角形を描く 山中和義 2004/08/25 19:56:25 
　　├その１ 山中和義 2004/08/25 19:57:14 
　　├その２ 山中和義 2004/08/25 19:58:04 
　　├その３ 山中和義 2004/08/25 20:00:01 
　　├その４ 山中和義 2004/08/25 20:00:34 
　　├試作ですので、バグもあります。 山中和義 2004/08/25 20:04:35 
　　│└改修版 山中和義 2004/08/27 19:08:15 
　　│　├その１ 山中和義 2004/08/27 19:10:03 
　　│　├その２ 山中和義 2004/08/27 19:12:01 
　　│　├その３ 山中和義 2004/08/27 19:12:56 
　　│　├その４ 山中和義 2004/08/27 19:13:28 
　　│　│└その４の訂正 山中和義 2004/08/27 19:51:57 
　　│　└山中さんへ ゆめの 2004/08/27 19:23:31 
　　│　　└辺か頂点を右クリックしてください。 山中和義 2004/08/27 19:56:23 
　　│　　　└ありがとうございました ゆめの 2004/08/27 20:41:54 
　　│　　　　└右クリックで切り取り線が ゆめの 2004/08/27 20:47:34 
　　├機能がアッブシテきましたね ゆめの 2004/08/25 20:37:31 
　　└もう少しマウスの反応が確実なほうが ゆめの 2004/08/26 00:02:04 

　　続、凹凸Ｎ角形を描く 山中和義 2004/08/25 19:56:25  ツリーへ

続、凹凸Ｎ角形を描く 返事を書く
山中和義 2004/08/25 19:56:25
!頂点を一筆書きで凹凸Ｎ角形を描く Ver 0.2
![使い方]
!　頂点、辺をドラッグして移動できる。
!　辺上をクリックして頂点(角数)を増やせる。
!　頂点をSPACEキーを押しながら、クリックしたら削除する。
!　右クリックで折り目を描く。
!　上下のカーソルキーで角数の増減ができる。（正Ｎ角形を描く）
!　ESCキーで終了。
 

　　├その１ 山中和義 2004/08/25 19:57:14  ツリーへ

Re: 続、凹凸Ｎ角形を描く 返事を書く
山中和義 2004/08/25 19:57:14
その１
SET BITMAP SIZE 640,480 !画面サイズ
SET WINDOW 0,640,0,480 !左下が原点。横がＸ、縦Ｙ
SET COLOR mode "NATIVE" !RGB指定
SET TEXT font "",12 !文字サイズ

LET N = 3 !角数
LET CX = 200 !中心(x,y)
LET CY = 300
LET R = 100 !半径
LET C = colorindex(1,0,1) !色

OPTION BASE 0
DIM PX(500),PY(500) !頂点の座標

LET L = 0 !折れ目の数
DIM LS(500),LE(500) !「折り目」線の端点の頂点番号

CALL CalcPoint(N,CX,CY,R,C,PX,PY) !Ｎ角形の頂点を求める
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !Ｎ角形を描く

LET drag_left = 0
LET drag_right = 0
LET click_right = 0

DO
mouse poll x,y,left,right !マウスの状態を得る

IF left=1 THEN !左ボタンが押された、押されていたら
SELECT CASE drag_left
CASE 3,4 !辺をドラッグ中なら
LET xx = x - xo
LET yy = y - yo
LET PX(pp-1) = PX(pp-1) + xx !マウスの位置に追従させる
LET PY(pp-1) = PY(pp-1) + yy
IF pp=1 THEN !Ｎ番目と０番目（同一点）
LET PX(N) = PX(0)
LET PY(N) = PY(0)
END IF
LET PX(pp) = PX(pp) + xx
LET PY(pp) = PY(pp) + yy
IF pp=N THEN !Ｎ番目と０番目（同一点）
LET PX(0) = PX(N)
LET PY(0) = PY(N)
END IF
LET xo = x
LET yo = y
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
LET drag_left = 4 !辺ならドラッグ中とする
CASE 1,2 !頂点をドラッグ中なら
LET PX(pp) = x !マウスの位置に追従させる
LET PY(pp) = y
IF pp=N THEN !Ｎ番目と０番目（同一点）
LET PX(0) = x
LET PY(0) = y
END IF
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !Ｎ角形を描く
LET drag_left = 2 !頂点ならドラッグ中とする
CASE 0
LET pp = CheckNear(N,x,y,PX,PY) !クリックした位置が
IF pp>0 THEN !頂点なら
IF getkeystate(32)<0 THEN !SPACEキーなら
CALL DelPoint(pp,N,PX,PY,L,LS,LE) !その位置の点を削除する
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
LET click_right = 0
ELSE
LET drag_left = 1 !ドラッグ開始とする
END IF
ELSE
LET pp = CheckNearLine(N,x,y,PX,PY) !クリックした位置が
IF pp>0 THEN !辺上なら
LET drag_left = 3 !ドラッグ開始とする
LET xo = x
LET yo = y
END IF
END IF
END SELECT
ELSE
IF drag_left = 3 THEN !辺をクリックしていたら
CALL AddPoint(pp,x,y,N,PX,PY,L,LS,LE) !その位置に点を追加する
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
END IF
LET drag_left = 0
END IF
 

　　├その２ 山中和義 2004/08/25 19:58:04  ツリーへ

Re: 続、凹凸Ｎ角形を描く 返事を書く
山中和義 2004/08/25 19:58:04
その２
IF right=1 THEN !右ボタンが押された、押されていたら
SELECT CASE drag_right
CASE 1,2 !ドラッグ中なら
LET drag_right = 2 !ドラッグ中とする
CASE 0
LET drag_right = 1 !ドラッグ開始とする
WAIT DELAY 0.1
END SELECT
ELSE
IF drag_right = 1 THEN !クリックしていたら
LET pp = CheckNear(N,x,y,PX,PY) !クリックした位置が
IF pp<0 THEN !頂点以外なら
LET pp = CheckNearLine(N,x,y,PX,PY) !クリックした位置が
IF pp>0 THEN !辺上なら
CALL AddPoint(pp,x,y,N,PX,PY,L,LS,LE) !その位置に点を追加する
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
END IF
END IF
IF pp>0 THEN !頂点または辺上をクリックしたら
IF click_right = 0 THEN !始点を指定したら
LET LS(L) = pp
LET click_right = 1
ELSE !終点を指定したら
LET LE(L) = pp
LET L = L + 1 !折り目の数を増やす
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE)
LET click_right = 0
END IF
END IF
END IF
LET drag_right = 0
END IF


IF click_right = 1 THEN !終点の指定待ちなら
SET LINE COLOR colorindex(0,0,1)
SET LINE WIDTH 1
PLOT LINES:PX(LS(L)),PY(LS(L)); x,y; !仮の折り目を描く
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
END IF


IF getkeystate(38)<0 THEN !上カーソルキーなら
LET N = N + 1 !角数を増やす
IF N>50 THEN LET N = 50
CALL CalcPoint(N,CX,CY,R,C,PX,PY)
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE)
END IF
IF getkeystate(40)<0 THEN !下カーソルキーなら
LET N = N - 1
IF N<3 THEN LET N = 3
CALL CalcPoint(N,CX,CY,R,C,PX,PY)
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE)
END IF
IF getkeystate(27)<0 THEN STOP !ESCキーなら

WAIT DELAY 0.1 !ちょっとだけ待つ
LOOP

END

!各頂点の位置を算出し、Ｎ角形を描く
EXTERNAL SUB CalcPoint(N,CX,CY,R,C,PX(),PY())
LET alp = PI/2 !１点目の位置を補正する
if N=4 then LET alp = PI/N

FOR i=0 TO N !各頂点の位置を算出する
LET PX(i) = -R*cos(2*PI*i/N + alp) + CX
LET PY(i) = R*SIN(2*PI*i/N + alp) + CY
NEXT i
END SUB

!当り判定　※２点間の距離を算出
EXTERNAL FUNCTION CheckNear(N,x,y,PX(),PY())
LET CheckNear = -1
FOR i=1 TO N !各頂点との
LET xx = PX(i) - x !距離を計算する
LET yy = PY(i) - y
IF xx*xx+yy*yy<81 THEN !近くなら
LET CheckNear = i !その頂点番号を返す
EXIT FUNCTION
END IF
NEXT i
END FUNCTION
 

　　├その３ 山中和義 2004/08/25 20:00:01  ツリーへ

Re: 続、凹凸Ｎ角形を描く 返事を書く
山中和義 2004/08/25 20:00:01
その３
!当り判定　※線上
EXTERNAL FUNCTION CheckNearLine(N,x,y,PX(),PY())
LET CheckNearLine = -1
FOR i=1 TO N !各線分との
! PRINT SideLine(x,y,PX(i-1),PY(i-1),PX(i),PY(i))
IF ABS(SideLine(x,y,PX(i-1),PY(i-1),PX(i),PY(i)))<400 THEN !近くなら
CALL SetP(X1,X2,PX(i-1),PX(i))
CALL SetP(Y1,Y2,PY(i-1),PY(i))
IF x-X1>=-5 AND x-X2<=5 AND y-Y1>=-5 AND y-Y2<=5 THEN !線分の範囲で
LET CheckNearLine = i !その線分番号を返す
EXIT FUNCTION
END IF
END IF
NEXT i
END FUNCTION

!点(x,y)を２点(x1,y1)、(x2,y2)を通る直線の式に代入する
!※正なら上側、負なら下側、０なら線上
EXTERNAL FUNCTION SideLine(x,y,X1,Y1,X2,Y2)
LET SideLine = (Y2-Y1)*(x-X1)-(X2-X1)*(y-Y1)
END FUNCTION

!点を座標値の大小で設定する　※X1<X2
EXTERNAL SUB SetP(X1,X2,XX1,XX2)
LET X1 = XX1
LET X2 = XX2
IF XX1>XX2 THEN
LET X1=XX2
LET X2=XX1
END IF
END SUB

!Ｋ番目に頂点を追加する　※角数はＮ＋１になる
EXTERNAL SUB AddPoint(K,x,y,N,PX(),PY(),L,LS(),LE())
FOR i=N TO K STEP -1 !Ｋ番目を空けるため、後方にずらす
LET PX(i+1) = PX(i)
LET PY(i+1) = PY(i)
NEXT i
LET N = N + 1 !角数を増やす
LET PX(K) = x !Ｋ番目に追加する
LET PY(K) = y

FOR i=0 TO L !折り目について、参照している頂点番号を１つずらす
IF LS(i)>=K THEN LET LS(i) = LS(i) + 1
IF LE(i)>=K THEN LET LE(i) = LE(i) + 1
NEXT i
END SUB

!Ｋ番目の頂点を削除する　※角数はＮ−１になる
EXTERNAL SUB DelPoint(K,N,PX(),PY(),L,LS(),LE())
IF N>=4 THEN !４角形以上
IF K=N THEN LET KK=0 ELSE LET KK=K
FOR i=KK TO N-1 !Ｋ番目を詰めるため、前方にずらす
LET PX(i) = PX(i+1)
LET PY(i) = PY(i+1)
NEXT i
LET N = N - 1 !角数を減らす
LET PX(N) = PX(0) !Ｎ番目と０番目は同一点
LET PY(N) = PY(0)

LET i = 0
DO WHILE i<L !折り目について、参照している頂点があればそれを削除する
IF LS(i)=K OR LE(i)=K THEN
CALL DelLine(i,L,LS,LE)
ELSE
IF LS(i)>K THEN LET LS(i) = LS(i) - 1
IF LE(i)>K THEN LET LE(i) = LE(i) - 1
LET i = i + 1
END IF
LOOP
END IF
END SUB

!Ｋ番目の折り目を追加する
EXTERNAL SUB AddLine(K,pp,L,LS(),LE())
FOR i=L TO K STEP -1 !Ｋ番目を空けるため、後方にずらす
LET LS(i+1) = LS(i)
LET LE(i+1) = LE(i)
NEXT i
LET LS(K) = pp
LET LE(K) = pp
LET L = L + 1 !数を増やす
END SUB

!Ｋ番目の折り目を削除する
EXTERNAL SUB DelLine(K,L,LS(),LE())
FOR i=K TO L-1 !Ｋ番目を詰めるため、前方にずらす
LET LS(i) = LS(i+1)
LET LE(i) = LE(i+1)
NEXT i
LET L = L - 1 !数を減らす
END SUB

 

　　├その４ 山中和義 2004/08/25 20:00:34  ツリーへ

Re: 続、凹凸Ｎ角形を描く 返事を書く
山中和義 2004/08/25 20:00:34
その４
!画面をクリア後、Ｎ角形を描く
EXTERNAL PICTURE DrawPolygon(N,C,PX(),PY(),L,LS(),LE())
SET DRAW MODE HIDDEN !ちらつきを抑える
SET AREA COLOR colorindex(1,1,1) !画面をクリアする
PLOT AREA:0,0; 640,0; 640,480; 0,480
DRAW polygon2(N,C,2,PX,PY) !頂点をつなげてＮ角形を描く
DRAW polyline(L,colorindex(0,0,1),1,LS,LE,PX,PY) !折り目を描く
SET DRAW MODE EXPLICIT
END PICTURE

!Ｎ角形を描く　※頂点(PX(),PY())
EXTERNAL PICTURE polygon2(N,C,W,PX(),PY()) !角数、色
SET LINE COLOR C !色
SET LINE WIDTH W !幅
FOR i=0 TO N
PLOT LINES:PX(i),PY(i); !辺を描く
PLOT POINTS:PX(i),PY(i) !頂点を描く
NEXT i
END PICTURE

!線分を描く　※頂点(PX(),PY())、端点の頂点番号LS(),LE()
EXTERNAL PICTURE polyline(L,C,W,LS(),LE(),PX(),PY()) !角数、色
SET LINE COLOR C
SET LINE WIDTH W
FOR i=0 TO L-1
PLOT LINES:PX(LS(i)),PY(LS(i)); PX(LE(i)),PY(LE(i))
NEXT i
END PICTURE
 

　　├試作ですので、バグもあります。 山中和義 2004/08/25 20:04:35  ツリーへ

Re: 続、凹凸Ｎ角形を描く 返事を書く
山中和義 2004/08/25 20:04:35
試作ですので、バグもあります。
・頂点を削除すると折り目が正しく削除されない場合がある。
・クリックが動作しづらい。（DELAYの間隔）
 

　　│└改修版 山中和義 2004/08/27 19:08:15  ツリーへ

Re: 試作ですので、バグもあります。 返事を書く
山中和義 2004/08/27 19:08:15
改修版
とりあえず完成とします。。。

!頂点を一筆書きで凹凸Ｎ角形を描く Ver 0.3
![使い方]
!　頂点、辺をドラッグして移動できる。
!　辺上をクリックして頂点(角数)を増やせる。
!　頂点をSPACEキーを押しながら、クリックしたら削除する。
!　右クリックで折り目を描く。
!　上下のカーソルキーで角数の増減ができる。（正Ｎ角形を描く）
!　ESCキーで終了。
 

　　│　├その１ 山中和義 2004/08/27 19:10:03  ツリーへ

Re: 改修版 返事を書く
山中和義 2004/08/27 19:10:03
その１
SET BITMAP SIZE 640,480 !画面サイズ
SET WINDOW 0,640,0,480 !左下が原点。横がＸ、縦Ｙ
SET COLOR mode "NATIVE" !RGB指定
SET TEXT font "",12 !文字サイズ

LET N = 3 !角数
LET CX = 200 !中心(x,y)
LET CY = 300
LET R = 100 !半径
LET C = colorindex(1,0,1) !色

OPTION BASE 0
DIM PX(500),PY(500) !頂点の座標

LET L = 0 !折れ目の数
DIM LS(500),LE(500) !「折り目」線の端点の頂点番号

CALL CalcPoint(N,CX,CY,R,C,PX,PY) !Ｎ角形の頂点を求める
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !Ｎ角形を描く

LET drag_left = 0
LET drag_right = 0
LET click_right = 0

DO
mouse poll x,y,left,right !マウスの状態を得る

IF left=1 THEN !左ボタンが押された、押されていたら
SELECT CASE drag_left
CASE 3,4 !辺をドラッグ中なら
LET xx = x - xo
LET yy = y - yo
LET PX(pp-1) = PX(pp-1) + xx !マウスの位置に追従させる
LET PY(pp-1) = PY(pp-1) + yy
IF pp=1 THEN !Ｎ番目と０番目（同一点）
LET PX(N) = PX(0)
LET PY(N) = PY(0)
END IF
LET PX(pp) = PX(pp) + xx
LET PY(pp) = PY(pp) + yy
IF pp=N THEN !Ｎ番目と０番目（同一点）
LET PX(0) = PX(N)
LET PY(0) = PY(N)
END IF
LET xo = x
LET yo = y
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
LET drag_left = 4 !辺ならドラッグ中とする
CASE 1,2 !頂点をドラッグ中なら
LET PX(pp) = x !マウスの位置に追従させる
LET PY(pp) = y
IF pp=N THEN !Ｎ番目と０番目（同一点）
LET PX(0) = x
LET PY(0) = y
END IF
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !Ｎ角形を描く
LET drag_left = 2 !頂点ならドラッグ中とする
CASE 0
LET pp = CheckNear(N,x,y,PX,PY) !クリックした位置が
IF pp>0 THEN !頂点なら
LET drag_left = 1 !ドラッグ開始とする
ELSE
LET pp = CheckNearLine(N,x,y,PX,PY) !クリックした位置が
IF pp>0 THEN !辺上なら
LET drag_left = 3 !ドラッグ開始とする
LET xo = x
LET yo = y
END IF
END IF
WAIT DELAY 0.15
CASE ELSE
END SELECT
 

　　│　├その２ 山中和義 2004/08/27 19:12:01  ツリーへ

Re: 改修版 返事を書く
山中和義 2004/08/27 19:12:01
その２
ELSE !押されていない
SELECT CASE drag_left
CASE 1 !頂点をクリックしていたら
IF getkeystate(32)<0 THEN !SPACEキーなら
IF click_right = 1 THEN
IF LS(L)=pp THEN LET click_right = 0
IF LS(L)>pp THEN LET LS(L) = LS(L) - 1
LET p1 = LS(L) !save it
END IF
CALL DelPoint(pp,N,PX,PY,L,LS,LE) !その位置の点を削除する
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
IF click_right = 1 THEN LET LS(L) = p1
END IF
CASE 3 !辺をクリックしていたら
CALL AddPoint(pp,x,y,N,PX,PY,L,LS,LE) !その位置に点を追加する
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
CASE ELSE
END SELECT
LET drag_left = 0
END IF


IF right=1 THEN !右ボタンが押された、押されていたら
SELECT CASE drag_right
CASE 1,2 !ドラッグ中なら
LET drag_right = 2 !ドラッグ中とする
CASE 0
LET drag_right = 1 !ドラッグ開始とする
WAIT DELAY 0.15
CASE ELSE
END SELECT
ELSE
IF drag_right = 1 THEN !クリックしていたら
LET pp = CheckNear(N,x,y,PX,PY) !クリックした位置が
IF pp<0 THEN !頂点以外なら
LET pp = CheckNearLine(N,x,y,PX,PY) !クリックした位置が
IF pp>0 THEN !辺上なら
CALL AddPoint(pp,x,y,N,PX,PY,L,LS,LE) !その位置に点を追加する
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
END IF
END IF
IF pp>0 THEN !頂点または辺上をクリックしたら
IF click_right = 0 THEN !始点を指定したら
LET LS(L) = pp
LET click_right = 1
ELSE !終点を指定したら
LET LE(L) = pp
LET L = L + 1 !折り目の数を増やす
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE)
LET click_right = 0
END IF
END IF
END IF
LET drag_right = 0
END IF


IF click_right = 1 THEN !終点の指定待ちなら
SET LINE COLOR colorindex(0,0,1)
SET LINE WIDTH 1
PLOT LINES:PX(LS(L)),PY(LS(L)); x,y !仮の折り目を描く
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !この時点で作画しておく
END IF


IF getkeystate(38)<0 THEN !上カーソルキーなら
LET N = N + 1 !角数を増やす
LET L = 0 !０本にする
IF N>50 THEN LET N = 50
CALL CalcPoint(N,CX,CY,R,C,PX,PY)
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE)
END IF
IF getkeystate(40)<0 THEN !下カーソルキーなら
LET N = N - 1
LET L = 0 !０本にする
IF N<3 THEN LET N = 3
CALL CalcPoint(N,CX,CY,R,C,PX,PY)
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE)
END IF
IF getkeystate(27)<0 THEN STOP !ESCキーなら

WAIT DELAY 0.1 !ちょっとだけ待つ
LOOP

END
 

　　│　├その３ 山中和義 2004/08/27 19:12:56  ツリーへ

Re: 改修版 返事を書く
山中和義 2004/08/27 19:12:56
その３
!各頂点の位置を算出し、Ｎ角形を描く
EXTERNAL SUB CalcPoint(N,CX,CY,R,C,PX(),PY())
LET alp = PI/2 !１点目の位置を補正する
if N=4 then LET alp = PI/N

FOR i=0 TO N !各頂点の位置を算出する
LET PX(i) = -R*cos(2*PI*i/N + alp) + CX
LET PY(i) = R*SIN(2*PI*i/N + alp) + CY
NEXT i
END SUB

!当り判定　※２点間の距離を算出
EXTERNAL FUNCTION CheckNear(N,x,y,PX(),PY())
LET CheckNear = -1
FOR i=1 TO N !各頂点との
LET xx = PX(i) - x !距離を計算する
LET yy = PY(i) - y
IF xx*xx+yy*yy<81 THEN !近くなら
LET CheckNear = i !その頂点番号を返す
EXIT FUNCTION
END IF
NEXT i
END FUNCTION

!当り判定　※線上
EXTERNAL FUNCTION CheckNearLine(N,x,y,PX(),PY())
LET CheckNearLine = -1
FOR i=1 TO N !各線分との
! PRINT SideLine(x,y,PX(i-1),PY(i-1),PX(i),PY(i))
IF ABS(SideLine(x,y,PX(i-1),PY(i-1),PX(i),PY(i)))<400 THEN !近くなら
CALL SetP(X1,X2,PX(i-1),PX(i))
CALL SetP(Y1,Y2,PY(i-1),PY(i))
IF x-X1>=-5 AND x-X2<=5 AND y-Y1>=-5 AND y-Y2<=5 THEN !線分の範囲で
LET CheckNearLine = i !その線分番号を返す
EXIT FUNCTION
END IF
END IF
NEXT i
END FUNCTION

!点(x,y)を２点(x1,y1)、(x2,y2)を通る直線の式に代入する
!※正なら上側、負なら下側、０なら線上
EXTERNAL FUNCTION SideLine(x,y,X1,Y1,X2,Y2)
LET SideLine = (Y2-Y1)*(x-X1)-(X2-X1)*(y-Y1)
END FUNCTION

!点を座標値の大小で設定する　※X1<X2
EXTERNAL SUB SetP(X1,X2,XX1,XX2)
LET X1 = XX1
LET X2 = XX2
IF XX1>XX2 THEN
LET X1=XX2
LET X2=XX1
END IF
END SUB
 

　　│　├その４ 山中和義 2004/08/27 19:13:28  ツリーへ

Re: 改修版 返事を書く
山中和義 2004/08/27 19:13:28
その４
!Ｋ番目に頂点を追加する　※0<K<N、角数はＮ＋１になる
EXTERNAL SUB AddPoint(K,x,y,N,PX(),PY(),L,LS(),LE())
FOR i=N TO K STEP -1 !Ｋ番目を空けるため、後方にずらす
LET PX(i+1) = PX(i)
LET PY(i+1) = PY(i)
NEXT i
LET N = N + 1 !角数を増やす
LET PX(K) = x !Ｋ番目に追加する
LET PY(K) = y

FOR i=0 TO L !折り目について、参照している頂点番号を１つずらす
IF LS(i)>=K THEN LET LS(i) = LS(i) + 1
IF LE(i)>=K THEN LET LE(i) = LE(i) + 1
NEXT i
END SUB

!Ｋ番目の頂点を削除する　※0<K<N、角数はＮ−１になる
EXTERNAL SUB DelPoint(K,N,PX(),PY(),L,LS(),LE())
IF N>=4 THEN !４角形以上
IF K=N THEN LET KK=0 ELSE LET KK=K
FOR i=KK TO N-1 !Ｋ番目を詰めるため、前方にずらす
LET PX(i) = PX(i+1)
LET PY(i) = PY(i+1)
NEXT i
LET N = N - 1 !角数を減らす
LET PX(N) = PX(0) !Ｎ番目と０番目は同一点
LET PY(N) = PY(0)

LET i = 0
DO WHILE i<L !折り目について、参照している頂点があればそれを削除する
IF LS(i)=KK OR LE(i)=K THEN
CALL DelLine(i,L,LS,LE)
ELSE
IF LS(i)>KK THEN LET LS(i) = LS(i) - 1
IF LE(i)>KK THEN LET LE(i) = LE(i) - 1
LET i = i + 1
END IF
LOOP
END IF
END SUB

!Ｋ番目の折り目を削除する　※0<=K<L
EXTERNAL SUB DelLine(K,L,LS(),LE())
FOR i=K TO L-1 !Ｋ番目を詰めるため、前方にずらす
LET LS(i) = LS(i+1)
LET LE(i) = LE(i+1)
NEXT i
LET L = L - 1 !数を減らす
END SUB

!画面をクリア後、Ｎ角形を描く
EXTERNAL PICTURE DrawPolygon(N,C,PX(),PY(),L,LS(),LE())
SET DRAW MODE HIDDEN !ちらつきを抑える
SET AREA COLOR colorindex(1,1,1) !画面をクリアする
PLOT AREA:0,0; 640,0; 640,480; 0,480
DRAW polygon2(N,C,2,PX,PY) !頂点をつなげてＮ角形を描く
DRAW polyline(L,colorindex(0,0,1),1,LS,LE,PX,PY) !折り目を描く
SET DRAW MODE EXPLICIT
END PICTURE

!Ｎ角形を描く　※頂点(PX(),PY())
EXTERNAL PICTURE polygon2(N,C,W,PX(),PY()) !角数、色
SET LINE COLOR C !色
SET LINE WIDTH W !幅
FOR i=0 TO N
PLOT LINES:PX(i),PY(i); !辺を描く
PLOT POINTS:PX(i),PY(i) !頂点を描く
NEXT i
END PICTURE

!線分を描く　※頂点(PX(),PY())、端点の頂点番号LS(),LE()
EXTERNAL PICTURE polyline(L,C,W,LS(),LE(),PX(),PY()) !角数、色
SET LINE COLOR C
SET LINE WIDTH W
FOR i=0 TO L-1
PLOT LINES:PX(LS(i)),PY(LS(i)); PX(LE(i)),PY(LE(i))
NEXT i
END PICTURE
 

　　│　│└その４の訂正 山中和義 2004/08/27 19:51:57  ツリーへ

Re: その４ 返事を書く
山中和義 2004/08/27 19:51:57
その４の訂正
!Ｋ番目に頂点を追加する　※0<K<N、角数はＮ＋１になる
EXTERNAL SUB AddPoint(K,x,y,N,PX(),PY(),L,LS(),LE())
FOR i=N TO K STEP -1 !Ｋ番目を空けるため、後方にずらす
LET PX(i+1) = PX(i)
LET PY(i+1) = PY(i)
NEXT i
LET N = N + 1 !角数を増やす
LET PX(K) = x !Ｋ番目に追加する
LET PY(K) = y

FOR i=0 TO L !折り目について、参照している頂点番号を１つずらす
IF LS(i)>=K THEN LET LS(i) = LS(i) + 1
IF LE(i)>=K THEN LET LE(i) = LE(i) + 1
NEXT i
END SUB

!Ｋ番目の頂点を削除する　※0<K<N、角数はＮ−１になる
EXTERNAL SUB DelPoint(K,N,PX(),PY(),L,LS(),LE())
IF N>=4 THEN !４角形以上
IF K=N THEN LET KK=0 ELSE LET KK=K
FOR i=KK TO N-1 !Ｋ番目を詰めるため、前方にずらす
LET PX(i) = PX(i+1)
LET PY(i) = PY(i+1)
NEXT i
LET N = N - 1 !角数を減らす
LET PX(N) = PX(0) !Ｎ番目と０番目は同一点
LET PY(N) = PY(0)

LET i = 0
DO WHILE i<L !折り目について、参照している頂点があればそれを削除する
IF LS(i)=K OR LE(i)=K THEN
CALL DelLine(i,L,LS,LE)
ELSE
IF LS(i)>KK THEN
LET LS(i) = LS(i) - 1
IF LS(i)=0 THEN LET LS(i) = N
END IF
IF LE(i)>KK THEN
LET LE(i) = LE(i) - 1
IF LE(i)=0 THEN LET LE(i) = N
END if
LET i = i + 1
END IF
LOOP
END IF
END SUB

!Ｋ番目の折り目を削除する　※0<=K<L
EXTERNAL SUB DelLine(K,L,LS(),LE())
FOR i=K TO L-1 !Ｋ番目を詰めるため、前方にずらす
LET LS(i) = LS(i+1)
LET LE(i) = LE(i+1)
NEXT i
LET L = L - 1 !数を減らす
END SUB

!画面をクリア後、Ｎ角形を描く
EXTERNAL PICTURE DrawPolygon(N,C,PX(),PY(),L,LS(),LE())
SET DRAW MODE HIDDEN !ちらつきを抑える
SET AREA COLOR colorindex(1,1,1) !画面をクリアする
PLOT AREA:0,0; 640,0; 640,480; 0,480
DRAW polygon2(N,C,2,PX,PY) !頂点をつなげてＮ角形を描く
DRAW polyline(L,colorindex(0,0,1),1,LS,LE,PX,PY) !折り目を描く
SET DRAW MODE EXPLICIT
END PICTURE

!Ｎ角形を描く　※頂点(PX(),PY())
EXTERNAL PICTURE polygon2(N,C,W,PX(),PY()) !角数、色
SET LINE COLOR C !色
SET LINE WIDTH W !幅
FOR i=0 TO N
PLOT LINES:PX(i),PY(i); !辺を描く
PLOT POINTS:PX(i),PY(i) !頂点を描く
NEXT i
END PICTURE

!線分を描く　※頂点(PX(),PY())、端点の頂点番号LS(),LE()
EXTERNAL PICTURE polyline(L,C,W,LS(),LE(),PX(),PY()) !角数、色
SET LINE COLOR C
SET LINE WIDTH W
FOR i=0 TO L-1
PLOT LINES:PX(LS(i)),PY(LS(i)); PX(LE(i)),PY(LE(i))
NEXT i
END PICTURE
 

　　│　└山中さんへ ゆめの 2004/08/27 19:23:31  ツリーへ

Re: 改修版 返事を書く
ゆめの 2004/08/27 19:23:31
山中さんへ
右クリックしても折り目の線が
ひけないので
やり方をくわしく教えて
ください
 

　　│　　└辺か頂点を右クリックしてください。 山中和義 2004/08/27 19:56:23  ツリーへ

Re: 山中さんへ 返事を書く
山中和義 2004/08/27 19:56:23
辺か頂点を右クリックしてください。
マウスの反応が良くないかも知れません。

 

　　│　　　└ありがとうございました ゆめの 2004/08/27 20:41:54  ツリーへ

Re: 辺か頂点を右クリックしてください。 返事を書く
ゆめの 2004/08/27 20:41:54
ありがとうございました

完成版つかってみます

あと、ぜひ立体の回転図を

今月中にお願いしたいですね＾＾
 

　　│　　　　└右クリックで切り取り線が ゆめの 2004/08/27 20:47:34  ツリーへ

Re: ありがとうございました 返事を書く
ゆめの 2004/08/27 20:47:34
右クリックで切り取り線が
ひけました
ありがと
 

　　├機能がアッブシテきましたね ゆめの 2004/08/25 20:37:31  ツリーへ

Re: 続、凹凸Ｎ角形を描く 返事を書く
ゆめの 2004/08/25 20:37:31
機能がアッブシテきましたね
改良がたのしみです　





　 

　　└もう少しマウスの反応が確実なほうが ゆめの 2004/08/26 00:02:04  ツリーへ

Re: 続、凹凸Ｎ角形を描く 返事を書く
ゆめの 2004/08/26 00:02:04
もう少しマウスの反応が確実なほうが
いいですね
　あと、作図した図形の
一部　及び　全部が
ワンタッチで　消せないと

連続的に使えないかもしれませんね。

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。