09-04-2022, 05:10 AM
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 Sub
