眼动编程||如何实现多客体追踪?
在眼动实验中,如何有效地实现多客体追踪?是我们在程序编写过程中一直十分头疼的问题。
举个栗子:如何实现个体注视某个客体固定的时间之后,另一个客体出现或者消失?
但在 Eyelink 和 E-prime 进行连接时,已有的功能并不能满足这一需求,因此我们需要运用 E-prime 中的Inline 功能。本次帖子主要分享 Michael C. Hout 实验室(网址为:http://michaelhout.com/ )所共享的一个示例程序,该程序主要是个体进行多客体追踪,追踪一定时间后,客体外围的颜色会发生变化。通过此次分享以其能为小伙伴们解决一定的编程疑惑。
(图1:程序示意图)
第一步:通过E-prime中的“View” 选中“Script” ,之后在"User"的界面中粘贴以下代码:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' User-defined Data Types
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Global Variables
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Counter variables
Dim i As Integer
Dim nTrial As Integer
'Used for monitoring gaze location
Dim nTimeOut As Integer
Dim nFixDur As Integer
Dim xFix As Integer
Dim yFix As Integer
Dim widFix As Integer
Dim htFix As Integer
Dim rectFix As Rect
Dim bRecalibrate As Boolean
Dim bWaitForFixTimeOut As Boolean
Dim nLoopTime As Integer
Dim bTerminateLoop As Boolean
Dim nStartTime As Double
Dim bInCentralFix As Boolean
Dim bCriteriaMet As Boolean
Dim centralFix As SlideVisualStim
Dim IA1 As Rect
Dim IA2 As Rect
Dim IA3 As Rect
Dim running1 As Integer
Dim running2 As Integer
Dim running3 As Integer
Dim bT1 As Boolean
Dim bT2 As Boolean
Dim bT3 As Boolean
Dim bProbeTimeout As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Eye-tracking / Data Logging
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim edfFileName As String
Dim tracker As Object 'global reference to hold tracker object
Dim elutil As Object 'global reference to hold elutil object
Dim timeStart As Long 'global integer to hold the time of screen start processing time
Dim timeEnd As Long 'global integer to hold the time of screen end time
Dim incount As Integer 'global integer to hold input count
Dim cal_background As String 'calibration background color
Dim cal_foreground As String 'calibration foreground
Dim cal_target_size As Integer 'calibration target size
Dim cal_pen_width As Integer 'calibration pen width, can be used to set the inner hole size.
'The inner hole size = cal_target_size-cal_pen_width
'Variables for real time access of gaze data
Dim nEye As Integer
Dim lastSampleTime As Double
Dim s As Object
Dim xGaze As Single
Dim yGaze As Single
Dim ptGaze As Point
Dim button As Integer
Dim waitBlock As Boolean
Dim stime As Long
Dim dwellTime As Double
'-------------------------------------------------------------------------------
Sub checkKeyInput()
'This example retrieves the responses stored in the KeyboardDevice's
'History property.
Dim theResponseData As ResponseData
Dim theHistory As RteCollection
Set theHistory = Keyboard.History
If (theHistory.Count > incount) Or (theHistory.Count < incount) Then
incount = theHistory.Count ' so we dont' get duplicate keys
Set theResponseData = CResponseData(theHistory(incount))
If Not theResponseData Is Nothing Then
If Len(theResponseData.RESP) = 1 Then
tracker.sendKeybutton asc(theResponseData.RESP), 0,0
Else
If theResponseData.RESP = "{SPACE}" Then
tracker.sendKeybutton asc(" "), 0,0
ElseIf theResponseData.RESP = "{ENTER}" Then
tracker.sendKeybutton 13, 0,0
ElseIf theResponseData.RESP = "{ESCAPE}" Then
tracker.sendKeybutton 27, 0,0
Else
Debug.Print "ignoring " & theResponseData.RESP
End If
End If
End If
End If
theHistory.RemoveAll
incount =0
End Sub
'-------------------------------------------------------------------------------
'Sub doTrackerDrawings
'Input:
' bcal - reference to BusyCal object
' customDrift - Optionl argument, if custom drift correct target needed.
'Output:None
'Purpose: In a busy loop, check the job state of bcal, and draw target,
'play target beeps accordingly.
Sub doTrackerDrawings(bcal As Object, Optional customDrift As Variant)
Dim cnvs As Canvas
Dim ofillColor As String 'original fill color
Dim oPenColor As String 'original pen color
Dim oPenWidth As Integer 'original pen Width
Set cnvs = Display.Canvas
Dim nPriority As Integer
nPriority = GetOSThreadPriority()
'Temporarily set the thread priority to a normal application
SetOSThreadPriority 3
While Not bcal Is Nothing
Dim job As Integer
Dim connected As Boolean
connected = tracker.isConnected()
job = bcal.job
' Exit
If job = -1 Or Not connected Then
Set bcal = Nothing
ElseIf job <> 0 Then
'Setup Cal Display
If job = 1 Then
'save color and pen info so that we can reset when we return.
oPenWidth= cnvs.PenWidth
oPenColor= cnvs.PenColor
ofillColor = cnvs.FillColor
'set the pen and color
cnvs.PenWidth = cal_pen_width
cnvs.PenColor = CColor(cal_foreground)
cnvs.FillColor = CColor(cal_background)
' Exit Cal Display
ElseIf job = 2 Then
'Reset anything that was done in Setup Cal Display
cnvs.PenWidth=oPenWidth
cnvs.PenColor=oPenColor
cnvs.FillColor=ofillColor
If Not IsMissing(customDrift) Then
Dim cd As TextDisplay
Set cd = customDrift
cd.draw
Set cd = Nothing
End If
' Clear Cal Display or Erase Cal Target
ElseIf (job = 5) Or (job = 6) Then
cnvs.Clear
'Cal Target Beep or DC Target Beep or cal done beep or dc done beep
ElseIf (job = 7) Or (job = 8) Or (job = 7) Or (job = 8) Then
Dim AuditoryStimulusSoundBuffer As SoundBuffer
Set AuditoryStimulusSoundBuffer = AuditoryStimulus.Buffers(1)
If (job = 7) Or (job = 8) Then
AuditoryStimulusSoundBuffer.Filename = "Resources/type.wav"
ElseIf (job = 14) Or (job = 15) Then
AuditoryStimulusSoundBuffer.Filename = "Resources/qbeep.wav"
End If
AuditoryStimulusSoundBuffer.Load
AuditoryStimulusSoundBuffer.Play 'play
' Draw Cal Target
ElseIf job = 9 Then
Dim x As Integer
Dim y As Integer
bcal.getCalLocation x, y
cnvs.Clear
cnvs.Circle x, y, cal_target_size
ElseIf (job = 10) Or (job = 11) Or (job = 12) Or (job = 13) Then
Debug.Print "Camera Image Not available"
Else
Debug.Print "Unhandled job " & job
End If
End If
'Check next keypress
checkKeyInput
Wend
Set cnvs = Nothing
'Reset the thread priority back
SetOSThreadPriority nPriority
End Sub
'-------------------------------------------------------------------------------
'Sub doCameraSetup
'Input: None
'Output:None
'Purpose: Setup busycal and calls doTrackerDrawings to perform busy cal output.
'Call this subroutine to do camera setup.
'Note: No camera image.
Sub doCameraSetup
Dim bcal As Object
Set bcal = elutil.getBusyCal()
bcal.startCameraSetup
doTrackerDrawings bcal
Set bcal = Nothing
End Sub
'-------------------------------------------------------------------------------
'Sub doDriftCorrect
'Input:
' xloc - xlocation of the drift correction target
' yloc - ylocation of the drift correction target
' draw - if false, no target is drawn. If this is false, optionally pass in customDrift
' TextDisplay, so that custom target can be re-drawn if drift correction is cancelled and calibration is performed.
' allow_setup - if this is false, pressing escape does not perform a calibration.
' customDrift - optional argument of type TextDisplay to re-draw custom target.
'Output:None
'Purpose: Setup busycal and calls doTrackerDrawings to perform busy cal output.
'Call this subroutine to do drift correct.
'Note: No camera image.
Sub doDriftCorrect(xloc As Integer, yloc As Integer, draw As Boolean, allow_setup As Boolean,Optional customDrift As Variant)
Dim bcal As Object
Set bcal = elutil.getBusyCal()
bcal.startDriftCorrect xloc,yloc,draw,allow_setup
doTrackerDrawings bcal,customDrift
Set bcal = Nothing
End Sub
'-------------------------------------------------------------------------------
第二步:如图1所示,在"elConnect" 的inline控件中粘贴以下代码:
'Turn the mouse on briefly
Mouse.ShowCursor True
'Set the trial counter to zero
nTrial = 0
'Ask for an EDF filename; Set default to Exp name & subject number
' NOTE: EDF filename must be DOS appropriate (ie, fewer than 9 characters)
edfFileName = AskBox("Please enter an EDF file name" , "TMO_" & c.GetAttrib("Subject") & ".edf")
'If the name gets deleted for some reason, set it to Test.EDF and show an error message
If Len(edfFileName) = 0 Then
edfFileName = "Test.edf"
MSGBox "EDF filename is set to TEST.EDF; !Abort! if not testing..."
End If
'Turn the mouse back off
Mouse.ShowCursor False
'''''
'Variables for size of the target and the pen width
Dim dbTarg As Double
Dim dbPen As Double
'Global variable to keep track of key board input
incount = 0
'Set the background color for calibration/validation/driftcorrection screens
'cal_background = "192,192,192"
cal_background = "255,255,255"
'Set the foreground color for calibration/validation/driftcorrection screens
cal_foreground = "0,0,0"
'Make the target a percentage of the resolution
dbTarg = (Display.XRes + Display.YRes) / 2
dbPen = dbTarg
dbTarg = dbTarg * .00857
'dbPen = dbPen * .00571
dbPen = .99 * dbTarg
'Set calibration target size
cal_target_size = CInt(dbTarg)
'Set calibration pen width. The inner hole size = cal_target_size-cal_pen_width
cal_pen_width = CInt(dbPen)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'DO NOT EDIT ANYTHING BELOW! ALL EYELINK SETUP CALLS!!!
Dim nPriority As Integer
nPriority = GetOSThreadPriority()
'Temporarily set the thread priority to a normal application
' otherwise you will get timed out when connect
SetOSThreadPriority 3
On Error GoTo ErrorHandle
'Get an instance of EyeLinkUtil
Set elutil = CreateObject("SREYELINK.EyeLinkUtil")
'Get an instance of EyeLink object
Set tracker = CreateObject("SREYELINK.EyeLink")
'Open the connection to the tracker
tracker.open "100.1.1.1",0
'Open edf file
tracker.openDataFile edfFileName
'Tell the tracker our resolution
tracker.sendCommand "screen_pixel_coords = 0 0 " & Display.XRes & " " & Display.YRes
' Setup calibration type
' NOTE: Possible to change this to more points (eg HV13)
tracker.sendCommand "calibration_type = HV9"
' Add resolution to EDF file
tracker.sendMessage "DISPLAY_COORDS 0 0 " & Display.XRes & " " & Display.YRes
' Report refresh rate
tracker.sendMessage "FRAMERATE " & Display.CalculatedRefreshRate
'Set parser saccade thresholds (conservative settings)
Dim trVerStr As String
Dim vindx As Integer
Dim trswVer As Integer
Dim eyelink_ver As Integer
eyelink_ver = tracker.getTrackerVersion()
trVerStr = tracker.getTrackerVersionString()
trVerStr = Trim(trVerStr)
vindx = Instr (1,trVerStr,"EYELINK CL")
If vindx > 0 Then
trVerStr = Mid(trVerStr,len("EYELINK CL")+1)
trVerStr = Trim(trVerStr)
trswVer = trVerStr
Else
trswVer = 0
End If
If eyelink_ver >= 2 Then
tracker.sendCommand "select_parser_configuration 0" ' 0 = standard sensitivity
If eyelink_ver = 2 Then 'turn off scenelink camera stuff
tracker.sendCommand "scene_camera_gazemap = NO"
End If
Else
'NOTE: A higher velocity and acceleration threshold values is a more conservative parsing method
'for identifying saccades (i.e., less likely to pick up tiny saccades and less susceptible to noise in data).
tracker.sendCommand "saccade_velocity_threshold = 35"
tracker.sendCommand "saccade_acceleration_threshold = 9500"
End If
'Set EDF file contents
tracker.sendCommand "file_event_filter = LEFT,RIGHT,FIXATION,SACCADE,BLINK,MESSAGE,BUTTON"
If trswVer >= 4 Then
tracker.sendCommand "file_sample_data = LEFT,RIGHT,GAZE,AREA,GAZERES,STATUS,HTARGET"
Else
tracker.sendCommand "file_sample_data = LEFT,RIGHT,GAZE,AREA,GAZERES,STATUS"
End If
'Set link data (used for gaze cursor)
tracker.sendCommand "link_event_filter = LEFT,RIGHT,FIXATION,SACCADE,BLINK,BUTTON"
If trswVer >= 4 Then
tracker.sendCommand "link_sample_data = LEFT,RIGHT,GAZE,GAZERES,AREA,STATUS,HTARGET"
Else
tracker.sendCommand "link_sample_data = LEFT,RIGHT,GAZE,GAZERES,AREA,STATUS"
End If
'Program button #5 for use in drift correction
tracker.sendCommand "button_function 5 'accept_target_fixation'"
'Reset the thread priority back
SetOSThreadPriority nPriority
'END - EYELINK SETUP CALLS
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
第三步:如图1所示,在"elCameraSetup" 的inline控件中粘贴以下代码:
' Perform camera setup
doCameraSetup
'Make sure cursor is turned off
Mouse.ShowCursor False
第四步:如图1所示,在"SetupTrial" 的inline控件中粘贴以下代码:
Mouse.ShowCursor False
'Increase the trial counter
nTrial = nTrial + 1
c.SetAttrib "TrialNum", nTrial
'''''''''''''''''
'NOTE: Here you can set how long you want to require fixation, and how long before you want the screen to time out (in the event of tracking difficulties)
'Set the time for the stimulus screen to expire
nTimeOut = 30000
'Set the time to require fixation
nFixDur = 2000
''''''''''''''''''''''''''''''''
'Declare and Set all the SlideVisualStim objects
Dim dOne As SlideVisualStim
Set dOne = CSlideVisualStim(Stimulus.States.Item("Default").Objects("Text1"))
Dim dTwo As SlideVisualStim
Set dTwo = CSlideVisualStim(Stimulus.States.Item("Default").Objects("Text2"))
Dim dThree As SlideVisualStim
Set dThree = CSlideVisualStim(Stimulus.States.Item("Default").Objects("Text3"))
dOne.BorderColor = CColor("red")
dTwo.BorderColor = CColor("red")
dThree.BorderColor = CColor("red")
dOne.BorderWidth = 1
dTwo.BorderWidth = 1
dThree.BorderWidth = 1
'''''''''''''''''''''''''''''''''
'Set up the tracking areas
IA1.Left = (Display.XRes / 4) - 100
IA1.Right = (Display.XRes / 4) + 100
IA1.Top = (Display.YRes / 2) - 100
IA1.Bottom = (Display.YRes / 2) + 100
IA2.Left = (Display.XRes / 2) - 100
IA2.Right = (Display.XRes / 2) + 100
IA2.Top = (Display.YRes / 2) - 100
IA2.Bottom = (Display.YRes / 2) + 100
IA3.Left = (Display.XRes * (3/4)) - 100
IA3.Right = (Display.XRes * (3/4)) + 100
IA3.Top = (Display.YRes / 2) - 100
IA3.Bottom = (Display.YRes / 2) + 100
第五步:如图1所示,在"MonitorObjects" 的inline控件中粘贴以下代码:
'Set the sampling rate
tracker.SendMessage "sample_rate = 1000"
'Always send a TRIALID message before starting to record.
'EyeLink Data Viewer defines the start of a trial by the TRIALID message.
'This message is different than the start of recording message START that is logged when the trial recording begins.
'The Data viewer will not parse any messages, events, or samples, that exist in the data file prior to this message.
tracker.sendMessage "TRIALID " & nTrial
'This supplies the title at the bottom of the eyetracker display
tracker.sendCommand "record_status_message 'TMO " & nTrial & "' "
'Before recording, we place reference graphics on the EyeLink display
tracker.sendCommand "set_idle_mode" 'Must be offline to draw to EyeLink screen
'The command "clear_screen" erases the tracker display to color 0 (black)
tracker.sendCommand "clear_screen 0"
'The command "draw_box" draws a box in color 7 (medium gray).
'tracker.sendCommand "draw_box " & Display.XRes/2 -50 & " " & Display.YRes/2 - 50 & " " & Display.XRes/2 + 50 & " " & Display.YRes/2 + 50 & " 7"
'tracker.sendCommand "set_idle_mode"
'Delay so tracker is ready
Sleep 50
tracker.startRecording True, True, True, True
'Allowing 100 milliseconds of data to accumulate before the trial display starts
elutil.pumpDelay 100
'Get the current time
stime = elutil.currentTime
'Wait for link sample data
waitBlock = tracker.waitForBlockStart(1000,True,False)
If(Not waitBlock) Then
button = -1
MSGBox "Cancelling out!!!!! There is a problem!"
GoTo CancelOut1
End If
'''''
'Determine which eye(s) are available
nEye = tracker.eyeAvailable()
'If both eye's data present: use left eye only
If nEye = 2 Then
nEye = 0
End If
'Initialize the dwell time to zero
dwellTime = 0
'Reset the current time
stime = elutil.currentTime()
'Initialize the lastSampleTime index
lastSampleTime = -1
'Set the criteria boolean to False
bCriteriaMet = False
bT1 = False
bT2 = False
bT3 = False
'Initialize counters to zero
running1 = 0
running2 = 0
running3 = 0
''''''''''''''''''''''''''''''''''''''''''
'Loop exit if fixation triggered, timed out, tracker disconnected or break pressed
While (tracker.IsConnected()) And (Not tracker.breakPressed()) And (bCriteriaMet = False)
'Check for new sample update
Set s = tracker.getNewestSample()
'Make sure we get a new sample and get gaze position from sample
' NOTE: Also makes sure that the current data point is within the resolution of the screen
If (Not s Is Nothing) And (lastSampleTime <> s.time) And (s.gx(nEye) > 0) And (s.gx(nEye) < (Display.XRes)) And (s.gy(nEye) > 0) And (s.gy(nEye) < (Display.YRes)) Then
'Set x and y to the gaze positions; converted to Integer values
xGaze = CInt(s.gx(nEye))
yGaze = CInt(s.gy(nEye))
ptGaze.X = xGaze
ptGaze.Y = yGaze
'Make sure we have at least 1 sample
If lastSampleTime > -1 Then
'Check the Interest Areas
If PointInRect(ptGaze, IA1) Then
'Increase the running time accordingly
running1 = running1 + (s.time - lastSampleTime)
End If
If PointInRect(ptGaze, IA2) Then
running2 = running2 + (s.time - lastSampleTime)
End If
If PointInRect(ptGaze, IA3) Then
running3 = running3 + (s.time - lastSampleTime)
End If
End If
'Hold on to the last sample time
lastSampleTime = s.time
'''''
'Check first to make sure the booleans are false
' If so, check the running time. If it exceeds the set duraation, change the border color,
' border width, redraw the object, and change its boolean
If bT1 = False Then
If running1 >= nFixDur Then
dOne.BorderColor = CColor("green")
dOne.BorderWidth = 2
'Display.WaitForVerticalBlank
dOne.Draw
bT1 = True
End If
End If
If bT2 = False Then
If running2 >= nFixDur Then
dTwo.BorderColor = CColor("green")
dTwo.BorderWidth = 2
'Display.WaitForVerticalBlank
dTwo.Draw
bT2 = True
End If
End If
If bT3 = False Then
If running3 >= nFixDur Then
dThree.BorderColor = CColor("green")
dThree.BorderWidth = 2
'Display.WaitForVerticalBlank
dThree.Draw
bT3 = True
End If
End If
'''''
'Check to see if the loop has timed out; if so, set attribute to log the occurence
If elutil.currentTime() >= (stime + nTimeOut) Then
bCriteriaMet = True
'MSGBox "TIMED OUT!!!"
c.SetAttrib "TimedOutProbe", "True"
bProbeTimeout = True
tracker.sendMessage "triggered probe " & s.time
End If
'If all the running times have been met (or have timed out), set the overall Boolean True
If (bT1 = True) And (bT2 = True) And (bT3 = True) Then
bCriteriaMet = True
End If
End If
Wend
''''''''''''''''''''''''''''''''''''''''''
'''''
CancelOut1:
'''''
第六步:如图1所示,在"elStopRec" 的inline控件中粘贴以下代码:
'Allow Windows to clean up while we record additional 100 msec of data
elutil.pumpDelay 100
tracker.stopRecording
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Track the interest area around the first object
tracker.SendMessage "!V IAREA RECTANGLE " & 1 & " " & CInt(IA1.Left) & " " & CInt(IA1.Top) & " " & CInt(IA1.Right) & " " & CInt(IA1.Bottom) & " Object1"
Sleep 1
'Track the interest area around the second object
tracker.SendMessage "!V IAREA RECTANGLE " & 2 & " " & CInt(IA2.Left) & " " & CInt(IA2.Top) & " " & CInt(IA2.Right) & " " & CInt(IA2.Bottom) & " Object2"
Sleep 1
'Track the interest area around the third object
tracker.SendMessage "!V IAREA RECTANGLE " & 3 & " " & CInt(IA3.Left) & " " & CInt(IA3.Top) & " " & CInt(IA3.Right) & " " & CInt(IA3.Bottom) & " Object3"
Sleep 1
'''''''''''''''
'Send trial variables
'tracker.SendMessage "!V TRIAL_VAR VAR_NAME " & VAR_VALUE
'Sleep 1
'Subject number
tracker.SendMessage "!V TRIAL_VAR Subject_Num " & c.GetAttrib("Subject")
Sleep 1
'Trial number
tracker.SendMessage "!V TRIAL_VAR Trial_Num " & nTrial
Sleep 1
'''''
'Indicates the end of the trial
tracker.sendMessage "TRIAL_RESULT " & nTrial
''''''
'Release the references
Set dOne = Nothing
Set dTwo = Nothing
Set dThree = Nothing
第七步:如图1所示,在"elClose" 的inline控件中粘贴以下代码:
' Set offline mode so we can transfer file
tracker.setOfflineMode
' Delay so tracker is ready
Sleep 500
' Close data file
tracker.closeDataFile
' Get the edf file to display pc
tracker.receiveDataFile edfFileName, ""
' Release tracker object
Set tracker = Nothing
' Release eyelink util object
Set elutil = Nothing
'Error checking
ErrorHandle:
If Err <> 0 Then
Set tracker = Nothing ' release tracker object
Set elutil = Nothing ' release eyelink util object
MsgBox Err.Number & ":" & Err.Description
'Exit Sub if this is not the last inline, we need an Exit Sub
End If
以上就是整个程序所需要的全部Inline语句,希望能对大家有用!
|| 往期经典
ERPLAB中计算差异波(即:对侧减同侧;N2pc\Pd\CDA)