DELETED

!デスクトップの「目玉（Eye）」

DECLARE EXTERNAL FUNCTION GetCursorPos
DECLARE EXTERNAL FUNCTION ClientToScreen

!Type POINTAPI
! X As Long
! Y As Long
!End Type

SET bitmap SIZE 200,200 !ドット単位にする
SET WINDOW 0,200,200,0 !クライアント座標（左上が原点）

LET hWnd=WinHandle("GRAPHICS") !グラフィックス画面のハンドルを得る

DO
LET pnt$=REPEAT$("#",4*2) !構造体POINTAPI
LET rc=GetCursorPos(pnt$) !デスクトップでのマウスの座標を得る
LET rc=ScreenToClient(hWnd,pnt$) !クライアント座標に変換する
LET mx=int32(pnt$,0)
LET my=int32(pnt$,4)
!PRINT mx;my

SET DRAW mode hidden !ちらつき防止(開始)
CLEAR
CALL Eye(60,100) !右
CALL Eye(140,100) !左
SET DRAW mode explicit !ちらつき防止(終了)
LOOP

SUB Eye(ox,oy) !目玉を描く
DRAW circle WITH SCALE(40)*SHIFT(ox,oy) !白目

LET dx=mx-ox !視線を計算する　※目玉の中心で考える
LET dy=my-oy
LET r=SQR(dx*dx+dy*dy)
!!!PRINT dx;dy;r
IF r<(40-15) THEN !目玉の内部なら
LET x=dx
LET y=dy
ELSE !外部なら
LET x=(40-15)*dx/r !相似三角形の比　x:(40-15)=dx:r
LET y=(40-15)*dy/r
END IF
DRAW disk WITH SCALE(15)*SHIFT(x+ox,y+oy) !黒目
END SUB

END

!Win32 API
EXTERNAL FUNCTION GetCursorPos(lpPoint$)
ASSIGN "user32.dll" ,"GetCursorPos"
END FUNCTION

EXTERNAL FUNCTION ScreenToClient(hWnd, lpPoint$)
ASSIGN "user32.dll" ,"ScreenToClient"
END FUNCTION

!補助ルーチン
EXTERNAL FUNCTION int32(s$,p)
OPTION CHARACTER byte
LET n=0
FOR i=1 TO 4
LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
IF n<2^31 THEN LET int32=n ELSE LET int32=n-2^32
END FUNCTION

楕円形の目玉の場合

以下のサブルーチンを置き換えます。

SUB Eye(ox,oy) !目玉を描く
LET a=40 !楕円
LET b=60

DRAW circle WITH SCALE(a,b)*SHIFT(ox,oy) !白目

LET dx=mx-ox !視線を計算する　※目玉の中心で考える
LET dy=my-oy
LET r2=dx*dx+dy*dy
!!!PRINT dx;dy;r

LET r=(a-15)*(b-15)/SQR(((b-15)*dx)^2+((a-15)*dy)^2)
LET x=dx*r
LET y=dy*r
IF r2<x*x+y*y THEN !目玉の内部なら
LET x=dx
LET y=dy
END IF
DRAW disk WITH SCALE(15)*SHIFT(x+ox,y+oy) !黒目
END SUB

APIを使わなくても、ドラッグすればグラフィックス画面外の座標を得ることができます。

十進BASICのマウスで座標を取得する命令文は、GET POINT文と独自の拡張のMAUSE POLL文の2種類があります。
どちらも通常はグラフィックス画面内部の点の座標しか取得できません。
しかし、描画領域内で左ボタンを押して外部にドラッグすれば、描画領域外部の点も取得できるようになります。

DIM x(100),y(100)
MAT GET POINT : x(?),y(?)

または

DO
MOUSE POLL x,y,l,r
LOOP UNTIL l=1
DO WHILE l=1
MOUSE POLL x,y,l,r
LOOP

これを使えば、プログラムは次のようなシンプルなものになります。
ただし、利用者には「ドラッグ」という操作を強いることになります。

あと、山中さんにこのような重箱の隅をつつくような指摘をするのは畏れ多いのですが、
SET WINDOW 0,200,200,0 とするならば、ビットマップサイズを201にすれば座標が整数値になりますよ。

!デスクトップの「目玉（Eye）」

SET bitmap SIZE 201,201 !ドット単位にする
SET WINDOW 0,200,200,0 !クライアント座標（左上が原点）

DO

MOUSE POLL mx,my,left,right !グラフィックス画面外へはドラッグして出る
!PRINT mx;my

SET DRAW mode hidden !ちらつき防止(開始)
CLEAR
CALL Eye(60,100) !右
CALL Eye(140,100) !左
SET DRAW mode explicit !ちらつき防止(終了)
LOOP

