■

Mrさんが出していた問いに反応してみる(id:supermr:20090314)

Ｑ．ＳＲＣの画面上のマウスの座標が三角形ABCの中にあるかどうかを取得する関数を作りなさい。

の解
↓

　マウスの位置を点Mとする。
　この時、線分ABと直線CMが交点を持ち、線分CMが線分CDに含まれるならば点Mは三角形ABCの内部に存在する。(ただし、Dは線分ABと直線CMの交点)

証明とかは割愛。
ベクトル式も表現がめんどくさいのでカット

##三角形の三頂点の座標は A(AX,AY),B(BX,BY),C(CX,CY) で与えられているものとする。


#Call(判定,MouseX,MouseY) = 0 なら中にない。
#Call(判定,MouseX,MouseY) = 1 なら中にある。

#引数はMouseX,MouseYでなくても構わない


判定:
XX = Args(1)
YY = Args(2)
R = (YY - CY) * (BX - AX) - (XX - CX) * (BY - AY)
If R = 0 Then
 If AX = BX and AY = BY Then
  If (AX >= XX And XX >= CX) Or (AX <= XX And XX <= CX) Then
   If (AY >= YY And YY >= CY) Or (AY <= YY And YY <= CY) Then
    Return 1
   EndIf
  EndIf
 ElseIf XX = CX And YY = CY Then
  Return 1
 EndIf
 Return 0
Else
 U = ((CX - AX) * (BY - AY) - (CY - AY) * (BX - AX)) / R
 T = ((CX - AX) * (YY - CY) - (CY - AY) * (XX - CX)) / R
EndIf
If U >= 1 And T <= 1 And T >= 0 Then
 Return 1
EndIf
Return 0





#使用例

スタート:
Cls
Font 12pt Regular
AX = 260
AY = 100
BX = 100
BY = 340
CX = 340
CY = 340
M = "点AのX座標 点AのY座標 点BのX座標 点BのY座標 点CのX座標 点CのY座標"
Mes = "右Click:Quit  左Click:Change"
Do
 Call 描く MouseX MouseY
 Call 変更
 If KeyState(2) Then
  break
 EndIf
Loop

Mes = "Push Space Key:Quit  左Click:Change"
目標X = -1
目標Y = -1
今X = 240
今Y = 240
Do
 If 目標X <> MouseX Or 目標Y <> MouseY Then
  目標X = MouseX
  目標Y = MouseY
  基準X = 今X
  基準Y = 今Y
  刻み = 0.95
 EndIf
 Incr 刻み 0.05
 今X = 目標X - Int((目標X - 基準X) / 刻み)
 今Y = 目標Y - Int((目標Y - 基準Y) / 刻み)
 Call 描く 今X 今Y
 Call 変更
 If KeyState(32) Then
  break
 EndIf
Loop

Quit



描く:
 If Call(判定,Args(1),Args(2)) Then
  Color #00ff00
  Line AX AY XX YY #00ff00
  Line BX BY XX YY #00ff00
  Line CX CY XX YY #00ff00
 Else
  Color #ffffff
  Line AX AY XX YY #ffffff
  Line BX BY XX YY #ffffff
  Line CX CY XX YY #ffffff
 EndIf
 Polygon AX AY BX BY CX CY
 Paintstring 0 450 "X=$(XX),Y=$(YY)"
 Paintstring 200 450 Mes
 Refresh
 Wait 0.1
 ClearPicture
return


変更:
 If KeyState(1) Then
  Poi = List(AX,AY,BX,BY,CX,CY)
  Array P Poi "リスト"
  AutoTalk
  0.1;三角形の頂点座標を変えます
  Suspend
  For i = 1 to 6
   Input PP "$(lindex(M,i))を設定" P[i]
   If PP <> "" And IsNumeric(PP) And PP <= 480 And PP >= 0 Then
    P[i] = PP
   Else
    Incr i -1
   EndIf
  Next
  AX = P[1]
  AY = P[2]
  BX = P[3]
  BY = P[4]
  CX = P[5]
  CY = P[6]
  Talk
  End
 Endif
return