• [0]

  • Full BASIC互換ライブラリ

  • 投稿者：白石　和夫
  • 投稿日：2013年12月31日(火)17時10分32秒
 
十進BASIC独自拡張機能をFull BASIC仕様の範囲内で実現するためのライブラリ
  • [1]

  • DRAW GRID (その１)

  • 投稿者：白石和夫
  • 投稿日：2013年12月31日(火)17時25分34秒
 

座標系の横縦比が１の場合，絵定義GRIDは次のコードで実現できます。
200行以降がGRIDの定義部です。絵定義GRIDを使うプログラム単位には，110行に示すような外部絵定義宣言を書きます。
Full BASICではTEXT HEIGHTの初期値は0.01なので，たいていの場合，この値は小さすぎます。そのため，290行のように縦座標の範囲に比例して大きくなるように指定する必要があります。


110 DECLARE EXTERNAL PICTURE grid
120 DEF f(x)=ABS(x)
130 SET WINDOW -4,4,-4,4
140 DRAW grid
150 FOR x=-4 TO 4 STEP 0.01
160    PLOT LINES: x,f(x);
170 NEXT x
180 END
190 !
200 EXTERNAL PICTURE GRID
210 ASK WINDOW L,R,B,T
220 ASK LINE STYLE S
230 SET LINE STYLE 3
240 ASK LINE COLOR C
250 SET LINE COLOR 15
260 ASK TEXT COLOR tc
270 ASK TEXT HEIGHT th
280 SET TEXT COLOR 15
290 SET TEXT HEIGHT (T-B)*0.02
300 FOR X=CEIL(L) TO INT(R)
310    PLOT LINES:X,B;X,T
320    PLOT TEXT, AT x,0:str$(x)
330 NEXT X
340 FOR Y=CEIL(B) TO INT(T)
350    PLOT LINES:L,Y;R,Y
360    PLOT TEXT, AT 0,y:str$(y)
370 NEXT Y
380 SET LINE STYLE 1
390 PLOT LINES:L,0;R,0
400 PLOT LINES:0,B;0,T
410 SET LINE COLOR C
420 SET LINE STYLE S
430 SET TEXT COLOR tc
440 SET TEXT HEIGHT th
450 END PICTURE


  • [2]

  • DRAW GRID (その2)

  • 投稿者：白石和夫
  • 投稿日：2013年12月31日(火)18時02分45秒
 
Full BASICのGRAPH TEXT文，PLOT TEXT文が描く文字の字形は問題座標で定義されているため，座標系の横縦比が１でない場合には，文字は左右に押しつぶされて，あるいは，引き伸ばされて描かれます。
その効果を相殺するため，文字を描くとき，左右方向に拡大または縮小しなければなりません。

110 DECLARE NUMERIC x
120 OPTION ANGLE DEGREES
130 SET WINDOW -180,720,-8,8
140 DECLARE EXTERNAL PICTURE GRID2
150 DRAW GRID2(90,1)
160 FOR x=-180 TO 720
170    PLOT LINES: x,COS(x)
180 NEXT x
190 END
1000 !
1010 EXTERNAL PICTURE GRID2(sx,sy)
1010 DECLARE NUMERIC X,Y,L,R,B,T,S,C,TC,TH
1015 DECLARE STRING ts1$,ts2$
1020 ASK WINDOW L,R,B,T
1030 ASK LINE STYLE S
1040 SET LINE STYLE 3
1050 ASK LINE COLOR C
1060 SET LINE COLOR 15 ! Silver
1070 ASK TEXT COLOR TC
1080 SET TEXT COLOR 15
1090 ASK TEXT HEIGHT th
1100 SET TEXT HEIGHT 0.025*(T-B)
1110 ASK TEXT JUSTIFY ts1$,ts2$
1120 SET TEXT JUSTIFY "RIGHT","TOP"
1130 FOR X=CEIL(L/sx)*sx TO INT(R/sx)*sx STEP sx
1140    PLOT LINES :X,B;X,T
1150    DRAW label(str$(x)) WITH SCALE ((R-L)/(T-B),1) * SHIFT(x,0)
1160 NEXT X
1170 FOR Y=CEIL(B/sy)*sy TO INT(T/sy)*sy STEP sy
1180    PLOT LINES: L,Y;R,Y
1190    DRAW label(str$(y)) WITH SCALE ((R-L)/(T-B),1) * SHIFT(0,y)
1200 NEXT Y
1210 SET LINE STYLE 1
1220 PLOT LINES:L,0;R,0
1230 PLOT LINES:0,B;0,T
1240 SET LINE COLOR C
1250 SET LINE STYLE S
1260 SET TEXT COLOR TC
1270 SET TEXT JUSTIFY ts1$,ts2$
1280 PICTURE label(s$)
1290    PLOT TEXT ,AT 0,0: s$
1300 END PICTURE
1310 END PICTURE
  • [3]

  • DRAW AXES

  • 投稿者：白石和夫
  • 投稿日：2013年12月31日(火)18時22分22秒
 
