QB64 Phoenix Edition
Graphics doodling. - 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: Graphics doodling. (/showthread.php?tid=1652)

Graphics doodling. - James D Jarvis - 05-01-2023

Nothing all that fancy just playing doodling with code.

Twirly uses WASD and a couple other keys to alter the generated image
Code: (Select All)
'Twirly
Screen _NewImage(800, 500, 32)
ib& = _NewImage(800, 500, 32)
Dim klr As _Unsigned Long
Randomize Timer
cx = 400
cy = 250
id = 0
rtn = 0
Do
    _Limit 20
    For n = 1 To Int(1 + Rnd * 8)
        px = Int(1 + Rnd * 400) / Int(1 + Rnd * 8)
        py = Int(1 + Rnd * 250) / Int(1 + Rnd * 4)
        cd = Int(1 + Rnd * 6)
        klr = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
        Circle (cx + px, cy + py), cd, klr
        Circle (cx + px, cy - py), cd, klr
        Circle (cx - px, cy + py), cd, klr
        Circle (cx - px, cy - py), cd, klr
    Next n

    _PutImage (0, 0)-(799, 499), 0, ib&, (id, id)-(799 - id, 499 - id)
    RotoZoom_jan23 cx, cy, ib&, 1, 1, rtn

    'Do
    kk$ = InKey$
    Select Case kk$
        Case "W", "w" 'move center up
            cy = cy - 1
        Case "S", "s" 'move center down
            cy = cy + 1
        Case "A", "a" 'move center left
            cx = cx - 1
        Case "D", "d" 'move center right
            cx = cx + 1
        Case "Z", "z" 'zoom in
            id = id + 1
        Case "X", "x" 'zoom out
            id = id - 1
        Case "Q", "q" 'rotate
            rtn = rtn - 1
        Case "E", "e" 'counter-rotate
            rtn = rtn + 1
        Case "O", "o" 'return to center of screen
            rtn = 0
            id = 0
            cx = 400
            cy = 250
    End Select
    _Display
    'Loop Until kk$ <> ""
Loop Until kk$ = Chr$(27)




Sub RotoZoom_jan23 (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
    Dim px(3) As Single: Dim py(3) As Single
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2 * xScale: py(0) = -H& / 2 * yScale: px(1) = -W& / 2 * xScale: py(1) = H& / 2 * yScale
    px(2) = W& / 2 * xScale: py(2) = H& / 2 * yScale: px(3) = W& / 2 * xScale: py(3) = -H& / 2 * yScale
    sinr! = Sin(-0.01745329 * Rotation): cosr! = Cos(-0.01745329 * Rotation)
    For i& = 0 To 3
        ' x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (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


Kzoom just started with me wondering about using rotozoom to alter an image. 
Code: (Select All)
'kzoom
Screen _NewImage(800, 500, 32)
ti& = _NewImage(800, 500, 32)
'pres esc to exit
Dim klr As _Unsigned Long
maxx = 1600
maxy = 1000
dw = 0
cx = 400
cy = 250
cdx = -1
cdy = -1
Randomize Timer
sc = 1
Window (-maxx, -maxy)-(maxx, maxy)
Do
    _Limit 8000
    px = Int(Rnd * 200)
    py = Int(Rnd * 200)
    klr = _RGB32(rr, gg, bb)
    rr = rr + 1
    If rr = 256 Then
        rr = Int(Rnd * 32)
        gg = gg + 1
    End If
    If gg = 256 Then
        gg = Int(Rnd * 32)
        bb = bb + 1
    End If
    If bb = 256 Then bb = Int(Rnd * 32)
    PSet (px, py), klr
    PSet (-px, py), klr
    PSet (-px, -py), klr
    PSet (px, -py), klr
    ' If Rnd * 10000 < 2 Then
    'd = Int(Rnd * maxy)
    'Circle (px, py), d, klr
    'Circle (-px, py), d, klr
    ' Circle (px, -py), d, klr
    'Circle (-px, -py), d, klr
    'End If

    c = c + 1
    If c = 2 Then
        ox = maxx - 4
        oy = maxy - 4
        Select Case dw
            Case 0
                maxx = maxx - 1
                maxy = maxy - 1
                If maxy < 10 Then dw = 1
            Case 1
                maxx = maxx + 1
                maxy = maxy + 1
                If maxy > 10000 Then dw = 0

        End Select
        Window (-maxx, -maxy)-(maxx, maxy)
        _PutImage , 0, ti&, (-ox, -oy)-(ox, oy)
        c = 0
    End If
    rc = rc + 1
    If rc = 1000 Then
        rot = rot + .1
        If rot > 1440 Then rot = 0
        rc = 0
        _PutImage , 0, ti&
        RotoZoom23d cx, cy, ti&, sc, sc, rot
        sc = sc * 1.001
        If sc > 4 Then sc = 1
        cx = cx + .01 * cdx
        cy = cy + .01 * cdy
        If Rnd * 8 < 2 Then cdx = cdx * -1
        If Rnd * 8 < 2 Then cdy = cdy * -1
    End If
    _Display
    ' If Rnd * 9000 < 1 Then Line (0, 0)-(maxx, Int(Rnd * maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    'If Rnd * 9000 < 1 Then Line (0, 0)-(maxx, Int(Rnd * -maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    'If Rnd * 9000 < 1 Then Line (0, 0)-(-maxx, Int(Rnd * -maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    ' If Rnd * 9000 < 1 Then Line (0, 0)-(-maxx, Int(Rnd * maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    kk$ = InKey$

Loop Until kk$ = Chr$(27)



Sub RotoZoom23d (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
    Dim px(3) As Single: Dim py(3) As Single
    Wi& = _Width(Image&): Hi& = _Height(Image&)
    W& = Wi& / 2 * xScale
    H& = Hi& / 2 * yScale
    px(0) = -W&: py(0) = -H&: px(1) = -W&: py(1) = H&
    px(2) = W&: py(2) = H&: px(3) = W&: py(3) = -H&
    sinr! = Sin(-0.01745329 * Rotation): cosr! = Cos(-0.01745329 * Rotation)
    For i& = 0 To 3
        ' x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    '_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    ' _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))


    _MapTriangle (0, 0)-(0, Hi& - 1)-(Wi& - 1, Hi& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(Wi& - 1, 0)-(Wi& - 1, Hi& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub


RE: Graphics doodling. - bplus - 05-02-2023

Thanks for filling dry spell in code postings.

Reminds me of a road in West Virginia:

RE: Graphics doodling. - James D Jarvis - 05-02-2023

I was working on a complicated linked list data structure for inventory management in an RPG and just wanted to have a little fun with my computer for a few hours. I just love how well qb64 works with shuffling graphics on modern hardware.

RE: Graphics doodling. - bplus - 05-02-2023

Yeah sometimes coders just wanna have fun!