+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Is your computer watching you? (/showthread.php?tid=851)
Is your computer watching you? - James D Jarvis - 09-04-2022
Is your computer watching you?
Code: (Select All)
'Your Computer is watching you
'
Screen _NewImage(640, 360, 32)
Randomize Timer
_FullScreen
_Title "The Computer Is Your Friend"
Dim Shared skintonemid As _Unsigned Long
Dim Shared skintonehigh As _Unsigned Long
Dim Shared skintonelow As _Unsigned Long
Dim pk&
pk& = _NewImage(4, 4, 32)
Dim Shared irismid As _Unsigned Long
Dim Shared irishigh As _Unsigned Long
Dim Shared irislow As _Unsigned Long
Dim Shared irisfleck As _Unsigned Long
Dim Shared eyewhite As _Unsigned Long
Do
Cls
ex = _Width / 2
ey = _Height / 2
sred& = 50 + Rnd * 175
sgreen& = 50 + Rnd * 175
sblue& = 50 + Rnd * 175
skintonehigh = _RGB32(sred&, sgreen&, sblue&)
skintonemid = _RGB32(sred& * .8, sgreen& * .9, sblue& * .95)
skintonelow = _RGB32(sred& * .6, sgreen& * .7, sblue& * .6)
Select Case Int(1 + Rnd * 16)
Case 1
ired& = 40
igreen& = 130
iblue& = 20
Case 2, 3
ired& = 50
igreen& = 70
iblue& = 240
Case 4, 5, 6
ired& = 150
igreen& = 200
iblue& = 220
Case 7, 8, 9, 10
ired& = 100
igreen& = 80
iblue& = 60
Case 11, 12, 13
ired& = 200
igreen& = 200
iblue& = 140
Case 14, 15
ired& = 170
igreen& = 180
iblue& = 150
Case 16
ired& = 200
igreen& = 200
iblue& = 23
End Select
irishigh = _RGB32(ired&, igreen&, iblue&)
irismid = _RGB32(ired& * .8, igreen& * .8, iblue& * .8)
irislow = _RGB32(ired& * .6, igreen& * .6, iblue& * .6)
irisfleck = _RGB32(ired& * .6 + Rnd * ired& * .2, igreen * .6 + Rnd * igreen& * .2, iblue * .6 + Rnd * iblue& * .2)
Line (0, 0)-(_Width, _Height), _RGB32(sred& * .9, sgreen& * .9, sblue& * .9), BF
irad = _Width * .15 + Rnd * 6
prad = _Width * .04 + Rnd * (irad * .2)
eyewhite = _RGB32(255 - Rnd * 4, 255 - Rnd * 4, 255 - Rnd * 4)
Circle (ex, ey), irad * 2.5, _RGB32(sred& * .67, sgreen& * .67, sblue& * .67), , , .8
Paint (ex, ey), _RGB32(sred& * .67, sgreen& * .67, sblue& * .67), _RGB32(sred& * .67, sgreen& * .67, sblue& * .67)
Line (0, 0)-(_Width, ey), _RGB32(sred& * .9, sgreen& * .9, sblue& * .9), BF
Circle (ex, ey), irad * 2.5, skintonemid, , , .7
Paint (ex, ey), skintonemid, skintonemid
For ir = irad * 1.2 To irad * 2.5 Step (4 + Rnd * 6)
Circle (ex, ey), ir, skintonehigh, .1, 3.0, 0.7
Next ir
For ir = irad * 2.5 To irad * 1.4 Step -(4 + Rnd * 6)
Circle (ex, ey), ir, skintonelow, 3.2, 0, 0.7
Next ir
Line (ex - irad * 2.5, ey)-(ex - irad * .165, ey - irad + 2), eyewhite
Line -(ex + irad * .165, ey - irad + 2), eyewhite
Line -(ex + irad * 2.5, ey), eyewhite
Line (ex - irad * 2.5, ey)-(ex - irad * .165, ey + irad - 2), eyewhite
Line -(ex + irad * .165, ey + irad - 2), eyewhite
Line -(ex + irad * 2.5, ey), eyewhite
Paint (ex, ey), eyewhite, eyewhite
circleBF ex, ey, irad, irislow
polyT ex + 2, ey - 2, irad * .9, irismid, Int(8 + Rnd * 20)
circleBF ex + 4, ey - 4, irad * .75, irishigh
polyT ex, ey, prad * ((105 + Rnd * 20) / 100), irislow, Int(8 + Rnd * 20)
circleBF ex, ey, prad, _RGB32(Int(Rnd * 9), Int(Rnd * 2), Int(Rnd * 4))
For deg = 0 To 360 Step (1 + Rnd * 6)
x2 = irad * .9 * Sin(0.01745329 * deg)
y2 = irad * .9 * Cos(0.01745329 * deg)
Line (ex, ey)-(ex + x2, ey + y2), irislow
Next deg
circleBF ex + prad, ey - prad, (irad * .6) - prad * .5, _RGB32(255, 255, 255, 40)
circleBF ex, ey, prad, _RGB32(Int(Rnd * 9), Int(Rnd * 2), Int(Rnd * 4))
Do
_Limit 20
ask$ = InKey$
Loop Until ask$ <> ""
Loop Until ask$ = Chr$(27)
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
rsqrd = r * r
y = -r
While y <= r
x = Sqr(rsqrd - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
y = y + 1
Wend
End Sub
Sub polyT (cx As Long, cy As Long, r As Long, klr As _Unsigned Long, deg As Long)
setklr klr
d = 0
x = r * Sin(0)
y = r * Cos(0)
While d < 360
d = d + deg
x2 = r * Sin(0.01745329 * d)
y2 = r * Cos(0.01745329 * d)
_MapTriangle (0, 2)-(2, 2)-(2, 0), pk& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
x = x2
y = y2
Wend
End Sub
Sub setklr (klr As _Unsigned Long)
_Dest pk&
Line (0, 0)-(2, 2), klr, BF
_Dest 0
End Sub
Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
fatlineLow x1, y1, x0, y0, r, klr
Else
fatlineLow x0, y0, x1, y1, r, klr
End If
Else
If y0 > y1 Then
fatlineHigh x1, y1, x0, y0, r, klr
Else
fatlineHigh x0, y0, x1, y1, r, klr
End If
End If
End Sub
Sub fatlineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
'D = (2 * dy) - dx
d = (dy + dy) - dx
y = y0
For x = x0 To x1
circleBF x, y, r, klr
If d > 0 Then
y = y + yi
' D = D + (2 * (dy - dx))
d = d + ((dy - dx) + (dy - dx))
Else
' D = D + 2 * dy
d = d + dy + dy
End If
Next x
End Sub
Sub fatlineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
' D = (2 * dx) - dy
D = (dx + dx) - dy
x = x0
For y = y0 To y1
circleBF x, y, r, klr
If D > 0 Then
x = x + xi
' D = D + (2 * (dx - dy))
D = D + ((dx - dy) + (dx - dy))
Else
' D = D + 2 * dx
D = D + dx + dx
End If
Next y
End SubRE: Is your computer watching you? - mnrvovrfc - 09-04-2022
Now I'd like to see played back that song by Hall & Oates even with "PLAY" commands from the old PC speaker, while this screen is enabled!
My request was actually "Play My Game" ROFLMAO but I seriously like that song by those guys.
RE: Is your computer watching you? - James D Jarvis - 09-04-2022
"Private Eyes"?
RE: Is your computer watching you? - SierraKen - 09-04-2022
LOL cool looking eyes! I like how you can press the Space Bar to see different kinds.
LOL mnrvovrfc. Well with QB64 the PLAY command and all other sounds are through your sound card. Might not be possible to use your internal speaker anymore.
RE: Is your computer watching you? - TerryRitchie - 09-04-2022
Back in 1982 there was a similar program for the TRS80 CoCo called MomInLaw, a giant eye on the screen that would look around. Cool program, thanks for the trip down memory lane too.
RE: Is your computer watching you? - JRace - 09-06-2022
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 SubRE: Is your computer watching you? - bplus - 09-06-2022
https://qb64phoenix.com/forum/showthread.php?tid=162&pid=2443#pid2443
Eyeballs and smile!
RE: Is your computer watching you? - JRace - 09-06-2022
(09-06-2022, 11:14 AM)bplus Wrote: https://qb64phoenix.com/forum/showthread.php?tid=162&pid=2443#pid2443
Eyeballs and smile!
LOL. I must've seen that when you first posted it, but didn't remember. Man, I'm gettin' old!