SUB Eye(ox,oy) !目玉を描く
DRAW circle WITH SCALE(40)*SHIFT(ox,oy) !白目

LET dx=mx-ox !視線を計算する　※目玉の中心で考える
LET dy=my-oy
LET r=SQR(dx*dx+dy*dy)
!!!PRINT dx;dy;r
IF r<(40-15) THEN !目玉の内部なら
LET x=dx
LET y=dy
ELSE !外部なら
LET x=(40-15)*dx/r !相似三角形の比　x:(40-15)=dx:r
LET y=(40-15)*dy/r
END IF
DRAW disk WITH SCALE(15)*SHIFT(x+ox,y+oy) !黒目
END SUB

END

アドバイス、ありがとうございます。

マウス座標だけではなくグラフィクス画面の座標も１対１に対応させておく必要がありますね。

これだとLinuxでも動く

Windows上で山中さんの「目玉」の動作面白く見させて頂きました。が、Linux上では
「ASSIGN "user32.dll" ,"GetCursorPos"」
の箇所でエラーが出て使えません。荒田さんのプログラムはそれを使わないのでLinux上
で動作しました。

ただ、mousepoll文はLinux上での動きが遅いので実用的ではありません。
DIM x(100),y(100)
MAT GET POINT : x(?),y(?)
を使う方法が有るとの事でしたが、動作速度がどの様になるのか試したいのですが、どの様に組み込むのか
コードを示して頂けないでしょうか？

10 DIM x(100),y(100)
20 MAT GET POINT : x(?),y(?)
30 MAT PLOT LINES:x,y
40 END
でテストできますが，Linuxではまともに使えないと思います。

ダメでした

先生の４行コードをFedora7上のBASICでテストしました
ら、マウスのドラッグで線が1本突然描かれたのですが、
その後BASICを中断出来なくなり、OSが完全にフリーズ
状態になってしまいました。
やむを得ず強制リセットで再起動しました。と言うこと
で、mousepollの方が良いと言う結果でした。

Re: DELETED	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/15 11:07:19 ** この記事は1回修正されてます
!デスクトップの「目玉（Eye）」 DECLARE EXTERNAL FUNCTION GetCursorPos DECLARE EXTERNAL FUNCTION ClientToScreen !Type POINTAPI ! X As Long ! Y As Long !End Type SET bitmap SIZE 200,200 !ドット単位にする SET WINDOW 0,200,200,0 !クライアント座標（左上が原点） LET hWnd=WinHandle("GRAPHICS") !グラフィックス画面のハンドルを得る DO LET pnt$=REPEAT$("#",42) !構造体POINTAPI LET rc=GetCursorPos(pnt$) !デスクトップでのマウスの座標を得る LET rc=ScreenToClient(hWnd,pnt$) !クライアント座標に変換する LET mx=int32(pnt$,0) LET my=int32(pnt$,4) !PRINT mx;my SET DRAW mode hidden !ちらつき防止(開始) CLEAR CALL Eye(60,100) !右 CALL Eye(140,100) !左 SET DRAW mode explicit !ちらつき防止(終了) LOOP SUB Eye(ox,oy) !目玉を描く DRAW circle WITH SCALE(40)SHIFT(ox,oy) !白目 LET dx=mx-ox !視線を計算する　※目玉の中心で考える LET dy=my-oy LET r=SQR(dxdx+dydy) !!!PRINT dx;dy;r IF r<(40-15) THEN !目玉の内部なら LET x=dx LET y=dy ELSE !外部なら LET x=(40-15)dx/r !相似三角形の比　x:(40-15)=dx:r LET y=(40-15)dy/r END IF DRAW disk WITH SCALE(15)SHIFT(x+ox,y+oy) !黒目 END SUB END !Win32 API EXTERNAL FUNCTION GetCursorPos(lpPoint$) ASSIGN "user32.dll" ,"GetCursorPos" END FUNCTION EXTERNAL FUNCTION ScreenToClient(hWnd, lpPoint$) ASSIGN "user32.dll" ,"ScreenToClient" END FUNCTION !補助ルーチン EXTERNAL FUNCTION int32(s$,p) OPTION CHARACTER byte LET n=0 FOR i=1 TO 4 LET n=n+256^(i-1)ORD(s$(p+i:p+i)) NEXT i IF n<2^31 THEN LET int32=n ELSE LET int32=n-2^32 END FUNCTION

