Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
Finally getting my feet wet coding again after a long break. Updated the old GooglyEyes screensaver. Some of you may remember that one. Clicking the eyes now make them go goofy and run off screen. Added a rotating background using rotozoom.
- Dav
Code: (Select All)
'===============
'GOOGLYEYES4.BAS
'===============
'Blinking Eyes drift around, looking in direction they go.
'Shows how to create images off screen to use with _PUTIMAGE.
'Demo also shows how to move the images in interesting ways.
'Has a scrolling background image.
'Coded by Dav, JULY/2023
'V4 - Clicking eyes make them go googly and run off screen.
' Added a sound effect when clicking on them.
' Added a rotating background image.
' Added press ESC to quit
'=== First, create 4 eye images to use....
'=== Create image of eyes looking left
eyeleft& = _NEWIMAGE(230, 200, 32)
_DEST eyeleft& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255 'left eye
ball 30, 50, 20, 0, 0, 128 'left pupil
ball 150, 50, 50, 255, 255, 255 'right eye
ball 130, 50, 20, 0, 0, 128 'right pupil
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (30, 50), 20, _RGB(0, 0, 0)
CIRCLE (130, 50), 20, _RGB(0, 0, 0)
'=== Create image of eyes looking right
eyeright& = _NEWIMAGE(230, 200, 32)
_DEST eyeright& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 70, 50, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 170, 50, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (70, 50), 20, _RGB(0, 0, 0)
CIRCLE (170, 50), 20, _RGB(0, 0, 0)
'=== Create an image of eyes looking up
eyeup& = _NEWIMAGE(230, 200, 32)
_DEST eyeup& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 50, 30, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 150, 30, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (50, 30), 20, _RGB(0, 0, 0)
CIRCLE (150, 30), 20, _RGB(0, 0, 0)
'=== Create an image of eyes looking down
eyedown& = _NEWIMAGE(230, 200, 32)
_DEST eyedown& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 50, 70, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 150, 70, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (50, 70), 20, _RGB(0, 0, 0)
CIRCLE (150, 70), 20, _RGB(0, 0, 0)
'=== Create an image of eyes blinking
eyeblink& = _NEWIMAGE(200, 800, 32)
_DEST eyeblink& 'point to above image so we can draw to it
ball 50, 150, 50, 196, 196, 196
ball 150, 150, 50, 196, 196, 196
ball 50, 150, 20, 64, 64, 128
ball 150, 150, 29, 64, 64, 128
CIRCLE (50, 150), 50, _RGB(0, 0, 0)
CIRCLE (150, 150), 50, _RGB(0, 0, 0)
'=== Create a background image to use
back& = _NEWIMAGE(200, 150, 32)
_DEST back&
FOR x = -1 TO 200
FOR y = -1 TO 150
LINE (x, y)-(x + RND * 10, y + RND * 10), _RGBA(RND * 32, RND * 32, 25 + RND * 200, 25 + RND * 200), BF
NEXT
NEXT
'=== smooth out the background image...
_SOURCE back&
FOR u = 1 TO 3 'do it 3 times for extra smooth
FOR x = 1 TO 199
FOR y = 1 TO 149
p1~& = POINT(x, y)
p2~& = POINT(x + 1, y)
p3~& = POINT(x, y + 1)
p4~& = POINT(x + 1, y + 1)
p5~& = POINT(x - 1, y)
p6~& = POINT(x, y - 1)
p7~& = POINT(x - 1, y - 1)
p8~& = POINT(x - 1, y + 1)
p9~& = POINT(x + 1, y - 1)
IF x + 1 > 200 THEN p2~& = p1~&: p4~& = p1~&: p9~& = p1~&
IF x - 1 < 0 THEN p5~& = p1~&: p7~& = p1~&: p8~& = p1~&
IF y + 1 > 150 THEN p3~& = p1~&: p4~& = p1~&: p8~& = p1~&
IF y - 1 < 0 THEN p6~& = p1~&: p7~& = p1~&: p9~& = p1~&
r = _RED32(p1~&) + _RED32(p2~&) + _RED32(p3~&) + _RED32(p4~&) + _RED32(p5~&) + _RED32(p6~&) + _RED32(p7~&) + _RED32(p8~&) + _RED32(p9~&)
g = _GREEN32(p1~&) + _GREEN32(p2~&) + _GREEN32(p3~&) + _GREEN32(p4~&) + _GREEN32(p5~&) + _GREEN32(p6~&) + _GREEN32(p7~&) + _GREEN32(p8~&) + _GREEN32(p9~&)
b = _BLUE32(p1~&) + _BLUE32(p2~&) + _BLUE32(p3~&) + _BLUE32(p4~&) + _BLUE32(p5~&) + _BLUE32(p6~&) + _BLUE32(p7~&) + _BLUE32(p8~&) + _BLUE32(p9~&)
PSET (x, y), _RGB(r / 9, g / 9, b / 9)
NEXT
NEXT
NEXT
'=== Now we point to main screen
_SOURCE 0
_DEST 0 'set destination to draw to main screen
SCREEN _NEWIMAGE(1000, 800, 32) 'main screen size
RANDOMIZE TIMER 'do this so the RND call is different everytime
Eyes = 50 'the number of eyes on screen
EyeSizeMax = 250 'largest size eyes can be
DIM EyeX(Eyes), EyeY(Eyes) 'x/y position of the eye
DIM EyeSize(Eyes) ' size of eye
DIM EyeGrowth(Eyes) 'eye growing or shrinking on screen
DIM EyeDrift(Eyes) 'direction eye drifts across screen
DIM EyeDriftSpeed(Eyes) 'speed for the drift
DIM EyeBlinkFlag(Eyes) 'eyes blinking flag
DIM EyeBlinkCount(Eyes)
DIM EyeGoogly(Eyes)
'generate eye values
FOR d = 1 TO Eyes
EyeX(d) = RND * _WIDTH 'make random x position
EyeY(d) = RND * _HEIGHT 'make random y position
EyeSize(d) = (RND * EyeSizeMax) 'random eye size, up to EyeSizeMax
EyeGrowth(d) = INT(RND * 2) 'make way eye size is changing, 0=shrinking, 1=growing
EyeDrift(d) = INT(RND * 4) 'make random direction a eye can drift (4 different ways)
EyeDriftSpeed(d) = INT(RND * 3) + 2 'speed eyes will be drifting
EyeBlinkFlag(d) = 0 'if eye is blinking or not
EyeBlinkCount(d) = 0
EyeGoogly(d) = 0
NEXT
DO
WHILE _MOUSEINPUT: WEND
'Bubble sort through eyesize, putting smallest size first so..
'..they will be _PUTIMAGE'd first, putting them in the background.
FOR b = 1 TO Eyes
FOR b2 = 1 TO Eyes
IF EyeSize(b2) > EyeSize(b) THEN
SWAP EyeX(b), EyeX(b2)
SWAP EyeY(b), EyeY(b2)
SWAP EyeSize(b), EyeSize(b2)
SWAP EyeGrowth(b), EyeGrowth(b2)
SWAP EyeDrift(b), EyeDrift(b2)
SWAP EyeDriftSpeed(b), EyeDriftSpeed(b2)
SWAP EyeBlinkFlag(b), EyeBlinkFlag(b2)
SWAP EyeBlinkCount(b), EyeBlinkCount(b2)
END IF
NEXT
NEXT
'CLS 'I don't think CLS is needed now, the back& image clears screen
'=== rotozoom background image
RotoZoom3 _WIDTH / 2, _HEIGHT / 2, back&, 30, 8, a
a = a + .01: IF a >= 360 THEN a = a - 360
'=== step through each eye
FOR d = 1 TO Eyes
'if eye is shrinking, subtract eyesize, else add to it
IF EyeGrowth(d) = 0 THEN
EyeSize(d) = EyeSize(d) - 1
ELSE
EyeSize(d) = EyeSize(d) + 1
END IF
'if eyesize reaches max size, switch growth to 0 start shrinking instead
IF EyeSize(d) >= EyeSizeMax THEN EyeGrowth(d) = 0
'if if reaches smallest eyesize, switch growth to 1 to start growing now
IF EyeSize(d) <= 20 THEN EyeGrowth(d) = 1
'drift eye in 1 of 4 directions we generated, and do +x,-x,+y,-y to it.
IF EyeDrift(d) = 0 THEN EyeX(d) = EyeX(d) + EyeDriftSpeed(d) 'drift right
IF EyeDrift(d) = 1 THEN EyeX(d) = EyeX(d) - EyeDriftSpeed(d) 'drift left
IF EyeDrift(d) = 2 THEN EyeY(d) = EyeY(d) + EyeDriftSpeed(d) 'drift down
IF EyeDrift(d) = 3 THEN EyeY(d) = EyeY(d) - EyeDriftSpeed(d) 'drift up
'this creates the shakiness. randomly adjust x/y positions by +/-2 each step
IF INT(RND * 2) = 0 THEN EyeX(d) = EyeX(d) + 2 ELSE EyeX(d) = EyeX(d) - 2
IF INT(RND * 2) = 0 THEN EyeY(d) = EyeY(d) + 2 ELSE EyeY(d) = EyeY(d) - 2
'below handles if eye goes off screen, let it dissapear completely.
'If it had been clicked and Gone Googly, then reset speed afterwards
IF EyeX(d) > _WIDTH + EyeSize(d) THEN EyeX(d) = -EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeX(d) < -EyeSize(d) THEN EyeX(d) = _WIDTH + EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeY(d) > _HEIGHT + EyeSize(d) THEN EyeY(d) = -EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeY(d) < -EyeSize(d) THEN EyeY(d) = _HEIGHT + EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
'drift eye in 1 of 4 directions we generated, and +x,-x,+y,-y to it.
'If blinking flag on...
IF EyeBlinkFlag(d) = 1 THEN
SELECT CASE EyeBlinkCount(d)
CASE 0 TO 3
_PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeblink&
CASE 4 TO 8
LINE (EyeX(d), EyeY(d) + (EyeSize(d) / 6))-(EyeX(d) + EyeSize(d), EyeY(d) + (EyeSize(d) / 6) + 3), _RGB(64, 64, 64), BF
CASE 9 TO 12
_PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeblink&
END SELECT
EyeBlinkCount(d) = EyeBlinkCount(d) + 1
IF EyeBlinkCount(d) > 12 THEN
EyeBlinkCount(d) = 0
EyeBlinkFlag(d) = 0
END IF
ELSE
'showing normal eyes
IF EyeDrift(d) = 0 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeright& 'drift right
IF EyeDrift(d) = 1 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeleft& 'drift left
IF EyeDrift(d) = 2 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyedown& 'drift down
IF EyeDrift(d) = 3 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeup& 'drift up
END IF
'Add code here to add nose and mouth to the here (next version...)
'get random direction change,growth and blinking once in a while
SELECT CASE INT(RND * 300)
CASE 1: EyeDrift(d) = 0: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 2: EyeDrift(d) = 1: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 3: EyeDrift(d) = 2: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 4: EyeDrift(d) = 3: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 5: EyeGrowth(d) = 0
CASE 6: EyeGrowth(d) = 1
CASE 7: IF EyeBlinkFlag(d) = 0 THEN EyeBlinkFlag(d) = 1
END SELECT
IF _MOUSEBUTTON(1) THEN
mx = _MOUSEX: my = _MOUSEY
IF mx > EyeX(d) AND mx < EyeX(d) + EyeSize(d) AND my > EyeY(d) AND my < EyeY(d) + EyeSize(d) THEN
EyeGrowth(d) = INT(RND * 2)
EyeDrift(d) = INT(RND * 4)
EyeDriftSpeed(d) = EyeDriftSpeed(d) + 4
SOUND 7000 + (RND * 3000), .1
END IF
END IF
NEXT
_DISPLAY
_LIMIT 30
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
SUB ball (x, y, size, r&, g&, b&)
'small sub that draws a filled ball with given color.
FOR s = 1 TO size STEP .4
CIRCLE (x, y), s, _RGB(r&, g&, b&)
r& = r& - 1: g& = g& - 1: b& = b& - 1
NEXT
END SUB
SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
DIM W&, H&, sinr!, cosr!, i&, x2&, y2& ' variables for image manipulation
W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
px(2) = W& / 2: py(2) = H& / 2 ' right bottom
px(3) = W& / 2: py(3) = -H& / 2 ' right top
sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
NEXT
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
Posts: 632
Threads: 93
Joined: Apr 2022
Reputation:
22
(07-08-2023, 09:19 PM)Dav Wrote: Finally getting my feet wet coding again after a long break. Updated the old GooglyEyes screensaver. Some of you may remember that one. Clicking the eyes now make them go goofy and run off screen. Added a rotating background using rotozoom.
- Dav
Code: (Select All)
'===============
'GOOGLYEYES4.BAS
'===============
'Blinking Eyes drift around, looking in direction they go.
'Shows how to create images off screen to use with _PUTIMAGE.
'Demo also shows how to move the images in interesting ways.
'Has a scrolling background image.
'Coded by Dav, JULY/2023
'V4 - Clicking eyes make them go googly and run off screen.
' Added a sound effect when clicking on them.
' Added a rotating background image.
' Added press ESC to quit
'=== First, create 4 eye images to use....
'=== Create image of eyes looking left
eyeleft& = _NEWIMAGE(230, 200, 32)
_DEST eyeleft& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255 'left eye
ball 30, 50, 20, 0, 0, 128 'left pupil
ball 150, 50, 50, 255, 255, 255 'right eye
ball 130, 50, 20, 0, 0, 128 'right pupil
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (30, 50), 20, _RGB(0, 0, 0)
CIRCLE (130, 50), 20, _RGB(0, 0, 0)
'=== Create image of eyes looking right
eyeright& = _NEWIMAGE(230, 200, 32)
_DEST eyeright& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 70, 50, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 170, 50, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (70, 50), 20, _RGB(0, 0, 0)
CIRCLE (170, 50), 20, _RGB(0, 0, 0)
'=== Create an image of eyes looking up
eyeup& = _NEWIMAGE(230, 200, 32)
_DEST eyeup& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 50, 30, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 150, 30, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (50, 30), 20, _RGB(0, 0, 0)
CIRCLE (150, 30), 20, _RGB(0, 0, 0)
'=== Create an image of eyes looking down
eyedown& = _NEWIMAGE(230, 200, 32)
_DEST eyedown& 'point to above image so we can draw to it
ball 50, 50, 50, 255, 255, 255
ball 50, 70, 20, 0, 0, 128
ball 150, 50, 50, 255, 255, 255
ball 150, 70, 20, 0, 0, 128
CIRCLE (50, 50), 50, _RGB(0, 0, 0)
CIRCLE (150, 50), 50, _RGB(0, 0, 0)
CIRCLE (50, 70), 20, _RGB(0, 0, 0)
CIRCLE (150, 70), 20, _RGB(0, 0, 0)
'=== Create an image of eyes blinking
eyeblink& = _NEWIMAGE(200, 800, 32)
_DEST eyeblink& 'point to above image so we can draw to it
ball 50, 150, 50, 196, 196, 196
ball 150, 150, 50, 196, 196, 196
ball 50, 150, 20, 64, 64, 128
ball 150, 150, 29, 64, 64, 128
CIRCLE (50, 150), 50, _RGB(0, 0, 0)
CIRCLE (150, 150), 50, _RGB(0, 0, 0)
'=== Create a background image to use
back& = _NEWIMAGE(200, 150, 32)
_DEST back&
FOR x = -1 TO 200
FOR y = -1 TO 150
LINE (x, y)-(x + RND * 10, y + RND * 10), _RGBA(RND * 32, RND * 32, 25 + RND * 200, 25 + RND * 200), BF
NEXT
NEXT
'=== smooth out the background image...
_SOURCE back&
FOR u = 1 TO 3 'do it 3 times for extra smooth
FOR x = 1 TO 199
FOR y = 1 TO 149
p1~& = POINT(x, y)
p2~& = POINT(x + 1, y)
p3~& = POINT(x, y + 1)
p4~& = POINT(x + 1, y + 1)
p5~& = POINT(x - 1, y)
p6~& = POINT(x, y - 1)
p7~& = POINT(x - 1, y - 1)
p8~& = POINT(x - 1, y + 1)
p9~& = POINT(x + 1, y - 1)
IF x + 1 > 200 THEN p2~& = p1~&: p4~& = p1~&: p9~& = p1~&
IF x - 1 < 0 THEN p5~& = p1~&: p7~& = p1~&: p8~& = p1~&
IF y + 1 > 150 THEN p3~& = p1~&: p4~& = p1~&: p8~& = p1~&
IF y - 1 < 0 THEN p6~& = p1~&: p7~& = p1~&: p9~& = p1~&
r = _RED32(p1~&) + _RED32(p2~&) + _RED32(p3~&) + _RED32(p4~&) + _RED32(p5~&) + _RED32(p6~&) + _RED32(p7~&) + _RED32(p8~&) + _RED32(p9~&)
g = _GREEN32(p1~&) + _GREEN32(p2~&) + _GREEN32(p3~&) + _GREEN32(p4~&) + _GREEN32(p5~&) + _GREEN32(p6~&) + _GREEN32(p7~&) + _GREEN32(p8~&) + _GREEN32(p9~&)
b = _BLUE32(p1~&) + _BLUE32(p2~&) + _BLUE32(p3~&) + _BLUE32(p4~&) + _BLUE32(p5~&) + _BLUE32(p6~&) + _BLUE32(p7~&) + _BLUE32(p8~&) + _BLUE32(p9~&)
PSET (x, y), _RGB(r / 9, g / 9, b / 9)
NEXT
NEXT
NEXT
'=== Now we point to main screen
_SOURCE 0
_DEST 0 'set destination to draw to main screen
SCREEN _NEWIMAGE(1000, 800, 32) 'main screen size
RANDOMIZE TIMER 'do this so the RND call is different everytime
Eyes = 50 'the number of eyes on screen
EyeSizeMax = 250 'largest size eyes can be
DIM EyeX(Eyes), EyeY(Eyes) 'x/y position of the eye
DIM EyeSize(Eyes) ' size of eye
DIM EyeGrowth(Eyes) 'eye growing or shrinking on screen
DIM EyeDrift(Eyes) 'direction eye drifts across screen
DIM EyeDriftSpeed(Eyes) 'speed for the drift
DIM EyeBlinkFlag(Eyes) 'eyes blinking flag
DIM EyeBlinkCount(Eyes)
DIM EyeGoogly(Eyes)
'generate eye values
FOR d = 1 TO Eyes
EyeX(d) = RND * _WIDTH 'make random x position
EyeY(d) = RND * _HEIGHT 'make random y position
EyeSize(d) = (RND * EyeSizeMax) 'random eye size, up to EyeSizeMax
EyeGrowth(d) = INT(RND * 2) 'make way eye size is changing, 0=shrinking, 1=growing
EyeDrift(d) = INT(RND * 4) 'make random direction a eye can drift (4 different ways)
EyeDriftSpeed(d) = INT(RND * 3) + 2 'speed eyes will be drifting
EyeBlinkFlag(d) = 0 'if eye is blinking or not
EyeBlinkCount(d) = 0
EyeGoogly(d) = 0
NEXT
DO
WHILE _MOUSEINPUT: WEND
'Bubble sort through eyesize, putting smallest size first so..
'..they will be _PUTIMAGE'd first, putting them in the background.
FOR b = 1 TO Eyes
FOR b2 = 1 TO Eyes
IF EyeSize(b2) > EyeSize(b) THEN
SWAP EyeX(b), EyeX(b2)
SWAP EyeY(b), EyeY(b2)
SWAP EyeSize(b), EyeSize(b2)
SWAP EyeGrowth(b), EyeGrowth(b2)
SWAP EyeDrift(b), EyeDrift(b2)
SWAP EyeDriftSpeed(b), EyeDriftSpeed(b2)
SWAP EyeBlinkFlag(b), EyeBlinkFlag(b2)
SWAP EyeBlinkCount(b), EyeBlinkCount(b2)
END IF
NEXT
NEXT
'CLS 'I don't think CLS is needed now, the back& image clears screen
'=== rotozoom background image
RotoZoom3 _WIDTH / 2, _HEIGHT / 2, back&, 30, 8, a
a = a + .01: IF a >= 360 THEN a = a - 360
'=== step through each eye
FOR d = 1 TO Eyes
'if eye is shrinking, subtract eyesize, else add to it
IF EyeGrowth(d) = 0 THEN
EyeSize(d) = EyeSize(d) - 1
ELSE
EyeSize(d) = EyeSize(d) + 1
END IF
'if eyesize reaches max size, switch growth to 0 start shrinking instead
IF EyeSize(d) >= EyeSizeMax THEN EyeGrowth(d) = 0
'if if reaches smallest eyesize, switch growth to 1 to start growing now
IF EyeSize(d) <= 20 THEN EyeGrowth(d) = 1
'drift eye in 1 of 4 directions we generated, and do +x,-x,+y,-y to it.
IF EyeDrift(d) = 0 THEN EyeX(d) = EyeX(d) + EyeDriftSpeed(d) 'drift right
IF EyeDrift(d) = 1 THEN EyeX(d) = EyeX(d) - EyeDriftSpeed(d) 'drift left
IF EyeDrift(d) = 2 THEN EyeY(d) = EyeY(d) + EyeDriftSpeed(d) 'drift down
IF EyeDrift(d) = 3 THEN EyeY(d) = EyeY(d) - EyeDriftSpeed(d) 'drift up
'this creates the shakiness. randomly adjust x/y positions by +/-2 each step
IF INT(RND * 2) = 0 THEN EyeX(d) = EyeX(d) + 2 ELSE EyeX(d) = EyeX(d) - 2
IF INT(RND * 2) = 0 THEN EyeY(d) = EyeY(d) + 2 ELSE EyeY(d) = EyeY(d) - 2
'below handles if eye goes off screen, let it dissapear completely.
'If it had been clicked and Gone Googly, then reset speed afterwards
IF EyeX(d) > _WIDTH + EyeSize(d) THEN EyeX(d) = -EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeX(d) < -EyeSize(d) THEN EyeX(d) = _WIDTH + EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeY(d) > _HEIGHT + EyeSize(d) THEN EyeY(d) = -EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
IF EyeY(d) < -EyeSize(d) THEN EyeY(d) = _HEIGHT + EyeSize(d): EyeDriftSpeed(d) = INT(RND * 3) + 2
'drift eye in 1 of 4 directions we generated, and +x,-x,+y,-y to it.
'If blinking flag on...
IF EyeBlinkFlag(d) = 1 THEN
SELECT CASE EyeBlinkCount(d)
CASE 0 TO 3
_PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeblink&
CASE 4 TO 8
LINE (EyeX(d), EyeY(d) + (EyeSize(d) / 6))-(EyeX(d) + EyeSize(d), EyeY(d) + (EyeSize(d) / 6) + 3), _RGB(64, 64, 64), BF
CASE 9 TO 12
_PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeblink&
END SELECT
EyeBlinkCount(d) = EyeBlinkCount(d) + 1
IF EyeBlinkCount(d) > 12 THEN
EyeBlinkCount(d) = 0
EyeBlinkFlag(d) = 0
END IF
ELSE
'showing normal eyes
IF EyeDrift(d) = 0 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeright& 'drift right
IF EyeDrift(d) = 1 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeleft& 'drift left
IF EyeDrift(d) = 2 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyedown& 'drift down
IF EyeDrift(d) = 3 THEN _PUTIMAGE (EyeX(d), EyeY(d))-(EyeX(d) + EyeSize(d), EyeY(d) + EyeSize(d)), eyeup& 'drift up
END IF
'Add code here to add nose and mouth to the here (next version...)
'get random direction change,growth and blinking once in a while
SELECT CASE INT(RND * 300)
CASE 1: EyeDrift(d) = 0: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 2: EyeDrift(d) = 1: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 3: EyeDrift(d) = 2: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 4: EyeDrift(d) = 3: EyeDriftSpeed(d) = INT(RND * 3) + 2
CASE 5: EyeGrowth(d) = 0
CASE 6: EyeGrowth(d) = 1
CASE 7: IF EyeBlinkFlag(d) = 0 THEN EyeBlinkFlag(d) = 1
END SELECT
IF _MOUSEBUTTON(1) THEN
mx = _MOUSEX: my = _MOUSEY
IF mx > EyeX(d) AND mx < EyeX(d) + EyeSize(d) AND my > EyeY(d) AND my < EyeY(d) + EyeSize(d) THEN
EyeGrowth(d) = INT(RND * 2)
EyeDrift(d) = INT(RND * 4)
EyeDriftSpeed(d) = EyeDriftSpeed(d) + 4
SOUND 7000 + (RND * 3000), .1
END IF
END IF
NEXT
_DISPLAY
_LIMIT 30
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
SUB ball (x, y, size, r&, g&, b&)
'small sub that draws a filled ball with given color.
FOR s = 1 TO size STEP .4
CIRCLE (x, y), s, _RGB(r&, g&, b&)
r& = r& - 1: g& = g& - 1: b& = b& - 1
NEXT
END SUB
SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
DIM W&, H&, sinr!, cosr!, i&, x2&, y2& ' variables for image manipulation
W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
px(2) = W& / 2: py(2) = H& / 2 ' right bottom
px(3) = W& / 2: py(3) = -H& / 2 ' right top
sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
NEXT
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
Quite entertaining!
I spent a relaxing few minutes playing a game of trying to empty the screen of googlies by clicking them. Very relaxing! 
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation:
45
07-09-2023, 03:45 PM
(This post was last modified: 07-09-2023, 03:46 PM by grymmjack.
Edit Reason: fixed caps
)
Me too @PhilofPerth
I also learned holding down the mouse made that process a lot more interesting and fun.
Thanks @Dav as usual, great work.
Posts: 3,885
Threads: 174
Joined: Apr 2022
Reputation:
201
07-09-2023, 07:37 PM
(This post was last modified: 07-09-2023, 07:41 PM by bplus.)
Hey Dav you got me goofing off today and modifying a similar program of mine!
Code: (Select All) _Title "All Eyes on the Bee"
' B+ 2019-03-06
' 2020-05-13 add smile
' 2023-07-09 multiply and avoid!
Const smile = 1 / 3 * _Pi
Screen _NewImage(1280, 720, 12)
_FullScreen
Dim Shared mx, my, maxDist
maxDist = _Hypot(_Width / 2, _Height / 2)
nFaces = 40
Dim Shared fx(1 To nFaces), fy(1 To nFaces), fdx(1 To nFaces), fdy(1 To nFaces)
Dim Shared fsz(1 To nFaces), fc(1 To nFaces)
For i = 1 To nFaces
fx(i) = Rnd * _Width: fy(i) = Rnd * _Height
fdx(i) = Rnd * 6 - 3: fdy(i) = Rnd * 6 - 3
fsz(i) = Rnd * 60 + 20: fc(i) = Int(Rnd * 15)
Next
Color , 15
_MouseHide
While _KeyDown(27) = 0 'until esc keypress
Cls
For i = 1 To nFaces
fx(i) = fx(i) + fdx(i)
fy(i) = fy(i) + fdy(i)
If fx(i) < 0 Then fx(i) = fx(i) + _Width
If fx(i) > _Width Then fx(i) = fx(i) - _Width
If fy(i) < 0 Then fy(i) = fy(i) + _Height
If fy(i) > _Height Then fy(i) = fy(i) - _Height
drawFace i
Next
While _MouseInput: Wend
mx = _MouseX: my = _MouseY
' bee body
For i = 1 To 8
If i Mod 2 Then bc = 0 Else bc = 14
FillCircle mx + i * 3, my + i * 3, 5, bc
Next
' bee wings
FillCircle mx - 15 + 20, my + 10, 8, 7
FillCircle mx + 8 + 20, my + 5, 8, 7
_Display 'prevent flicker
_Limit 30 'save CPU fan
Wend
Sub drawFace (i)
If _Hypot(fx(i) - mx, fy(i) - my) < 100 Then
avoid = _Atan2(fy(i) - my, fx(i) - mx)
speed = 103 - _Hypot(fx(i) - mx, fy(i) - my)
fdx(i) = speed * Cos(avoid)
fdy(i) = speed * Sin(avoid)
End If
angle = _Atan2(my - fy(i), mx - (fx(i) - .45 * fsz(i)))
angle2 = _Atan2(my - fy(i), mx - (fx(i) + .45 * fsz(i)))
FillCircle fx(i), fy(i), fsz(i), fc(i)
FEllipse fx(i) - .45 * fsz(i), fy(i), .35 * fsz(i), .25 * fsz(i), 15
FEllipse fx(i) + .45 * fsz(i), fy(i), .35 * fsz(i), .25 * fsz(i), 15
x1 = fx(i) - .45 * fsz(i) + .125 * fsz(i) * Cos(angle)
y1 = fy(i) + .10 * fsz(i) * Sin(angle)
x2 = fx(i) + .45 * fsz(i) + .125 * fsz(i) * Cos(angle2)
y2 = fy(i) + .10 * fsz(i) * Sin(angle2)
FillCircle x1, y1, .17 * fsz(i), 9
FillCircle x2, y2, .17 * fsz(i), 9
FillCircle x1, y1, .09 * fsz(i), 0
FillCircle x2, y2, .09 * fsz(i), 0
mw = _Hypot(mx - fx(i), my - fy(i)) * 100 / _Hypot(_Width, _Height) + 2
arc fx(i), fy(i), .73 * fsz(i), _Pi / 2 - smile * mw / 100, _Pi / 2 + smile * mw / 100, 15
End Sub
'fill circle
Sub FillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
'use radians
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long)
Dim al, a
'x, y origin, r = radius, c = color
'raStart is first angle clockwise from due East = 0 degrees
' arc will start drawing there and clockwise until raStop angle reached
If raStop < raStart Then
arc x, y, r, raStart, _Pi(2), c
arc x, y, r, 0, raStop, c
Else
' modified to easier way suggested by Steve
'Why was the line method not good? I forgot.
al = _Pi * r * r * (raStop - raStart) / _Pi(2)
For a = raStart To raStop Step 1 / al
Circle (x + r * Cos(a), y + r * Sin(a)), 1, c '<<< modify for smile
Next
End If
End Sub
Sub FEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Move the bee around allot and things get stirred up, give it a rest and things settle down.
b = b + ...
Posts: 292
Threads: 15
Joined: Apr 2022
Reputation:
49
wow, beeutiful mod beeplus
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
Neat one, @bplus! Runs very smooth too, even on my old laptop. I'm trying to come up with a buzzing sound...
- Dav
Posts: 632
Threads: 93
Joined: Apr 2022
Reputation:
22
Very nice bplus.
But it's harder to at least, get the feel that you're winning, when you play the "CLS" game!
The more you try, the more faces appear. 
Posts: 3,885
Threads: 174
Joined: Apr 2022
Reputation:
201
(07-10-2023, 12:06 AM)PhilOfPerth Wrote: Very nice bplus.
But it's harder to at least, get the feel that you're winning, when you play the "CLS" game!
The more you try, the more faces appear.
Ah same amount of faces but they are sure in a hurry!
b = b + ...
Posts: 98
Threads: 1
Joined: Jun 2023
Reputation:
3
Dav, I enjoyed Googlyeyes.bas it ran with no problems. Keep it up!
Posts: 292
Threads: 15
Joined: Apr 2022
Reputation:
49
I have attempted a similar mod a long time ago, bplus, but I was incapable of getting it to work correctly as it can be challenging
Code: (Select All) $resize:on
deflng a-z
sw = 640
sh = 600
screen _newimage(sw,sh,32),,1,0
line (0,0)-(sw,sh),_rgb(255,255,255),bf
ellipsef sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef 3*sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
ellipsef 3*sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
screen ,,0,0
dim a as double, b as double
do
do
mx = _mousex
my = _mousey
loop while _mouseinput
if _resize then
sw = _resizewidth
sh = _resizeheight
screen ,,1,0
line (0,0)-(sw,sh),_rgb(255,255,255),bf
ellipsef sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef 3*sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
ellipsef 3*sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
screen ,,0,0
end if
pcopy 1,0
a = _atan2(sh/2 - my, sw/4 - mx)
b = _atan2(sh/2 - my, 3*sw/4 - mx)
x1 = sw/4 - 0.5*sw*cos(a)/4
y1 = sh/2 - 0.5*sh*sin(a)/2
if abs(sw/4-mx) < 0.5*sw/4 or abs(sh/2-my) < 0.5*sh/2 then
x1 = mx
y1 = my
end if
x2 = 3*sw/4 - 0.5*sw*cos(b)/4
y2 = sh/2 - 0.5*sh*sin(b)/2
if abs(3*sw/4-mx) < 0.5*sw/4 or abs(sh/2-my) < 0.5*sh/2 then
x2 = mx
y2 = my
end if
ellipsef x1, y1, 0.2*sw/4, 0.2*sh/2, _rgb(0,0,0)
ellipsef x2, y2, 0.2*sw/4, 0.2*sh/2, _rgb(0,0,0)
_display
loop until _keyhit = 27
system
sub ellipsef (x0, y0, rx, ry, c)
a = 2*rx*rx
b = 2*ry*ry
x = rx
y = 0
xx = ry*ry*(1 - 2*rx)
yy = rx*rx
e = 0
sx = b*rx
sy = 0
do while sx >= sy
line (x0 - x, y0 + y)-(x0 + x, y0 + y), c, bf
line (x0 - x, y0 - y)-(x0 + x, y0 - y), c, bf
y = y + 1
sy = sy + a
e = e + yy
yy = yy + a
if 2*e + xx > 0 then
x = x - 1
sx = sx - b
e = e + xx
xx = xx + b
end if
loop
x = 0
y = ry
xx = rx*ry
yy = rx*rx*(1 - 2*ry)
e = 0
sx = 0
sy = a*ry
do while sx <= sy
line (x0 - x, y0 - y)-(x0 + x, y0 - y), c, bf
line (x0 - x, y0 + y)-(x0 + x, y0 + y), c, bf
x = x + 1
sx = sx + b
e = e + xx
xx = xx + b
if 2*e + yy > 0 then
y = y - 1
sy = sy - a
e = e + yy
yy = yy + a
end if
loop
end sub
|
