Drawing Tools Subs or Functions with Demo

[bplus]

Update @James D Jarvis sorry, didn't want to look like I ignored your comment. I just don't know what to do about it. I've wasted quite some time trying to get better results off some RotoZomm images and failed. You seem to report a distortion due to increase in image size but I see Galleon code does subtract 1 from W and H when starting from 0,0 so IDK?

_________________________________________________________________________________________________________________

Plasma Laser Canon (PLC)

Code: (Select All)

_Title "Plasma Laser Cannon demo" 'b+ 2020-11-11
Screen _NewImage(1024, 700, 32)
_Delay .25
_ScreenMove _Middle
Randomize Timer

Dim Shared tx, ty, tr, tc As _Unsigned Long
newTarget
Do
    Cls
    'PRINT tx, ty, tr, tc
    drawBall tx, ty, tr, tc
    drawShip _Width / 2, _Height / 2, &HFF3366AA
    While _MouseInput: Wend 'aim with mouse
    mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
    If mb Then
        PLC _Width / 2, _Height / 2, _MouseX, _MouseY, tr
        _Display
    End If
    If _Hypot(mx - tx, my - ty) < tr And mb Then
        For r = 0 To 255
            fcirc tx, ty, r, _RGBA32(255, 255 - r, 0, 10)
            _Display
            _Limit 400
        Next
        newTarget
    End If
    If InKey$ = " " Then newTarget
    _Display
    _Limit 60
Loop Until _KeyDown(27)

Sub newTarget
    If Rnd < .5 Then
        If Rnd < .5 Then tx = Rnd * 200 + 50 Else tx = _Width - 250 + Rnd * 200
        ty = Rnd * (_Height - 100) + 50
    Else
        If Rnd < .5 Then ty = Rnd * 200 + 50 Else ty = _Height - 250 + Rnd * 100
        tx = Rnd * (_Width - 100) + 50
    End If
    tr = Rnd * 50 + 20
    tc = _RGB32(60 + Rnd * 195, Rnd * 255, Rnd * 255)
End Sub

Sub PLC (baseX, baseY, targetX, targetY, targetR) ' PLC for PlasmaLaserCannon
    r = Rnd ^ 2 * Rnd: g = Rnd ^ 2 * Rnd: b = Rnd ^ 2 * Rnd: hp = _Pi(.5) ' red, green, blue, half pi
    ta = _Atan2(targetY - baseY, targetX - baseX) ' angle of target to cannon base
    dist = _Hypot(targetY - baseY, targetX - baseX) ' distance cannon to target
    dr = targetR / dist
    For r = 0 To dist Step .25
        x = baseX + r * Cos(ta)
        y = baseY + r * Sin(ta)
        c = c + .3
        fcirc x, y, dr * r, _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
    Next
    For rr = dr * r To 0 Step -.5
        c = c + 1
        fcirc x, y, rr, _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
    Next
End Sub

Sub drawBall (x, y, r, c As _Unsigned Long)
    Dim rred As Long, grn As Long, blu As Long, rr As Long, f
    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
    For rr = r To 0 Step -1
        f = 1 - rr / r
        fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)
    Next
End Sub

Sub drawShip (x, y, colr As _Unsigned Long) 'shipType     collisions same as circle x, y radius = 30
    Static ls
    Dim light As Long, r As Long, g As Long, b As Long
    r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
    fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
    fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
    fellipse x, y, 30, 7, _RGB32(r, g, b)
    For light = 0 To 5
        fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
    Next
    ls = ls + 1
    If ls > 5 Then ls = 0
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

'vince version  fill circle x, y, radius, color
Sub vfcirc (x As Long, y As Long, R As Long, C As _Unsigned Long)
    Dim x0 As Long, y0 As Long, e As Long
    x0 = R: y0 = 0: e = 0
    Do While y0 < x0
        If e <= 0 Then
            y0 = y0 + 1
            Line (x - x0, y + y0)-(x + x0, y + y0), C, BF
            Line (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        Else
            Line (x - y0, y - x0)-(x + y0, y - x0), C, BF
            Line (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1: e = e - 2 * x0
        End If
    Loop
    Line (x - R, y)-(x + R, y), C, BF
End Sub

'from Steve Gold standard
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

A little fun! Along with code for the PLC you get my famous space ship drawing sub.