平行投影

 投稿者:しばっち  投稿日:2017年 2月11日(土)18時31分47秒
  立方体を平行投影で表示します
ワイヤーフレームで陰線処理はしていないので
見にくいかもしれません

LOCATE VALUE スライドバーもう少し増やせないでしょうか?

OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
DIM M(4,4),POINT(4),ROTX(4,4),ROTY(4,4),ROTZ(4,4)
SET POINT STYLE 1
LET LMIN=1E+10
LET LMAX=-1E+10
LET L=100
LOCATE VALUE NOWAIT(1),RANGE -180 TO 180,AT 0:XTH
LOCATE VALUE NOWAIT(2),RANGE -180 TO 180,AT 0:YTH
LOCATE VALUE NOWAIT(3),RANGE -180 TO 180,AT 0:ZTH
LOCATE VALUE NOWAIT(4),RANGE -500 TO 500,AT 0:XMOVE
LOCATE VALUE NOWAIT(5),RANGE -500 TO 500,AT 0:YMOVE
DO
   LOCATE VALUE NOWAIT(1):XTH
   LOCATE VALUE NOWAIT(2):YTH
   LOCATE VALUE NOWAIT(3):ZTH
   LOCATE VALUE NOWAIT(4):XMOVE
   LOCATE VALUE NOWAIT(5):YMOVE
   MAT ROTX=IDN ! x軸のまわりの回転
   LET ROTX(2,2)=COS(XTH)
   LET ROTX(2,3)=SIN(XTH)
   LET ROTX(3,2)=-SIN(XTH)
   LET ROTX(3,3)=COS(XTH)
   MAT ROTY=IDN ! y軸のまわりの回転
   LET ROTY(1,1)=COS(YTH)
   LET ROTY(1,3)=-SIN(YTH)
   LET ROTY(3,1)=SIN(YTH)
   LET ROTY(3,3)=COS(YTH)
   MAT ROTZ=IDN ! z軸のまわりの回転
   LET ROTZ(1,1)=COS(ZTH)
   LET ROTZ(1,2)=SIN(ZTH)
   LET ROTZ(2,1)=-SIN(ZTH)
   LET ROTZ(2,2)=COS(ZTH)
   MAT M=ROTX*ROTY*ROTZ
   SET DRAW MODE HIDDEN
   CLEAR
   CALL CUBE(XMOVE,YMOVE,ZMOVE,L)
   IF FL=0 THEN
      SET WINDOW LMIN*2,LMAX*2,LMIN*2,LMAX*2
   END IF
   LET FL=1
   SET DRAW MODE EXPLICIT
LOOP

SUB PLOT(X,Y,Z)
   LET POINT(1)=X
   LET POINT(2)=Y
   LET POINT(3)=Z
   MAT POINT=POINT*M
   IF FL=0 THEN
      LET LMIN=MIN(LMIN,POINT(1))
      LET LMAX=MAX(LMAX,POINT(1))
      LET LMIN=MIN(LMIN,POINT(2))
      LET LMAX=MAX(LMAX,POINT(2))
   ELSE
      PLOT LINES:POINT(1),POINT(2);
   END IF
END SUB

SUB PLOTLINE(X1,Y1,Z1,X2,Y2,Z2)
   PLOT LINES
   CALL PLOT(X1,Y1,Z1)
   CALL PLOT(X2,Y2,Z2)
   PLOT LINES
END SUB

SUB CUBE(X,Y,Z,L)
   CALL PLOT(X-L/2,Y+L/2,Z-L/2)
   CALL PLOT(X+L/2,Y+L/2,Z-L/2)
   CALL PLOT(X+L/2,Y+L/2,Z+L/2)
   CALL PLOT(X-L/2,Y+L/2,Z+L/2)
   CALL PLOT(X-L/2,Y+L/2,Z-L/2)
   PLOT LINES
   CALL PLOT(X-L/2,Y-L/2,Z-L/2)
   CALL PLOT(X+L/2,Y-L/2,Z-L/2)
   CALL PLOT(X+L/2,Y-L/2,Z+L/2)
   CALL PLOT(X-L/2,Y-L/2,Z+L/2)
   CALL PLOT(X-L/2,Y-L/2,Z-L/2)
   PLOT LINES
   CALL PLOTLINE(X-L/2,Y+L/2,Z-L/2,X-L/2,Y-L/2,Z-L/2)
   CALL PLOTLINE(X+L/2,Y+L/2,Z-L/2,X+L/2,Y-L/2,Z-L/2)
   CALL PLOTLINE(X+L/2,Y+L/2,Z+L/2,X+L/2,Y-L/2,Z+L/2)
   CALL PLOTLINE(X-L/2,Y+L/2,Z+L/2,X-L/2,Y-L/2,Z+L/2)
END SUB
END

 

