+- 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 - SierraKen - 05-26-2022
Here is a slight mod to your Image to Sphere demo. I changed it so it doesn't show the background map, just the mapped sphere with the grid. I also smoothed the animation out a little bit by doubling the Limit from 60 to 120. Using a black background I also added a CLS. You probably knew how to do this already but I thought I would add this for people that just wanted the sphere. This needs the Worldmap.png from your original post on this thread.
Code: (Select All)
_Title "Image to Sphere by bplus - mod with only globe by SierraKen" 'b+ 2022-05-23 SierraKen 2022-05-26
Randomize Timer
Const wW = 1280, wH = 720
Screen _NewImage(wW, wH, 32)
_ScreenMove 65, 0
'_MouseHide
map& = _LoadImage("worldmap.png")
mw& = _Width(map&)
mh& = _Height(map&)
grid& = _NewImage(mw&, mh&, 32)
_Dest grid&
Color &HFF000000
drawGrid 0, 0, (mw& - 1) / 36, (mh& - 1) / 18, 36, 18
_Dest 0
'Color , &HFFFFFFFF ' test grid
'Cls
'_PutImage (0, 0), grid&, 0
'End
While _KeyDown(27) = 0
'_PutImage , map&, 0 <<< Removed
'_PutImage , grid&, 0 <<< Removed
xoff = (xoff + 4) Mod (_Width(map&) + 1)
a = a + _Pi(2 / 320)
x = 640 + 330 * Cos(a): y = 360 + 58 * Sin(a)
projectImagetoSphere map&, x, y, 300, xoff
projectImagetoSphere grid&, x, y, 300, xoff
_Display
Cls '<<< Needed for black background.
_Limit 120 '<<< Doubled to make video smoother.
Wend
Sub projectImagetoSphere (image&, x0, y0, sr, xo)
r = _Height(image&) / 2
iW = _Width(image&)
iH = _Height(image&)
scale = sr / r
For y = -r To r
x1 = Sqr(r * r - y * y)
tv = (_Asin(y / r) + 1.5) / 3
For x = -x1 + 1 To x1
tu = (_Asin(x / x1) + 1.5) / 6
_Source image&
pc~& = Point((xo + tu * iW) Mod iW, tv * iH)
_Dest 0
PSet (x * scale + x0, y * scale + y0), pc~&
Next x
Next y
End Sub
Sub drawGrid (x, y, xs, ys, xn, yn) ' top left x, y, x side, y side, number of x, nmber of y
Dim As Long i, dx, dy
dx = xs * xn: dy = ys * yn
For i = 0 To xn
Line (x + xs * i, y)-(x + xs * i, y + dy)
Next
For i = 0 To yn
Line (x, y + ys * i)-(x + dx, y + ys * i)
Next
End SubRE: Drawing Tools Subs or Functions with Demo - bplus - 06-05-2022
WuLine for AntiAlias
Not sure if you can see much from snapshots but if you need clean looking circles I highly recommend WuLine drawing!
I leave you a zip of my test folder including a version by Fellippe along with my versions, 4 bas files.
RE: Drawing Tools Subs or Functions with Demo - bplus - 07-24-2022
Today I drag out my old Draw String Commands and convert the QB64 colors of a screen 12 to full RGB colors of _NewImage using 32. Now I can load images like a turtle with my turtle drawing modifications.
So the other day we were trying to duplicate the Spiral Hexagon of a site called Mini micro and after finally getting the spiral right with Turtle like command string I wanted to top it off with turtle image:
Here is the code, to which you can add images as I have here.
Code: (Select All)
_Title "Draw Strings try Hexagon Spiral" 'b+ mod 2022-07-23 7-24 add turtle image
'2022-07-24 adding QB colors so can add images to drawings
' ref https://forum.codebuddies.org/t/mini-micro-a-new-programming-environment-for-beginners-and-non-beginners/303
' trying to duplicate the 1st screen shot, got it along with last red line along the bottom after turning turtle North to start!
' 2020-01-19 translate from
' Draw strings 2.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-06
'Deluxe draw strings.sdlbas [B+=MGA] 2017-01-03
'translated from:
'v2 turtle strings.bas SmallBASIC 0.12.2 [B+=MGA] 2016-04-04
'2017-05-08 fixes Box d and e for width and height
' test draw strings fixed for arc
'=================================================================
' Commands Set
'==================================================================
'Note all commands are a letter for function followed by number n
'commands pn -1 to 15, 0-15 are QB colors, -1 is pen up
'command xn set absolute screen coordinate for turtle x
'command yn set absolute screen coordinate for turtle y
'command gn move turtle relative to its current x position
' + n = right, -n = left (pneumonic g for go!)
'command hn move turtle relative to its current y position
' + n down?, -n up? depends which way the angle is set
' (pnuemonic h follows g like y follows x)
'command fn draws at current ta angle a distance of n (set ta turtle angle first by tn or an)
' (pnuemonic f is for forward use -n for back)
'command an sets angle or heading of turtle
' (pnuemonic a is for angle (degrees)
' 0 degrees is true North or 12 o'clock)
'command tn (turns) t=right n degrees when positive
' and turn left n degrees when negative
'v2 2016-04-05 the great and powerful repeat uses recursive sub
'command rn repeat drawstrings n amount of times
'v is a variable that can replace a number n in commands for setting a turtle var probably need another
'add 2 more commands for setting and incrementing the tv variable
'command sn will set v at n value, dim shared tv tracks v
'command in will increment v with n value, dim shared tv tracks v
'Deluxe draw strings 2017-01-03
' draw filled box current tx, ty is one corner
'command zn for pen siZe radius to draw thick lines
'command dn sets box width
'command en sets box height
'command bn for Box color n = 0 - 15
'command un to set a circle radius
'command cn to draw a filled circle of color n = 0 - 15
'command jn to set the arc deg angle start
'command kn to set the arc deg angle end
'command ln draw arc color n = 0 - 15
'================================================ QB64 translation notes
'Looks like we will need to setup screen with _newimage(xmax, ymax, 12) for easy color numbers for pen p, p9 = blue
' p-1 means no drawing color = just moving pen into a new position, p0 is pen with Black ink
Const xmax = 800, ymax = 600 'standard 800 x 600 screen
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40 'center
Dim Shared qb(15) ' convert qb to rgb
qb(0) = &HFF000000
qb(1) = &HFF000088
qb(2) = &HFF008800
qb(3) = &HFF008888
qb(4) = &HFF880000
qb(5) = &HFF880088
qb(6) = &HFF888800
qb(7) = &HFFCCCCCC
qb(8) = &HFF888888
qb(9) = &HFF0000FF
qb(10) = &HFF00FF00
qb(11) = &HFF00FFFF
qb(12) = &HFFFF0000
qb(13) = &HFFFF00FF
qb(14) = &HFFFFFF00
qb(15) = &HFFFFFFFF
' thanks CLEANPNG World Animal Day https://www.cleanpng.com/png-turtle-shell-wood-turtle-carapace-leatherback-sea-4595063/
turtle& = _LoadImage("turtle.png")
If turtle& > -2 Then Print "Image did not Load.": End
'======================================================================
'turtle globals should you translate to another dialect
Dim Shared scale, tx, ty, tx2, ty2, tr, taStart, taStop, tc, ta, tv, tz 'keep all these as single?
'initialize turtle constants
scale = 1 'external to string settings
tx = 0: ty = 0 ' x, y turtle position
tx2 = 0: ty2 = 0 ' 2nd x,y for fill box or for ellipse width and height
taStart = 0 ' turtle arc Start
taStop = 0 ' turtle arc Stop
tc = 15 ' turtle color (QB colors 0 - 15 and -1 means pen up
ta = 0 ' turtle angle
tv = 0 ' new turtle increment var for changing tv
tz = 1 ' tz is tracking pen size
tr = 0 ' radius
tt "z1p-1x400y300z1t-90r50p5i1fvt59p9i1fvt59p2i1fvt59p14i1fvt59p6i1fvt59p4i1fvt59"
Color _RGB32(255, 185, 0)
_PrintString (5, 10), "tt " + Chr$(34) + "z1p-1x400y300z1t-90r50p5i1fvt59p9i1fvt59p2i1fvt59p14i1fvt59p6i1fvt59p4i1fvt59" + Chr$(34)
RotoZoom 220, 535, turtle&, .1, -74
Sleep
Sub tt (tstring$)
'local cmd, ds, i, c, d, tst, across, down, lngth, dx, dy, j, aa, stepper
tstring$ = UCase$(tstring$)
cmd$ = "": d$ = ""
For i = 1 To Len(tstring$)
c$ = Mid$(tstring$, i, 1)
If c$ = "V" Then ds$ = Str$(tv)
If InStr("0123456789.-", c$) Then ds$ = ds$ + c$
If InStr("ABCDEFGHIJKLPRSTUXYZ", c$) Or i = Len(tstring$) Then
'execute last cmd if one
If cmd$ <> "" Then
n = Val(ds$)
Select Case cmd$
Case "G": tx = tx + n 'move relative to tx, ty
Case "H": ty = ty + n
Case "X": tx = n 'move to absolute screen x, y
Case "Y": ty = n
Case "D": tx2 = n '2nd corner box relative to tx
Case "E": ty2 = n '2nd corner box relative to ty
Case "J": taStart = n 'arc start angle
Case "K": taStop = n 'arc stop angle
Case "P": tc = n 'pen to qb color, -1 no pen
Case "Z": tz = n 'pen size
Case "A": ta = n 'set angle
Case "T": ta = ta + n 'change angle - = left, + = right
Case "U": tr = n 'set radius for circle (R used for repeat)
Case "I": tv = tv + n 'increment variable
Case "S": tv = n 'set or reset variable
Case "R" ' repeat calls out for another call to tt
tst$ = Mid$(tstring$, i) ' this assumes the rest of the string
repete tst$, n ' is the repeat part.
Exit For
Case "F" 'Forward d distance according to angle ta
across = scale * n * Cos(_D2R(ta - 90))
down = scale * n * Sin(_D2R(ta - 90))
If tc > -1 Then
If tz <= 1 Then
Line (tx, ty)-Step(across, down), qb(tc)
Else
lngth = ((across) ^ 2 + (down) ^ 2) ^ .5
If lngth Then
dx = across / lngth: dy = down / lngth
For j = 0 To lngth
fcirc tx + dx * j, ty + dy * j, tz, qb(tc)
Next
End If
End If
End If
tx = tx + across: ty = ty + down 'update turtle position
Case "B"
Line (tx - tx2 / 2, ty - ty2 / 2)-(tx + tx2 / 2, ty + ty2 / 2), qb(n), BF
Case "C"
fcirc tx, ty, tr, qb(n)
Case "L" 'arc ld u sets radius, j and k set start and end angle
If tc > -1 Then
stepper = 1 / (3 * _Pi * tr)
For aa = taStart To taStop Step stepper
dx = tr * Cos(_D2R(aa))
dy = tr * Sin(_D2R(aa))
If tz < 1 Then
PSet (tx + dx, ty + dy), qb(n)
Else
fcirc tx + dx, ty + dy, tz, qb(n)
End If
Next
End If
End Select
ds$ = "": cmd$ = "" 'reset for next build of ds and cmd
End If
cmd$ = c$
End If
Next
End Sub
Sub repete (tts$, times)
'local i
For i = 1 To times
tt tts$
Next
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
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)
Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
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 SubDang I forgot, to change color to print the string that drew the Spiral!
OK
RE: Drawing Tools Subs or Functions with Demo - bplus - 11-29-2022
PaintImage - just like Paint to a Border, you can Paint and image
Here is a demo:
Code: (Select All)
_Title "Brick Pattern Tile, click a spot to spray paint a brick image."
' 2019-11-22 new and improved use of BC to eliminate Border lines.
Const xmax = 800, ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40
'make brick pattern
brickpat& = _NewImage(16, 16, 32)
_Dest brickpat&
Line (0, 0)-(_Width(brickpat&) - 1, _Height(brickpat&) - 1), _RGB32(128, 0, 0), BF
Line (0, 0)-(_Width(brickpat&) - 1, 0), _RGB32(200, 200, 200), BF
Line (0, 7)-(_Width(brickpat&) - 1, 8), _RGB32(200, 200, 200), BF
Line (0, 15)-(_Width(brickpat&) - 1, 15), _RGB32(200, 200, 200), BF
Line (0, 0)-(1, 8), _RGB32(200, 200, 200), BF
Line (7, 8)-(8, 15), _RGB32(200, 200, 200), BF
_Dest 0
Dim Shared BC As _Unsigned Long
BC = _RGB32(119, 17, 2)
While _KeyDown(27) = 0
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
If mb Then
r = r + 1
If r > 20 Then r = 1
Circle (mx, my), 50, BC
paintImage mx, my, BC, 0, brickpat&
End If
_Display
_Limit 60
Wend
Sub paintImage (x, y, Border~&, destHandle&, imageHandle&)
d = _Dest: s = _Source
_Dest destHandle&
Paint (x, y), BC, Border~&
For y = 0 To _Height(destHandle&)
For x = 0 To _Width(destHandle&)
_Source destHandle&
If Point(x, y) = BC Then
_Source imageHandle&
PSet (x, y), Point(x Mod _Width(imageHandle&), y Mod _Height(imageHandle&))
End If
Next
Next
_Dest d: _Source s
End SubRE: Drawing Tools Subs or Functions with Demo - james2464 - 11-29-2022
This is amazing! And now I have questions
I have never used MOD (just learned about it this past weekend due to the posts on that subject) and I wonder how important it is for this program?
Thank you for sharing this
RE: Drawing Tools Subs or Functions with Demo - bplus - 11-29-2022
I use MOD the Image Width and Height to keep from going outside the image being painted when x, y of destination > than image. Mod is like our analog clocks after 12 you go back to 1 or week days after Sunday restart on Monday.
The paint image will 'tile' sort of like pixelating and it would be noticeable if tiles did not meet up back to front or bottom to top again but when they do, like with this brick pattern, it is seamless.
RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-04-2024
Hey @bplus I've been playing around with your image to sphere code. (cool by the way!)
I've whittled it down to the bare essentials and understand most of it. Could you please explain to me what lines 54 and 57 of the code are doing?
Code: (Select All)
CONST wW = 1280 ' screen width
CONST wH = 720 ' screen height
DIM x AS INTEGER ' x center of sphere
DIM y AS INTEGER ' y center of sphere
DIM map AS LONG ' map image
SCREEN _NEWIMAGE(wW, wH, 32)
map = _LOADIMAGE("worldmap.png")
x = wW / 2 ' center sphere horizontally on screen
y = wH / 2 ' center sphere vertically on screen
WHILE _KEYDOWN(27) = 0 ' ESC key pressed?
xoff = (xoff + 4) MOD (_WIDTH(map) + 1) ' no, rotate left (can't go right because of MOD use)
projectImagetoSphere map, x, y, 300, xoff ' map image to sphere
_DISPLAY
_LIMIT 60
WEND
SUB projectImagetoSphere (image AS LONG, x0 AS INTEGER, y0 AS INTEGER, sr AS INTEGER, xo AS INTEGER)
' image : image passed in
' x0 : center x location of sphere
' y0 : center y location of sphere
' sr : sphere radius
' xo : image x offset
' Note: use x1 = _HYPOT(r, y) to map to a funnel structure
DIM iW AS INTEGER ' width of image
DIM iH AS INTEGER ' height of image
DIM r AS SINGLE ' half image height
DIM scale AS SINGLE ' proportion of sphere radius to image height
DIM x AS INTEGER ' location along horizontal line within sphere
DIM y AS INTEGER ' vertical location within image
DIM x1 AS SINGLE ' length of horizontal line within sphere
DIM tv AS SINGLE
DIM tu AS SINGLE
DIM pc AS _UNSIGNED LONG ' POINT on image
DIM oSource AS LONG ' calling SOURCE
oSource = _SOURCE ' get calling source
_SOURCE image ' POINT data will be retrieved from image
iW = _WIDTH(image) ' get width of image
iH = _HEIGHT(image) ' get height of image
r = iH / 2 ' calculate image half height
scale = sr / r ' calculate proportion of radius to image height
y = -r ' start at top of image
DO ' begin vertical loop
x1 = SQR(r * r - y * y) ' length of line across sphere at y location
tv = (_ASIN(y / r) + 1.5) / 3
x = -x1 + 1 ' start at left side of sphere
DO ' begin horizontal loop
tu = (_ASIN(x / x1) + 1.5) / 6
pc = POINT((xo + tu * iW) MOD iW, tv * iH)
PSET (x * scale + x0, y * scale + y0), pc
x = x + 1 ' move one pixel across image to the right
LOOP UNTIL x > x1 ' leave when right side of image reached
y = y + 1 ' move one pixel down the image
LOOP UNTIL y > r ' leave when bottom of image reached
_SOURCE oSource ' restore calling source
END SUBRE: Drawing Tools Subs or Functions with Demo - bplus - 09-05-2024
You must mean: what are tu and tv? _Asin is going to return an angle. The t of tu and tv my guess is: t is for translate because we are getting a point off the rectangular image and projecting it onto the sphere/circle in 2d. (Line 57 for me is x = x + 1 and I know you don't mean that!)
Translations are done like converting x, y coordinates to polar you need and angle and a distance from an origin.
I suspect tu and tv are getting the angles for the translation. Looking at pc using tv and tu we might be doing the reverse, translating polar to x, y coordinates?
Take the above as possible clues not gospel.
I believe this is first time I've ever seen _Asin practically used but I don't live the life of Pete
Update: Oh we are getting (x, y) points off the sphere/circle/disk and looking at the Point color on the Image for the color. Notice how the code is like our circle fill routines with x,y about cx, cy.
BTW we could use this for really fancy gradients unfortunately it would be pretty slow.
RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-05-2024
(09-05-2024, 12:32 AM)bplus Wrote: You must mean: what are tu and tv? _Asin is going to return an angle. The t of tu and tv my guess is: t is for translate because we are getting a point off the rectangular image and projecting it onto the sphere/circle in 2d. (Line 57 for me is x = x + 1 and I know you don't mean that!)Yep, tu and tv were the variables I was referring to. I kinda figured they were mapping the points from the rectangle to the circle. I didn't even know _ASIN existed. I've read up on it in the Wiki and I get what it's doing. Hard to believe it's been around since version 1.00 and I'm just now learning about it. (that goes for _ACOS too)
Translations are done like converting x, y coordinates to polar you need and angle and a distance from an origin.
I suspect tu and tv are getting the angles for the translation. Looking at pc using tv and tu we might be doing the reverse, translating polar to x, y coordinates?
Take the above as possible clues not gospel.
I believe this is first time I've ever seen _Asin practically used but I don't live the life of Pete
Update: Oh we are getting (x, y) points off the sphere/circle/disk and looking at the Point color on the Image for the color. Notice how the code is like our circle fill routines with x,y about cx, cy.
BTW we could use this for really fancy gradients unfortunately it would be pretty slow.
I'm going to plot a few points by hand on paper so I can get a handle on exactly how tu and tv are calculated.
The magic numbers 1.5, 3, and 6 in those code lines has me wondering what they control as well.
As far as speed goes I wonder if there is way the _MEM commands could help with that? I'm going to play some more. I want to add this function to my list of library image goodies.
You wouldn't happen to have a link to the forum where you found the original code would you?
RE: Drawing Tools Subs or Functions with Demo - bplus - 09-05-2024
Quote:You wouldn't happen to have a link to the forum where you found the original code would you?
The original forum, RetroBasic, is gone but it was preserved in a Board at AllBasic Forum.
I can't find exact code from ZXDunny I used but this does the same thing, sorta, projecting an image into spheres:
https://retrobasic.allbasic.info/index.php?topic=721.0
I believe I posted a version of this here too. This one does not use ASin.
I think I was main poster of code at that place!
Found it on You Tube: https://www.youtube.com/watch?v=0EGDJybA_HE
There is the code with ASin!