Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Is there a faster way to do this glow circle effect?
#1
Trying to make a glow/spotlight effect where only the circle area of the screen where the mouse is at shows.  This works but it lags pretty bad on my laptop.  The circle draws are the slow down.  Is there a better way to do this effect?  I remember someone at the old forum posted an effect like this, but I forget who it was.

- Dav

Code: (Select All)

Screen _NewImage(1000, 700, 32)

'draw a background
For x = 0 To _Width Step 25
    For y = 0 To _Height Step 25
        Line (x, y)-Step(25, 25), _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, 150), BF
    Next
Next

'copy screen as image
back& = _CopyImage(_Display)

Do

    'get mouse input
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY

    'place background first
    _PutImage (0, 0), back&

    'draw fadeout circle where mouse x/y is
    For x = 0 To _Height * 2 Step .333
        Circle (mx, my), x, _RGBA(0, 0, 0, x / 1.9)
    Next

    _Display
    _Limit 30

Loop Until InKey$ <> ""

Find my programs here in Dav's QB64 Corner
Reply
#2
Right after I posted that I got an idea, this method is much faster because I don't have to use CIRCLE to darken the entire image, only the mouse area.

- Dav

Code: (Select All)

Screen _NewImage(1000, 700, 32)

'draw a background
For x = 0 To _Width Step 25
    For y = 0 To _Height Step 25
        Line (x, y)-Step(25, 25), _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, 150), BF
    Next
Next

back& = _CopyImage(_Display) 'image to use
work& = _CopyImage(_Display) 'work screen
area& = _NewImage(600, 600, 32) 'faded area image

Do

    'get mouse input
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY

    'point to the work screen
    _Dest work&

    'place background first
    _PutImage (0, 0), back&
    'draw fadeout circle where mouse x/y is
    For x = 0 To 450 Step .333
        Circle (mx, my), x, _RGBA(0, 0, 0, x / 1.9)
    Next
    'put changed part of work screen into area&
    _PutImage (0, 0), work&, area&, (mx - 300, my - 300)-(mx + 300, my + 300)

    'go back to main screen
    _Dest 0
    'clear it
    Line (0, 0)-(_Width, _Height), _RGB(0, 0, 0), BF

    'put faded area& onto screen
    _PutImage (mx - 300, my - 300), area&

    _Display
    _Limit 30

Loop Until InKey$ <> ""

Find my programs here in Dav's QB64 Corner
Reply
#3
faster? better light for sure
Code: (Select All)
_Title "text over search light, move mouse wheel" 'started 2019-04-21 B+

Const xmax = 800
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove _Middle
Dim txt(1 To 37) As String, v(1 To 37)
For i = 1 To 37
    b$ = ""
    For j = 1 To 100
        b$ = b$ + Chr$(Int(Rnd * 96) + 32)
    Next
    txt(i) = b$: v(i) = Int(Rnd * 3) + 1
Next
r = 100
Color _RGB32(40, 20, 10), _RGBA32(0, 0, 0, 40)
While _KeyDown(27) = 0
    Cls
    Do While _MouseInput
        r = r + _MouseWheel
    Loop
    mx = _MouseX: my = _MouseY
    For i = r To 0 Step -1
        fcirc mx, my, i, _RGB((r - i) ^ 1.2 / r * 255, (r - i) / r * 255, (r - i) / r * 255)
    Next
    For i = 1 To 37
        txt(i) = Mid$(txt(i), v(i)) + Mid$(txt(i), 1, v(i) - 1)
        Locate i, 1: Print Mid$(txt(i), 1, 100);
    Next
    _Display
    _Limit 5
Wend

Sub fcirc (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
    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
b = b + ...
Reply
#4
Instead of drawing the circles over and over again I converted that into a light source image.

(you can remove that PCOPY 0, 1. That was another approach I was playing with, forgot to delete line)
Code: (Select All)

SCREEN _NEWIMAGE(1000, 700, 32)

'draw a background
FOR x = 0 TO _WIDTH STEP 25
    FOR y = 0 TO _HEIGHT STEP 25
        LINE (x, y)-STEP(25, 25), _RGBA(RND * 255, RND * 255, RND * 255, 150), BF
    NEXT
NEXT
PCOPY 0, 1

'draw a light source
light& = _NEWIMAGE(900, 900, 32)
_DEST light&
FOR x = 0 TO 450 STEP .333
    CIRCLE (449, 449), x, _RGBA(0, 0, 0, x / 1.9)
NEXT

_DEST 0

back& = _COPYIMAGE(_DISPLAY) 'image to use
work& = _COPYIMAGE(_DISPLAY) 'work screen
area& = _NEWIMAGE(600, 600, 32) 'faded area image

DO

    'get mouse input
    WHILE _MOUSEINPUT: WEND
    mx = _MOUSEX: my = _MOUSEY

    'point to the work screen
    _DEST work&

    'place background first
    _PUTIMAGE (0, 0), back&

    'place light source
    _PUTIMAGE (mx - 450, my - 450), light&

    'draw fadeout circle where mouse x/y is
    'FOR x = 0 TO 450 STEP .333
    '    CIRCLE (mx, my), x, _RGBA(0, 0, 0, x / 1.9)
    'NEXT

    'put changed part of work screen into area&
    _PUTIMAGE (0, 0), work&, area&, (mx - 300, my - 300)-(mx + 300, my + 300)

    'go back to main screen
    _DEST 0
    'clear it
    LINE (0, 0)-(_WIDTH, _HEIGHT), _RGB(0, 0, 0), BF

    'put faded area& onto screen
    _PUTIMAGE (mx - 300, my - 300), area&

    _DISPLAY
    _LIMIT 30

LOOP UNTIL INKEY$ <> ""
There are two ways to write error-free programs; only the third one works.
QB64 Tutorial
Reply
#5
here it is with no fade, like laser spot light
Code: (Select All)
Screen _NewImage(1000, 700, 32)

'draw a background
For x = 0 To _Width Step 25
    For y = 0 To _Height Step 25
        Line (x, y)-Step(25, 25), _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, 150), BF
    Next
