+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Drawing Tools Subs or Functions with Demo (/showthread.php?tid=272)
RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-07-2024
(09-07-2024, 12:51 AM)bplus Wrote: @TerryRitchie the escape worked fine in your demo but when I tried
while _keydown(27) = 0
to loop the rotation of the checkered glode it would not draw anytyhing.
This is my mod of your code included in the zip. I rotated the checkered globe like the first worldmap globe to check speed for one thing and to see how easy it was to adopt your version image2sphere for another reason.
The checkerboard image is square. If you want to rotate it you'll need to change the code to make the image twice as wide.
Edit: oops, that's only if you need something like a globe of Mars or Earth for instance. Never mind, getting late, tired.
RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-09-2024
I have dived deeper into this rabbit hole and come up with even faster (much faster) code for the fake sphere mapping.
This time the code creates a precalculated x coordinate translation array which removes the need to calculate latitude and longitude coordinates every time the sphere is redrawn. Next, the translation array and images are all handled in memory using _MEM commands for speed.
I'm getting very close to 100 frames per second rotating a 953x953 sphere!
I'm exploring ways of turning this proof on concept code into a workable subroutine or function.
The downside to this approach is that the map image needs to be doubled in width. Essentially two of the images need to be next to each other since there is no way to do what MOD is performing in the previous code above. I'm exploring ways of overcoming this as well, perhaps through some clever memory address manipulation.
The ZIP file below contains the world map image that is 954 pixels high.
Code: (Select All)
' Fake Sphere Mapping
'
' Proof of concept using a precalculated x coordinate translation array and _MEM memory buffers.
' This demo achieves almost 100 frames per second creating and rotating a 953x953 spehere.
' This was achieved on an older test system running an i7-6700K at 4Ghz.
' Results on more modern equipment should be even more impressive.
OPTION _EXPLICIT
DIM imageWidth AS INTEGER ' width of initial image
DIM imageHeight AS INTEGER ' height of initial image
DIM baseImage AS LONG ' initial image (temporary)
DIM image AS LONG ' working image (2 base images next to each other)
DIM sphere AS LONG ' output image
DIM Mapx AS INTEGER ' calculation map x coordinate
DIM x AS INTEGER ' horizontal counter
DIM y AS INTEGER ' vertical counter
DIM xOffset AS INTEGER ' horizontal drawing offset within image
DIM mMap AS _MEM ' texture map x coordinate array
DIM mMapOffset AS _OFFSET ' memory location of calculation map array
DIM mImage AS _MEM ' image array
DIM mImageOffset AS _OFFSET ' memory location of image array
DIM mSphere AS _MEM ' sphere output image array
DIM mSphereOffset AS _OFFSET ' memory location of sphere output image array
DIM Pixel AS _UNSIGNED LONG ' image pixel
baseImage = _LOADIMAGE("worldmap2.png", 32) ' load image to map
imageWidth = _WIDTH(baseImage) ' record image width
imageHeight = _HEIGHT(baseImage) ' record image height
image = _NEWIMAGE(imageWidth * 2, imageHeight, 32) ' create texture image (2 base images side by side)
_PUTIMAGE (0, 0), baseImage, image ' draw first image onto texture image
_PUTIMAGE (imageWidth, 0), baseImage, image ' draw second image onto texture image
_FREEIMAGE baseImage ' map image no longer needed
mImage = _MEMIMAGE(image) ' create image array in memory from texture image
sphere = _NEWIMAGE(imageHeight, imageHeight, 32) ' create image array in memory from output image
mMap = _MEMNEW(imageHeight * imageHeight * 2) ' create texture map x coordinate array in memory
mSphere = _MEMIMAGE(sphere) ' create sphere array in memory
SCREEN _NEWIMAGE(imageHeight, imageHeight, 32) ' screen same height as output image
initMapPos ' create texture map x coordinate array
xOffset = 0 ' reset image x offset
DO ' begin demo
$CHECKING:OFF
y = 0 ' reset vertical counter
DO ' begin vertical loop
mMapOffset = mMap.OFFSET + (y * imageHeight * 2) ' start memory location of horizontal line within map
mSphereOffset = mSphere.OFFSET + (y * imageHeight * 4) ' start memory location of horizontal line within sphere
mImageOffset = mImage.OFFSET + (y * imageWidth * 8) ' start memory location of horizontal line within image
x = 0 ' reset horizontal counter
DO ' begin horizontal loop
_MEMGET mMap, mMapOffset + (x * 2), Mapx ' get x texture coordinate
IF Mapx <> -1 THEN ' valid coordinate?
_MEMGET mImage, mImageOffset + (Mapx + xOffset) * 4, Pixel ' yes, get pixel from image
_MEMPUT mSphere, mSphereOffset + (x * 4), Pixel ' apply pixel to output image
END IF
x = x + 1 ' increment horizontal counter
LOOP UNTIL x = imageHeight ' leave when entire horizontal line processed
y = y + 1 ' increment vertical counter
LOOP UNTIL y = imageHeight ' leave when entire vertical line processed
xOffset = xOffset + 1 ' increment image x offset
IF xOffset > imageWidth - 1 THEN xOffset = 0 ' reset image x offset when needed
_PUTIMAGE (0, 0), sphere ' display output image
_DISPLAY ' update screen with changes
'_LIMIT 60
$CHECKING:ON
LOOP UNTIL _KEYDOWN(27) ' leave demo when ESC pressed
_MEMFREE mMap ' free memory assets
_MEMFREE mSphere
_MEMFREE mImage
_FREEIMAGE image ' free image assets
_FREEIMAGE sphere
SYSTEM ' return to operating system
'-----------------------------------------------------------------------------------------------------------------------------------------+
SUB initMapPos () ' |
'+------------------------------------------------------------------------------------------------------------------------------------+
'| Create an x coordinate translation array so latitude and longitude calculations only need to be peformed once. |
'+------------------------------------------------------------------------------------------------------------------------------------+
CONST HALFPI = _PI * .5 ' half of Pi
CONST rPI = 1 / _PI ' Pi reciprocated
SHARED imageWidth AS INTEGER ' need width of image
SHARED imageHeight AS INTEGER ' need height of image
SHARED mMap AS _MEM ' need access to texture map x coordinate array
DIM radius AS SINGLE ' sphere radius
DIM Index AS _UNSIGNED LONG ' array memory offset for each value
DIM sLongitude AS SINGLE ' sine longitude calculation
DIM longitude AS SINGLE ' longitude calculation
DIM x AS INTEGER ' horizontal counter
DIM y AS INTEGER ' vertical counter
radius = imageHeight * .5 ' calculate sphere radius
y = 0 ' reset vertical counter
DO ' begin vetical loop
x = 0 ' reset horizontal counter
DO ' begin horizontal loop
Index = (y * imageHeight + x) * 2 ' value memory location
sLongitude = (x - radius) / (radius * COS(_ASIN((y - radius) / radius))) ' calculate sine longitude of pixel
IF sLongitude >= -1 AND sLongitude <= 1 THEN ' is pixel inside the circle?
longitude = _ASIN(sLongitude) + HALFPI ' yes, complete longitude calculation
_MEMPUT mMap, mMap.OFFSET + Index, (longitude * imageWidth * .5) * rPI AS INTEGER ' store corresponding image x coordinate
ELSE ' no, pixel is outside of circle
_MEMPUT mMap, mMap.OFFSET + Index, -1 AS INTEGER ' mark x coordinate as outside of circle
END IF
x = x + 1 ' increment horizontal counter
LOOP UNTIL x = imageHeight ' leave when entire horizontal line processed
y = y + 1 ' increment vertical counter
LOOP UNTIL y = imageHeight ' leave when entire vertical line processed
END SUBRE: Drawing Tools Subs or Functions with Demo - vince - 09-11-2024
check out this mod, B+, drag mouse and use mousewheel
Code: (Select All)
defdbl a-z
dim shared pi, p, q, uu, vv
zoom = 200
sw = 800
sh = 600
screen _newimage(sw, sh, 32)
img = _loadimage("bluemarble_small.png")
w = _width(img)
h = _height(img)
pi = 4*atn(1)
du = 2*pi/24
dv = pi/14
vv = -pi/6
drag = 0
_source img
_dest 0
do
oz = zoom
do
mx = _mousex
my = _mousey
mb = _mousebutton(1)
zoom = zoom - 10*_mousewheel
loop while _mouseinput
cls
'uu = uu + 0.01
'vv = vv + 0.01
if mb and drag = 1 then
uu = (-mx - omx)*pi/sh
vv = (my - omy)*pi/sh
end if
if mb and drag = 0 then
omx = mx
omy = my
drag = 1
end if
if mb = 0 and drag = 1 then
drag = 0
end if
for v=-pi/2 to pi/2 step 3/zoom
for u=0 to 2*pi step 3/zoom
r = cos(v)
z = sin(v)
x = r*cos(u)
y = r*sin(u)
xx = x
yy = y
zz = z
rotz x,y,z,uu
rotx x,y,z,vv
sx = 0
sy = -1
sz = 0
proj xx, yy, zz
pp = sw/2 + zoom*p
qq = sh/2 - zoom*q
if pp>0 and pp<sw and qq>0 and qq<sh then
if (x*sx + y*sy + z*sz) < 0 then
dim c as _unsigned long
cx = (w*u/(2*pi) ) mod w
cy = (h - h*(v + pi/2)/pi ) mod h
c = point(cx, cy)
pset (sw/2 + zoom*p, sh/2 - zoom*q), c
end if
end if
next
next
if drag or (zoom <> oz) then
for v=0 to 2*pi step dv
for u=0 to 2*pi step du
r = cos(v)
z = sin(v)
x = r*cos(u)
y = r*sin(u)
rotz x,y,z,uu
rotx x,y,z,vv
sx = 0
sy = -1
sz = 0
color _rgb(100,100,100)
if (x*sx + y*sy + z*sz) < 0 then
r = cos(v)
proj r*cos(u), r*sin(u), sin(v)
pset (sw/2 + zoom*p, sh/2 - zoom*q)
proj r*cos(u + du), r*sin(u + du), sin(v)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
r = cos(v + dv)
proj r*cos(u + du), r*sin(u + du), sin(v + dv)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
proj r*cos(u), r*sin(u), sin(v + dv)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
r = cos(v)
proj r*cos(u), r*sin(u), sin(v)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
end if
next
next
end if
_limit 30
_display
loop until _keyhit = 27
sleep
system
sub proj(x, y, z)
'p = x + 0.707*y
'q = z + 0.707*y
rotz x,y,z,uu
rotx x,y,z,vv
d = 10
p = x*d/(10 + y)
q = z*d/(10 + y)
end sub
sub rotx(x, y, z, a)
xx = x
yy = y*cos(a) - z*sin(a)
zz = y*sin(a) + z*cos(a)
x = xx
y = yy
z = zz
end sub
sub roty(x, y, z, a)
xx = x*cos(a) + z*sin(a)
yy = y
zz = -x*sin(a) + z*cos(a)
x = xx
y = yy
z = zz
end sub
sub rotz(x, y, z, a)
xx = x*cos(a) - y*sin(a)
yy = x*sin(a) + y*cos(a)
zz = z
x = xx
y = yy
z = zz
end sub
RE: Drawing Tools Subs or Functions with Demo - bplus - 09-11-2024
+1 @vince allot of nice features you have, rotate glode all 3 axis and use mousewheel to expand and shrink. All the black lines and interferrence patterns detract from image though:
I tried Worldmap image from our previous posts, true the image does not have great contrast but lines drown image:
Wait... did that get reversed???
RE: Drawing Tools Subs or Functions with Demo - vince - 09-11-2024
maybe try this mod, B+
Code: (Select All)
defdbl a-z
dim shared pi, p, q, uu, vv
zoom = 350
sw = 1024
sh = 768
screen _newimage(sw, sh, 32)
img = _loadimage("bluemarble_small.png")
'img = _loadimage("mars_huge.png")
w = _width(img)
h = _height(img)
pi = 4*atn(1)
du = 2*pi/24
dv = pi/14
uu = pi
vv = -pi/6
drag = 0
_source img
_dest 0
do
oz = zoom
do
mx = _mousex
my = _mousey
mb = _mousebutton(1)
zoom = zoom - 10*_mousewheel
loop while _mouseinput
cls
'uu = uu + 0.01
'vv = vv + 0.01
if mb and drag = 1 then
uu = (-mx - omx)*pi/sh
vv = (my - omy)*pi/sh
end if
if mb and drag = 0 then
omx = mx
omy = my
drag = 1
end if
if mb = 0 and drag = 1 then
drag = 0
end if
for v=-pi/2 to pi/2 step 0.001
for u=0 to 2*pi step 0.001
r = cos(v)
z = sin(v)
x = r*cos(u)
y = r*sin(u)
xx = x
yy = y
zz = z
rotz x,y,z,uu
rotx x,y,z,vv
sx = 0
sy = -1
sz = 0
proj xx, yy, zz
pp = sw/2 + zoom*p
qq = sh/2 - zoom*q
if pp>0 and pp<sw and qq>0 and qq<sh then
if (x*sx + y*sy + z*sz) < 0 then
dim c as _unsigned long
cx = (w - w*u/(2*pi) ) mod w
cy = (h - h*(v + pi/2)/pi ) mod h
c = point(cx, cy)
pset (sw/2 + zoom*p, sh/2 - zoom*q), c
end if
end if
next
next
'if drag or (zoom <> oz) then
for v=0 to 2*pi step dv
for u=0 to 2*pi step du
r = cos(v)
z = sin(v)
x = r*cos(u)
y = r*sin(u)
rotz x,y,z,uu
rotx x,y,z,vv
sx = 0
sy = -1
sz = 0
color _rgb(100,100,100)
if (x*sx + y*sy + z*sz) < 0 then
r = cos(v)
proj r*cos(u), r*sin(u), sin(v)
pset (sw/2 + zoom*p, sh/2 - zoom*q)
proj r*cos(u + du), r*sin(u + du), sin(v)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
r = cos(v + dv)
proj r*cos(u + du), r*sin(u + du), sin(v + dv)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
proj r*cos(u), r*sin(u), sin(v + dv)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
r = cos(v)
proj r*cos(u), r*sin(u), sin(v)
line -(sw/2 + zoom*p, sh/2 - zoom*q)
end if
next
next
'end if
_limit 30
_display
loop until _keyhit = 27
sleep
system
sub proj(x, y, z)
'p = x + 0.707*y
'q = z + 0.707*y
rotz x,y,z,uu
rotx x,y,z,vv
d = 10
p = x*d/(10 + y)
q = z*d/(10 + y)
end sub
sub rotx(x, y, z, a)
xx = x
yy = y*cos(a) - z*sin(a)
zz = y*sin(a) + z*cos(a)
x = xx
y = yy
z = zz
end sub
sub roty(x, y, z, a)
xx = x*cos(a) + z*sin(a)
yy = y
zz = -x*sin(a) + z*cos(a)
x = xx
y = yy
z = zz
end sub
sub rotz(x, y, z, a)
xx = x*cos(a) - y*sin(a)
yy = x*sin(a) + y*cos(a)
zz = z
x = xx
y = yy
z = zz
end sub
i will eventually invert the coordinate systems to get pixel by pixel rendering but it will be so slow per frame, im not yet sure how to approach it, maybe a qbjs solution
RE: Drawing Tools Subs or Functions with Demo - bplus - 09-11-2024
Sorry I ran out of time for playing.
I want to try this, vince's, and Terry's and rotozoom a disk at all sorts of angles
RE: Drawing Tools Subs or Functions with Demo - bplus - 10-14-2024
I have revised my PieSlice drawing tools towards Steve's method only mine goes CW around the Center Point like the rest of the Trig Functions in Basic (but unlike an arc drawn with Circle Sub). In Basic Trig Functions angles increase around center point in Clockwise (CW) direction from East = 0 degrees/radians.
Code: (Select All)
' bplus mod to Steve way of coding 2024-10-13 but for East = 0 And CW arcs 10-14 rev Fill Paint tests
Sub PieSlice (CX As Long, CY As Long, R As Long, RAStart!, RAEnd!, C As _Unsigned Long, Fill As Long)
Dim As Long x, y, x1, y1, xt, yt
Dim As Single i, REnd ' rend to copy RAEnd! before changing value
If RAStart! > RAEnd! Then REnd = RAEnd! + _Pi * 2 Else REnd = RAEnd! ' rev 10-14
x1 = Cos(RAStart!) * R
y1 = Sin(RAStart!) * R
Line (CX, CY)-Step(x1, y1), C
For i = RAStart! To REnd Step _D2R(Sgn(REnd - RAStart!))
x = Cos(i) * R
y = Sin(i) * R
Line -(CX + x, CY + y), C
If x <> x1 And y <> y1 And xt = 0 Then 'choose a point inside the arc to fill
xt = CX + Cos(i) * R / 2
yt = CY + Sin(i) * R / 2
End If
Next
Line -(CX, CY), C
If xt <> 0 And Fill <> 0 Then Paint (xt, yt), C ' rev 10-14 don't Paint unless found a free pixel inside slice
'Circle ( xt, yt), c
End SubDemo comparing Steve's Math Graph and mine consistent with Basic Funbctions and Screen Y axis:
Code: (Select All)
Option _Explicit
_Title "PieSlice Tests with Steve coding" ' bplus 2024-10-13 rev 10-14 option _explicit and paint test
$Color:32
Screen _NewImage(1200, 600, 32)
_ScreenMove 40, 60
Dim degree10, xc1, xc, yc, xc2, r, a, x1, y1, at, sa$, xoff, yoff, x2, y2
degree10 = _Pi(2 / 36) ' like hours on clock
xc1 = 300: xc2 = 900: yc = 300: r = 200
_PrintString (xc1 - _PrintWidth("CW Regular East = 0 Deg/Rads Calcs") / 2, 292), "CW Regular East = 0 Deg/Rads Calcs"
_PrintString (xc2 - _PrintWidth("CCW Steve's East = 0 Deg/Rads Calcs") / 2, 292), "CCW Steve's East = 0 Deg/Rads Calcs"
For a = 0 To _Pi(1.999) Step degree10
' Regular East = 0 calcs
x1 = xc1 + r * Cos(a)
y1 = yc + r * Sin(a)
at = Int(_R2D(_Atan2(y1 - yc, x1 - xc1)) + .0001)
If at < 0 Then at = at + 360
sa$ = _Trim$(Str$(at))
xoff = _PrintWidth(sa$) / 2
yoff = 16 / 2
_PrintString (x1 - xoff, y1 - yoff), sa$
' East = 0 calcs but Counter Clockwise
x2 = xc2 + r * Sin(a + _Pi / 2)
y2 = yc + r * Cos(a + _Pi / 2)
at = Int(AtanSteve(xc2, yc, x2, y2))
sa$ = _Trim$(Str$(at))
xoff = _PrintWidth(sa$) / 2
yoff = 16 / 2
_PrintString (x2 - xoff, y2 - yoff), sa$
_Limit 10
Next
PieSlice 80, 90, 80, _D2R(45), 0, Red, 1 ' 1 for fill
PieSlice 200, 200, 50, _D2R(270), _D2R(120), Green, 1 ' 1 for fill
PieSlice 400, 400, 50, _D2R(120), _D2R(270), Gold, 1 ' 1 for fill
PieSliceSteve 620, 90, 80, 45, 0, Red
PieSliceSteve 800, 200, 50, 270, 120, Green
PieSliceSteve 1000, 400, 50, 120, 270, Gold
Locate 33, 1: Print "PieSlice 80, 90, 80, _D2R(45), 0, Red, 1 ' 1 for fill";
Locate 34, 1: Print "PieSlice 200, 200, 50, _D2R(270), _D2R(120), Green, 1 ' 1 for fill";
Locate 35, 1: Print "PieSlice 400, 400, 50, _D2R(120), _D2R(270), Gold, 1 ' 1 for fill";
Locate 33, 76: Print "PieSliceSteve 620, 90, 80, 45, 0, Red";
Locate 34, 76: Print "PieSliceSteve 800, 200, 50, 270, 120, Green";
Locate 35, 76: Print "PieSliceSteve 1000, 400, 50, 120, 270, Gold";
' nice method for PieSlice but goes CCW not CW
Sub PieSliceSteve (cx As Long, cy As Long, r As Long, startAngle As Long, endAngle As Long, c As _Unsigned Long)
Dim As Long x, y, x1, y1, i, xt, yt
If startAngle > endAngle Then endAngle = endAngle + 360
x1 = Sin(_D2R(startAngle + 90)) * r
y1 = Cos(_D2R(startAngle + 90)) * r
Line (cx, cy)-Step(x1, y1), c
For i = startAngle To endAngle Step Sgn(endAngle - startAngle)
x = Sin(_D2R(i + 90)) * r
y = Cos(_D2R(i + 90)) * r
Line -(cx + x, cy + y), c ' <<< bplus fixed cy + y not cx + y !!!!
If x <> x1 And y <> y1 And xt = 0 Then 'chose a point inside the arc to fill
xt = Sin(_D2R(i + 90)) * r / 2
yt = Cos(_D2R(i + 90)) * r / 2
End If
Next
Line -(cx, cy), c
Paint (cx + xt, cy + yt), c
End Sub
Function AtanSteve (x1, y1, x2, y2)
AtanSteve = (360 - _R2D(_Atan2(y2 - y1, x2 - x1))) Mod 360
End Function
' bplus mod to Steve way of coding 2024-10-13 but for East = 0 And CW arcs 10-14 rev Fill Paint tests
Sub PieSlice (CX As Long, CY As Long, R As Long, RAStart!, RAEnd!, C As _Unsigned Long, Fill As Long)
Dim As Long x, y, x1, y1, xt, yt
Dim As Single i, REnd ' rend to copy RAEnd! before changing value
If RAStart! > RAEnd! Then REnd = RAEnd! + _Pi * 2 Else REnd = RAEnd! ' rev 10-14
x1 = Cos(RAStart!) * R
y1 = Sin(RAStart!) * R
Line (CX, CY)-Step(x1, y1), C
For i = RAStart! To REnd Step _D2R(Sgn(REnd - RAStart!))
x = Cos(i) * R
y = Sin(i) * R
Line -(CX + x, CY + y), C
If x <> x1 And y <> y1 And xt = 0 Then 'choose a point inside the arc to fill
xt = CX + Cos(i) * R / 2
yt = CY + Sin(i) * R / 2
End If
Next
Line -(CX, CY), C
If xt <> 0 And Fill <> 0 Then Paint (xt, yt), C ' rev 10-14 don't Paint unless found a free pixel inside slice
'Circle ( xt, yt), c
End SubRE: Drawing Tools Subs or Functions with Demo - bplus - 10-14-2024
Oh heck I just found a fix I made in 2022, instead of EndRadianAngle it adds a arc measure in radians to the StartRadianAngle:
Code: (Select All)
Sub drawArc (xc, yc, radius, rStart, rMeasure, colr As _Unsigned Long)
' xc, yc Center for arc circle
' rStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
' rMeasure is the measure of Arc in Radain units, use _D2R for conversion from Degrees to Radians
' Arc will start at rStart and go clockwise around for rMeasure Radians
Dim rEnd, stepper, a, x, y
rEnd = rStart + rMeasure
stepper = 1 / radius ' the bigger the radius the smaller the steps
For a = rStart To rEnd Step stepper
x = xc + radius * Cos(a)
y = yc + radius * Sin(a)
If a > rStart Then Line -(x, y), colr Else PSet (x, y), colr
Next
End Sub
'Arc New 2022-09-28 independent of constants and routines
Sub drawPieSlice (xc, yc, radius, rStart, rMeasure, colr As _Unsigned Long)
' xc, yc Center for arc circle
' rStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
' rMeasure is the measure of Arc in Radain units, use _D2R for conversion from Degrees to Radians
' Arc will start at rStart and go clockwise around for rMeasure Radians
Dim rEnd, stepper, a, x, y
rEnd = rStart + rMeasure
Line (xc, yc)-(xc + radius * Cos(rStart), yc + radius * Sin(rStart)), colr
Line (xc, yc)-(xc + radius * Cos(rEnd), yc + radius * Sin(rEnd)), colr
stepper = 1 / radius ' the bigger the radius the smaller the steps
For a = rStart To rEnd Step stepper
x = xc + radius * Cos(a)
y = yc + radius * Sin(a)
If a > rStart Then Line -(x, y), colr Else PSet (x, y), colr
Next
Paint (xc + .5 * radius * Cos(rStart + .5 * rMeasure), yc + .5 * radius * Sin(rStart + .5 * rMeasure)), colr, colr
End SubRE: Drawing Tools Subs or Functions with Demo - bplus - 10-14-2024
EDIT: turns out there was a problem with filling PieSlices that I didn't catch until I attempted to use transparent colors. Then I found out the fills weren't always happening.
So I have completely revised my PieSlice code and tested for fills with both solid and transparent color.
see next reply.
RE: Drawing Tools Subs or Functions with Demo - bplus - 10-15-2024
Arcs and PieSlices
These routines follow Basic Trig functions that start 0 Degrees/Radians Due East and go Clock wise around the screen from there:
Code: (Select All)
Option _Explicit
_Title "Arc & PieSlice (Filled) testing, escape for 2nd test" ' bplus rev 2024-10-15
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60
Dim As Single xc, yc, a, x1, y1, s, e, r, degree10, at, xoff, yoff, radius, x, y, cnt
Dim sa$
Dim cc As _Unsigned Long
degree10 = _Pi(2 / 36)
xc = 400: yc = 300
r = 250
Do
Cls
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
For a = 0 To _Pi(1.999) Step degree10
' Regular East = 0 calcs
x1 = xc + r * Cos(a)
y1 = yc + r * Sin(a)
at = Int(_R2D(_Atan2(y1 - yc, x1 - xc)) + .0001)
If at < 0 Then at = at + 360
sa$ = _Trim$(Str$(at))
xoff = _PrintWidth(sa$) / 2
yoff = 16 / 2
_PrintString (x1 - xoff, y1 - yoff), sa$
Next
radius = Rnd * 100 + 100
Arc 400, 300, radius, s, e, cc
PieSlice 400, 300, radius - 10, s, e, cc, 1 ' test all fills !!!!
Print "Start Angle:"; Int(_R2D(s)) ' covert to degrees
Print "End Angle:"; Int(_R2D(e))
Print: Print "zzz, Press any...."
Sleep
Loop Until _KeyDown(27)
Cls
_KeyClear
_Title "Failure if the Screen floods by a bad Paint Job, any ky quits."
Do
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
radius = Rnd * 100 + 10
x = Rnd * _Width: y = Rnd * _Height
Arc x, y, radius, s, e, cc
PieSlice x, y, radius - 5, s, e, cc, 1 ' test all fills !!!!
_Limit 1
cnt = cnt + 1
If cnt Mod 50 = 49 Then Cls
Loop While InKey$ = ""
Sub Arc (CX, CY, R, RAStart, RAStop, C~&) ' rev 2024-10-14
'CX, CY Center Circle point, R = radius, C~& = color
' RaStart and RAStop are Radian angles,
' RAStart is first angle clockwise from due East = 0 Radians
' Arc will start drawing there and go clockwise until raEnd is reached
'note in Basic: degrees start due East = 0 and go clockwise
Dim raEnd, stepper, a
If RAStop < RAStart Then raEnd = RAStop + _Pi(2) Else raEnd = RAStop
stepper = 1 / R
For a = RAStart To raEnd Step stepper
If (a - RAStart) < stepper Then
PSet (CX + R * Cos(a), CY + R * Sin(a)), C~&
Else
Line -(CX + R * Cos(a), CY + R * Sin(a)), C~&
End If
Next
End Sub
Sub PieSlice (XC, YC, R, RStart, REnd, C As _Unsigned Long, FillTF) 'rev 2024-10-15
' XC, YC Center for arc circle with radius R
' RStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
' REnd is Radian End Angle
' Arc will start at rStart and go clockwise around to rEnd Radians
Dim rStop, rMid, stepper, a, x, y
Dim bc As _Unsigned Long
bc = _RGB32(_Red32(C), _Green32(C), _Blue32(C))
If REnd < RStart Then rStop = REnd + _Pi(2) Else rStop = REnd
rMid = rStop - RStart
Line (XC, YC)-(XC + R * Cos(RStart), YC + R * Sin(RStart)), bc
Line (XC, YC)-(XC + R * Cos(rStop), YC + R * Sin(rStop)), bc
stepper = 1 / R ' the bigger the radius the smaller the steps
For a = RStart To rStop Step stepper
x = XC + R * Cos(a)
y = YC + R * Sin(a)
If a > RStart Then Line -(x, y), bc Else PSet (x, y), bc
Next
If FillTF Then Paint (XC + R / 2 * Cos(RStart + rMid / 2), YC + R / 2 * Sin(RStart + rMid / 2)), C, bc
End SubMore Newly revised PieSlice and testing code, works for transparent colors with more dependable Fills.
Code: (Select All)
Option _Explicit
_Title "Arc & PieSlice (Filled) testing, escape for 2nd test" ' bplus rev 2024-10-15
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60
Dim As Single xc, yc, a, x1, y1, s, e, r, degree10, at, xoff, yoff, radius, x, y, cnt
Dim sa$
Dim cc As _Unsigned Long
degree10 = _Pi(2 / 36)
xc = 400: yc = 300
r = 250
Do
Cls
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
For a = 0 To _Pi(1.999) Step degree10
' Regular East = 0 calcs
x1 = xc + r * Cos(a)
y1 = yc + r * Sin(a)
at = Int(_R2D(_Atan2(y1 - yc, x1 - xc)) + .0001)
If at < 0 Then at = at + 360
sa$ = _Trim$(Str$(at))
xoff = _PrintWidth(sa$) / 2
yoff = 16 / 2
_PrintString (x1 - xoff, y1 - yoff), sa$
Next
radius = Rnd * 100 + 100
Arc 400, 300, radius, s, e, cc
PieSlice 400, 300, radius - 10, s, e, cc, 1 ' test all fills !!!!
Print "Start Angle:"; Int(_R2D(s)) ' covert to degrees
Print "End Angle:"; Int(_R2D(e))
Print: Print "zzz, Press any...."
Sleep
Loop Until _KeyDown(27)
Cls
_KeyClear
_Title "Failure if the Screen floods by a bad Paint Job, any ky quits."
Do
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
radius = Rnd * 100 + 10
x = Rnd * _Width: y = Rnd * _Height
Arc x, y, radius, s, e, cc
PieSlice x, y, radius - 5, s, e, cc, 1 ' test all fills !!!!
_Limit 1
cnt = cnt + 1
If cnt Mod 50 = 49 Then Cls
Loop While InKey$ = ""
Sub Arc (CX, CY, R, RAStart, RAStop, C~&) ' rev 2024-10-14
'CX, CY Center Circle point, R = radius, C~& = color
' RaStart and RAStop are Radian angles,
' RAStart is first angle clockwise from due East = 0 Radians
' Arc will start drawing there and go clockwise until raEnd is reached
'note in Basic: degrees start due East = 0 and go clockwise
Dim raEnd, stepper, a
If RAStop < RAStart Then raEnd = RAStop + _Pi(2) Else raEnd = RAStop
stepper = 1 / R
For a = RAStart To raEnd Step stepper
If (a - RAStart) < stepper Then
PSet (CX + R * Cos(a), CY + R * Sin(a)), C~&
Else
Line -(CX + R * Cos(a), CY + R * Sin(a)), C~&
End If
Next
End Sub
Sub PieSlice (XC, YC, R, RStart, REnd, C As _Unsigned Long, FillTF) 'rev 2024-10-15
' XC, YC Center for arc circle with radius R
' RStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
' REnd is Radian End Angle
' Arc will start at rStart and go clockwise around to rEnd Radians
Dim rStop, rMid, stepper, a, x, y
Dim bc As _Unsigned Long
bc = _RGB32(_Red32(C), _Green32(C), _Blue32(C))
If REnd < RStart Then rStop = REnd + _Pi(2) Else rStop = REnd
rMid = rStop - RStart
Line (XC, YC)-(XC + R * Cos(RStart), YC + R * Sin(RStart)), bc
Line (XC, YC)-(XC + R * Cos(rStop), YC + R * Sin(rStop)), bc
stepper = 1 / R ' the bigger the radius the smaller the steps
For a = RStart To rStop Step stepper
x = XC + R * Cos(a)
y = YC + R * Sin(a)
If a > RStart Then Line -(x, y), bc Else PSet (x, y), bc
Next
If FillTF Then Paint (XC + R / 2 * Cos(RStart + rMid / 2), YC + R / 2 * Sin(RStart + rMid / 2)), C, bc
End Sub