十進BASICの組込絵定義AXESのようにトゲの生えた軸を描くのは，結構，面倒です。1100行に示すように，ASK PIXEL SIZE文を利用して，座標系が設定された領域のピクセル数を調べます。

120 SET WINDOW -5,5,-5,5
130 DECLARE EXTERNAL PICTURE axes
140 DRAW axes
180 END
1010 !
1020 EXTERNAL PICTURE AXES
1030 ASK WINDOW L,R,B,T
1040 ASK LINE STYLE S
1050 SET LINE STYLE 1
1060 ASK LINE COLOR C
1070 SET LINE COLOR 15
1080 ASK TEXT COLOR tc
1090 SET TEXT COLOR 15
1100 ASK PIXEL SIZE(L,B;R,T) PX,PY
1110 LET DX=(R-L)/PX*2
1120 LET DY=(T-B)/PY*2
1130 SET TEXT HEIGHT DY*6
1140 PLOT LINES: L,0;R,0
1150 FOR X=CEIL(L) TO INT(R)
1160    PLOT LINES :X,-DY;X,DY
1170    PLOT TEXT, AT x,0:STR$(x)
1180 NEXT X
1190 PLOT LINES:0,B;0,T
1200 FOR Y=CEIL(B) TO INT(T)
1210    PLOT LINES: -DX,Y;DX,Y
1220    PLOT TEXT,AT 0,y:str$(y)
1230 NEXT Y
1240 SET LINE COLOR C
1250 SET LINE STYLE S
1260 SET TEXT COLOR tc
1270 END PICTURE
  • [4]

  • PLOT LABEL

  • 投稿者：白石和夫
  • 投稿日：2013年12月31日(火)20時28分26秒
 

十進BASIC独自拡張命令のPLOT LABELは，文字の字形や向きは物理座標で，基点のみを変換します。
同等の機能をFull BASICの命令で実現するためには，文字を描くときは逆変換をかませてやります。逆変換をかけて描くために，基点の座標は現在変形から計算して指定します。問題座標系の横縦比による文字のゆがみを補正するために，x軸方向にのみ拡大・縮小をかけます。

1060～1130行で，p,qに変換された座標が得られる。

ASK WINDOW l,r,b,t
DRAW TEXT WITH scale((r-l)/(t-b),1)*shift(p,q)
PICTURE TEXT
     PLOT TEXT,AT 0,0:s$
END PICTURE
で座標系の横縦比を補正して点(p,q)にs$を描く意味になる。
1150行は，それを現在変形の逆変換をかけて描くことを意味する。