Re: 平行投影

 投稿者:nagram  投稿日:2017年 2月12日(日)20時47分45秒
  > No.4258[元記事へ]

しばっちさんへのお返事です。

> LOCATE VALUE スライドバーもう少し増やせないでしょうか?

以前作ったスライドバーを実装しました。また、立方体の辺を色分けしました。
グラフィックス画面が長方形になっているので、ドラッグしてすべて表示させて下さい。

DECLARE EXTERNAL SUB prep,slide.init,slide.bar_operation,slide.scales,global_graphic.asks,global_graphic.sets
!
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
DIM M(4,4),POINT(4),ROTX(4,4),ROTY(4,4),ROTZ(4,4)
SET POINT STYLE 1
LET LMIN=1E+10
LET LMAX=-1E+10
LET L=100
!
LET slb_n=6   ! スライドバー本数(最大12本)
DIM slb_x0(slb_n),slb_y0(slb_n),slb_init_v(slb_n)
LET slb_area_pix=45  ! スライドバー1本を描くために必要な幅の画素数
SET BITMAP SIZE 641+slb_area_pix*slb_n+5+1,641
ASK DEVICE WINDOW slb_x1,slb_x2,slb_y1,slb_y2
SET VIEWPORT 641/(641+slb_area_pix*slb_n+5),1,0,1
SET WINDOW 0,slb_area_pix*slb_n+5,0,640/slb_y2
CALL prep(slb_n,slb_x0,slb_y0,slb_init_v)
FOR slb_i=1 TO slb_n
   CALL result(slb_i,slb_init_v(slb_i))
NEXT slb_i
!
DO !! メインルーチン
!
   SET VIEWPORT 641/(641+slb_area_pix*slb_n+5),1,0,1
   SET WINDOW 0,slb_area_pix*slb_n+5,0,640/slb_y2
   LET ms_l9=ms_ll   ! ms_l9=マウスの左ボタンの直前の状態
   MOUSE POLL ms_xx,ms_yy,ms_ll,ms_rr
   SET DRAW MODE HIDDEN
   CALL slide.bar_operation(slb_num,slb_v,ms_l9,ms_ll,ms_xx,ms_yy) ! **バー操作**
   ! slb_num=操作したバーの番号(0or1~n,戻り値), slb_v=バーの値(戻り値)
   IF slb_num<>0 THEN CALL result(slb_num,slb_v) ! 結果
   SET DRAW MODE EXPLICIT
   !
   SET VIEWPORT 0,640/(641+slb_area_pix*slb_n+5),0,1*slb_y2
   SET WINDOW LMIN*2,LMAX*2,LMIN*2,LMAX*2
   MAT ROTX=IDN ! x軸のまわりの回転
   LET ROTX(2,2)=COS(XTH)
   LET ROTX(2,3)=SIN(XTH)
   LET ROTX(3,2)=-SIN(XTH)
   LET ROTX(3,3)=COS(XTH)
   MAT ROTY=IDN ! y軸のまわりの回転
   LET ROTY(1,1)=COS(YTH)
   LET ROTY(1,3)=-SIN(YTH)
   LET ROTY(3,1)=SIN(YTH)
   LET ROTY(3,3)=COS(YTH)
   MAT ROTZ=IDN ! z軸のまわりの回転
   LET ROTZ(1,1)=COS(ZTH)
   LET ROTZ(1,2)=SIN(ZTH)
   LET ROTZ(2,1)=-SIN(ZTH)
   LET ROTZ(2,2)=COS(ZTH)
   MAT M=ROTX*ROTY*ROTZ
   SET DRAW MODE HIDDEN
   SET AREA COLOR 0
   PLOT AREA :LMIN*2,LMIN*2;LMAX*2,LMIN*2;LMAX*2,LMAX*2;LMIN*2,LMAX*2
   CALL CUBE(XMOVE,YMOVE,ZMOVE,L)
   IF FL=0 THEN
      SET VIEWPORT 0,640/(641+slb_area_pix*slb_n+5),0,1*slb_y2
      SET WINDOW LMIN*2,LMAX*2,LMIN*2,LMAX*2
   END IF
   LET FL=1
   SET DRAW MODE EXPLICIT
   !
LOOP

SUB PLOT(X,Y,Z)
   LET POINT(1)=X
   LET POINT(2)=Y
   LET POINT(3)=Z
   MAT POINT=POINT*M
   IF FL=0 THEN
      LET LMIN=MIN(LMIN,POINT(1))
      LET LMAX=MAX(LMAX,POINT(1))
      LET LMIN=MIN(LMIN,POINT(2))
      LET LMAX=MAX(LMAX,POINT(2))
   ELSE
      PLOT LINES:POINT(1),POINT(2);
   END IF
END SUB

SUB PLOTLINE(X1,Y1,Z1,X2,Y2,Z2)
   PLOT LINES
   CALL PLOT(X1,Y1,Z1)
   CALL PLOT(X2,Y2,Z2)
   PLOT LINES
