Drawing Tools Subs or Functions with Demo

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 Sub