100 DECLARE EXTERNAL PICTURE PLOT_LABEL
110 DECLARE EXTERNAL PICTURE GRID
120 DECLARE NUMERIC T(4,4)
130 DATA 1,  0,  0, -0.2
140 DATA 0,  1,  0,  0.1
150 DATA 0,  0,  1,  0
160 DATA 0,  0,  0,  1
170 MAT READ T
180 SET WINDOW -2,10,-2,4
190 SET TEXT HEIGHT 0.5
200 DRAW test WITH T
210 PICTURE test
220    DRAW GRID
230    DRAW PLOT_LABEL(1,-1,"Hello!")
240    SET TEXT ANGLE PI/4
250    DRAW PLOT_LABEL(2,1,"BASIC")
260 END PICTURE
270 END
1000 !
1010 EXTERNAL PICTURE PLOT_LABEL(x,y,s$)
1020 DECLARE NUMERIC M(4,4),MM(4,4)
1030 DECLARE NUMERIC u(4),v(4)
1040 DECLARE NUMERIC l,r,b,t
1050 ASK WINDOW l,r,b,t
1060 MAT M=TRANSFORM
1070 LET u(1)=x
1080 LET u(2)=y
1090 LET u(3)=0
1100 LET u(4)=1
1110 MAT v=u*M
1120 LET p=v(1)/v(4)
1130 LET q=v(2)/v(4)
1140 MAT MM=INV(M)
1150 DRAW TEXT WITH scale((r-l)/(t-b),1)*shift(p,q) * MM
1160 PICTURE TEXT
1170    PLOT TEXT,AT 0,0:s$
1180 END PICTURE
1190 END PICTURE
2000 !
2010 EXTERNAL PICTURE GRID
2020 ASK WINDOW L,R,B,T
2030 ASK LINE STYLE S
2040 SET LINE STYLE 3
2050 ASK LINE COLOR C
2060 SET LINE COLOR 15
2070 ASK TEXT COLOR tc
2080 ASK TEXT HEIGHT th
2090 ASK TEXT ANGLE ta
2100 SET TEXT ANGLE 0
2110 SET TEXT COLOR 15
2120 SET TEXT HEIGHT (T-B)*0.05
2130 FOR X=CEIL(L) TO INT(R)
2140    PLOT LINES:X,B;X,T
2150    PLOT TEXT, AT x,0:str$(x)
2160 NEXT X
2170 FOR Y=CEIL(B) TO INT(T)
2180    PLOT LINES:L,Y;R,Y
2190    PLOT TEXT, AT 0,y:STR$(y)
2200 NEXT Y
2210 SET LINE STYLE 1
2220 PLOT LINES:L,0;R,0
2230 PLOT LINES:0,B;0,T
2240 SET LINE COLOR C
2250 SET LINE STYLE S
2260 SET TEXT COLOR tc
2270 SET TEXT HEIGHT th
2280 SET TEXT ANGLE ta
2290 END PICTURE
  • [5]

  • 色指標

  • 投稿者：白石和夫
  • 投稿日：2013年12月31日(火)20時35分54秒
 
色指標と実際の色との対応は規格では定められていません。
十進BASICと同じ色を割り当てたいときは，次のような副プログラムinitを呼び出します。
十進BASICのSET xxxx COLOR文には色名を文字列式で指定する独自拡張がありますが，副プログラムを書けば実現可能です。