END SUB

SUB CUBE(X,Y,Z,L)
   SET LINE COLOR 2
   CALL PLOT(X-L/2,Y+L/2,Z-L/2)
   CALL PLOT(X+L/2,Y+L/2,Z-L/2)
   SET LINE COLOR 4
   CALL PLOT(X+L/2,Y+L/2,Z+L/2)
   SET LINE COLOR 2
   CALL PLOT(X-L/2,Y+L/2,Z+L/2)
   SET LINE COLOR 4
   CALL PLOT(X-L/2,Y+L/2,Z-L/2)
   PLOT LINES
   CALL PLOT(X-L/2,Y-L/2,Z-L/2)
   SET LINE COLOR 2
   CALL PLOT(X+L/2,Y-L/2,Z-L/2)
   SET LINE COLOR 4
   CALL PLOT(X+L/2,Y-L/2,Z+L/2)
   SET LINE COLOR 2
   CALL PLOT(X-L/2,Y-L/2,Z+L/2)
   SET LINE COLOR 4
   CALL PLOT(X-L/2,Y-L/2,Z-L/2)
   PLOT LINES
   SET LINE COLOR 3
   CALL PLOTLINE(X-L/2,Y+L/2,Z-L/2,X-L/2,Y-L/2,Z-L/2)
   CALL PLOTLINE(X+L/2,Y+L/2,Z-L/2,X+L/2,Y-L/2,Z-L/2)
   CALL PLOTLINE(X+L/2,Y+L/2,Z+L/2,X+L/2,Y-L/2,Z+L/2)
   CALL PLOTLINE(X-L/2,Y+L/2,Z+L/2,X-L/2,Y-L/2,Z+L/2)
END SUB

!
SUB result(c,v_bar) ! 結果
   CALL global_graphic.asks
   SET TEXT JUSTIFY "LEFT","BOTTOM"
   SET TEXT HEIGHT 14
   SET TEXT COLOR "BLUE"
   SET TEXT BACKGROUND "OPAQUE"
   SELECT CASE c
   CASE 1
      LET XTH=v_bar
      PLOT TEXT ,AT slb_x0(c)-24,slb_y0(c)+552 ,USING "---%" : XTH
   CASE 2
      LET YTH=v_bar
      PLOT TEXT ,AT slb_x0(c)-24,slb_y0(c)+552 ,USING "---%" : YTH
   CASE 3
      LET ZTH=v_bar
      PLOT TEXT ,AT slb_x0(c)-24,slb_y0(c)+552 ,USING "---%" : ZTH
   CASE 4
      LET XMOVE=v_bar
      PLOT TEXT ,AT slb_x0(c)-24,slb_y0(c)+612 ,USING "---%" : XMOVE
   CASE 5
      LET YMOVE=v_bar
      PLOT TEXT ,AT slb_x0(c)-24,slb_y0(c)+612 ,USING "---%" : YMOVE
   CASE 6
      LET ZMOVE=v_bar
      PLOT TEXT ,AT slb_x0(c)-24,slb_y0(c)+612 ,USING "---%" : ZMOVE
   CASE ELSE
   END SELECT
   CALL global_graphic.sets
END SUB
END

EXTERNAL SUB prep(n,x0(),y0(),v_init()) ! 準備(nはスライドバーの本数,最大12本)
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL SUB slide.init,slide.scales
FOR i=1 TO n
   READ x0(i),y0(i),x9,y9,bar,terminal,v_min,v_max,v_interval,v_init(i)
   CALL slide.init(i,x0(i),y0(i),x9,y9,bar,terminal,v_min,v_max,v_interval,v_init(i))
   READ scl_posi,grad,unit$,texth
   CALL slide.scales(i,scl_posi,grad,unit$,texth) ! **目盛描画**
NEXT i
! バー描画データ
!DATA スライドバー全体の左下座標x,y,右上座標x,y,バー長さ,端子長さ,最小値,最大値,バー移動間隔,バー初期値
!DATA 目盛位置(0=下or左,1=上or右),目盛間隔(0=目盛描画せず),単位記号,数字高さ(0=数字描画せず)
DATA 35,2,45,542 , 20,0 , -180,180,0,0
DATA 0,15,"XTH",10
DATA 80,2,90,542 , 20,0 , -180,180,0,0
DATA 0,15,"YTH",10
DATA 125,2,135,542 , 20,0 , -180,180,0,0
DATA 0,15,"ZTH",10
DATA 170,2,180,602 , 20,0 , -500,500,0,0
DATA 0,50,"XMOVE",10
DATA 215,2,225,602 , 20,0 , -500,500,0,0
DATA 0,50,"YMOVE",10
DATA 260,2,270,602 , 20,0 , -500,500,0,0
DATA 0,50,"ZMOVE",10
END SUB