Next

back& = _CopyImage(_Display) 'image to use

rsearch = 100

Do
    Cls
    _PutImage , back&, 0

    'get mouse input
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY

    'point to the work screen
    If work& Then _FreeImage work&
    work& = _NewImage(_Width, _Height, 32) 'faded area image
    _Dest work&

    'place background first
    Circle (mx, my), rsearch, _RGB32(0, 0, 0)
    If mx < 2 * rsearch And my < 2 * rsearch Then
        Paint (_Width - 1, _Height - 1), _RGB32(0, 0, 0), _RGB32(0, 0, 0)
    Else
        Paint (0, 0), _RGB32(0, 0, 0), _RGB32(0, 0, 0)
    End If

    'go back to main screen
    _Dest 0

    'put faded area& onto screen
    _PutImage , work&, 0

    _Display
    _Limit 30

Loop Until InKey$ <> ""
b = b + ...
Reply
#6
The fastest method is to create a virtual screen with transparency using CIRCLE and PAINT and then use PUTIMAGE to insert this image into the target area, instead of having to draw it all the time. The same is for foreground, draw it once and then place both images to screen, image with transparency to mouse location.


Reply
#7
How about something like this:

Code: (Select All)
SCREEN _NEWIMAGE(1000, 700, 32)

'draw a background
FOR x = 0 TO _WIDTH STEP 25
    FOR y = 0 TO _HEIGHT STEP 25
        LINE (x, y)-STEP(25, 25), _RGBA(RND * 255, RND * 255, RND * 255, 150), BF
    NEXT
NEXT

'copy screen as image
back& = _COPYIMAGE(_DISPLAY)

DO

    'get mouse input
    WHILE _MOUSEINPUT: WEND
    mx = _MOUSEX: my = _MOUSEY

    'place background first
    _PUTIMAGE (0, 0), back&

    'draw fadeout circle where mouse x/y is
    FadeCircle mx, my
    _DISPLAY
    _LIMIT 30

LOOP UNTIL INKEY$ <> ""


SUB FadeCircle (mx, my)
    STATIC CircleImage, FadeScreen, wide2
    IF CircleImage = 0 THEN
        wide = 450: wide2 = wide / 2
        CircleImage = _NEWIMAGE(wide, wide, 32)
        FadeScreen = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
        d = _DEST
        _DEST CircleImage
        CLS , _RGB32(0, 0, 0)
        _DONTBLEND
        FOR i = 0 TO wide2 STEP .333
            CIRCLE (wide2, wide2), i, _RGBA32(0, 0, 0, i * (255 / wide2))
        NEXT
        _DEST d
    END IF
    CLS , _RGB32(0, 0, 0), FadeScreen
    _PUTIMAGE (mx - wide2, my - wide2), CircleImage, FadeScreen
    _PUTIMAGE , FadeScreen
END SUB

Predraw the faded circle.   Then just put that faded circle on a black screen, and then put that completed screen over your display.

This shouldn't take a lot of time of process.  At it's heart, it's nothing more than a CLS and 2 _PUTIMAGE commands at work, after the initial first call.

(Note that you can simply change the variable "WIDE" in the sub, if you want to change the size of the lightsource.  )
Reply
#8
Cool!  You guys posted some great methods.   I'll be tinker with these.  Thank you!

I'm attempting to make an 'Escape the room' type of game, needed a flashlight kind of effect like this - until the player finds/turns on the room light switch.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#9
(06-16-2024, 05:15 PM)Dav Wrote: Cool!  You guys posted some great methods.   I'll be tinker with these.  Thank you!

I'm attempting to make an 'Escape the room' type of game, needed a flashlight kind of effect like this - until the player finds/turns on the room light switch.

- Dav

With the method I shared, I'd create a couple of static circle images, of various widths.   Then a SELECT CASE down at the end of that SUB where you can choose which one to use with the black screen...  One for a small candle flame.  A larger one for a lantern.  An even larger one for an industrial flashlight..  Then the player can acquire larger lightsources to make the darkness less intimidating over time.  Smile
Reply
#10
Good idea.  Nice little SUB you put together.

EDIT:  Gave it a flickering effect by doing 'wide = 350 + Int(Rnd * 100)'.  (commenting out the  'If CircleImage = 0 Then.. above it).  Worked swell.  Will be good for a candle.

- Dav

Find my programs here in Dav's QB64 Corner
Reply




Users browsing this thread: 3 Guest(s)