QB64 Phoenix Edition
Googly Eyes looking around screen - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Googly Eyes looking around screen (/showthread.php?tid=1085)

Pages: 1 2

RE: Googly Eyes looking around screen - bplus - 11-10-2022

Fix Pete up!

Code: (Select All)
_Title "Mouse school of critters - Click to toggle Mouse as Predator or Prey    by bplus 2018-04-27"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'from: Mouse school critters separated.txt for JB 2.0 B+ 2018-04-24
'2018-04-27 update for Predator / Prey Toggle with Click

Const xmax = 1200
Const ymax = 700
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 100, 40
Randomize Timer
Dim Shared qb(15)
qb(0) = &HFF000000
qb(1) = &HFF000088
qb(2) = &HFF008800
qb(3) = &HFF008888
qb(4) = &HFF880000
qb(5) = &HFF880088
qb(6) = &HFF888800
qb(7) = &HFFCCCCCC
qb(8) = &HFF888888
qb(9) = &HFF0000FF
qb(10) = &HFF00FF00
qb(11) = &HFF00FFFF
qb(12) = &HFFFF0000
qb(13) = &HFFFF00FF
qb(14) = &HFFFFFF00
qb(15) = &HFFFFFFFF

na = 50
Dim Shared x(na), y(na), v(na), r(na), c(na), predator
For i = 1 To na
    x(i) = rand(0, xmax)
    y(i) = rand(0, ymax)
    rr = Int(Rnd * 15)
    v(i) = rr * 1
    r(i) = rand(10, 30)
    c(i) = qb(rr)
Next

While 1
    Cls
    If InKey$ = "q" Then End
    For i = 1 To na
        m = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        If mb Then
            While mb
                m = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
                _Limit 200
            Wend
            If predator Then predator = 0 Else predator = 1
        End If

        'radian angle to mouse
        ra = _Atan2(my - y(i), mx - x(i)) '  + pi kind of interesting too
        'draw it
        critter i, ra

        'separate critters for next frame and further down i line
        For j = i + 1 To na

            ' The following is STATIC's adjustment of ball positions if overlapping
            ' before calcultion of new positions from collision
            ' Displacement vector and its magnitude.  Thanks STxAxTIC !
            nx = x(j) - x(i)
            ny = y(j) - y(i)
            nm = Sqr(nx ^ 2 + ny ^ 2)
            If nm < 10 + r(i) + r(j) Then
                nx = nx / nm
                ny = ny / nm

                ' Regardless of momentum exchange, separate the balls along the lone connecting them.
                While nm < 10 + r(i) + r(j)

                    flub = 10 '  massively increased for JB to speed up code

                    x(j) = x(j) + flub * nx
                    y(j) = y(j) + flub * ny

                    x(i) = x(i) - flub * nx
                    y(i) = y(i) - flub * ny

                    nx = x(j) - x(i)
                    ny = y(j) - y(i)
                    nm = Sqr(nx ^ 2 + ny ^ 2)
                    nx = nx / nm
                    ny = ny / nm
                Wend
            End If
        Next
        If predator Then
            x(i) = x(i) + v(i) * Cos(ra + _Pi)
            y(i) = y(i) + v(i) * Sin(ra + _Pi)
        Else
            x(i) = x(i) + v(i) * Cos(ra)
            y(i) = y(i) + v(i) * Sin(ra)
        End If
    Next
    _Display
    _Limit 20
Wend

Sub critter (i, ra)
    Color c(i)
    fcirc x(i), y(i), r(i)
    If predator Then
        x1 = x(i) + .75 * r(i) * Cos(ra - _Pi(1 / 9) + _Pi)
        y1 = y(i) + .75 * r(i) * Sin(ra - _Pi(1 / 9) + _Pi)
        x2 = x(i) + .75 * r(i) * Cos(ra + _Pi(1 / 9) + _Pi)
        y2 = y(i) + .75 * r(i) * Sin(ra + _Pi(1 / 9) + _Pi)
    Else
        x1 = x(i) + .75 * r(i) * Cos(ra - _Pi(1 / 9))
        y1 = y(i) + .75 * r(i) * Sin(ra - _Pi(1 / 9))
        x2 = x(i) + .75 * r(i) * Cos(ra + _Pi(1 / 9))
        y2 = y(i) + .75 * r(i) * Sin(ra + _Pi(1 / 9))
    End If
    Color qb(15)
    fcirc x1, y1, .25 * r(i)
    fcirc x2, y2, .25 * r(i)
    If predator Then
        x3 = x1 + .125 * r(i) * Cos(ra + _Pi)
        y3 = y1 + .125 * r(i) * Sin(ra + _Pi)
        x4 = x2 + .125 * r(i) * Cos(ra + _Pi)
        y4 = y2 + .125 * r(i) * Sin(ra + _Pi)
    Else
        x3 = x1 + .125 * r(i) * Cos(ra)
        y3 = y1 + .125 * r(i) * Sin(ra)
        x4 = x2 + .125 * r(i) * Cos(ra)
        y4 = y2 + .125 * r(i) * Sin(ra)
    End If
    Color qb(0)
    fcirc x3, y3, .125 * r(i)
    fcirc x4, y4, .125 * r(i)
End Sub

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): 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), , 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), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function


RE: Googly Eyes looking around screen - Gadgetjack - 11-10-2022

I like that a lot!! Great work.

RE: Googly Eyes looking around screen - bplus - 11-10-2022

Thanks Mr Gadget! That's how I started my Boids series, check it out on Internet.

RE: Googly Eyes looking around screen - Pete - 11-10-2022

Yikes! Carni-balls!

Pete