!! スライドバー
MODULE slide
DECLARE EXTERNAL SUB global_graphic.asks,global_graphic.sets
MODULE OPTION ARITHMETIC NATIVE
PUBLIC SUB init,bar_operation,scales
SHARE NUMERIC barcol,markcol,tcol,amc
CALL bar_col_set
SHARE NUMERIC k,bp(12),mn(12),mx(12),rg(12),siv(12),ivr(12),x0(12),y0(12),px(12),py(12),l(12),w(12),br(12),tr(12)
SHARE NUMERIC sln,cp(12),cp9(12),ap(4,4),a(4,4)  ! 12=バーの最大本数(拡張可)
LET sln=0
MAT READ ap  ! 縦バー変形行列
DATA 0,1,0,0 , -1,0,0,0 , 0,0,1,0 , 0,0,0,1
!
!! バー色
EXTERNAL SUB bar_col_set
   CALL global_graphic.asks
   SET COLOR MODE "REGULAR"
   READ barcol,markcol,tcol ! バー色,マーク色,トラック色
   DATA 196,129,73          ! 薄青,濃灰,薄灰
   ASK COLOR MIX(barcol) r,g,b
   ASK MAX COLOR amc     ! amc=255(色指標最大値)
   SET COLOR MIX(amc) MIN(1.5*r,1),MIN(1.5*g,1),MIN(1.5*b,1) ! 枠線明色(255)
   SET COLOR MIX(amc-1) 0.5*r,0.5*g,0.5*b   ! 枠線暗色(254)
   SET COLOR MIX(amc-2) 0.8*r,0.8*g,0.8*b   ! 枠線中間色(253)
   SET COLOR MIX(amc-3) MIN(1.3*r,1),MIN(1.3*g,1),MIN(1.3*b,1) ! バー待機色(252)
   ASK COLOR MIX(markcol) rm,gm,bm
   SET COLOR MIX(amc-4) MIN(1.3*rm,1),MIN(1.3*gm,1),MIN(1.3*bm,1) ! マーク待機色(251)
   CALL global_graphic.sets
END SUB
!
!! **スライドバー初期登録**
EXTERNAL SUB init(slk,slx0,sly0,slx9,sly9,slbl,sltl,vmin,vmax,vinterval,vinit)
!slk=番号(1~12),(slx0,sly0)=スライドバー全体の左下座標,(slx9,sly9)=スライドバー全体の右上座標
!slbl=バー長さ,sltl=端子長さ(非表示は0)
!vmin=最小値,vmax=最大値,vinterval=バー移動間隔(連続移動は0),vinit=バー初期値
   DECLARE EXTERNAL SUB bar_pict,terminal_pict
   LET k=slk       ! バー番号
   LET mn(k)=vmin  ! 最小値
   LET mx(k)=vmax  ! 最大値
   LET rg(k)=vmax-vmin   ! バー値範囲
   LET siv(k)=vinterval  ! バー移動間隔,vinterval=0で連続移動
   LET ivr(k)=vinterval/rg(k)  ! バー移動間隔比(0<=ivr<1)
   LET x0(k)=slx0  ! スライドバー全体の左下x座標
   LET y0(k)=sly0  ! スライドバー全体の左下y座標
   LET px(k)=MIN(x0(k),slx9)
   LET py(k)=MIN(y0(k),sly9)
   IF ABS(slx9-slx0)>ABS(sly9-sly0) THEN LET bp(k)=0 ELSE LET bp(k)=1 ! 0=横バー,1=縦バー
   IF bp(k)=0 THEN LET l(k)=slx9-x0(k) ELSE LET l(k)=sly9-y0(k) ! スライドバー全体の長さ
   IF bp(k)=0 THEN LET w(k)=sly9-y0(k) ELSE LET w(k)=slx9-x0(k) ! スライドバー全体の幅
   LET br(k)=ABS(slbl/l(k)) ! スライドバー全長に対するバー長さ比
   LET tr(k)=ABS(sltl/l(k)) ! スライドバー全長に対する端子1個の長さ比,非表示はsltl=0
   LET cp(k)=(vinit-mn(k))/rg(k) ! バー位置(0<=cp<=1)
   LET cp9(k)=cp(k)
   CALL bar_pict(cp(k),amc-3,amc-4)
   IF sltl<>0 then
      CALL terminal_pict(0,amc-3,amc-4)
      CALL terminal_pict(1,amc-3,amc-4)
   END IF
   LET sln=sln+1 ! バー総本数