100 DECLARE EXTERNAL SUB init
110 DECLARE EXTERNAL SUB SET_POINT_COLOR
120 DECLARE EXTERNAL SUB SET_LINE_COLOR
130 DECLARE EXTERNAL SUB SET_AREA_COLOR
140 DECLARE EXTERNAL SUB SET_TEXT_COLOR
150 CALL init
160 SET LINE COLOR 3
170 PLOT LINES:0,0;1,1
180 CALL SET_LINE_COLOR("blue")
190 PLOT LINES:1,0;0,1
200 END
1000 !
1010 EXTERNAL SUB init
1020 DATA 1 , 1 , 1
1030 DATA 0 , 0 , 0
1040 DATA 0 , 0 , 1
1050 DATA 0 , 1 , 0
1060 DATA 1 , 0 , 0
1070 DATA 0 , 1 , 1
1080 DATA 1 , 1 , 0
1090 DATA 1 , 0 , 1
1100 DATA .501960784313726 , .501960784313726 , .501960784313726
1110 DATA 0 , 0 , .501960784313726
1120 DATA 0 , .501960784313726 , 0
1130 DATA 0 , .501960784313726 , .501960784313726
1140 DATA .501960784313726 , 0 , 0
1150 DATA .501960784313726 , .501960784313726 , 0
1160 DATA .501960784313726 , 0 , .501960784313726
1170 DATA .752941176470588 , .752941176470588 , .752941176470588
1180 DECLARE NUMERIC i,r,g,b,maxcolor
1190 ASK MAX COLOR maxcolor
1200 FOR i=0 TO MIN(15,maxcolor)
1210    READ r,g,b
1220    SET COLOR MIX(i) r,g,b
1230 NEXT i
1240 END sub
1250 !
1260 EXTERNAL SUB SET_POINT_COLOR(s$)
1270 DECLARE EXTERNAL FUNCTION COLOR_INDEX_OF
1280 SET POINT COLOR COLOR_INDEX_OF(s$)
1290 END SUB
1300 !
1310 EXTERNAL SUB SET_LINE_COLOR(s$)
1320 DECLARE EXTERNAL FUNCTION COLOR_INDEX_OF
1330 SET LINE COLOR COLOR_INDEX_OF(s$)
1340 END SUB
1350 !
1360 EXTERNAL SUB SET_AREA_COLOR(s$)
1370 DECLARE EXTERNAL FUNCTION COLOR_INDEX_OF
1380 SET AREA COLOR COLOR_INDEX_OF(s$)
1390 END SUB
1400 !
1410 EXTERNAL SUB SET_TEXT_COLOR(s$)
1420 DECLARE EXTERNAL FUNCTION COLOR_INDEX_OF
1430 SET TEXT COLOR COLOR_INDEX_OF(s$)
1440 END SUB
1450 !
1460 EXTERNAL FUNCTION COLOR_INDEX_OF(s$)
1470 DECLARE NUMERIC k,maxcolor
1480 ASK MAX COLOR maxcolor
1490 LET s$=UCASE$(s$)
1500 SELECT CASE s$
1510 CASE "WHITE"
1520    LET k=0
1530 CASE "BLACK"
1540    LET k=1
1550 CASE "BLUE"
1560    LET k=2
1570 CASE "GREEN"
1580    LET k=3
1590 CASE "RED"
1600    LET k=4
1610 CASE "CYAN"
1620    LET k=5
1630 CASE "MAGENTA"
1640    LET k=6
1650 CASE "YELLOW"
1660    LET k=7
1670 CASE "GRAY"
1680    LET k=8
1690 CASE "SILVER"
1700    LET k=15
1710 CASE ELSE
1720    CAUSE EXCEPTION 11085
1730 END SELECT
1740 IF k>maxcolor THEN CAUSE EXCEPTION 11085
1750 LET COLOR_INDEX_OF=k
1760 END FUNCTION
  • [6]

  • 円と円板（DRAW CIRCLE　と　DRAW DISK）

  • 投稿者：白石和夫
  • 投稿日：2014年 1月 1日(水)07時00分46秒
 
単位円の座標を配列に記憶させておき，MAT PLOT LINESあるいはMAT　PLOT AREA文で円(circle)，円板(disk)を描く。

100 SET WINDOW -4,4,-4,4
110 DECLARE EXTERNAL PICTURE circles.circle, circles.disk
120 DRAW circle WITH SHEAR(PI/3)
130 DRAW disk WITH SCALE(1/2)*SHIFT(0,2)
140 END
1000 !
1010 MODULE circles
1020 PUBLIC SUB circle, disk
1030 SHARE NUMERIC p(0 TO 360,2)
1040 DECLARE NUMERIC x
1050 OPTION ANGLE DEGREES
1060 FOR x=0 TO 360
1070 LET p(x,1)=COS(x)
1080 LET p(x,2)=SIN(x)
1090 NEXT x
1100 !
1110 EXTERNAL PICTURE circle
1120 MAT PLOT LINES : p
1130 END PICTURE
1140 !
1150 EXTERNAL PICTURE disk
1160 MAT PLOT AREA:p
1170 END PICTURE
1180 END MODULE
  • [7]

  • SET DRAW MODE MASK　（減色混合）

  • 投稿者：白石和夫
  • 投稿日：2014年 1月 1日(水)12時11分3秒
 

Full BASICには，指定した画素の色指標を調べる命令 ASK PIXEL VALUEがあるので，draw mode mask と同等の結果を得ることは不可能ではない。
1020～1090行のように色指標を定めておくと，減色混合するための色指標を2進数のOR演算で求めることができる（が，Full BASICには2進数のOR演算の機能がないので，面倒(1230～1232行)）。
なお，次プログラムのように注釈に日本語を書くと規格合致ではない。
MAC上の十進BASIC 0.6.3.2はDRAW MODE MASKが機能しないが，この手法はMAC上の十進BASICにも適用できる。
（bitORは使えるので1220行の注釈を解除して1230～1232行を削除する。ただし，それでも遅い。）



