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.
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 Sub
07-24-2022, 06:11 PM (This post was last modified: 07-24-2022, 06:18 PM by bplus.)
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.
'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
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 Sub
Dang I forgot, to change color to print the string that drew the Spiral!
_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 Sub
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.