END SUB
!
!! **バー操作**
EXTERNAL SUB bar_operation(bar_on,bar_val,l9,ll,x,y) ! 引数bar_onとbar_valは参照渡し
! bar_on=バーON(0=OFF,1~n=ON),bar_val=バー値(mn(k)~mx(k)),l9=直前の左ボタン,ll=左ボタン,(x,y)=ポインタ座標
   DECLARE EXTERNAL FUNCTION bar_position
   DECLARE EXTERNAL SUB bar_pict,terminal_pict
   IF ll=0 THEN
      IF l9=1 AND bar_on>0 THEN ! バーOFF処理
         CALL bar_pict(cp9(k),amc-3,amc-4) ! バー色を待機色に
         IF tr(k)<>0 AND (cp9(k)=0 OR cp9(k)=1) THEN CALL terminal_pict(cp9(k),amc-3,amc-4)
      END IF
      LET bar_on=0
      EXIT SUB
   END IF
   IF l9=0 THEN
      FOR i=1 TO sln
         IF x>px(i) AND x<px(i)+ABS(l(i)*(1-bp(i))+w(i)*bp(i)) AND y>py(i) AND y<py(i)+ABS(w(i)*(1-bp(i))+l(i)*bp(i)) THEN
            LET bar_on=i
            EXIT FOR
         END IF
      NEXT i
   END IF
   IF bar_on=0 THEN EXIT SUB
   LET cp9(k)=cp(k)
   LET k=bar_on
   IF bp(k)=0 THEN LET mp=x ELSE LET mp=y  ! mp=マウスポインタの座標
   LET cp(k)=bar_position(mp)  ! 0<=cp<=1
   CALL bar_pict(cp(k),barcol,markcol)
   IF tr(k)<>0 THEN
      IF (cp(k)=0 OR cp(k)=1) AND cp(k)<>cp9(k) THEN
         CALL terminal_pict(cp(k),barcol,markcol)
      ELSEIF cp(k)>0 AND cp(k)<1 AND (cp9(k)=0 OR cp9(k)=1) THEN
         CALL terminal_pict(cp9(k),amc-3,amc-4)
      END IF
   END IF
   IF ivr(k)=0 OR cp(k)=1 THEN
      LET bar_val=cp(k)*rg(k)+mn(k)
   ELSE
      LET bar_val=ROUND(cp(k)*rg(k)/siv(k),0)*siv(k)+mn(k)
   END IF
   !! PRINT bar_val
END SUB
!
!! バー中心位置
EXTERNAL FUNCTION bar_position(mp)  ! mp=マウスポインタの座標
   IF bp(k)=0 THEN LET sl0=x0(k) ELSE LET sl0=y0(k)
   LET pp=((mp-sl0)/l(k)-tr(k)-br(k)/2)/(1-2*tr(k)-br(k))
   IF ivr(k)<>0 AND pp>0 AND pp<1 THEN LET pp=pp-MOD(pp+ivr(k)/2,ivr(k))+ivr(k)/2 !バーの移動間隔をivrに固定
   IF pp<=0 OR (mp-sl0)/l(k)<=tr(k) THEN
      LET bar_position=0
   ELSEIF pp>=1 OR (mp-sl0)/l(k)>=1-tr(k) THEN
      LET bar_position=1
   ELSE
      LET bar_position=pp   ! バー移動範囲での位置(0<=pp<=1)
   END IF
END FUNCTION
!
!! バー描画
EXTERNAL SUB bar_pict(pp,bcol,mcol)  ! pp=バー中心位置(0<=pp<=1)
   DECLARE EXTERNAL SUB global_graphic.asks,global_graphic.sets
   DECLARE EXTERNAL PICTURE button_sl
   CALL global_graphic.asks
   SET COLOR MODE "REGULAR"
   SET DRAW MODE HIDDEN
   IF bp(k)=0 THEN MAT a=IDN ELSE MAT a=ap
   DRAW bar WITH SCALE(l(k),w(k)*(-2*bp(k)+1))*a*SHIFT(x0(k),y0(k))
   SET DRAW MODE EXPLICIT
   CALL global_graphic.sets
   PICTURE bar
      SET AREA COLOR tcol
      SET LINE STYLE 1
      PLOT AREA : tr(k),0;1-tr(k),0;1-tr(k),1;tr(k),1
      LET b0=pp*(1-2*tr(k)-br(k))+tr(k)    ! バーの描画基準位置(バー左下)
      DRAW button_sl(bcol) WITH SCALE(br(k),1)*SHIFT(b0,0)
      DRAW b_mark WITH SCALE(br(k),1)*SHIFT(b0,0)
      IF tr(k)<>0 THEN
         SET LINE WIDTH 1
         SET LINE COLOR amc-1+bp(k)        ! amc=255
         PLOT LINES : tr(k),0;tr(k),1      ! 端子境界線(小側)
         SET LINE COLOR amc-bp(k)
         PLOT LINES : 1-tr(k),0;1-tr(k),1  ! 端子境界線(大側)
         SET LINE COLOR amc                ! 明色
         PLOT LINES : bp(k),1-bp(k);bp(k)+(1-2*bp(k))*tr(k),1-bp(k) ! 補正
      END IF
   END PICTURE
   PICTURE b_mark  ! マーク(3本線)
      SET LINE COLOR mcol
      SET LINE WIDTH 1
      PLOT LINES : 0.3,0.3;0.3,0.7
      PLOT LINES : 0.5,0.1;0.5,0.9
      PLOT LINES : 0.7,0.3;0.7,0.7
   END PICTURE
