05-01-2023, 08:50 PM
Nothing all that fancy just playing doodling with code.
Twirly uses WASD and a couple other keys to alter the generated image
Kzoom just started with me wondering about using rotozoom to alter an image.
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 SubKzoom 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