凹凸Ｎ角形を描く

　　凹凸Ｎ角形を描く 山中和義 2004/08/24 18:31:45 
　　├その１ 山中和義 2004/08/24 18:34:03 
　　├その２ 山中和義 2004/08/24 18:35:08 
　　├おもしろそうですね ゆめの 2004/08/24 20:19:49 
　　├どの点からも移動できるのがいいですね ゆめの 2004/08/24 20:40:23 
　　└作図がおわった後で ゆめの 2004/08/24 21:12:14

　　凹凸Ｎ角形を描く 山中和義 2004/08/24 18:31:45  ツリーへ

凹凸Ｎ角形を描く 返事を書く

山中和義 2004/08/24 18:31:45

!頂点を一筆書きで凹凸Ｎ角形を描く
![使い方]
!　頂点をドラッグして移動できる。
!　辺上をクリック、ドラッグして頂点(角数)を増やせる。
!　辺を右ドラッグして移動できる。
!　上下のカーソルキーで角数の増減ができる。
!　ESCキーで終了。

　　├その１ 山中和義 2004/08/24 18:34:03  ツリーへ

Re: 凹凸Ｎ角形を描く 返事を書く

山中和義 2004/08/24 18:34: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)

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

LET drag_left = 0
LET drag_right = 0

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

IF left=1 THEN !左ボタンが押された、押されていたら
IF drag_left = 1 THEN !ドラッグ中なら
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) !Ｎ角形を描く
ELSE
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 = 1 !線上ならドラッグ中とする
CALL AddPoint(pp,x,y,N,PX,PY) !クリックした点を追加する
DRAW DrawPolygon(N,C,PX,PY) !この時点で作画しておく
END IF
END IF
END IF
ELSE
LET drag_left = 0
END IF

IF right=1 THEN !右ボタンが押された、押されていたら
IF drag_right = 1 THEN !ドラッグ中なら
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
DRAW DrawPolygon(N,C,PX,PY)
LET xo = x
LET yo = y
ELSE
LET pp = CheckNearLine(N,x,y,PX,PY)
IF pp>0 THEN
LET drag_right = 1
LET xo = x
LET yo = y
END IF
END IF
ELSE
LET drag_right = 0
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)
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)
END IF
IF getkeystate(27)<0 THEN STOP !ESCキーなら

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

END

　　├その２ 山中和義 2004/08/24 18:35:08  ツリーへ

Re: 凹凸Ｎ角形を描く 返事を書く

山中和義 2004/08/24 18:35:08

その２

!各頂点の位置を算出し、Ｎ角形を描く
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

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

!画面をクリア後、Ｎ角形を描く
EXTERNAL PICTURE DrawPolygon(N,C,PX(),PY())
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,PX,PY) !Ｎ角形を描く
SET DRAW MODE EXPLICIT
END PICTURE

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

　　├おもしろそうですね ゆめの 2004/08/24 20:19:49  ツリーへ

Re: 凹凸Ｎ角形を描く 返事を書く

ゆめの 2004/08/24 20:19:49

おもしろそうですね
まえのと比べてみます

　　├どの点からも移動できるのがいいですね ゆめの 2004/08/24 20:40:23  ツリーへ

Re: 凹凸Ｎ角形を描く 返事を書く

ゆめの 2004/08/24 20:40:23

どの点からも移動できるのがいいですね

折り紙ソフトと比較してみると
自由度が高くて良いと思います。

できれば　書いた図形を
メニュー　で印刷
全部消す　が　できるといいですね

学校では　ストローを使って
辺をそれぞれ違う色で表しますが

作図したあと　説明用に

始点と　終点を　マウスで決めて
辺ごとに　三角形や四角形の
辺を表示できると
わかりやすいですね。
改良できるでしょうか？

　　└作図がおわった後で ゆめの 2004/08/24 21:12:14  ツリーへ

Re: 凹凸Ｎ角形を描く 返事を書く

ゆめの 2004/08/24 21:12:14

作図がおわった後で
任意の辺上の任意の点から
他の辺上の任意の点に
点線がひけるようにできますでしょうか？
折りたたむという
指導・指示が多いのです。
もしできれば宜しく
お願いします。

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