Re: !デスクトップの「目玉（Eye）」	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/17 13:08:08
楕円形の目玉の場合以下のサブルーチンを置き換えます。 SUB Eye(ox,oy) !目玉を描く LET a=40 !楕円 LET b=60 DRAW circle WITH SCALE(a,b)SHIFT(ox,oy) !白目 LET dx=mx-ox !視線を計算する　※目玉の中心で考える LET dy=my-oy LET r2=dxdx+dydy !!!PRINT dx;dy;r LET r=(a-15)(b-15)/SQR(((b-15)dx)^2+((a-15)dy)^2) LET x=dxr LET y=dyr IF r2<xx+yy THEN !目玉の内部なら LET x=dx LET y=dy END IF DRAW disk WITH SCALE(15)*SHIFT(x+ox,y+oy) !黒目 END SUB

Re: !デスクトップの「目玉（Eye）」	返事を書くノートメニュー
荒田浩二 <knrztrhoel> 2007/10/17 14:05:28
APIを使わなくても、ドラッグすればグラフィックス画面外の座標を得ることができます。十進BASICのマウスで座標を取得する命令文は、GET POINT文と独自の拡張のMAUSE POLL文の2種類があります。どちらも通常はグラフィックス画面内部の点の座標しか取得できません。しかし、描画領域内で左ボタンを押して外部にドラッグすれば、描画領域外部の点も取得できるようになります。 DIM x(100),y(100) MAT GET POINT : x(?),y(?) または DO MOUSE POLL x,y,l,r LOOP UNTIL l=1 DO WHILE l=1 MOUSE POLL x,y,l,r LOOP これを使えば、プログラムは次のようなシンプルなものになります。ただし、利用者には「ドラッグ」という操作を強いることになります。あと、山中さんにこのような重箱の隅をつつくような指摘をするのは畏れ多いのですが、 SET WINDOW 0,200,200,0 とするならば、ビットマップサイズを201にすれば座標が整数値になりますよ。 !デスクトップの「目玉（Eye）」 SET bitmap SIZE 201,201 !ドット単位にする SET WINDOW 0,200,200,0 !クライアント座標（左上が原点） DO MOUSE POLL mx,my,left,right !グラフィックス画面外へはドラッグして出る !PRINT mx;my SET DRAW mode hidden !ちらつき防止(開始) CLEAR CALL Eye(60,100) !右 CALL Eye(140,100) !左 SET DRAW mode explicit !ちらつき防止(終了) LOOP SUB Eye(ox,oy) !目玉を描く DRAW circle WITH SCALE(40)SHIFT(ox,oy) !白目 LET dx=mx-ox !視線を計算する　※目玉の中心で考える LET dy=my-oy LET r=SQR(dxdx+dydy) !!!PRINT dx;dy;r IF r<(40-15) THEN !目玉の内部なら LET x=dx LET y=dy ELSE !外部なら LET x=(40-15)dx/r !相似三角形の比　x:(40-15)=dx:r LET y=(40-15)dy/r END IF DRAW disk WITH SCALE(15)SHIFT(x+ox,y+oy) !黒目 END SUB END

Re: APIを使わなくても、ドラッグすればグラフィ...	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/17 19:34:24
アドバイス、ありがとうございます。マウス座標だけではなくグラフィクス画面の座標も１対１に対応させておく必要がありますね。

Re: APIを使わなくても、ドラッグすればグラフィ...	返事を書くノートメニュー
島村1243 <bjllmpcujp> 2007/10/20 10:50:25
これだとLinuxでも動く Windows上で山中さんの「目玉」の動作面白く見させて頂きました。が、Linux上では「ASSIGN "user32.dll" ,"GetCursorPos"」の箇所でエラーが出て使えません。荒田さんのプログラムはそれを使わないのでLinux上で動作しました。ただ、mousepoll文はLinux上での動きが遅いので実用的ではありません。 DIM x(100),y(100) MAT GET POINT : x(?),y(?) を使う方法が有るとの事でしたが、動作速度がどの様になるのか試したいのですが、どの様に組み込むのかコードを示して頂けないでしょうか？

DELETED	返事を書く
山中和義 <drdlxujciw> 2007/10/13 17:19:37 ** この記事は削除されました

Re: これだとLinuxでも動く	返事を書くノートメニュー
白石　和夫 <fbdfvqwhki> 2007/10/20 16:11:05
10 DIM x(100),y(100) 20 MAT GET POINT : x(?),y(?) 30 MAT PLOT LINES:x,y 40 END でテストできますが，Linuxではまともに使えないと思います。

Re: 10DIMx(100),y(100)	返事を書くノートメニュー
島村1243 <bjllmpcujp> 2007/10/20 17:44:17
ダメでした先生の４行コードをFedora7上のBASICでテストしましたら、マウスのドラッグで線が1本突然描かれたのですが、その後BASICを中断出来なくなり、OSが完全にフリーズ状態になってしまいました。やむを得ず強制リセットで再起動しました。と言うことで、mousepollの方が良いと言う結果でした。