Is your computer watching you?

[JRace]

B-Eyes.  Not an original idea; it's a simple version of XEyes for QB64.

Only tracks when the pointer is over the eye window.  Press <ESC> to quit.

Won't win any awards for features or elegance, but it works.  (Tested only on Windoze.)

(BTW: I had to reverse-engineer my old C version of this to figure out how it handled certain matters!  It's been a long time since I touched it.)

Code: (Select All)

'B-Eyes pointer tracking "utility", written for QB64PE, v2022.09.05 by JSR.
'Free to a good home.


Type ptype
    centerx As Integer
    centery As Integer
    currentx As Integer
    currenty As Integer
End Type

Dim Shared pupil(1) As ptype

Dim Shared As Integer pointerx, pointery, pupilsize, pupildist

DefInt A-Z

pupil(0).centerx = 160
pupil(0).centery = 240
pupil(0).currentx = 160
pupil(0).currenty = 240
pupil(1).centerx = 160 + 320
pupil(1).centery = 240
pupil(1).currentx = 160 + 320
pupil(1).currenty = 240

pupilsize = 28
pupildist = 84

Screen 12 '640x480x16
_PaletteColor 0, _RGB32(0, 0, 0)
_PaletteColor 1, _RGB32(255, 255, 255)


Cls
draweyes
_Display

Do
    If _MouseInput Then
        pointerx = _MouseX 'returns coords within window
        pointery = _MouseY 'returns coords within window
        'we're going to redraw the pupils only, to improve program speed....
        erasepupils
        calcpupils
        drawpupils
        _Display
    Else
        _Delay 0.05
    End If
Loop Until InKey$ = Chr$(27) ' quit when <ESC> pressed
End



Sub draweyes
    Circle (160, 240), 140, 1 'the whites of its eyes
    Paint (160, 240), 1
    Circle (480, 240), 140, 1
    Paint (480, 240), 1
    drawpupils
End Sub



Sub drawpupils
    Circle (pupil(0).currentx, pupil(0).currenty), pupilsize, 0 'draw the pupils
    Paint (pupil(0).currentx, pupil(0).currenty), 0
    Circle (pupil(1).currentx, pupil(1).currenty), pupilsize, 0
    Paint (pupil(1).currentx, pupil(1).currenty), 0
End Sub



Sub erasepupils
    Paint (pupil(0).currentx, pupil(0).currenty), 1
    Paint (pupil(1).currentx, pupil(1).currenty), 1
End Sub



Sub calcpupils
    Dim As Double dist, x, y
    Dim As Integer eye
    eye = 0
    Do
        x = pointerx - pupil(eye).centerx
        y = pointery - pupil(eye).centery
      ' determine the distance from the pointer to the eye center;
      ' use that to keep pupil X & Y distances within range....
        dist = Sqr((x * x) + (y * y))
        If dist > pupildist Then
            x = x / (dist / pupildist)
            y = y / (dist / pupildist)
        End If
        pupil(eye).currentx = pupil(eye).centerx + Int(x)
        pupil(eye).currenty = pupil(eye).centery + Int(y)
        eye = eye + 1
    Loop Until eye = 2
End Sub