END SUB
!
!! 端子描画
EXTERNAL SUB terminal_pict(pp,bcol,mcol) ! pp=0,1
   DECLARE EXTERNAL SUB global_graphic.asks,global_graphic.sets
   DECLARE EXTERNAL PICTURE button_sl
   CALL global_graphic.asks
   SET COLOR MODE "REGULAR"
   IF bp(k)=0 THEN MAT a=IDN ELSE MAT a=ap
   IF pp=0 THEN
      DRAW terminal0 WITH SCALE(l(k),w(k)*(-2*bp(k)+1))*a*SHIFT(x0(k),y0(k))
   ELSE
      DRAW terminal1 WITH SCALE(l(k),w(k)*(-2*bp(k)+1))*a*SHIFT(x0(k),y0(k))
   END IF
   CALL global_graphic.sets
   PICTURE terminal0
      DRAW button_sl(bcol) WITH SCALE(tr(k),1)
      SET AREA COLOR mcol
      DRAW t_mark WITH SCALE(tr(k),1)
   END PICTURE
   PICTURE terminal1
      DRAW button_sl(bcol) WITH SCALE(tr(k),1)*SHIFT(1-tr(k),0)
      SET AREA COLOR mcol
      DRAW t_mark WITH SCALE(-tr(k),1)*SHIFT(1,0)
   END PICTURE
   PICTURE t_mark  ! マーク(三角)
      SET LINE COLOR mcol
      SET LINE STYLE 1
      SET LINE WIDTH 1
      PLOT AREA : 0.25,0.5;0.75,0.25;0.75,0.75
      PLOT LINES : 0.25,0.8;0.25,0.2
   END PICTURE
END SUB
!
!! ボタン描画
EXTERNAL PICTURE button_sl(buttoncol)
   SET LINE STYLE 1
   SET AREA COLOR buttoncol
   PLOT AREA : 0,0;1,0;1,1;0,1
   SET LINE COLOR amc-2   ! 中間色(amc=255)
   SET LINE WIDTH 2
   PLOT LINES : bp(k),bp(k);1-bp(k),bp(k);1-bp(k),1-bp(k)
   SET LINE WIDTH 1
   SET LINE COLOR amc-1   ! 右下線(暗色)
   PLOT LINES : bp(k),bp(k);1-bp(k),bp(k);1-bp(k),1-bp(k)
   SET LINE COLOR amc     ! 左上線(明色)
   PLOT LINES : 1-bp(k),1-bp(k);bp(k),1-bp(k);bp(k),bp(k)
END PICTURE
!
!! **目盛描画**
EXTERNAL SUB scales(k,d,grad,u$,texth)
!k=番号,d=目盛位置(0=下or左,1=上or右),grad=目盛間隔(0で目盛表示せず),u$=単位,texth=文字高さ(0で表示せず)
   DECLARE EXTERNAL SUB global_graphic.asks,global_graphic.sets
   IF grad=0 THEN EXIT SUB   ! キャンセル
   CALL global_graphic.asks
   IF bp(k)=0 THEN MAT a=IDN ELSE MAT a=ap
   DRAW scl WITH SCALE(l(k),w(k)*(1-2*bp(k)))*a*SHIFT(x0(k)+w(k)*bp(k)*(2*d-1),y0(k)+w(k)*(1-bp(k))*(2*d-1))
   CALL global_graphic.sets
   PICTURE scl
      SET LINE STYLE 1
      SET LINE WIDTH 1
      IF texth>0 THEN
         SET TEXT HEIGHT texth   ! 文字高さ(問題座標の値で指定)
         IF bp(k)=0 AND d=0 THEN SET TEXT JUSTIFY "CENTER","TOP"
         IF bp(k)=0 AND d=1 THEN SET TEXT JUSTIFY "CENTER","BOTTOM"
         IF bp(k)=1 AND d=0 THEN SET TEXT JUSTIFY "RIGHT","HALF"
         IF bp(k)=1 AND d=1 THEN SET TEXT JUSTIFY "LEFT","HALF"
      END IF
      IF d=0 THEN LET s=1 ELSE LET s=-1
      LET m=(mx(k)-mn(k))/grad   ! 目盛本数(整数でなくとも可)
      FOR j=0 TO m
         LET  pp=j*(1-2*tr(k)-br(k))/m+tr(k)+br(k)/2
         PLOT LINES : pp,0.5+0.25*s;pp,0.5+0.45*s
         IF texth>0 THEN PLOT LABEL ,AT pp,0.5+0.2*s : LEFT$(STR$(j*grad+mn(k)),4)
      NEXT j
      IF m-INT(m)>1/(10*m) THEN
         PLOT LINES : 1-tr(k)-br(k)/2,0.5+0.25*s;1-tr(k)-br(k)/2,0.5+0.45*s
         IF texth>0 THEN PLOT LABEL ,AT 1-tr(k)-br(k)/2,0.5+0.2*s : LEFT$(STR$(mx(k)),4)
      END IF
      IF tr(k)<>0 THEN
         IF bp(k)=0 AND d=0 THEN SET TEXT JUSTIFY "LEFT","TOP"
         IF bp(k)=0 AND d=1 THEN SET TEXT JUSTIFY "LEFT","BOTTOM"
         IF bp(k)=1 AND d=0 THEN SET TEXT JUSTIFY "RIGHT","BOTTOM"
         IF bp(k)=1 AND d=1 THEN SET TEXT JUSTIFY "LEFT","BOTTOM"
      END IF
      IF texth>0 THEN PLOT LABEL ,AT 1-tr(k)+.012,0.5+0.2*s+1.5 : u$ !!!
   END PICTURE
