|
|
一部修正しました(赤字)。
極座標軸を描画する外部絵定義(polar)を作りました。
動径,偏角の数字の有無や目盛間隔など指定できます。
偏角の表示は,1[-180<θ<=180]か,2[0<=θ<360]のどちらかを指定できます。
十進BASICの直交座標軸を描画するDRAW AXESやDRAW GRIDと仕様を合せているので重ねての描画も可能です。
外部絵定義 p_coordinate は,問題座標を極座標に変換して表示します。
DECLARE EXTERNAL PICTURE polar,p_coordinate
READ x0,x9,y0,y9
SET WINDOW x0,x9,y0,y9
!DATA -1,1,-1,1 ! 2*2
DATA -2.1,2.1,-2.1,2.1 ! 4.2*4.2
!DATA 0.2,2.5,-0.6,1.7 ! 2.3*2.3
!DATA -8.5,-3.5,4,9 ! 5*5
! 極座標軸(動径表示位置(0～3),偏角表示範囲(0～2),軸,動径目盛間隔,偏角目盛間隔(度))
DRAW polar(2,2,"grid",0.5,15)
!DRAW AXES(0.5,0.5) ! 直交座標軸(十進BASIC独自拡張)
!DRAW GRID(0.5,0.5) ! 直交座標軸(十進BASIC独自拡張)
DEF r(t)=t/PI ! 螺旋
!DEF r(t)=1*(1-0.8^2)/(1+0.8*COS(t)) ! 楕円(長半径=1,離心率=0.8)
!DEF r(t)=0.8*0.5/(1-0.8*COS(t)) ! 楕円(離心率=0.8,準線x=-0.5)
!DEF r(t)=2*COS(t) ! 円
!DEF r(t)=1+COS(t) ! カージオイド
!DEF r(t)=2*SIN(2*t) ! 正葉曲線
!DEF r(t)=1/(5/4*COS(t)+3/2*SIN(t)) ! 直交座標(4/5,0),(0,2/3)を通る直線
CALL red_point1
SET BEAM MODE "IMMORTAL"
LET t0=0 ! LET t0=-PI
LET t9=2*PI ! LET t9=PI
FOR t=t0 TO t9+1E-8 STEP (t9-t0)/500
CALL red_point2
WHEN EXCEPTION IN
PLOT LINES : r(t)*COS(t),r(t)*SIN(t);
! PLOT POINTS : r(t)*COS(t),r(t)*SIN(t)
USE
PLOT LINES
END WHEN
WAIT DELAY 0.01
NEXT t
PLOT LINES
SET BEAM MODE "RIGOROUS"
BEEP
PLOT TEXT ,AT (x9+x0)/2,y0 : "クリックで極座標表示,右クリックで終了"
DRAW p_coordinate(2,3) ! 極座標表示(偏角範囲(1～2),表示位置(1～4))
SUB red_point1
IF SGN(x0)<>SGN(x9) THEN LET rx0=0 ELSE LET rx0=MIN(ABS(x0),ABS(x9))
IF SGN(y0)<>SGN(y9) THEN LET ry0=0 ELSE LET ry0=MIN(ABS(y0),ABS(y9))
LET r1=SQR(rx0^2+ry0^2) ! 動径最小値
LET r9=SQR(MAX(ABS(x0),ABS(x9))^2+MAX(ABS(y0),ABS(y9))^2) ! 動径最大値
LET r8=r1+(r9-r1)/SQR(2) ! 赤点移動半径
LET x1=r8*COS(t0)
LET y1=r8*SIN(t0)
END SUB
SUB red_point2
LET x2=r8*COS(t)
LET y2=r8*SIN(t)
SET POINT STYLE 3
SET POINT COLOR 0
PLOT POINTS : x1,y1
SET POINT COLOR 4
PLOT POINTS : x2,y2 ! 赤点*
LET x1=x2
LET y1=y2
SET POINT STYLE 1
SET POINT COLOR 1
END SUB
END
REM 極座標軸(動径表示位置,偏角表示範囲,軸,動径目盛間隔,偏角目盛間隔)
EXTERNAL PICTURE polar(rn,tn,ag$,rs,ts)
! rn=動径表示位置(0無,1始線,2十字状,3放射状) ; tn=偏角表示範囲(0無,1[-180～180],2[0～360])
! ag$=軸("axis"始線のみ,"grid"円放射格子) ; rs=動径目盛間隔(>=0) ; ts=偏角目盛間隔(0<=ts<360)
ASK LINE COLOR alc
ASK LINE STYLE als
ASK TEXT COLOR atc
ASK TEXT JUSTIFY atjx$,atjy$
ASK AREA COLOR aac
SET LINE COLOR 15
SET TEXT COLOR 15
SET TEXT JUSTIFY "RIGHT","TOP"
ASK WINDOW x0,x9,y0,y9
LET r9=SQR(MAX(ABS(x0),ABS(x9))^2+MAX(ABS(y0),ABS(y9))^2) ! 動径最大値
IF SGN(x0)<>SGN(x9) THEN LET rx0=0 ELSE LET rx0=MIN(ABS(x0),ABS(x9))
IF SGN(y0)<>SGN(y9) THEN LET ry0=0 ELSE LET ry0=MIN(ABS(y0),ABS(y9))
SET LINE STYLE 1
PLOT LINES : 0,0 ; r9,0 ! 極座標始線
IF rn>=1 THEN PLOT TEXT ,AT 0,0 : STR$(0)
IF rs>0 THEN ! 動径目盛
ASK DEVICE SIZE PX,PY,S$
LET r0=rs*INT(SQR(rx0^2+ry0^2)/rs) ! 動径最小目盛
FOR r=r0 TO r9 STEP rs
IF LCASE$(ag$)="axis" OR LCASE$(ag$)="axes" THEN
PLOT LINES : r,-(y9-y0)/PY/2000 ; r,(y9-y0)/PY/2000 ! 始線目盛
ELSEIF LCASE$(ag$)="grid" THEN
SET LINE STYLE 3
DRAW CIRCLE WITH SHIFT(0,0)*SCALE(r) ! 同心円
END IF
IF rn=>1 THEN ! 動径数字あり
PLOT TEXT ,AT r,0 : STR$(r) ! 始線
IF rn>=2 THEN
PLOT TEXT ,AT 0,r : STR$(r) ! 十字状上
PLOT TEXT ,AT -r,0 : STR$(r) ! 十字状左
PLOT TEXT ,AT 0,-r : STR$(r) ! 十字状下
END IF
END IF
NEXT r
END IF
IF ts>0 THEN ! 偏角目盛
SET LINE STYLE 3
!FOR t=ts TO 360-ts+1E-6 STEP ts
FOR t=ts TO 360-1E-6 STEP ts
IF LCASE$(ag$)="grid" THEN PLOT LINES : 0,0;r9*COS(RAD(t)),r9*SIN(RAD(t)) ! 放射状破線
IF rn=3 THEN ! 動径数字放射状
FOR r=r0 TO r9 STEP rs
PLOT TEXT ,AT r*COS(RAD(t)),r*SIN(RAD(t)) : STR$(r)
NEXT r
END IF
NEXT t
IF tn>=1 THEN ! 偏角数字あり(単位;度)
LET r1=SQR(rx0^2+ry0^2) ! 動径最小値
LET r5=(r1+r9)/2 ! 偏角数字位置
IF rn=3 THEN SET TEXT BACKGROUND "OPAQUE"
!FOR t=ts TO 360-ts+1E-6 STEP ts
FOR t=ts TO 360-1E-6 STEP ts
IF MOD(t,90)<>0 OR rn<=1 OR rs=0 THEN
IF t<=180 OR tn=2 THEN LET a=t ELSE LET a=t-360 ! a=偏角
CALL adjust(a)
PLOT TEXT ,AT r5*COS(RAD(t)),r5*SIN(RAD(t)) : STR$(a)
END IF
NEXT t
END IF
END IF
SET TEXT BACKGROUND "TRANSPARENT"
SET LINE COLOR alc
SET LINE STYLE als
SET TEXT COLOR atc
SET TEXT JUSTIFY atjx$,atjy$
SET AREA COLOR aac
SUB adjust(d) ! 偏角数字位置調整
IF ABS(d)<=67.5 OR d>=292.5 THEN
LET tj1$="LEFT"
ELSEIF ABS(d)>67.5 AND ABS(d)<112.5 OR d>247.5 AND d<292.5 THEN
LET tj1$="CENTER"
ELSE
LET tj1$="RIGHT"
END IF
IF ABS(d)<22.5 OR d>337.5 OR ABS(d)>157.5 AND d<202.5 THEN
LET tj2$="HALF"
ELSEIF d>=22.5 AND d<67.5 OR d>112.5 AND d<=157.5 THEN
LET tj2$="BASE"
ELSEIF d>=67.5 AND d<=112.5 THEN
LET tj2$="BOTTOM"
ELSEIF d>=-112.5 AND d<=-67.5 OR d>=247.5 AND d<=292.5 THEN
LET tj2$="TOP"
ELSE
LET tj2$="CAP"
END IF
SET TEXT JUSTIFY tj1$,tj2$
END SUB
END PICTURE
REM 極座標(r,θ)表示
EXTERNAL PICTURE p_coordinate(tn,p)
! マウスポインタが指す点の極座標(動径,偏角)を表示
! 左クリック(ドラッグ)で表示,右クリックで終了
! tn=偏角範囲(1[-π<θ<=π],2[0<=θ<2π]) ; p=表示位置(1右上,2左上,3左下,4右下)
ASK WINDOW x0,x9,y0,y9
ASK TEXT JUSTIFY atjx$,atjy$
ASK TEXT HEIGHT ath
ASK AREA COLOR aac
SET TEXT FONT "",10
SET AREA COLOR 0
IF SGN(x0)<>SGN(x9) THEN LET rx0=0 ELSE LET rx0=MIN(ABS(x0),ABS(x9))
IF SGN(y0)<>SGN(y9) THEN LET ry0=0 ELSE LET ry0=MIN(ABS(y0),ABS(y9))
LET r1=SQR(rx0^2+ry0^2) ! 動径最小値
LET r9=SQR(MAX(ABS(x0),ABS(x9))^2+MAX(ABS(y0),ABS(y9))^2) ! 動径最大値
LET r9d=LOG10(r9)
LET rd=LOG10((r9-r1)/2000)
IF r9d>0 THEN LET u$=REPEAT$("-",CEIL(r9d)-1)&"%" ELSE LET u$="%"
IF rd<0 THEN LET u$=u$&"."&REPEAT$("#",CEIL(ABS(rd)))
CALL position
DO
MOUSE POLL mx,my,ml,mr
IF ml=1 THEN
LET r=SQR(mx^2+my^2) ! 動径
WHEN EXCEPTION IN
LET t=ANGLE(mx,my) ! 偏角(-π<t<=π)
IF tn=2 AND t<0 THEN LET t=t+2*PI ! 偏角(0<=t<2π)
USE
LET r,t=0 ! 特異点(極)
END WHEN
LET r$=USING$(u$,r) ! 動径
LET t$=USING$("-%.####",t) ! 偏角
LET d$=USING$("---%.##",DEG(t)) ! (度)
PLOT AREA : x1,y1;x2,y1;x2,y2;x1,y2
PLOT TEXT ,AT x1,y1 : r$&" "&t$&"("&d$&"°)"
END IF
WAIT DELAY 0.01 ! CPU負荷軽減
LOOP UNTIL mr=1 ! 右クリックで終了
SET TEXT JUSTIFY atjx$,atjy$
SET TEXT HEIGHT ath
SET AREA COLOR aac
SUB position ! 表示位置
ASK TEXT WIDTH(REPEAT$("W",LEN(u$)+20)) atw
LET x1=x9
LET x2=x9-atw
LET y1=y9
LET y2=y9-1.1*ath
SELECT CASE p
CASE 1 ! 画面右上
SET TEXT JUSTIFY "RIGHT","TOP"
CASE 2 ! 画面左上
SET TEXT JUSTIFY "LEFT","TOP"
LET x1=x0
LET x2=x0+atw
CASE 3 ! 画面左下
SET TEXT JUSTIFY "LEFT","BOTTOM"
LET x1=x0
LET x2=x0+atw
LET y1=y0
LET y2=y0+1.1*ath
CASE 4 ! 画面右下
SET TEXT JUSTIFY "RIGHT","BOTTOM"
LET y1=y0
LET y2=y0+1.1*ath
END SELECT
END SUB
END PICTURE
|
|