100 REM ローレンツ・アトラクタ
110 REM 左赤，右シアンのフィルターを通して立体視する。
115 OPTION ARITHMETIC NATIVE
120 DECLARE EXTERNAL SUB init_Colors, SET_POINT_COLOR, PLOT_POINT
130 CALL init_Colors
140 CLEAR
150 SET WINDOW -60,60,-60,60
160 SET POINT STYLE 1
170 LET s=11
180 LET b=8/4
190 LET r=88
200 LET x=-10
210 LET y=-10
220 LET z=-30
230 LET dt=0.00001
240 FOR t=0 TO 10 STEP dt
250    LET xx=x+(-s*x+s*y)*dt
260    LET yy=y+(r*x-y-x*z)*dt
270    LET zz=z+(-b*z+x*y)*dt
280    LET x=xx
290    LET y=yy
300    LET z=zz
310    CALL SET_POINT_COLOR("cyan") ! 左目
320    call PLOT_POINT(x+0.02*z ,y)
330    call SET_POINT_COLOR("red") ! 右目
340    CALL PLOT_POINT(x-0.02*z ,y)
350 NEXT t
360 END
1000 !
1010 EXTERNAL SUB init_Colors
1015 OPTION ARITHMETIC NATIVE
1020 DATA 1 , 1 , 1 ! 0 White
1030 DATA 0 , 1 , 1 ! 1 Cyan
1040 DATA 1 , 0 , 1 ! 2 Magenta
1050 DATA 0 , 0 , 1 ! 3 Blue
1060 DATA 1 , 1 , 0 ! 4 Yellow
1070 DATA 0 , 1 , 0 ! 5 Green
1080 DATA 1 , 0 , 0 ! 6 Red
1090 DATA 0 , 0 , 0 ! 7 Black
1100 DECLARE NUMERIC i,r,g,b
1110 FOR i=0 TO 7
1120    READ r,g,b
1130    SET COLOR MIX(i) r,g,b
1140 NEXT i
1150 END sub
1155 !
1160 EXTERNAL SUB PLOT_POINT(x,y)
1165 OPTION ARITHMETIC NATIVE
1170 DECLARE NUMERIC a,b,c
1180 SET POINT STYLE 1
1190 ASK POINT COLOR b
1200 ASK pixel VALUE (x,y) c
1210 IF c>=0 THEN
1220    ! LET a=bitOR(b,c)
1230    LET a=MAX(MOD(b,2),MOD(c,2))
1231    LET a=a+MAX(MOD(INT(b/2),2), MOD(INT(c/2),2))*2
1232    LET a=a+MAX(MOD(INT(b/4),2), MOD(INT(c/4),2))*4
1240    SET POINT COLOR a
1250    PLOT POINTS: x,y
1260 END IF
1270 SET POINT COLOR b
1280 END SUB
1285 !
1290 EXTERNAL SUB SET_POINT_COLOR(s$)
1295 OPTION ARITHMETIC NATIVE
1300 DECLARE EXTERNAL FUNCTION COLOR_INDEX_OF
1310 SET POINT COLOR COLOR_INDEX_OF(s$)
1320 END SUB
1480 !
1490 EXTERNAL FUNCTION COLOR_INDEX_OF(s$)
1495 OPTION ARITHMETIC NATIVE
1500 DECLARE NUMERIC k
1510 LET s$=UCASE$(s$)
1520 SELECT CASE s$
1530 CASE "WHITE"
1540    LET k=0
1550 CASE "BLACK"
1560    LET k=7
1570 CASE "BLUE"
1580    LET k=3
1590 CASE "GREEN"
1600    LET k=5
1610 CASE "RED"
1620    LET k=6
1630 CASE "CYAN"
1640    LET k=1
1650 CASE "MAGENTA"
1660    LET k=2
1670 CASE "YELLOW"
1680    LET k=4
1690 CASE "GRAY"
1700    LET k=8
1710 CASE "SILVER"
1720    LET k=15
1730 CASE ELSE
1740    CAUSE EXCEPTION 11085
1750 END SELECT
1760 LET COLOR_INDEX_OF=k
1770 END FUNCTION
  


http://

　戻る