END SUB
!
END MODULE

!! グラフィックス設定の一時記憶
MODULE global_graphic
MODULE OPTION ARITHMETIC NATIVE
MODULE OPTION ANGLE DEGREES
PUBLIC SUB asks,sets
SHARE NUMERIC apc,aps,alc,als,alw,aac,aasi,atc,ath,ata
SHARE STRING acmd$,aas$,atjx$,atjy$
EXTERNAL SUB asks
   ASK COLOR MODE acmd$
   ASK POINT COLOR apc
   ASK POINT STYLE aps
   ASK LINE COLOR alc
   ASK LINE STYLE als
   ASK LINE WIDTH alw
   ASK AREA COLOR aac
   ASK AREA STYLE aas$
   ASK AREA STYLE INDEX aasi
   ASK TEXT COLOR atc
   ASK TEXT JUSTIFY atjx$,atjy$
   ASK TEXT HEIGHT ath
   ASK TEXT ANGLE ata
END SUB
EXTERNAL SUB sets
   SET COLOR MODE acmd$
   SET POINT COLOR apc
   SET POINT STYLE aps
   SET LINE COLOR alc
   SET LINE STYLE als
   SET LINE WIDTH alw
   SET AREA COLOR aac
   SET AREA STYLE aas$
   SET AREA STYLE INDEX aasi
   SET TEXT COLOR atc
   SET TEXT JUSTIFY atjx$,atjy$
   SET TEXT HEIGHT ath
   SET TEXT ANGLE ata
END SUB
END MODULE
 

Re: 平行投影

 投稿者:しばっち  投稿日:2017年 2月25日(土)10時04分58秒
  立方体を4次元回転してみました

OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
DIM M(4,4),POINT(4),ROTXY(4,4),ROTXZ(4,4),ROTYU(4,4),ROTYZ(4,4),ROTXU(4,4),ROTZU(4,4)
SET POINT STYLE 1
LET LMIN=1E+10
LET LMAX=-1E+10
LET L=100
LOCATE VALUE NOWAIT(1),RANGE -180 TO 180,AT 0:XY
LOCATE VALUE NOWAIT(2),RANGE -180 TO 180,AT 0:XZ
LOCATE VALUE NOWAIT(3),RANGE -180 TO 180,AT 0:YU
LOCATE VALUE NOWAIT(4),RANGE -180 TO 180,AT 0:YZ
LOCATE VALUE NOWAIT(5),RANGE -180 TO 180,AT 0:XU
DO
   LOCATE VALUE NOWAIT(1):XY
   LOCATE VALUE NOWAIT(2):XZ
   LOCATE VALUE NOWAIT(3):YU
   LOCATE VALUE NOWAIT(4):YZ
   LOCATE VALUE NOWAIT(5):XU
   MAT ROTXY=IDN !'XY平面上の回転(ZU平面を軸とする回転)
   LET ROTXY(1,1)=COS(XY)
   LET ROTXY(1,2)=SIN(XY)
   LET ROTXY(2,1)=-SIN(XY)
   LET ROTXY(2,2)=COS(XY)
   MAT ROTXZ=IDN !'XZ平面上の回転(YU平面を軸とする回転)
   LET ROTXZ(1,1)=COS(XZ)
   LET ROTXZ(1,3)=-SIN(XZ)
   LET ROTXZ(3,1)=SIN(XZ)
   LET ROTXZ(3,3)=COS(XZ)
   MAT ROTYU=IDN !'YU平面上の回転(XZ平面を軸とする回転)
   LET ROTYU(2,2)=COS(YU)
   LET ROTYU(2,4)=-SIN(YU)
   LET ROTYU(4,2)=SIN(YU)
   LET ROTYU(4,4)=COS(YU)
   MAT ROTYZ=IDN !'YZ平面上の回転(XU平面を軸とする回転)
   LET ROTYZ(2,2)=COS(YZ)
   LET ROTYZ(2,3)=SIN(YZ)
   LET ROTYZ(3,2)=-SIN(YZ)
   LET ROTYZ(3,3)=COS(YZ)
   MAT ROTXU=IDN !'XU平面上の回転(YZ平面を軸とする回転)
   LET ROTXU(1,1)=COS(XU)
   LET ROTXU(1,4)=SIN(XU)
   LET ROTXU(4,1)=-SIN(XU)
   LET ROTXU(4,4)=COS(XU)
   MAT ROTZU=IDN !'ZU平面上の回転(XY平面を軸とする回転)
   LET ROTZU(3,3)=COS(ZU)
   LET ROTZU(3,4)=-SIN(ZU)
   LET ROTZU(4,3)=SIN(ZU)
   LET ROTZU(4,4)=COS(ZU)

   MAT M=ROTXY*ROTXZ*ROTYU*ROTYZ*ROTXU*ROTZU
   SET DRAW MODE HIDDEN
   CLEAR
   CALL CUBE(0,0,0,0,L)
   IF FL=0 THEN
      SET WINDOW LMIN*2,LMAX*2,LMIN*2,LMAX*2
      LET FL=1
   END IF
   SET DRAW MODE EXPLICIT
