新しく発言する EXIT インデックスへ
続、凹凸N角形を描く

  続、凹凸N角形を描く 山中和義 2004/08/25 19:56:25 
  その1 山中和義 2004/08/25 19:57:14 
  その2 山中和義 2004/08/25 19:58:04 
  その3 山中和義 2004/08/25 20:00:01 
  その4 山中和義 2004/08/25 20:00:34 
  試作ですので、バグもあります。 山中和義 2004/08/25 20:04:35 
  │└改修版 山中和義 2004/08/27 19:08:15 
  │ ├その1 山中和義 2004/08/27 19:10:03 
  │ ├その2 山中和義 2004/08/27 19:12:01 
  │ ├その3 山中和義 2004/08/27 19:12:56 
  │ ├その4 山中和義 2004/08/27 19:13:28 
  │ │└その4の訂正 山中和義 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 

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

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

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

Re: 続、凹凸N角形を描く 返事を書く
山中和義 2004/08/25 19:57:14
その1
SET BITMAP SIZE 640,480 !画面サイズ
SET WINDOW 0,640,0,480 !左下が原点。横がX、縦Y
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) !N角形の頂点を求める
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !N角形を描く

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 !N番目と0番目(同一点)
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 !N番目と0番目(同一点)
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 !N番目と0番目(同一点)
LET PX(0) = x
LET PY(0) = y
END IF
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !N角形を描く
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

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

Re: 続、凹凸N角形を描く 返事を書く
山中和義 2004/08/25 19:58:04
その2
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

!各頂点の位置を算出し、N角形を描く
EXTERNAL SUB CalcPoint(N,CX,CY,R,C,PX(),PY())
LET alp = PI/2 !1点目の位置を補正する
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

!当り判定 ※2点間の距離を算出
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

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

Re: 続、凹凸N角形を描く 返事を書く
山中和義 2004/08/25 20:00:01
その3
!当り判定 ※線上
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)を2点(x1,y1)、(x2,y2)を通る直線の式に代入する
!※正なら上側、負なら下側、0なら線上
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

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

FOR i=0 TO L !折り目について、参照している頂点番号を1つずらす
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

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

!K番目の折り目を追加する
EXTERNAL SUB AddLine(K,pp,L,LS(),LE())
FOR i=L TO K STEP -1 !K番目を空けるため、後方にずらす
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

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

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

Re: 続、凹凸N角形を描く 返事を書く
山中和義 2004/08/25 20:00:34
その4
!画面をクリア後、N角形を描く
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) !頂点をつなげてN角形を描く
DRAW polyline(L,colorindex(0,0,1),1,LS,LE,PX,PY) !折り目を描く
SET DRAW MODE EXPLICIT
END PICTURE

!N角形を描く ※頂点(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: 続、凹凸N角形を描く 返事を書く
山中和義 2004/08/25 20:04:35
試作ですので、バグもあります。
・頂点を削除すると折り目が正しく削除されない場合がある。
・クリックが動作しづらい。(DELAYの間隔)

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

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

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

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

Re: 改修版 返事を書く
山中和義 2004/08/27 19:10:03
その1
SET BITMAP SIZE 640,480 !画面サイズ
SET WINDOW 0,640,0,480 !左下が原点。横がX、縦Y
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) !N角形の頂点を求める
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !N角形を描く

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 !N番目と0番目(同一点)
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 !N番目と0番目(同一点)
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 !N番目と0番目(同一点)
LET PX(0) = x
LET PY(0) = y
END IF
DRAW DrawPolygon(N,C,PX,PY,L,LS,LE) !N角形を描く
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

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

Re: 改修版 返事を書く
山中和義 2004/08/27 19:12:01
その2
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 !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 !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

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

Re: 改修版 返事を書く
山中和義 2004/08/27 19:12:56
その3
!各頂点の位置を算出し、N角形を描く
EXTERNAL SUB CalcPoint(N,CX,CY,R,C,PX(),PY())
LET alp = PI/2 !1点目の位置を補正する
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

!当り判定 ※2点間の距離を算出
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)を2点(x1,y1)、(x2,y2)を通る直線の式に代入する
!※正なら上側、負なら下側、0なら線上
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

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

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

FOR i=0 TO L !折り目について、参照している頂点番号を1つずらす
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

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

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

!画面をクリア後、N角形を描く
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) !頂点をつなげてN角形を描く
DRAW polyline(L,colorindex(0,0,1),1,LS,LE,PX,PY) !折り目を描く
SET DRAW MODE EXPLICIT
END PICTURE

!N角形を描く ※頂点(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

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

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

FOR i=0 TO L !折り目について、参照している頂点番号を1つずらす
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

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

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

!画面をクリア後、N角形を描く
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) !頂点をつなげてN角形を描く
DRAW polyline(L,colorindex(0,0,1),1,LS,LE,PX,PY) !折り目を描く
SET DRAW MODE EXPLICIT
END PICTURE

!N角形を描く ※頂点(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: 続、凹凸N角形を描く 返事を書く
ゆめの 2004/08/25 20:37:31
機能がアッブシテきましたね
改良がたのしみです 





 

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

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

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




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