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.
Dang I forgot, to change color to print the string that drew the Spiral!
OK
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
b = b + ...