眼动编程||注视固定区域一定有效时间后自动跳转

在眼动实验中，为了保证实验程序进行的流畅性，在实际程序编制的过程中，我们往往要求被试将注意力集中到某个有效区域内一定的时间，然后在自动跳转到下一个界面。

但在 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

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    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" , "WFF_" & 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 fixation to expire
nTimeOut = 10000

'Set the time to require fixation 
nFixDur = 2000

'''''''''''''''''

'Set the intended location of the fixation (center of the screen)
xFix = Display.XRes / 2
yFix = Display.YRes / 2   

'Set the dimensions accepted for fixation
widFix = 100
htFix = 100

'Set the rectangle dimensions (according to location, height, width)
rectFix.Left = xFix - (widFix / 2)
rectFix.Right = xFix + (widFix / 2)
rectFix.Top = yFix - (htFix / 2)
rectFix.Bottom = yFix + (htFix / 2)

第五步：如图1所示，在"elWaitForFix" 的inline控件中粘贴以下代码：

'Draw a feedback box to monitor the fixation (based on rectFix dimensions/coordinates)
tracker.sendCommand "draw_filled_box " & rectFix.Left & " " & rectFix.Top & " " & rectFix.Right & " " & rectFix.Bottom & " 7"

'''''

'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 'WFF " & 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 CancelOut2
End If

'Mark the onset of the Fixation screen
tracker.sendMessage "Fix_Onset"
Sleep 1

'Boolean for triggering of the fixation
Dim bTriggered As Boolean
bTriggered = False

'''''

'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 last sample time
lastSampleTime = -1 

'Loop exit if fixation triggered, timed out, tracker disconnected or break pressed
While (tracker.IsConnected()) And (Not tracker.breakPressed()) And (bTriggered = False)

    'Check for new sample update
    Set s = tracker.getNewestSample() 

    'Make sure we get a new sample and get gaze position from sample 
    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
        xGaze = CInt(s.gx(nEye))
        yGaze = CInt(s.gy(nEye))
        ptGaze.X = xGaze
        ptGaze.Y = yGaze

        'Make sure we have at least one sample, and check the location of the gaze
        If (lastSampleTime > -1) And (PointInRect(ptGaze, rectFix)) Then
            'Increase the dwell time if in the fixation rectangle
            dwellTime = dwellTime + (s.time - lastSampleTime)
            'tracker.sendMessage "In "
        Else
            'Reset the dwell time if gaze left the fixation rectangle
            dwellTime = 0
            'tracker.sendMessage "out "
        End If

        'Hold on to the last sample time
        lastSampleTime = s.time

        'If the dwell exceeds the requirement, trigger the fixation
        If dwellTime > nFixDur Then
            'MSGBox "Triggered"
            tracker.sendMessage "triggered waitforfix " & s.time
            bTriggered = True
            c.SetAttrib "TimedOutWaitForFix", "False"
        End If

    End If

    'Check to see if the loop has timed out
    If elutil.currentTime() >= (stime + nTimeOut) Then
        bTriggered = True
        'MSGBox "TIMED OUT!!!"
        c.SetAttrib "TimedOutWaitForFix", "True"
    End If

Wend

'''''
CancelOut2:
'''''

'Mark the offset of the Fixation screen
tracker.sendMessage "Fix_Offset"
Sleep 1

'''

'Set the appropriate feedback
If c.GetAttrib("TimedOutWaitForFix") = False Then
    c.SetAttrib "FeedbackText", "Good job! Fixation achieved."
    c.SetAttrib "FdbkColor", "green"
Else
    c.SetAttrib "FeedbackText", "Wait For Fixation timed out!"
    c.SetAttrib "FdbkColor", "red"
End If

第六步：如图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 fixation cross
tracker.SendMessage "!V IAREA RECTANGLE " & 1 & " " & CInt(rectFix.Left) & " " & CInt(rectFix.Top) & " " & CInt(rectFix.Right) & " " & CInt(rectFix.Bottom) & " IAFixation"
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

第七步：如图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语句，希望能对大家有用！