LOOP

SUB PLOT(X,Y,Z,U)
   LET POINT(1)=X
   LET POINT(2)=Y
   LET POINT(3)=Z
   LET POINT(4)=U
   MAT POINT=POINT*M
   IF FL=0 THEN
      LET LMIN=MIN(LMIN,POINT(1))
      LET LMAX=MAX(LMAX,POINT(1))
      LET LMIN=MIN(LMIN,POINT(2))
      LET LMAX=MAX(LMAX,POINT(2))
   ELSE
      PLOT LINES:POINT(1),POINT(2);
   END IF
END SUB

SUB PLOTLINE(X1,Y1,Z1,U1,X2,Y2,Z2,U2)
   PLOT LINES
   CALL PLOT(X1,Y1,Z1,U1)
   CALL PLOT(X2,Y2,Z2,U2)
   PLOT LINES
END SUB

SUB CUBE(X,Y,Z,U,L)
   SET LINE COLOR 2
   CALL PLOT(X-L/2,Y+L/2,Z-L/2,U)
   CALL PLOT(X+L/2,Y+L/2,Z-L/2,U)
   SET LINE COLOR 4
   CALL PLOT(X+L/2,Y+L/2,Z+L/2,U)
   SET LINE COLOR 2
   CALL PLOT(X-L/2,Y+L/2,Z+L/2,U)
   SET LINE COLOR 4
   CALL PLOT(X-L/2,Y+L/2,Z-L/2,U)
   PLOT LINES
   CALL PLOT(X-L/2,Y-L/2,Z-L/2,U)
   SET LINE COLOR 2
   CALL PLOT(X+L/2,Y-L/2,Z-L/2,U)
   SET LINE COLOR 4
   CALL PLOT(X+L/2,Y-L/2,Z+L/2,U)
   SET LINE COLOR 2
   CALL PLOT(X-L/2,Y-L/2,Z+L/2,U)
   SET LINE COLOR 4
   CALL PLOT(X-L/2,Y-L/2,Z-L/2,U)
   PLOT LINES
   SET LINE COLOR 3
   CALL PLOTLINE(X-L/2,Y+L/2,Z-L/2,U,X-L/2,Y-L/2,Z-L/2,U)
   CALL PLOTLINE(X+L/2,Y+L/2,Z-L/2,U,X+L/2,Y-L/2,Z-L/2,U)
   CALL PLOTLINE(X+L/2,Y+L/2,Z+L/2,U,X+L/2,Y-L/2,Z+L/2,U)
   CALL PLOTLINE(X-L/2,Y+L/2,Z+L/2,U,X-L/2,Y-L/2,Z+L/2,U)
END SUB
END

 

Re: 平行投影

 投稿者:SHIRAISHI Kazuo  投稿日:2017年 5月21日(日)18時29分10秒
  > No.4258[元記事へ]

> LOCATE VALUE スライドバーもう少し増やせないでしょうか?

BASICAccとParact BASICは20まで増やしました。
BASIC.exeは6.6.3.0で対応します。

スライドバーの本数は,
ASK MAX VALUE DEVICE n
を実行して知ることができます(JIS Full BASIC規格)。

Paract BASIC 0.9.0.0 は LOCATE VALUE NOWAIT が正常に機能しません。
0.9.0.1 で修正しました。

 

戻る