凹凸Ｎ角形を描く	返事を書く
山中和義 2004/08/24 18:31:45
!頂点を一筆書きで凹凸Ｎ角形を描く ![使い方] !　頂点をドラッグして移動できる。 !　辺上をクリック、ドラッグして頂点(角数)を増やせる。 !　辺を右ドラッグして移動できる。 !　上下のカーソルキーで角数の増減ができる。 !　ESCキーで終了。

Re: 凹凸Ｎ角形を描く	返事を書く
山中和義 2004/08/24 18:34: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) CALL CalcPoint(N,CX,CY,R,C,PX,PY) !Ｎ角形の頂点を求める DRAW DrawPolygon(N,C,PX,PY) !Ｎ角形を描く LET drag_left = 0 LET drag_right = 0 DO mouse poll x,y,left,right !マウスの状態を得る IF left=1 THEN !左ボタンが押された、押されていたら IF drag_left = 1 THEN !ドラッグ中なら 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) !Ｎ角形を描く ELSE 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 = 1 !線上ならドラッグ中とする CALL AddPoint(pp,x,y,N,PX,PY) !クリックした点を追加する DRAW DrawPolygon(N,C,PX,PY) !この時点で作画しておく END IF END IF END IF ELSE LET drag_left = 0 END IF IF right=1 THEN !右ボタンが押された、押されていたら IF drag_right = 1 THEN !ドラッグ中なら 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 DRAW DrawPolygon(N,C,PX,PY) LET xo = x LET yo = y ELSE LET pp = CheckNearLine(N,x,y,PX,PY) IF pp>0 THEN LET drag_right = 1 LET xo = x LET yo = y END IF END IF ELSE LET drag_right = 0 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) 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) END IF IF getkeystate(27)<0 THEN STOP !ESCキーなら WAIT DELAY 0.1 !ちょっとだけ待つ LOOP END

Re: 凹凸Ｎ角形を描く	返事を書く
山中和義 2004/08/24 18:35:08
その２ !各頂点の位置を算出し、Ｎ角形を描く 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) = -Rcos(2PIi/N + alp) + CX LET PY(i) = RSIN(2PIi/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 xxxx+yyyy<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 !Ｋ番目に頂点を追加する　※角数はＮ＋１になる EXTERNAL SUB AddPoint(K,x,y,N,PX(),PY()) FOR i=N TO K STEP -1 !Ｋ番目を空けるため、後方にずらす LET PX(i+1) = PX(i) LET PY(i+1) = PY(i) NEXT i LET PX(K) = x !Ｋ番目に追加する LET PY(K) = y LET N = N + 1 !角数を増やす END SUB !画面をクリア後、Ｎ角形を描く EXTERNAL PICTURE DrawPolygon(N,C,PX(),PY()) 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,PX,PY) !Ｎ角形を描く SET DRAW MODE EXPLICIT END PICTURE !Ｎ角形を描く EXTERNAL PICTURE polygon2(N,C,PX(),PY()) !角数、中心点、半径、色 SET LINE COLOR C SET LINE WIDTH 2 FOR i=0 TO N PLOT LINES:PX(i),PY(i); !辺を描く PLOT POINTS:PX(i),PY(i) !頂点を描く NEXT i END PICTURE

Re: 凹凸Ｎ角形を描く	返事を書く
ゆめの 2004/08/24 20:19:49
おもしろそうですねまえのと比べてみます

Re: 凹凸Ｎ角形を描く	返事を書く
ゆめの 2004/08/24 20:40:23
どの点からも移動できるのがいいですね折り紙ソフトと比較してみると自由度が高くて良いと思います。できれば　書いた図形をメニュー　で印刷全部消す　が　できるといいですね学校では　ストローを使って辺をそれぞれ違う色で表しますが作図したあと　説明用に始点と　終点を　マウスで決めて辺ごとに　三角形や四角形の辺を表示できるとわかりやすいですね。改良できるでしょうか？

Re: 凹凸Ｎ角形を描く	返事を書く
ゆめの 2004/08/24 21:12:14
作図がおわった後で任意の辺上の任意の点から他の辺上の任意の点に点線がひけるようにできますでしょうか？折りたたむという指導・指示が多いのです。もしできれば宜しくお願いします。