Post by johnno56 on Nov 24, 2022 13:57:59 GMT -6
This program was found in a BBC Micro Advanced Graphics book from 1983. The user 'King Mocker' at QB64pe converted it to QB64. I thought it was cool so I converted it to RC... I have absolutely no idea if this program is useful... but here it is...
xmax = 800
ymax = 600
title$ = "Rotate and Resize Shapes"
center_x = windowpos_centered
center_y = windowpos_centered
WindowOpen(1,title$,center_x,center_y,xmax,ymax,WindowMode(1,0,0,0,0),1)
SetWindowAutoClose(1, 0)
CanvasOpen(1,xmax,ymax,0,0,xmax,ymax,0)
ClearCanvas
randomize(timer)
Dim x[30]
Dim y[30]
Dim n, xc, yc, size, i, j
Dim dx, dy, scale, maxsize, minsize, maxdxy, shape
Dim alpha, spinspeed, adif, shapecolor, k
' =================================
' Setup some default values
' =================================
xc = 300 + rand(200)
yc = 200 + rand(200)
n = 10
alpha = 0
spinspeed = 0.005
size = 150
scale = 10
minsize = 50
maxsize = 200
dx = 5 + rand(5) + 1
dy = 5 + rand(5) + 1
maxdxy = 40
shape = 1
shapecolor = rgb(240, 240, 240)
pi = 3.141592654
' =================
' Main Loop
' =================
Do
ClearCanvas
setColor(rgb(255, 255, 255))
locate(1, 1)
prints("Left/Right: Dec/Inc Spin Speed. Down/Up: Dec/Inc. size -/+: Dec/Inc # of Points")
locate(1, 2)
prints("A/D : Dec/Inc X direction W/S : Dec/Inc Y direction Space: Change Shape")
' =========================================
' Generate new points for the shape
' =========================================
adif = (2 * pi / n) + spinspeed
for i = 1 to n
x = cos(alpha) * size + xc
y = sin(alpha) * size + yc
alpha = alpha + adif
next
' ======================
' Draw the shape
' ======================
setColor(shapecolor)
for i = 1 to n - 1
for j = i + 1 to n
if shape = 1 then
line(x, y, x[j], y[j])
else
box(x, y, x[j], y[j])
end if
next
next
' ==============================
' Get new shape position
' ==============================
xc = xc + dx
yc = yc + dy
' ==========================
' Process user input
' ==========================
if key(k_up) and size >= minsize and xc >= size + scale and yc >= size + scale then
size = size - scale
end if
if key(k_down) and size <= maxsize then
if xmax - size - (2 * scale) > xc and ymax - size - (2 * scale) > yc then
if xc >= size + (2 * scale) and yc >= size + (2 * scale) then
size = size + scale
end if
end if
end if
if key(k_left) and spinspeed > -0.02 then
spinspeed = spinspeed - 0.001
end if
if key(k_right) and spinspeed < 0.02 then
spinspeed = spinspeed + 0.001
end if
k = inkey
select case k
case 97
if abs(dx) > 1 then
if abs(dx) >= 1 and abs(dx) <= maxdxy then
dx = sign(dx) * abs(dx) - (sign(dx) * 1)
end if
end if
case 100
if abs(dx) < maxdxy then
if abs(dx) >= 1 and abs(dx) <= maxdxy then
dx = sign(dx) * abs(dx) + (sign(dx) * 1)
end if
end if
case 119
if abs(dy) < maxdxy then
if abs(dy) >= 1 and abs(dy) <= maxdxy then
dy = sign(dy) * abs(dy) + (sign(dy) * 1)
end if
end if
case 115
if abs(dy) > 1 then
if abs(dy) >= 1 and abs(dy) <= maxdxy then
dy = sign(dy) * abs(dy) - (sign(dy) * 1)
end if
end if
end select
If k = 45 and n > 3 then
n = n - 1
end if
if k = 61 and n < 30 then
n = n + 1
end if
if k = 32 then
shape = shape * -1
end if
' ==========================================================
' Change direction of shape within screen boundaries
' ==========================================================
if xc > xmax - size - scale then
dx = -dx
end if
if xc < size then
dx = -dx
end if
if yc > ymax - size - scale then
dy = -dy
end if
if yc < size then
dy = -dy
end if
if Not WindowExists(1) Or WindowEvent_Close(1) Then
end
end if
update()
loop until key(27) = 1
ymax = 600
title$ = "Rotate and Resize Shapes"
center_x = windowpos_centered
center_y = windowpos_centered
WindowOpen(1,title$,center_x,center_y,xmax,ymax,WindowMode(1,0,0,0,0),1)
SetWindowAutoClose(1, 0)
CanvasOpen(1,xmax,ymax,0,0,xmax,ymax,0)
ClearCanvas
randomize(timer)
Dim x[30]
Dim y[30]
Dim n, xc, yc, size, i, j
Dim dx, dy, scale, maxsize, minsize, maxdxy, shape
Dim alpha, spinspeed, adif, shapecolor, k
' =================================
' Setup some default values
' =================================
xc = 300 + rand(200)
yc = 200 + rand(200)
n = 10
alpha = 0
spinspeed = 0.005
size = 150
scale = 10
minsize = 50
maxsize = 200
dx = 5 + rand(5) + 1
dy = 5 + rand(5) + 1
maxdxy = 40
shape = 1
shapecolor = rgb(240, 240, 240)
pi = 3.141592654
' =================
' Main Loop
' =================
Do
ClearCanvas
setColor(rgb(255, 255, 255))
locate(1, 1)
prints("Left/Right: Dec/Inc Spin Speed. Down/Up: Dec/Inc. size -/+: Dec/Inc # of Points")
locate(1, 2)
prints("A/D : Dec/Inc X direction W/S : Dec/Inc Y direction Space: Change Shape")
' =========================================
' Generate new points for the shape
' =========================================
adif = (2 * pi / n) + spinspeed
for i = 1 to n
x = cos(alpha) * size + xc
y = sin(alpha) * size + yc
alpha = alpha + adif
next
' ======================
' Draw the shape
' ======================
setColor(shapecolor)
for i = 1 to n - 1
for j = i + 1 to n
if shape = 1 then
line(x, y, x[j], y[j])
else
box(x, y, x[j], y[j])
end if
next
next
' ==============================
' Get new shape position
' ==============================
xc = xc + dx
yc = yc + dy
' ==========================
' Process user input
' ==========================
if key(k_up) and size >= minsize and xc >= size + scale and yc >= size + scale then
size = size - scale
end if
if key(k_down) and size <= maxsize then
if xmax - size - (2 * scale) > xc and ymax - size - (2 * scale) > yc then
if xc >= size + (2 * scale) and yc >= size + (2 * scale) then
size = size + scale
end if
end if
end if
if key(k_left) and spinspeed > -0.02 then
spinspeed = spinspeed - 0.001
end if
if key(k_right) and spinspeed < 0.02 then
spinspeed = spinspeed + 0.001
end if
k = inkey
select case k
case 97
if abs(dx) > 1 then
if abs(dx) >= 1 and abs(dx) <= maxdxy then
dx = sign(dx) * abs(dx) - (sign(dx) * 1)
end if
end if
case 100
if abs(dx) < maxdxy then
if abs(dx) >= 1 and abs(dx) <= maxdxy then
dx = sign(dx) * abs(dx) + (sign(dx) * 1)
end if
end if
case 119
if abs(dy) < maxdxy then
if abs(dy) >= 1 and abs(dy) <= maxdxy then
dy = sign(dy) * abs(dy) + (sign(dy) * 1)
end if
end if
case 115
if abs(dy) > 1 then
if abs(dy) >= 1 and abs(dy) <= maxdxy then
dy = sign(dy) * abs(dy) - (sign(dy) * 1)
end if
end if
end select
If k = 45 and n > 3 then
n = n - 1
end if
if k = 61 and n < 30 then
n = n + 1
end if
if k = 32 then
shape = shape * -1
end if
' ==========================================================
' Change direction of shape within screen boundaries
' ==========================================================
if xc > xmax - size - scale then
dx = -dx
end if
if xc < size then
dx = -dx
end if
if yc > ymax - size - scale then
dy = -dy
end if
if yc < size then
dy = -dy
end if
if Not WindowExists(1) Or WindowEvent_Close(1) Then
end
end if
update()
loop until key(27) = 1