|
|
十進BASICの軸・格子を描く組込み絵定義 AXES(p,q),GRID(p,q)を、いつでも数字が描画されるように拡張しました。
描画領域内に座標軸がない場合、下端左端に数字を描きます。
（注意：数字の"0"の位置は必ずしも原点(0,0)を示しているわけではない）
数字文字列が長いときは小数部分をカットし、重なって描画されるのを回避します。(指数部のある場合を除く)
AXES0(p,q),AXES(p,q)では、座標軸が描画されないときには描画領域周囲に目盛線を描画するようにしました。
両軸とも描画されている場合は、組込み絵定義と同じ結果になります。
既存のプログラムに、140行END以下の外部絵定義を付加するだけで拡張できます。お試しください。
（注意：引数のないDRAW AXES,DRAW GRIDなどはエラーとなる）
100 SET WINDOW 2,10,5,13
!SET WINDOW -4,4,-4,4
!SET WINDOW -3,5,4,12
110 LET a=1 ! a=.425
120 LET b=1
130 DRAW AXES(a,b)
!DRAW AXES0(a,b)
!DRAW GRID(a,b)
!DRAW GRID0(a,b) ! 組込み絵定義
140 END
REM ** 座標数字位置自動調整 **
EXTERNAL PICTURE AXES(p,q)
DRAW axes_grid("on","ax",STR$(p),STR$(q))
END PICTURE
EXTERNAL PICTURE AXES0(p,q)
DRAW axes_grid("off","ax",STR$(p),STR$(q))
END PICTURE
EXTERNAL PICTURE GRID(p,q)
DRAW axes_grid("on","gr",STR$(p),STR$(q))
END PICTURE
!
!十進BASIC添付"\BASICw32\Library\Grid2.lib"参照
! num$="off"数字無,"on"数字有 , ag$="ax"軸,"gr"格子 , sx=x軸目盛間隔 , sy=y軸目盛間隔
EXTERNAL PICTURE axes_grid(num$,ag$,sx$,sy$)
OPTION ARITHMETIC DECIMAL
FUNCTION val_r(f$) ! 有理数を小数に変換
LET vrp=POS(f$,"/")
IF vrp=0 THEN LET val_r=VAL(f$) ELSE LET val_r=VAL(f$(1:vrp-1))/VAL(f$(vrp+1:LEN(f$)))
END FUNCTION
FUNCTION round_cut$(a$,A,s) ! 小数桁カット
ASK TEXT WIDTH(a$) w
LET d=LEN(a$)
LET p=POS(a$,".")
IF w>s AND p>0 AND POS(a$,"E")=0 AND d>2 AND NOT(d=3 AND a$(1:2)="-." OR a$(d:d)=".") THEN
LET a$=STR$(SGN(A)*ROUND(ABS(A),d-p-1))
! LET a$=STR$(ROUND(A,d-p-1))
IF POS(a$,".")>0 THEN LET a$=a$&"00000000" ELSE LET a$=a$&".00000000"
LET a$=round_cut$(a$(1:d-1),A,s)
END IF
LET round_cut$=a$
END FUNCTION
LET sx=val_r(sx$)
LET sy=val_r(sy$)
ASK WINDOW L,R,B,T
ASK LINE STYLE S
ASK LINE COLOR C
SET LINE COLOR 15 ! 銀色
ASK TEXT COLOR TC
SET TEXT COLOR 15 ! 銀色
ASK TEXT JUSTIFY ts1$,ts2$
SET LINE STYLE 1
PLOT LINES:L,0;R,0 ! x軸
PLOT LINES:0,B;0,T ! y軸
IF ag$="gr" THEN SET LINE STYLE 3
IF sx<>0 THEN
IF B*T<0 OR T=0 THEN SET TEXT JUSTIFY "RIGHT","TOP" ELSE SET TEXT JUSTIFY "RIGHT","BOTTOM"
IF B*T<0 OR T=0 THEN LET y0=0 ELSE LET y0=B
LET wy=WORLDY(PIXELY(0)+2)
LET n=ABS(INT(LOG10(sx)-2))
FOR X=CEIL(L/sx)*sx TO INT(R/sx)*sx+1.001*sx STEP sx
IF ag$="gr" THEN PLOT LINES:X,B;X,T ELSE PLOT LINES:X,-wy;X,wy
IF y0=B AND ag$="ax" THEN
PLOT LINES:X,B-(T-B)/100;X,WORLDY(3) ! 下端目盛線
PLOT LINES:X,T+(T-B)/100;X,WORLDY(PIXELY(T)-3) ! 上端目盛線
END IF
IF num$="on" THEN PLOT TEXT,AT X,y0 : round_cut$(STR$(ROUND(X,n)),X,sx)
NEXT X
END IF
IF sy<>0 THEN
IF L*R<0 OR R=0 THEN SET TEXT JUSTIFY "RIGHT","TOP" ELSE SET TEXT JUSTIFY "LEFT","TOP"
IF L*R<0 OR R=0 THEN LET x0=0 ELSE LET x0=L
LET wx=WORLDX(PIXELX(0)+2)
LET n=ABS(INT(LOG10(sy)-2))
FOR Y=CEIL(B/sy)*sy TO INT(T/sy)*sy+1.001*sy STEP sy
IF ag$="gr" THEN PLOT LINES:L,Y;R,Y ELSE PLOT LINES:-wx,Y;wx,Y
IF x0=L AND ag$="ax" THEN
PLOT LINES:L-(R-L)/100,Y;WORLDX(3),Y ! 左端目盛線
PLOT LINES:R+(R-L)/100,Y;WORLDX(PIXELX(R)-3),Y ! 右端目盛線
END IF
IF num$="on" THEN PLOT TEXT,AT x0,Y : STR$(ROUND(Y,n))
NEXT Y
END IF
SET TEXT JUSTIFY "RIGHT","TOP"
IF num$="on" AND sx=0 AND sy=0 THEN PLOT TEXT,AT 0,0:STR$(0)
SET LINE COLOR C
SET LINE STYLE S
SET TEXT COLOR TC
SET TEXT JUSTIFY ts1$,ts2$
END PICTURE
|
|