Print Page - 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees

Title: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 20, 2021, 06:33:02 pm

I've been playing with some basic 2D raster drawing / plotting / manipulation routines (operating on a 2-D array).

For rotating a 2-D sprite array to an arbitrary angle, I found a 3-shear rotation routine that works after some massaging, but am seeing this issue where the quality drops when rotating to multiples of 30 degrees (specifically 30, 60, 120, 150, 210, 240, 300, and 330 degrees are the sour spots, 90, 180, & 270 are OK).

If anyone has a minute, run the program and try option 5 or 6, and notice how it looks when it gets to any of those angles.

To quickly find the rotation logic, search for "Sub ShearRotate".

What gives? Any help much appreciated...

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Basic 2D plotting functions
' Version 1.00 by madscijr
' with help from various (sources cited below).
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS
' =============================================================================
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' -----------------------------------------------------------------------------
' USER DEFINED TYPES
' -----------------------------------------------------------------------------
Type RotationType
    origx As Integer
    origy As Integer
    'z as integer
    c As Integer
End Type ' RotationType
 
' -----------------------------------------------------------------------------
' GLOBAL VARIABLES
' -----------------------------------------------------------------------------
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug: m_bDebug = FALSE
 
' =============================================================================
' BEGIN MAIN PROGRAM
' =============================================================================
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' START THE MENU
main
 
' -----------------------------------------------------------------------------
' DONE
Print m_ProgramName$ + " finished."
'Screen 0
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' EXIT
System ' return control to the operating system
End
 
' =============================================================================
' END MAIN PROGRAM
' =============================================================================
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
 
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Some basic 2D plotting"
        Print
        Print "1. PlotPointTest"
        Print "2. PlotSquareTest"
        Print "3. PlotCircleTest"
        Print "4. PlotLineTest"
        Print "5. ShearRotateTest1"
        Print "6. ShearRotateTest2"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(Left$(in$, 1))
 
        If in$ = "1" Then
            PlotPointTest
        ElseIf in$ = "2" Then
            PlotSquareTest
        ElseIf in$ = "3" Then
            PlotCircleTest
        ElseIf in$ = "4" Then
            PlotLineTest
        ElseIf in$ = "5" Then
            ShearRotateTest1
        ElseIf in$ = "6" Then
            ShearRotateTest2
        End If
    Loop Until in$ = "q"
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' MyArray(1 To 32, 1 To 32) AS STRING
 
Sub PlotPoint (X As Integer, Y As Integer, S As String, MyArray() As String)
    If (X >= LBound(MyArray, 2)) Then
        If (X <= UBound(MyArray, 2)) Then
            If (Y >= LBound(MyArray, 1)) Then
                If (Y <= UBound(MyArray, 1)) Then
                    If Len(S) = 1 Then
                        MyArray(Y, X) = S
                    Else
                        If Len(S) > 1 Then
                            MyArray(Y, X) = Left$(S, 1)
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub ' PlotPoint
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotPointTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a point."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type x,y (1-32, 1-32) coordinate to plot point at."
        Input "X,Y OR 0 TO QUIT? "; X, Y
        If X > 0 And Y > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X) + ", Y=" + cstr$(Y)
            PlotPoint X, Y, Chr$(iChar), MyArray()
 
            Print "Current point plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotPointTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquare (X1 As Integer, Y1 As Integer, L As Integer, S As String, MyArray() As String)
    Dim X As Integer
    Dim X2 As Integer
    Dim Y As Integer
    Dim Y2 As Integer
    Dim sChar$
 
    If Len(S) = 1 Then
        sChar$ = S
    Else
        If Len(S) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(S, 1)
        End If
    End If
 
    X2 = (X1 + L) - 1
    Y2 = (Y1 + L) - 1
    For X = X1 To X2
        For Y = Y1 To Y2
            PlotPoint X, Y, sChar$, MyArray()
        Next Y
    Next X
End Sub ' PlotSquare
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquareTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Enter parameters to draw a square."
    Print ArrayToStringTest(MyArray())
    Print
    Do
        Print "Type top left x,y (1-32, 1-32) coordinate to plot square,"
        Print "and size (1-32) of square."
        Input "X,Y,L OR 0 TO QUIT? "; X, Y, L
        If X > 0 And Y > 0 And L > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "L=" + cstr$(L)
            Print
            PlotSquare X, Y, L, Chr$(iChar), MyArray()
 
            Print "Square plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotSquareTest
 
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
 
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
 
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
 
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM  : FAST CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
 
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
 
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
 
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM  : SLOW CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
 
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK   1 (drawing a pixel), 0 (erasing a pixel)
' X     X coordinate of the pixel
' Y     Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
 
' More on plotting circles:
'     Drawing a circle in BASIC - fast
'     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
 
' X,Y     = center point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircle (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        B = R
        C = 0
        A = R - 1
        Do
            PlotPoint X + C, Y + B, S2, MyArray()
            PlotPoint X + C, Y - B, S2, MyArray()
            PlotPoint X - C, Y - B, S2, MyArray()
            PlotPoint X - C, Y + B, S2, MyArray()
            PlotPoint X + B, Y + C, S2, MyArray()
            PlotPoint X + B, Y - C, S2, MyArray()
            PlotPoint X - B, Y - C, S2, MyArray()
            PlotPoint X - B, Y + C, S2, MyArray()
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then ' IF A>=0 THEN 190
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do ' 190 IF B>=C THEN 60
        Loop
    End If
End Sub ' PlotCircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a raster circle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotCircle X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotCircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
' From: http://www.thedubber.altervista.org/qbsrc.htm
 
Sub PlotLine (x1%, y1%, x2%, y2%, c$, MyArray() As String)
    Dim iLoop%
    Dim steep%: steep% = 0
    Dim ev%: ev% = 0
    Dim sx%
    Dim sy%
    Dim dx%
    Dim dy%
 
    If (x2% - x1%) > 0 Then
        sx% = 1
    Else
        sx% = -1
    End If
 
    dx% = Abs(x2% - x1%)
    If (y2% - y1%) > 0 Then
        sy% = 1
    Else
        sy% = -1
    End If
 
    dy% = Abs(y2% - y1%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x1%, y1%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
 
    ev% = 2 * dy% - dx%
    For iLoop% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y1%, x1%), c%:
            'LOCATE y1%, x1%
            'PRINT c$;
            PlotPoint y1%, x1%, c$, MyArray()
        Else
            ''PSET (x1%, y1%), c%
            'LOCATE x1%, y1%
            'PRINT c$;
            PlotPoint x1%, y1%, c$, MyArray()
        End If
 
        While ev% >= 0
            y1% = y1% + sy%
            ev% = ev% - 2 * dx%
        Wend
        x1% = x1% + sx%
        ev% = ev% + 2 * dy%
    Next iLoop%
    ''PSET (x2%, y2%), c%
    'LOCATE x2%, y2%
    'PRINT c$;
    PlotPoint x2%, y2%, c$, MyArray()
End Sub ' PlotLine
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotLineTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim in$
    Dim X1 As Integer
    Dim Y1 As Integer
    Dim X2 As Integer
    Dim Y2 As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot line with Bresenham Algorithm"
    Print "based on BRESNHAM.BAS by Kurt Kuzba (4/16/96)."
    Print
    Print ArrayToStringTest(MyArray())
    Do
        Print "Enter coordinate values for "
        Print "line start point x1, y1 (1-32, 1-32)"
        Print "line end   point x2, y2 (1-32, 1-32)"
        Input "ENTER X1,Y1,X2,Y2 OR 0 TO QUIT: "; X1, Y1, X2, Y2
        If X1 > 0 And Y1 > 0 And X2 > 0 And Y2 > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X1=" + cstr$(X1)
            Print "Y1=" + cstr$(Y1)
            Print "X2=" + cstr$(X2)
            Print "Y2=" + cstr$(Y2)
 
            PlotLine X1, Y1, X2, Y2, Chr$(iChar), MyArray()
 
            Print "Line plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotLineTest
 
' /////////////////////////////////////////////////////////////////////////////
' 3 shear method testing
 
' _PUT Rotation Help
' https://www.qb64.org/forum/index.php?topic=1959.0
 
' 3 Shear Rotation - rotates without any aliasing(holes)
' https://www.freebasic.net/forum/viewtopic.php?t=24557
 
' From: leopardpm
' Date: Apr 02, 2016 1:21
' Last edited by leopardpm on Apr 02, 2016 17:18, edited 1 time in total.
'
' This is just a little 3-shear rotation routine
' (I am using 3-shear because it leaves no gaps/aliasing)
' that I was wondering if anyone sees how to make it faster.
' Obviously, I am just thinking about inside the double loop.
 
' Thanks again to BasicCoder2 for linking me to this little routine, it is wonderful so far!
 
'''                      roto-zooming algorithm
'''                    coded by Michael S. Nissen
'''                        jernmager@yahoo.dk
'
''' ===============================================================
''' Recoded to run on FBC 32/64 bit WIN, Version 1.05.0, 2016, by MrSwiss
''' Heavy flickering before going Full-Screen on 64 Bit !!!
''' This seems NOT to be the Case on 32 Bit ...
''' ===============================================================
'
'Type Pixel
'  As Single   X, Y
'  As ULong    C
'End Type
'
'''  dim vars
'Dim shared as Any Ptr Img_Buffer
'''  write the name of the .bmp image you want to rotozoom here:
'''  (it has to be sqare ie. 100x100 pixels, 760x760 pixels or whatever)
'Dim As String Img_Name = "phobos.bmp"
'Dim shared as Integer X_Mid, Y_Mid, scrn_wid, scrn_hgt, P1, P2, P3, P4, C
'Dim shared as Short Img_Hgt, Img_Wid, Img_Lft, Img_Rgt, Img_Top, Img_Btm, X, Y
'Dim Shared As Single Cos_Ang, Sin_Ang, Rot_Fac_X, Rot_Fac_Y, Angle = 0, Scale = 1
'
''' changed Function to Sub (+ recoded arguments list)
'Sub Calc_rotozoom ( ByRef Cos_Ang As Single, _
'               ByRef Sin_Ang As Single, _
'               ByVal S_Fact  As Single, _
'               ByVal NewAng  As Single )
'  Cos_Ang = Cos(NewAng)*S_Fact
'  Sin_Ang = Sin(NewAng)*S_Fact
'End Sub
'
'''  full screen
'ScreenInfo scrn_wid, scrn_hgt
'screenRes scrn_wid, scrn_hgt, 32,,1
'
'''  dim screenpointer (has to be done after screenres)
'Dim As ULong Ptr Scrn_Ptr = Screenptr
'
'''  place image in center of screen
'X_Mid = scrn_wid\2
'Y_Mid = scrn_hgt\2
'Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'
'''  find image dimensions
'Open Img_Name For Binary As #1
'Get #1, 19, Img_Wid
'Get #1, 23, Img_Hgt
'Close #1
'
'''  prepare to dim the array that will hold the image.
'Img_Rgt = (Img_Wid-1)\2
'Img_Lft = -Img_Rgt
'Img_Btm = (Img_Hgt-1)\2
'Img_Top = -Img_Btm
'
'''  dim array to hold image. Note: pixel (0, 0) is in the center.
'Dim As Pixel Pixel(Img_Lft to Img_Rgt, Img_Top to Img_Btm)
'
'''  imagecreate sprite and load image to sprite
'Img_Buffer = ImageCreate (Img_Wid, Img_Hgt)
'Bload (Img_Name, Img_Buffer)
'
'''  load image from sprite to array with point command
'For Y = Img_Top to Img_Btm
'  For X = Img_Lft to Img_Rgt
'    With Pixel(X, Y)
'      .X = X_Mid+X
'      .Y = Y_Mid+Y
'      C = Point (X-Img_Top, Y-Img_Lft, Img_buffer)
'      If C <> RGB(255, 0, 255) Then
'        .C = C
'      Else
'        .C = RGB(0, 0, 0)
'      End If
'    End With
'  Next X
'Next Y
'
'''  we don't need the sprite anymore, kill it
'ImageDestroy Img_Buffer
'Img_Buffer = 0
'
'''  main program loop
'Do
'
'  ''  scale in/out with uparrow/downarrow
'  If Multikey(80) Then
'    Scale *= 1.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(72) Then
'    Scale *= 0.97
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  rotate left/right with leftarrow/rightarrow
'  If Multikey(77) Then
'    Angle -= 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(75) Then
'    Angle += 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  lock screen in order to use screen pointers
'  ScreenLock
'
'    ''  draw pixel in center of image
'    Scrn_Ptr[ X_Mid + Y_Mid * scrn_wid ] = Pixel(0, 0).C
'    ''  draw all other pixels - 4 at a time
'    For Y = Img_Top to 0
'      For X = Img_Lft to -1
'        ''  find pixel positions
'        P1 = (X_Mid+X) + (Y_Mid+Y) * scrn_wid
'        P2 = (X_Mid-X) + (Y_Mid-Y) * scrn_wid
'        P3 = (X_Mid+Y) + (Y_Mid-X) * scrn_wid
'        P4 = (X_Mid-Y) + (Y_Mid+X) * scrn_wid
'        ''  erase old pixels (paint them black)
'        Scrn_Ptr[P1] = 0
'        Scrn_Ptr[P2] = 0
'        Scrn_Ptr[P3] = 0
'        Scrn_Ptr[P4] = 0
'        ''  rotate and zoom
'        Rot_Fac_X = X*Cos_Ang - Y*Sin_Ang
'        Rot_Fac_Y = X*Sin_Ang + Y*Cos_Ang
'        If Rot_Fac_X < Img_Lft Or Rot_Fac_X > Img_Rgt Then Continue For
'        If Rot_Fac_Y < Img_Top Or Rot_Fac_Y > Img_Btm Then Continue For
'        ''  draw new pixels
'        Scrn_Ptr[P1] = Pixel(Rot_Fac_X, Rot_Fac_Y).C
'        Scrn_Ptr[P2] = Pixel(-Rot_Fac_X, -Rot_Fac_Y).C
'        Scrn_Ptr[P3] = Pixel(Rot_Fac_Y, -Rot_Fac_X).C
'        Scrn_Ptr[P4] = Pixel(-Rot_Fac_Y, Rot_Fac_X).C
'      Next X
'    Next Y
'
'  ScreenUnLock
'
'  Sleep 10, 1
'Loop Until InKey() = Chr(27)
 
' UPDATES:
' Fixed bug where values 135, 224, and 314 all resolve to -45 degrees.
' Fixed bug where an angle of 46-135 degrees caused the image to be flipped wrong.
 
' TODO:
' Fix issue where image looks bad at 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
Sub ShearRotate (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotateTest1
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim in$
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print
 
    sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
    Print "Initial contents of Rotation Array:"
    Print RotationArrayToStringTest(RoArray1())
    Print
 
    ' ROTATE THE SHAPE
    Do
        Print "Type degrees to rotate (0 TO 360) or non-numeric value to quit."
        Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
 
        Input "Degrees to rotate (q to quit)? "; in$
        If IsNum%(in$) Then
            D = Val(in$)
            If D >= 0 And D <= 360 Then
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
End Sub ' ShearRotateTest1
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotateTest2
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotateTest2
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "11111111111111111111111111111111" + Chr$(13) ' 1
    m$ = m$ + "4..............................2" + Chr$(13) ' 2
    m$ = m$ + "4....##.....#######.....####...2" + Chr$(13) ' 3
    m$ = m$ + "4...####....##...###...######..2" + Chr$(13) ' 4
    m$ = m$ + "4..##..##...##...###..##....##.2" + Chr$(13) ' 5
    m$ = m$ + "4.##....##..#######...##.......2" + Chr$(13) ' 6
    m$ = m$ + "4.########..#######...##.......2" + Chr$(13) ' 7
    m$ = m$ + "4.########..##...###..##....##.2" + Chr$(13) ' 8
    m$ = m$ + "4.##....##..##...###...######..2" + Chr$(13) ' 9
    m$ = m$ + "4.##....##..#######.....####...2" + Chr$(13) ' 10
    m$ = m$ + "4..............................2" + Chr$(13) ' 11
    m$ = m$ + "4..............................2" + Chr$(13) ' 12
    m$ = m$ + "4..ABBBBBBBBBBBBBBBBBBBBBBBBC..2" + Chr$(13) ' 13
    m$ = m$ + "4..A...........EE...........C..2" + Chr$(13) ' 14
    m$ = m$ + "4..A..........FFFF..........C..2" + Chr$(13) ' 15
    m$ = m$ + "4..A.........GGGGGG.........C..2" + Chr$(13) ' 16
    m$ = m$ + "4..A........HHHHHHHH........C..2" + Chr$(13) ' 17
    m$ = m$ + "4..A.......IIIIIIIIII.......C..2" + Chr$(13) ' 18
    m$ = m$ + "4..A......JJJJJJJJJJJJ......C..2" + Chr$(13) ' 19
    m$ = m$ + "4..DDDDDDDDDDDDDDDDDDDDDDDDDC..2" + Chr$(13) ' 20
    m$ = m$ + "4..............................2" + Chr$(13) ' 21
    m$ = m$ + "4..............................2" + Chr$(13) ' 22
    m$ = m$ + "4.######....########..########.2" + Chr$(13) ' 23
    m$ = m$ + "4.#######...########..########.2" + Chr$(13) ' 24
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 25
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 26
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 27
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 28
    m$ = m$ + "4.#######...##........##.......2" + Chr$(13) ' 29
    m$ = m$ + "4.######....########..##.......2" + Chr$(13) ' 30
    m$ = m$ + "4..............................2" + Chr$(13) ' 31
    m$ = m$ + "33333333333333333333333333333332" + Chr$(13) ' 32
    TestSprite1$ = m$
End Function ' TestSprite1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite2$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "...............AA..............." + Chr$(13) ' 1
    m$ = m$ + "..............//BB.............." + Chr$(13) ' 2
    m$ = m$ + ".............??..CC............." + Chr$(13) ' 3
    m$ = m$ + "............==....DD............" + Chr$(13) ' 4
    m$ = m$ + "...........++......EE..........." + Chr$(13) ' 5
    m$ = m$ + "..........&&........FF.........." + Chr$(13) ' 6
    m$ = m$ + ".........zz..........GG........." + Chr$(13) ' 7
    m$ = m$ + "........yy............HH........" + Chr$(13) ' 8
    m$ = m$ + ".......xx..............II......." + Chr$(13) ' 9
    m$ = m$ + "......ww................JJ......" + Chr$(13) ' 10
    m$ = m$ + ".....vv..................KK....." + Chr$(13) ' 11
    m$ = m$ + "....uu....................LL...." + Chr$(13) ' 12
    m$ = m$ + "...tt......DDAAAAAAA.......MM..." + Chr$(13) ' 13
    m$ = m$ + "..ss.......DDAAAAAAA........NN.." + Chr$(13) ' 14
    m$ = m$ + ".rr........DD.....BB.........OO." + Chr$(13) ' 15
    m$ = m$ + "qq.........DD.....BB..........PP" + Chr$(13) ' 16
    m$ = m$ + "pp.........DD.....BB..........QQ" + Chr$(13) ' 17
    m$ = m$ + ".oo........DD.....BB.........RR." + Chr$(13) ' 18
    m$ = m$ + "..nn.......CCCCCCCBB........SS.." + Chr$(13) ' 19
    m$ = m$ + "...mm......CCCCCCCBB.......TT..." + Chr$(13) ' 20
    m$ = m$ + "....ll....................UU...." + Chr$(13) ' 21
    m$ = m$ + ".....kk..................VV....." + Chr$(13) ' 22
    m$ = m$ + "......jj................WW......" + Chr$(13) ' 23
    m$ = m$ + ".......ii..............XX......." + Chr$(13) ' 24
    m$ = m$ + "........hh............YY........" + Chr$(13) ' 25
    m$ = m$ + ".........gg..........ZZ........." + Chr$(13) ' 26
    m$ = m$ + "..........ff........@@.........." + Chr$(13) ' 27
    m$ = m$ + "...........ee......##..........." + Chr$(13) ' 28
    m$ = m$ + "............dd....$$............" + Chr$(13) ' 29
    m$ = m$ + ".............cc..%%............." + Chr$(13) ' 30
    m$ = m$ + "..............bb\\.............." + Chr$(13) ' 31
    m$ = m$ + "...............aa..............." + Chr$(13) ' 32
    TestSprite2$ = m$
End Function ' TestSprite2$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToString$ (MyArray( 1 To 32 , 1 To 32) As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        MyString = MyString + sLine + Chr$(13)
    Next iY
    ArrayToString$ = MyString
End Function ' ArrayToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToStringTest$ (MyArray() As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
 
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    ArrayToStringTest$ = MyString
End Function ' ArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function RotationArrayToStringTest$ (RoArray() As RotationType)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    For iY = LBound(RoArray, 1) To UBound(RoArray, 1)
        sLine = ""
        sLine = sLine + Right$("    " + cstr$(iY), 3)
        For iX = LBound(RoArray, 2) To UBound(RoArray, 2)
            sLine = sLine + Chr$(RoArray(iX, iY, 0).c)
        Next iX
        sLine = sLine + Right$("   " + cstr$(iY), 3)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    RotationArrayToStringTest$ = MyString
End Function ' RotationArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
' 1. split string by line breaks CHR$(13)
' 2. split lines up to 1 column per char
' 3. count rows, columns
' 4. DIM array, making sure array has
'    a) an _ODD_ number of rows/columns, with a center point
'    b) index is in cartesian format, where center is (0,0)
' 5. populate array with contents of string
 
' dimension #1 = columns
' dimension #2 = rows
 
Sub StringToRotationArray (RoArray() As RotationType, MyString As String, EmptyChar As String)
    Dim RoutineName As String: RoutineName = "StringToRotationArray"
    ReDim arrLines$(0)
    Dim delim$
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iColCount As Integer
    Dim iRowCount As Integer
    Dim iCount As Integer
    Dim bAddedRow As Integer: bAddedRow = FALSE
    Dim bAddedColumn As Integer: bAddedColumn = FALSE
    Dim iHalf1 As Integer
    Dim iHalf2 As Integer
    Dim iFrom1 As Integer
    Dim iFrom2 As Integer
    Dim iTo1 As Integer
    Dim iTo2 As Integer
    Dim iEmpty As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
 
    iRowCount = UBound(arrLines$) + 1
 
    ' look at all the rows and find the max # of columns used
    iColCount = 0
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
 
        ' count the columns for this row
        iCount = 0
        For iCol% = 1 To Len(arrLines$(iRow%))
            iCount = iCount + 1
        Next iCol%
 
        ' if this row has the most so far, then set that to the max
        If iCount > iColCount Then
            iColCount = iCount
        End If
    Next iRow%
 
    ' adjust columns to be odd
    If IsEven%(iColCount) Then
        iColCount = iColCount + 1
        bAddedColumn = TRUE
    End If
 
    ' calculate array bounds for columns
    iHalf1 = (iColCount - 1) / 2
    iFrom1 = 0 - iHalf1
    iTo1 = iHalf1
 
    ' adjust rows to be odd
    If IsEven%(iRowCount) Then
        iRowCount = iRowCount + 1
        bAddedRow = TRUE
    End If
 
    ' calculate array bounds for rows
    iHalf2 = (iRowCount - 1) / 2
    iFrom2 = 0 - iHalf2
    iTo2 = iHalf2
 
    ' size array to new bounds
    ReDim RoArray(iFrom1 To iTo1, iFrom2 To iTo2, 127) As RotationType
 
    ' get value for empty
    If Len(EmptyChar) > 0 Then
        iEmpty = Asc(EmptyChar)
    Else
        iEmpty = 32 ' (use space as default)
    End If
 
    ' clear array
    For iY = LBound(RoArray, 2) To UBound(RoArray, 2)
        For iX = LBound(RoArray, 1) To UBound(RoArray, 1)
            RoArray(iX, iY, 0).c = iEmpty
            RoArray(iX, iY, 0).origx = iX
            RoArray(iX, iY, 0).origy = iY
        Next iX
    Next iY
 
    ' fill array
    iY = LBound(RoArray, 2) - 1
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        iY = iY + 1
        iX = LBound(RoArray, 1) - 1
        For iCol% = 1 To Len(arrLines$(iRow%))
            iX = iX + 1
            sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
            RoArray(iX, iY, 0).c = Asc(sChar$)
        Next iCol%
    Next iRow%
 
End Sub ' StringToRotationArray
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: Petr on December 21, 2021, 04:09:35 am

I tried to write text rotation using text commands on a text screen in my own way. It's gratifying that my rendering is as bad as yours. I guess that's the screen resolution. Try to write down the coordinates of individual points and you will see for yourself. They must not be a pair with the same coordinates, but because you rotate in a field (as I understood by a quick look at your program), some characters are printed on top of each other. I am adding a simplified custom version for text rotation. Uncommenting the GoTo command starts the same thing in the graphical design, where it works nicely. What is there otherwise? Coordinate calculation. What is the character ratio - witdht/height in text mode? 1: 1. What is the aspect ratio of the character in graphics mode? For FONT 16 it is 8 pixels wide, 16 pixels high. I guess that's the problem.

Maybe it can really be done better in text mode, if someone can do it, I'll be happy to learn something new.

Code: QB64: [Select]

Screen _NewImage(60, 60, 0) 'text screen 60x60
 
'TEXT MODE
text$ = "It's a SCREEN resolution?"
 
 
Lenght = Len(text$)
 
Type XY
    X As Integer
    Y As Integer
End Type
Dim XY(Lenght) As XY
 
'GoTo graphic        'uncomment this for view better output
 
Do
    angle = angle + 0.01
    For coordinate = 0 To Lenght
        XY(coordinate).X = 30 + Sin(angle) * coordinate
        XY(coordinate).Y = 30 + Cos(angle) * coordinate
    Next
 
    For PrintIt = 0 To Lenght
        Locate XY(PrintIt).Y, XY(PrintIt).X: Print Mid$(text$, PrintIt, 1)
    Next
    _Limit 15
    Cls
Loop
 
'GRAPHIC MODE
graphic:
Screen _NewImage(800, 800, 256)
 
 
 
Do
    angle = angle + 0.01
    For coordinate = 0 To Lenght
        XY(coordinate).X = 400 + Sin(angle) * coordinate * 16
        XY(coordinate).Y = 400 + Cos(angle) * coordinate * 16
    Next
 
    For PrintIt = 0 To Lenght
        _PrintString (XY(PrintIt).X, XY(PrintIt).Y), Mid$(text$, PrintIt, 1)
    Next
    _Limit 15
    Cls
Loop
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: STxAxTIC on December 21, 2021, 04:20:36 am

Just by the looks of things, it's a binning problem. Without digging into the code, I know that rotations are usually done in some kind of polar coordinates, in which case a differential "box" is a weird pie-slice type shape. In regular screen/cartesian coordinates, of course, boxes are just boxes. Point is, I think some letters are drawing directly on top of others in your special cases. Just an armchair speculation.

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 21, 2021, 11:41:26 am

Quote from: Petr on December 21, 2021, 04:09:35 am

They must not be a pair with the same coordinates, but because you rotate in a field (as I understood by a quick look at your program), some characters are printed on top of each other.

Aha! That totally makes sense.
Thanks for your reply.

I took your example and added a check to see if any characters are missing at a given angle
(code below) - it happens a lot!

Perhaps if we check first to make sure we aren't overwriting a character,
we add it to a "find somewhere for this to go" list and skip it for now,
then at the end, we go through that list, and place each of them in the nearest optimal blank space?
I'm not sure what the logic to determine which is the optimal space would be,
we'd have to play with it...
Anyway, thanks for your reply, that definitely explains it.

Code: QB64: [Select]

' ################################################################################################################################################################
' Petr's rotation routine
' https://www.qb64.org/forum/index.php?topic=4502.msg139260#msg139260
 
' Changes: missing characters check added by madscijr
' ################################################################################################################################################################
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' UDTs
Type XY
    X As Integer
    Y As Integer
End Type
 
' global variables
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
 
' local variables
Dim in$
 
' start menu
Screen 0: _ScreenMove 0, 0
main
 
' done
Input "Press <ENTER> to continue", in$
System ' return control to the operating system
End
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim in$
 
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Petr's rotation demo"
        Print
        Print "1. TEXT MODE"
        Print "2. GRAPHIC MODE"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(Left$(in$, 1))
 
        If in$ = "1" Then
            PetrRotateTextMode
        ElseIf in$ = "2" Then
            PetrRotateGraphicMode
        End If
 
        _KeyClear
    Loop Until in$ = "q"
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' TEXT MODE
 
Sub PetrRotateTextMode
    Dim text$
    Dim Lenght As Integer
    ReDim XY(-1) As XY
    Dim angle As Single
    Dim coordinate As Integer
    Dim PrintIt As Integer
    Dim chars$
    Dim missing$
    Dim in$
 
    Screen _NewImage(60, 60, 0) ' text screen 60x60
    _ScreenMove 0, 0
 
    text$ = "It's a SCREEN resolution?"
    Lenght = Len(text$)
    ReDim XY(Lenght) As XY
    angle = 0
    missing$ = ""
 
    Cls
    Do
        Cls
        angle = angle + 0.01
        For coordinate = 0 To Lenght
            XY(coordinate).X = 30 + Sin(angle) * coordinate
            XY(coordinate).Y = 30 + Cos(angle) * coordinate
        Next coordinate
        For PrintIt = 0 To Lenght
            Locate XY(PrintIt).Y, XY(PrintIt).X
            Print Mid$(text$, PrintIt, 1)
        Next PrintIt
        chars$ = CharsMissing$(text$, 5, 0, 0, 0)
        missing$ = Replace$(chars$, " ", "")
 
        Locate 1, 1
        Print "rotation angle: " + _Trim$(Str$(angle))
        Print "rotation text : " + Chr$(34) + text$ + Chr$(34)
        Print "chars missing : " + IIFSTR$(Len(missing$) = 0, "(none)", Chr$(34) + chars$ + Chr$(34))
        If Len(missing$) > 0 Then
            Input "PRESS <ENTER> TO CONTINUE OR q TO QUIT"; in$
            If in$ = "q" Then Exit Do
        Else
            Print "PRESS <ESC> TO QUIT"
        End If
 
        _Limit 15
    Loop Until _KeyDown(27) ' leave loop when ESC key pressed
    _KeyClear
End Sub ' PetrRotateTextMode
 
' /////////////////////////////////////////////////////////////////////////////
 
Function CharsMissing$ (MyString As String, iStartLine1 As Integer, iEndLine1 As Integer, iStartColumn1 As Integer, iEndColumn1 As Integer)
    Dim x As Integer
    Dim y As Integer
    Dim iLen As Integer
    Dim TestString As String
    Dim i154 As Integer
    Dim iPinkFlag As Integer
    Dim iStartLine As Integer
    Dim iEndLine As Integer
    Dim iStartColumn As Integer
    Dim iEndColumn As Integer
 
    If iStartLine1 > 0 And iStartLine1 <= _Height(0) Then
        iStartLine = iStartLine1
    Else
        iStartLine = 1
    End If
    If iEndLine1 > 0 And iEndLine1 <= _Height(0) Then
        iEndLine = iEndLine1
    Else
        iEndLine = _Height(0)
    End If
    If iStartColumn1 > 0 And iStartColumn1 <= _Width(0) Then
        iStartColumn = iStartColumn1
    Else
        iStartColumn = 1
    End If
    If iEndColumn1 > 0 And iEndColumn1 <= _Width(0) Then
        iEndColumn = iEndColumn1
    Else
        iEndColumn = _Width(0)
    End If
 
    TestString = MyString
 
    iLen = Len(MyString)
 
    For x = iStartColumn To iEndColumn
        For y = iStartLine To iEndLine
            'codeorcolor% = SCREEN (row%, column% [, colorflag%])
            i154 = Screen(y, x)
            iPinkFlag = InStr(1, TestString, Chr$(i154))
            If iPinkFlag > 0 Then
                If iPinkFlag = 1 Then
                    TestString = " " + Right$(TestString, Len(TestString) - 1)
                ElseIf iPinkFlag = Len(TestString) Then
                    TestString = Left$(TestString, Len(TestString) - 1) + " "
                    'TestString = left$(TestString, len(TestString)-1)
                Else
                    TestString = Left$(TestString, iPinkFlag - 1) + " " + Right$(TestString, Len(TestString) - iPinkFlag)
                    'TestString = left$(TestString, iPinkFlag-1) + right$(TestString, Len(TestString)-iPinkFlag)
                End If
            End If
        Next y
    Next x
 
    'CharsMissing$ = Replace$ (TestString, " ", "")
    CharsMissing$ = TestString
End Function ' CharsMissing$
 
' /////////////////////////////////////////////////////////////////////////////
' GRAPHIC MODE
 
Sub PetrRotateGraphicMode
    Dim text$
    Dim Lenght As Integer
    ReDim XY(-1) As XY
    Dim angle As Double
    Dim coordinate As Integer
    Dim PrintIt As Integer
 
    Screen _NewImage(800, 800, 256)
    _ScreenMove 0, 0
 
    text$ = "It's a SCREEN resolution?"
    Lenght = Len(text$)
    ReDim XY(Lenght) As XY
    angle = 0
 
    Do
        Cls
        Print "PRESS <ESC> TO QUIT"
        angle = angle + 0.01
        For coordinate = 0 To Lenght
            XY(coordinate).X = 400 + Sin(angle) * coordinate * 16
            XY(coordinate).Y = 400 + Cos(angle) * coordinate * 16
        Next coordinate
        For PrintIt = 0 To Lenght
            _PrintString (XY(PrintIt).X, XY(PrintIt).Y), Mid$(text$, PrintIt, 1)
        Next PrintIt
        _Limit 15
    Loop Until _KeyDown(27) ' leave loop when ESC key pressed
    _KeyClear
End Sub ' PetrRotateGraphicMode
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.qb64.org)
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 21, 2021, 11:42:59 am

Quote from: STxAxTIC on December 21, 2021, 04:20:36 am

Just by the looks of things, it's a binning problem. Without digging into the code, I know that rotations are usually done in some kind of polar coordinates, in which case a differential "box" is a weird pie-slice type shape. In regular screen/cartesian coordinates, of course, boxes are just boxes. Point is, I think some letters are drawing directly on top of others in your special cases. Just an armchair speculation.

I think you're right. @Petr replied with a little demo program that illustrates just that.
Thanks for your reply!

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 21, 2021, 02:12:23 pm

Well @Petr and @STxAxTIC, I tried writing some logic to handle the issue you pointed out.
It takes any points that would have overwritten an already occupied point on the screen,
and tries to place them in an adjacent unused space.
This is more of a proof of concept, the logic is simple and surely flawed,
but it seems to produce better looking results than without it?

Before & after #1.
Rotated to 30 degrees.

Old logic (ShearRotateTest2) has many lost points:
[ This attachment cannot be displayed inline in 'Print Page' view ]

New logic (ShearRotateTest3) has a lot less lost points:
[ This attachment cannot be displayed inline in 'Print Page' view ]

Before & after #2 (simpler example!)
Rotated to 30 degrees.

Old logic (ShearRotateTest2) has lost points:
[ This attachment cannot be displayed inline in 'Print Page' view ]

New logic (ShearRotateTest3) has no lost points:
[ This attachment cannot be displayed inline in 'Print Page' view ]

Run the below code and judge for yourself.
You will see menu options

Code: [Select]

6. ShearRotateTest2 (auto advances 0-360 degrees)"
7. ShearRotateTest2 (auto advances 0-360 degrees) (uses Petr's text)"
8. ShearRotateTest3 (tries to correct for missing points)"
9. ShearRotateTest3 (tries to correct for missing points) (uses Petr's text)"

Choose option 6 or 7 for the original "lossy" rotation (the only difference is 7 uses the string from @Petr 's program).
It now counts and displays the # of "lost" points that are overwritten, for the current rotation angle.
You'll see the lost points show up at 30, 60, 120, 150, etc. angles.

Choose option 8 or 9 for the new logic (the only difference is 9 uses the string from @Petr 's program).
It counts and displays the # of "lost" points that were not successfully relocated, for the current rotation angle.
You'll see a lot less lost points now at 30, 60, 120, 150, etc. angles.

The way the current logic works is, it keeps looking for an empty space farther out in the given direction until it either finds one or reaches the boundary of the screen.
So it could theoretically plot a point 2 or more spaces away that are no longer adjacent, yielding some funky looking results.
I think the logic could be improved where, if it doesn't find an empty space immediatly above/below, to the right/left, or diagonally,
it can try looking one space in the opposite directions, and if not, then quit.

Thoughts?

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Basic 2D plotting functions
' Version 1.00 by madscijr
' with help from various (sources cited below).
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS
' =============================================================================
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' -----------------------------------------------------------------------------
' USER DEFINED TYPES
' -----------------------------------------------------------------------------
Type RotationType
    origx As Integer
    origy As Integer
    'z as integer
    c As Integer
End Type ' RotationType
 
' -----------------------------------------------------------------------------
' GLOBAL VARIABLES
' -----------------------------------------------------------------------------
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug: m_bDebug = TRUE
 
' =============================================================================
' BEGIN MAIN PROGRAM
' =============================================================================
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' START THE MENU
main
 
' -----------------------------------------------------------------------------
' DONE
Print m_ProgramName$ + " finished."
'Screen 0
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' EXIT
System ' return control to the operating system
End
 
' =============================================================================
' END MAIN PROGRAM
' =============================================================================
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
 
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Some basic 2D plotting"
        Print
        Print "1. PlotPointTest"
        Print "2. PlotSquareTest"
        Print "3. PlotCircleTest"
        Print "4. PlotLineTest"
        Print "5. ShearRotateTest1"
        Print "6. ShearRotateTest2 (auto advances 0-360 degrees)"
        Print "7. ShearRotateTest2 (auto advances 0-360 degrees) (uses Petr's text)"
        Print "8. ShearRotateTest3 (tries to correct for missing points)"
        Print "9. ShearRotateTest3 (tries to correct for missing points) (uses Petr's text)"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(Left$(in$, 1))
 
        If in$ = "1" Then
            PlotPointTest
        ElseIf in$ = "2" Then
            PlotSquareTest
        ElseIf in$ = "3" Then
            PlotCircleTest
        ElseIf in$ = "4" Then
            PlotLineTest
        ElseIf in$ = "5" Then
            ShearRotateTest1
        ElseIf in$ = "6" Then
            ShearRotateTest2 TestSprite1$
        ElseIf in$ = "7" Then
            ShearRotateTest2 PetrText1$
        ElseIf in$ = "8" Then
            ShearRotateTest3 TestSprite1$
        ElseIf in$ = "9" Then
            ShearRotateTest3 PetrText1$
        End If
    Loop Until in$ = "q"
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' MyArray(1 To 32, 1 To 32) AS STRING
 
Sub PlotPoint (X As Integer, Y As Integer, S As String, MyArray() As String)
    If (X >= LBound(MyArray, 2)) Then
        If (X <= UBound(MyArray, 2)) Then
            If (Y >= LBound(MyArray, 1)) Then
                If (Y <= UBound(MyArray, 1)) Then
                    If Len(S) = 1 Then
                        MyArray(Y, X) = S
                    Else
                        If Len(S) > 1 Then
                            MyArray(Y, X) = Left$(S, 1)
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub ' PlotPoint
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotPointTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a point."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type x,y (1-32, 1-32) coordinate to plot point at."
        Input "X,Y OR 0 TO QUIT? "; X, Y
        If X > 0 And Y > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X) + ", Y=" + cstr$(Y)
            PlotPoint X, Y, Chr$(iChar), MyArray()
 
            Print "Current point plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotPointTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquare (X1 As Integer, Y1 As Integer, L As Integer, S As String, MyArray() As String)
    Dim X As Integer
    Dim X2 As Integer
    Dim Y As Integer
    Dim Y2 As Integer
    Dim sChar$
 
    If Len(S) = 1 Then
        sChar$ = S
    Else
        If Len(S) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(S, 1)
        End If
    End If
 
    X2 = (X1 + L) - 1
    Y2 = (Y1 + L) - 1
    For X = X1 To X2
        For Y = Y1 To Y2
            PlotPoint X, Y, sChar$, MyArray()
        Next Y
    Next X
End Sub ' PlotSquare
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquareTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Enter parameters to draw a square."
    Print ArrayToStringTest(MyArray())
    Print
    Do
        Print "Type top left x,y (1-32, 1-32) coordinate to plot square,"
        Print "and size (1-32) of square."
        Input "X,Y,L OR 0 TO QUIT? "; X, Y, L
        If X > 0 And Y > 0 And L > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "L=" + cstr$(L)
            Print
            PlotSquare X, Y, L, Chr$(iChar), MyArray()
 
            Print "Square plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotSquareTest
 
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
 
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
 
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
 
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM  : FAST CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
 
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
 
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
 
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM  : SLOW CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
 
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK   1 (drawing a pixel), 0 (erasing a pixel)
' X     X coordinate of the pixel
' Y     Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
 
' More on plotting circles:
'     Drawing a circle in BASIC - fast
'     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
 
' X,Y     = center point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircle (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        B = R
        C = 0
        A = R - 1
        Do
            PlotPoint X + C, Y + B, S2, MyArray()
            PlotPoint X + C, Y - B, S2, MyArray()
            PlotPoint X - C, Y - B, S2, MyArray()
            PlotPoint X - C, Y + B, S2, MyArray()
            PlotPoint X + B, Y + C, S2, MyArray()
            PlotPoint X + B, Y - C, S2, MyArray()
            PlotPoint X - B, Y - C, S2, MyArray()
            PlotPoint X - B, Y + C, S2, MyArray()
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then ' IF A>=0 THEN 190
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do ' 190 IF B>=C THEN 60
        Loop
    End If
End Sub ' PlotCircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a raster circle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotCircle X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotCircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
' From: http://www.thedubber.altervista.org/qbsrc.htm
 
Sub PlotLine (x1%, y1%, x2%, y2%, c$, MyArray() As String)
    Dim iLoop%
    Dim steep%: steep% = 0
    Dim ev%: ev% = 0
    Dim sx%
    Dim sy%
    Dim dx%
    Dim dy%
 
    If (x2% - x1%) > 0 Then
        sx% = 1
    Else
        sx% = -1
    End If
 
    dx% = Abs(x2% - x1%)
    If (y2% - y1%) > 0 Then
        sy% = 1
    Else
        sy% = -1
    End If
 
    dy% = Abs(y2% - y1%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x1%, y1%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
 
    ev% = 2 * dy% - dx%
    For iLoop% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y1%, x1%), c%:
            'LOCATE y1%, x1%
            'PRINT c$;
            PlotPoint y1%, x1%, c$, MyArray()
        Else
            ''PSET (x1%, y1%), c%
            'LOCATE x1%, y1%
            'PRINT c$;
            PlotPoint x1%, y1%, c$, MyArray()
        End If
 
        While ev% >= 0
            y1% = y1% + sy%
            ev% = ev% - 2 * dx%
        Wend
        x1% = x1% + sx%
        ev% = ev% + 2 * dy%
    Next iLoop%
    ''PSET (x2%, y2%), c%
    'LOCATE x2%, y2%
    'PRINT c$;
    PlotPoint x2%, y2%, c$, MyArray()
End Sub ' PlotLine
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotLineTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim in$
    Dim X1 As Integer
    Dim Y1 As Integer
    Dim X2 As Integer
    Dim Y2 As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot line with Bresenham Algorithm"
    Print "based on BRESNHAM.BAS by Kurt Kuzba (4/16/96)."
    Print
    Print ArrayToStringTest(MyArray())
    Do
        Print "Enter coordinate values for "
        Print "line start point x1, y1 (1-32, 1-32)"
        Print "line end   point x2, y2 (1-32, 1-32)"
        Input "ENTER X1,Y1,X2,Y2 OR 0 TO QUIT: "; X1, Y1, X2, Y2
        If X1 > 0 And Y1 > 0 And X2 > 0 And Y2 > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X1=" + cstr$(X1)
            Print "Y1=" + cstr$(Y1)
            Print "X2=" + cstr$(X2)
            Print "Y2=" + cstr$(Y2)
 
            PlotLine X1, Y1, X2, Y2, Chr$(iChar), MyArray()
 
            Print "Line plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotLineTest
 
' /////////////////////////////////////////////////////////////////////////////
' 3 shear method testing
 
' _PUT Rotation Help
' https://www.qb64.org/forum/index.php?topic=1959.0
 
' 3 Shear Rotation - rotates without any aliasing(holes)
' https://www.freebasic.net/forum/viewtopic.php?t=24557
 
' From: leopardpm
' Date: Apr 02, 2016 1:21
' Last edited by leopardpm on Apr 02, 2016 17:18, edited 1 time in total.
'
' This is just a little 3-shear rotation routine
' (I am using 3-shear because it leaves no gaps/aliasing)
' that I was wondering if anyone sees how to make it faster.
' Obviously, I am just thinking about inside the double loop.
 
' Thanks again to BasicCoder2 for linking me to this little routine, it is wonderful so far!
 
'''                      roto-zooming algorithm
'''                    coded by Michael S. Nissen
'''                        jernmager@yahoo.dk
'
''' ===============================================================
''' Recoded to run on FBC 32/64 bit WIN, Version 1.05.0, 2016, by MrSwiss
''' Heavy flickering before going Full-Screen on 64 Bit !!!
''' This seems NOT to be the Case on 32 Bit ...
''' ===============================================================
'
'Type Pixel
'  As Single   X, Y
'  As ULong    C
'End Type
'
'''  dim vars
'Dim shared as Any Ptr Img_Buffer
'''  write the name of the .bmp image you want to rotozoom here:
'''  (it has to be sqare ie. 100x100 pixels, 760x760 pixels or whatever)
'Dim As String Img_Name = "phobos.bmp"
'Dim shared as Integer X_Mid, Y_Mid, scrn_wid, scrn_hgt, P1, P2, P3, P4, C
'Dim shared as Short Img_Hgt, Img_Wid, Img_Lft, Img_Rgt, Img_Top, Img_Btm, X, Y
'Dim Shared As Single Cos_Ang, Sin_Ang, Rot_Fac_X, Rot_Fac_Y, Angle = 0, Scale = 1
'
''' changed Function to Sub (+ recoded arguments list)
'Sub Calc_rotozoom ( ByRef Cos_Ang As Single, _
'               ByRef Sin_Ang As Single, _
'               ByVal S_Fact  As Single, _
'               ByVal NewAng  As Single )
'  Cos_Ang = Cos(NewAng)*S_Fact
'  Sin_Ang = Sin(NewAng)*S_Fact
'End Sub
'
'''  full screen
'ScreenInfo scrn_wid, scrn_hgt
'screenRes scrn_wid, scrn_hgt, 32,,1
'
'''  dim screenpointer (has to be done after screenres)
'Dim As ULong Ptr Scrn_Ptr = Screenptr
'
'''  place image in center of screen
'X_Mid = scrn_wid\2
'Y_Mid = scrn_hgt\2
'Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'
'''  find image dimensions
'Open Img_Name For Binary As #1
'Get #1, 19, Img_Wid
'Get #1, 23, Img_Hgt
'Close #1
'
'''  prepare to dim the array that will hold the image.
'Img_Rgt = (Img_Wid-1)\2
'Img_Lft = -Img_Rgt
'Img_Btm = (Img_Hgt-1)\2
'Img_Top = -Img_Btm
'
'''  dim array to hold image. Note: pixel (0, 0) is in the center.
'Dim As Pixel Pixel(Img_Lft to Img_Rgt, Img_Top to Img_Btm)
'
'''  imagecreate sprite and load image to sprite
'Img_Buffer = ImageCreate (Img_Wid, Img_Hgt)
'Bload (Img_Name, Img_Buffer)
'
'''  load image from sprite to array with point command
'For Y = Img_Top to Img_Btm
'  For X = Img_Lft to Img_Rgt
'    With Pixel(X, Y)
'      .X = X_Mid+X
'      .Y = Y_Mid+Y
'      C = Point (X-Img_Top, Y-Img_Lft, Img_buffer)
'      If C <> RGB(255, 0, 255) Then
'        .C = C
'      Else
'        .C = RGB(0, 0, 0)
'      End If
'    End With
'  Next X
'Next Y
'
'''  we don't need the sprite anymore, kill it
'ImageDestroy Img_Buffer
'Img_Buffer = 0
'
'''  main program loop
'Do
'
'  ''  scale in/out with uparrow/downarrow
'  If Multikey(80) Then
'    Scale *= 1.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(72) Then
'    Scale *= 0.97
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  rotate left/right with leftarrow/rightarrow
'  If Multikey(77) Then
'    Angle -= 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(75) Then
'    Angle += 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  lock screen in order to use screen pointers
'  ScreenLock
'
'    ''  draw pixel in center of image
'    Scrn_Ptr[ X_Mid + Y_Mid * scrn_wid ] = Pixel(0, 0).C
'    ''  draw all other pixels - 4 at a time
'    For Y = Img_Top to 0
'      For X = Img_Lft to -1
'        ''  find pixel positions
'        P1 = (X_Mid+X) + (Y_Mid+Y) * scrn_wid
'        P2 = (X_Mid-X) + (Y_Mid-Y) * scrn_wid
'        P3 = (X_Mid+Y) + (Y_Mid-X) * scrn_wid
'        P4 = (X_Mid-Y) + (Y_Mid+X) * scrn_wid
'        ''  erase old pixels (paint them black)
'        Scrn_Ptr[P1] = 0
'        Scrn_Ptr[P2] = 0
'        Scrn_Ptr[P3] = 0
'        Scrn_Ptr[P4] = 0
'        ''  rotate and zoom
'        Rot_Fac_X = X*Cos_Ang - Y*Sin_Ang
'        Rot_Fac_Y = X*Sin_Ang + Y*Cos_Ang
'        If Rot_Fac_X < Img_Lft Or Rot_Fac_X > Img_Rgt Then Continue For
'        If Rot_Fac_Y < Img_Top Or Rot_Fac_Y > Img_Btm Then Continue For
'        ''  draw new pixels
'        Scrn_Ptr[P1] = Pixel(Rot_Fac_X, Rot_Fac_Y).C
'        Scrn_Ptr[P2] = Pixel(-Rot_Fac_X, -Rot_Fac_Y).C
'        Scrn_Ptr[P3] = Pixel(Rot_Fac_Y, -Rot_Fac_X).C
'        Scrn_Ptr[P4] = Pixel(-Rot_Fac_Y, Rot_Fac_X).C
'      Next X
'    Next Y
'
'  ScreenUnLock
'
'  Sleep 10, 1
'Loop Until InKey() = Chr(27)
 
' UPDATES:
' Fixed bug where values 135, 224, and 314 all resolve to -45 degrees.
' Fixed bug where an angle of 46-135 degrees caused the image to be flipped wrong.
 
' TODO:
' Fix issue where image looks bad at 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
Sub ShearRotate (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate
 
' /////////////////////////////////////////////////////////////////////////////
' Same as ShearRotate, except adds iOverwriteCount parameter,
' and counts how many points are overwriting existing points,
' and return that value byref in parameter iOverwriteCount.
 
Sub ShearRotate1 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iOverwriteCount As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    iOverwriteCount = 0
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
 
                    ' count points that will be overwritten
                    If NewArray(fx, fy, 0).c <> iEmpty Then
                        iOverwriteCount = iOverwriteCount + 1
                    End If
 
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate1
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate2 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iMissing As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the angle of rotation?
    ' perhaps if we divide the screen up into 4 zones:
    '
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '| 271-359 degrees)  | (1-89 degrees)   |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '| (181-269 degrees) | (91-179 degrees) |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   search direction (y,x)
    ' -------   ----------------------
    ' 1         up   + right
    ' 2         down + right
    ' 3         down + left
    ' 4         up   + left
 
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint%(arrLost(iLoop), angle1, iEmpty, x, y, NewArray())
        If bFound = TRUE Then
            If m_bDebug = TRUE Then
                _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        Else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        End If
    Next iLoop
 
End Sub ' ShearRotate2
 
' /////////////////////////////////////////////////////////////////////////////
' Receives
' FindMe (RotationType) = contains the starting location (.origx, .origy) to start looking from, and the value (.c) to write
' angle1 (Integer) = angle we were rotating to, to determine direction to look in
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint% (FindMe As RotationType, angle1 As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
 
    destX = 0
    destY = 0
 
    ' Choose search direction depending on the angle
    If angle1 > 0 And angle1 < 90 Then
        dirX = 1
        dirY = -1
    ElseIf angle1 > 90 And angle1 < 180 Then
        dirX = 1
        dirY = 1
    ElseIf angle1 > 180 And angle1 < 270 Then
        dirX = -1
        dirY = 1
    ElseIf angle1 > 270 And angle1 < 360 Then
        dirX = -1
        dirY = -1
    Else
        dirX = 0
        dirY = 0
    End If
 
    If dirX <> 0 Then
        x = FindMe.origx
        y = FindMe.origy
        Do
            ' quit if we're out of bounds
            If x < LBound(NewArray, 1) Then Exit Do
            If x > UBound(NewArray, 1) Then Exit Do
            If y < LBound(NewArray, 2) Then Exit Do
            If y > UBound(NewArray, 2) Then Exit Do
 
            ' look along y axis for a blank spot
            destX = x
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(destX, destY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look along x axis for a blank spot
            destX = x + dirX
            destY = y
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look diagonally for a blank spot
            destX = x + dirX
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' Keep looking
            x = x + dirX
            y = y + dirY
        Loop
    End If
 
    ' Return result
    FindEmptyShearRotationPoint% = bResult
End Function ' FindEmptyShearRotationPoint%
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotateTest1
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim in$
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print
 
    sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
    Print "Initial contents of Rotation Array:"
    Print RotationArrayToStringTest(RoArray1())
    Print
 
    ' ROTATE THE SHAPE
    Do
        Print "Type degrees to rotate (0 TO 360) or non-numeric value to quit."
        Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
 
        Input "Degrees to rotate (q to quit)? "; in$
        If IsNum%(in$) Then
            D = Val(in$)
            If D >= 0 And D <= 360 Then
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
End Sub ' ShearRotateTest1
 
' /////////////////////////////////////////////////////////////////////////////
' Now receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotateTest2 TestSprite1$
 
Sub ShearRotateTest2 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iOverwriteCount As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotateTest2
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points.
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotateTest3 TestSprite1$
 
Sub ShearRotateTest3 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotateTest3
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "11111111111111111111111111111111" + Chr$(13) ' 1
    m$ = m$ + "4..............................2" + Chr$(13) ' 2
    m$ = m$ + "4....##.....#######.....####...2" + Chr$(13) ' 3
    m$ = m$ + "4...####....##...###...######..2" + Chr$(13) ' 4
    m$ = m$ + "4..##..##...##...###..##....##.2" + Chr$(13) ' 5
    m$ = m$ + "4.##....##..#######...##.......2" + Chr$(13) ' 6
    m$ = m$ + "4.########..#######...##.......2" + Chr$(13) ' 7
    m$ = m$ + "4.########..##...###..##....##.2" + Chr$(13) ' 8
    m$ = m$ + "4.##....##..##...###...######..2" + Chr$(13) ' 9
    m$ = m$ + "4.##....##..#######.....####...2" + Chr$(13) ' 10
    m$ = m$ + "4..............................2" + Chr$(13) ' 11
    m$ = m$ + "4..............................2" + Chr$(13) ' 12
    m$ = m$ + "4..ABBBBBBBBBBBBBBBBBBBBBBBBC..2" + Chr$(13) ' 13
    m$ = m$ + "4..A...........EE...........C..2" + Chr$(13) ' 14
    m$ = m$ + "4..A..........FFFF..........C..2" + Chr$(13) ' 15
    m$ = m$ + "4..A.........GGGGGG.........C..2" + Chr$(13) ' 16
    m$ = m$ + "4..A........HHHHHHHH........C..2" + Chr$(13) ' 17
    m$ = m$ + "4..A.......IIIIIIIIII.......C..2" + Chr$(13) ' 18
    m$ = m$ + "4..A......JJJJJJJJJJJJ......C..2" + Chr$(13) ' 19
    m$ = m$ + "4..DDDDDDDDDDDDDDDDDDDDDDDDDC..2" + Chr$(13) ' 20
    m$ = m$ + "4..............................2" + Chr$(13) ' 21
    m$ = m$ + "4..............................2" + Chr$(13) ' 22
    m$ = m$ + "4.######....########..########.2" + Chr$(13) ' 23
    m$ = m$ + "4.#######...########..########.2" + Chr$(13) ' 24
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 25
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 26
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 27
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 28
    m$ = m$ + "4.#######...##........##.......2" + Chr$(13) ' 29
    m$ = m$ + "4.######....########..##.......2" + Chr$(13) ' 30
    m$ = m$ + "4..............................2" + Chr$(13) ' 31
    m$ = m$ + "33333333333333333333333333333332" + Chr$(13) ' 32
    TestSprite1$ = m$
End Function ' TestSprite1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite2$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "...............AA..............." + Chr$(13) ' 1
    m$ = m$ + "..............//BB.............." + Chr$(13) ' 2
    m$ = m$ + ".............??..CC............." + Chr$(13) ' 3
    m$ = m$ + "............==....DD............" + Chr$(13) ' 4
    m$ = m$ + "...........++......EE..........." + Chr$(13) ' 5
    m$ = m$ + "..........&&........FF.........." + Chr$(13) ' 6
    m$ = m$ + ".........zz..........GG........." + Chr$(13) ' 7
    m$ = m$ + "........yy............HH........" + Chr$(13) ' 8
    m$ = m$ + ".......xx..............II......." + Chr$(13) ' 9
    m$ = m$ + "......ww................JJ......" + Chr$(13) ' 10
    m$ = m$ + ".....vv..................KK....." + Chr$(13) ' 11
    m$ = m$ + "....uu....................LL...." + Chr$(13) ' 12
    m$ = m$ + "...tt......DDAAAAAAA.......MM..." + Chr$(13) ' 13
    m$ = m$ + "..ss.......DDAAAAAAA........NN.." + Chr$(13) ' 14
    m$ = m$ + ".rr........DD.....BB.........OO." + Chr$(13) ' 15
    m$ = m$ + "qq.........DD.....BB..........PP" + Chr$(13) ' 16
    m$ = m$ + "pp.........DD.....BB..........QQ" + Chr$(13) ' 17
    m$ = m$ + ".oo........DD.....BB.........RR." + Chr$(13) ' 18
    m$ = m$ + "..nn.......CCCCCCCBB........SS.." + Chr$(13) ' 19
    m$ = m$ + "...mm......CCCCCCCBB.......TT..." + Chr$(13) ' 20
    m$ = m$ + "....ll....................UU...." + Chr$(13) ' 21
    m$ = m$ + ".....kk..................VV....." + Chr$(13) ' 22
    m$ = m$ + "......jj................WW......" + Chr$(13) ' 23
    m$ = m$ + ".......ii..............XX......." + Chr$(13) ' 24
    m$ = m$ + "........hh............YY........" + Chr$(13) ' 25
    m$ = m$ + ".........gg..........ZZ........." + Chr$(13) ' 26
    m$ = m$ + "..........ff........@@.........." + Chr$(13) ' 27
    m$ = m$ + "...........ee......##..........." + Chr$(13) ' 28
    m$ = m$ + "............dd....$$............" + Chr$(13) ' 29
    m$ = m$ + ".............cc..%%............." + Chr$(13) ' 30
    m$ = m$ + "..............bb\\.............." + Chr$(13) ' 31
    m$ = m$ + "...............aa..............." + Chr$(13) ' 32
    TestSprite2$ = m$
End Function ' TestSprite2$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function PetrText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "....It's a SCREEN resolution?..." + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    PetrText1$ = m$
End Function ' PetrText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToString$ (MyArray( 1 To 32 , 1 To 32) As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        MyString = MyString + sLine + Chr$(13)
    Next iY
    ArrayToString$ = MyString
End Function ' ArrayToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToStringTest$ (MyArray() As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
 
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    ArrayToStringTest$ = MyString
End Function ' ArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function RotationArrayToStringTest$ (RoArray() As RotationType)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    For iY = LBound(RoArray, 1) To UBound(RoArray, 1)
        sLine = ""
        sLine = sLine + Right$("    " + cstr$(iY), 3)
        For iX = LBound(RoArray, 2) To UBound(RoArray, 2)
            sLine = sLine + Chr$(RoArray(iX, iY, 0).c)
        Next iX
        sLine = sLine + Right$("   " + cstr$(iY), 3)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    RotationArrayToStringTest$ = MyString
End Function ' RotationArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
' 1. split string by line breaks CHR$(13)
' 2. split lines up to 1 column per char
' 3. count rows, columns
' 4. DIM array, making sure array has
'    a) an _ODD_ number of rows/columns, with a center point
'    b) index is in cartesian format, where center is (0,0)
' 5. populate array with contents of string
 
' dimension #1 = columns
' dimension #2 = rows
 
Sub StringToRotationArray (RoArray() As RotationType, MyString As String, EmptyChar As String)
    Dim RoutineName As String: RoutineName = "StringToRotationArray"
    ReDim arrLines$(0)
    Dim delim$
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iColCount As Integer
    Dim iRowCount As Integer
    Dim iCount As Integer
    Dim bAddedRow As Integer: bAddedRow = FALSE
    Dim bAddedColumn As Integer: bAddedColumn = FALSE
    Dim iHalf1 As Integer
    Dim iHalf2 As Integer
    Dim iFrom1 As Integer
    Dim iFrom2 As Integer
    Dim iTo1 As Integer
    Dim iTo2 As Integer
    Dim iEmpty As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
 
    iRowCount = UBound(arrLines$) + 1
 
    ' look at all the rows and find the max # of columns used
    iColCount = 0
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
 
        ' count the columns for this row
        iCount = 0
        For iCol% = 1 To Len(arrLines$(iRow%))
            iCount = iCount + 1
        Next iCol%
 
        ' if this row has the most so far, then set that to the max
        If iCount > iColCount Then
            iColCount = iCount
        End If
    Next iRow%
 
    ' adjust columns to be odd
    If IsEven%(iColCount) Then
        iColCount = iColCount + 1
        bAddedColumn = TRUE
    End If
 
    ' calculate array bounds for columns
    iHalf1 = (iColCount - 1) / 2
    iFrom1 = 0 - iHalf1
    iTo1 = iHalf1
 
    ' adjust rows to be odd
    If IsEven%(iRowCount) Then
        iRowCount = iRowCount + 1
        bAddedRow = TRUE
    End If
 
    ' calculate array bounds for rows
    iHalf2 = (iRowCount - 1) / 2
    iFrom2 = 0 - iHalf2
    iTo2 = iHalf2
 
    ' size array to new bounds
    ReDim RoArray(iFrom1 To iTo1, iFrom2 To iTo2, 127) As RotationType
 
    ' get value for empty
    If Len(EmptyChar) > 0 Then
        iEmpty = Asc(EmptyChar)
    Else
        iEmpty = 32 ' (use space as default)
    End If
 
    ' clear array
    For iY = LBound(RoArray, 2) To UBound(RoArray, 2)
        For iX = LBound(RoArray, 1) To UBound(RoArray, 1)
            RoArray(iX, iY, 0).c = iEmpty
            RoArray(iX, iY, 0).origx = iX
            RoArray(iX, iY, 0).origy = iY
        Next iX
    Next iY
 
    ' fill array
    iY = LBound(RoArray, 2) - 1
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        iY = iY + 1
        iX = LBound(RoArray, 1) - 1
        For iCol% = 1 To Len(arrLines$(iRow%))
            iX = iX + 1
            sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
            RoArray(iX, iY, 0).c = Asc(sChar$)
        Next iCol%
    Next iRow%
 
End Sub ' StringToRotationArray
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: STxAxTIC on December 22, 2021, 09:56:04 pm

Hello,

So I played with this a little bit last night, and then deleted my response because I hated it. I hate it a little less today so lemme give this a try... So consider a problematic angle like 30 degrees. Of course the argument applies for all the bad angles, but let me just use 30 for a second.

To get a good view for 30, calculate the view for the two neighboring angles, namely 29 and 31. Also of course calculate what the view at 30 *should* be - the skeletal, bony snapshot of your image. To hang meat on those bones, we can borrow from 29 and 31. First you can run a check to see at which points 29 and 31 overlap. With that info, you can certainly lay those shared points over your view of 30. Basically you've done the binary AND of 29 an 31. Feel* me? If so, in this lingo, you can also do the OR of 29 and 31 to get more points to send to 30. Of course if you just use a pure OR, then the view of 30 will just be the blurred sum of 29 and 31. You want to avoid that, and there are a number of ways to proceed, but...

Tell me if this ballpark feels right. It should do better than a pathfinding-like solution. If it's too much work, then what you've got should basically work but it might add weird fuzz where you dont want it.

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 23, 2021, 12:12:17 pm

Quote from: STxAxTIC on December 22, 2021, 09:56:04 pm

So I played with this a little bit last night, and then deleted my response because I hated it. I hate it a little less today so lemme give this a try...

What's to hate? You're just thinking through the problem, it's fine. Thanks for your response!

Quote from: STxAxTIC on December 22, 2021, 09:56:04 pm

So consider a problematic angle like 30 degrees. Of course the argument applies for all the bad angles, but let me just use 30 for a second.

To get a good view for 30, calculate the view for the two neighboring angles, namely 29 and 31. Also of course calculate what the view at 30 *should* be - the skeletal, bony snapshot of your image. To hang meat on those bones, we can borrow from 29 and 31.

First you can run a check to see at which points 29 and 31 overlap. With that info, you can certainly lay those shared points over your view of 30. Basically you've done the binary AND of 29 an 31. Fee me?

Interesting approach...

Quote from: STxAxTIC on December 22, 2021, 09:56:04 pm

If so, in this lingo, you can also do the OR of 29 and 31 to get more points to send to 30. Of course if you just use a pure OR, then the view of 30 will just be the blurred sum of 29 and 31. You want to avoid that, and there are a number of ways to proceed, but...

This is where it gets fuzzy... What ways might you suggest to avoid just getting the blurred sum of 29 and 31?

Quote from: STxAxTIC on December 22, 2021, 09:56:04 pm

Tell me if this ballpark feels right. It should do better than a pathfinding-like solution. If it's too much work, then what you've got should basically work but it might add weird fuzz where you dont want it.

Your idea definitely has me thinking. The pathfinding version I posted could definitely be made smarter.

There are 2 questions here -
1. how can we get it to render a more accurate result, and
2. how can we do it more efficiently and save processing cycles?

Thanks again for your response and the interesting ideas!

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 23, 2021, 12:17:36 pm

@Petr and @STxAxTIC

Here is the latest code, I just added in circle fill and ellipse routines by @SMcNeill and @bplus.
I want to add a "fill" routine too, which I have not ever tried before.
I saw this thread that might provide the method
https://qb64forum.alephc.xyz//index.php?topic=1914.0 (https://qb64forum.alephc.xyz//index.php?topic=1914.0)

Anyway, here is the latest version...

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Basic 2D plotting functions
' Version 1.00 by madscijr
' with help from various (sources cited below).
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS
' =============================================================================
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' -----------------------------------------------------------------------------
' USER DEFINED TYPES
' -----------------------------------------------------------------------------
Type RotationType
    origx As Integer
    origy As Integer
    'z as integer
    c As Integer
End Type ' RotationType
 
' -----------------------------------------------------------------------------
' GLOBAL VARIABLES
' -----------------------------------------------------------------------------
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug: m_bDebug = TRUE
 
' =============================================================================
' BEGIN MAIN PROGRAM
' =============================================================================
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' START THE MENU
main
 
' -----------------------------------------------------------------------------
' DONE
Print m_ProgramName$ + " finished."
'Screen 0
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' EXIT
System ' return control to the operating system
End
 
' =============================================================================
' END MAIN PROGRAM
' =============================================================================
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
 
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Some basic 2D plotting"
        Print
        Print " 1. PlotPointTest"
        Print " 2. PlotSquareTest"
        Print " 3. PlotCircleTest"
        Print " 4. CircleFillTest"
        Print " 5. EllipseTest"
        Print " 6. EllipseFillTest"
        Print " 7. PlotLineTest"
        Print " 8. ShearRotateTest1"
        Print " 9. ShearRotateTest2 (auto advances 0-360 degrees)"
        Print "10. ShearRotateTest2 (auto advances 0-360 degrees) (uses Petr's text)"
        Print "11. ShearRotateTest3 (tries to correct for missing points)"
        Print "12. ShearRotateTest3 (tries to correct for missing points) (uses Petr's text)"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(_Trim$(in$))
 
        If in$ = "1" Then
            PlotPointTest
        ElseIf in$ = "2" Then
            PlotSquareTest
        ElseIf in$ = "3" Then
            PlotCircleTest
        ElseIf in$ = "4" Then
            CircleFillTest
        ElseIf in$ = "5" Then
            EllipseTest
        ElseIf in$ = "6" Then
            EllipseFillTest
        ElseIf in$ = "7" Then
            PlotLineTest
        ElseIf in$ = "8" Then
            ShearRotateTest1
        ElseIf in$ = "9" Then
            ShearRotateTest2 TestSprite1$
        ElseIf in$ = "10" Then
            ShearRotateTest2 PetrText1$
        ElseIf in$ = "11" Then
            ShearRotateTest3 TestSprite1$
        ElseIf in$ = "12" Then
            ShearRotateTest3 PetrText1$
        End If
    Loop Until in$ = "q"
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' MyArray(1 To 32, 1 To 32) AS STRING
 
Sub PlotPoint (X As Integer, Y As Integer, S As String, MyArray() As String)
    If (X >= LBound(MyArray, 2)) Then
        If (X <= UBound(MyArray, 2)) Then
            If (Y >= LBound(MyArray, 1)) Then
                If (Y <= UBound(MyArray, 1)) Then
                    If Len(S) = 1 Then
                        MyArray(Y, X) = S
                    Else
                        If Len(S) > 1 Then
                            MyArray(Y, X) = Left$(S, 1)
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub ' PlotPoint
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotPointTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a point."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type x,y (1-32, 1-32) coordinate to plot point at."
        Input "X,Y OR 0 TO QUIT? "; X, Y
        If X > 0 And Y > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X) + ", Y=" + cstr$(Y)
            PlotPoint X, Y, Chr$(iChar), MyArray()
 
            Print "Current point plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotPointTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquare (X1 As Integer, Y1 As Integer, L As Integer, S As String, MyArray() As String)
    Dim X As Integer
    Dim X2 As Integer
    Dim Y As Integer
    Dim Y2 As Integer
    Dim sChar$
 
    If Len(S) = 1 Then
        sChar$ = S
    Else
        If Len(S) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(S, 1)
        End If
    End If
 
    X2 = (X1 + L) - 1
    Y2 = (Y1 + L) - 1
    For X = X1 To X2
        For Y = Y1 To Y2
            PlotPoint X, Y, sChar$, MyArray()
        Next Y
    Next X
End Sub ' PlotSquare
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquareTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Enter parameters to draw a square."
    Print ArrayToStringTest(MyArray())
    Print
    Do
        Print "Type top left x,y (1-32, 1-32) coordinate to plot square,"
        Print "and size (1-32) of square."
        Input "X,Y,L OR 0 TO QUIT? "; X, Y, L
        If X > 0 And Y > 0 And L > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "L=" + cstr$(L)
            Print
            PlotSquare X, Y, L, Chr$(iChar), MyArray()
 
            Print "Square plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotSquareTest
 
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
 
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
 
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
 
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM  : FAST CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
 
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
 
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
 
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM  : SLOW CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
 
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK   1 (drawing a pixel), 0 (erasing a pixel)
' X     X coordinate of the pixel
' Y     Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
 
' More on plotting circles:
'     Drawing a circle in BASIC - fast
'     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
 
' X,Y     = center point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircle (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        B = R
        C = 0
        A = R - 1
        Do
            PlotPoint X + C, Y + B, S2, MyArray()
            PlotPoint X + C, Y - B, S2, MyArray()
            PlotPoint X - C, Y - B, S2, MyArray()
            PlotPoint X - C, Y + B, S2, MyArray()
            PlotPoint X + B, Y + C, S2, MyArray()
            PlotPoint X + B, Y - C, S2, MyArray()
            PlotPoint X - B, Y - C, S2, MyArray()
            PlotPoint X - B, Y + C, S2, MyArray()
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then ' IF A>=0 THEN 190
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do ' 190 IF B>=C THEN 60
        Loop
    End If
End Sub ' PlotCircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a raster circle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotCircle X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotCircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg1913#msg1913
 
' From: SMcNeill
' Date: « Reply #30 on: June 26, 2018, 03:34:18 pm »
'
' Sometimes, computers do things that are completely counter-intuitive to us, and
' we find ourselves having to step back as programmers and simply say, "WOW!!"
' Here's a perfect example of that:
' Here we look at two different circle fill routines -- one, which I'd assume to
' be faster, which precalculates the offset needed to find the endpoints for each
' line which composes a circle, and another, which is the same old CircleFill
' program which I've shared countless times over the years with people on various
' QB64 forums.
'
' When all is said and done though, CircleFill is STILL even faster than
' CircleFillFast, which pregenerates those end-points for us!
 
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, S As String, MyArray() As String)
    Dim Radius As Integer
    Dim RadiusError As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
 
    If Radius = 0 Then
        'PSET (CX, CY), C
        PlotPoint CX, CY, S, MyArray()
        Exit Sub
    End If
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    For iLoopX = CX - X To CX + X
        PlotPoint iLoopX, CY, S, MyArray()
    Next iLoopX
 
    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
                iLoopY = CY - X
                For iLoopX = CX - Y To CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                Next iLoopX
 
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                iLoopY = CY + X
                For iLoopX = CX - Y To CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                Next iLoopX
            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
        iLoopY = CY - Y
        For iLoopX = CX - X To CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopX
 
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        iLoopY = CY + Y
        For iLoopX = CX - X To CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopX
    Wend
End Sub ' CircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a filled circle"
    Print "Based on CircleFill by SMcNeill."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            'PlotCircle X, Y, R, Chr$(iChar), MyArray()
            CircleFill X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' CircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
 
Sub Ellipse (CX As Integer, CY As Integer, xRadius As Integer, yRadius As Integer, S As String, MyArray() As String)
    Dim scale As Single
    Dim xs As Integer
    Dim x As Integer
    Dim y As Integer
    Dim lastx As Integer
    Dim lasty As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    scale = yRadius / xRadius
    xs = xRadius * xRadius
 
    'PSET (CX, CY - yRadius)
    PlotPoint CX, CY - yRadius, S, MyArray()
 
    'PSET (CX, CY + yRadius)
    PlotPoint CX, CY + yRadius, S, MyArray()
 
    lastx = 0: lasty = yRadius
    For x = 1 To xRadius
        y = scale * Sqr(xs - x * x)
        'LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)
        PlotLine CX + lastx, CY - lasty, CX + x, CY - y, S, MyArray()
 
        'LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)
        PlotLine CX + lastx, CY + lasty, CX + x, CY + y, S, MyArray()
 
        'LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)
        PlotLine CX - lastx, CY - lasty, CX - x, CY - y, S, MyArray()
 
        'LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)
        PlotLine CX - lastx, CY + lasty, CX - x, CY + y, S, MyArray()
 
        lastx = x
        lasty = y
    Next x
End Sub ' Ellipse
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot an ellipse"
    Print "Based on ellipse by bplus."
    Print
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 And Y > 0 And RX > 0 And RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
 
            Ellipse X, Y, RX, RY, Chr$(iChar), MyArray()
 
            Print "Ellipse plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' EllipseTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
'
' Here is my ellipse and filled ellipse routines, no where near
' Steve's level of performance. The speed is cut in half at
' least because you probably have to do a whole quadrants worth
' of calculations (ellipse not as symmetric as circle).
'
' But I am sure this code can be optimized more than it is:
 
Sub EllipseFill (CX As Integer, CY As Integer, xRadius As Integer, yRadius As Integer, S As String, MyArray() As String)
    Dim scale As Single
    Dim x As Integer
    Dim y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    scale = yRadius / xRadius
 
    'LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    For iLoopY = CY - yRadius To CY + yRadius
        PlotPoint CX, iLoopY, S, MyArray()
    Next iLoopY
 
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
 
        'LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
        iLoopX = CX + x
        For iLoopY = CY - y To CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopY
 
        'LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
        iLoopX = CX - x
        For iLoopY = CY - y To CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopY
    Next x
End Sub ' EllipseFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a filled ellipse"
    Print "Based on fellipse by bplus."
    Print
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 And Y > 0 And RX > 0 And RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
 
            EllipseFill X, Y, RX, RY, Chr$(iChar), MyArray()
 
            Print "Ellipse plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' EllipseFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
' From: http://www.thedubber.altervista.org/qbsrc.htm
 
Sub PlotLine (x1%, y1%, x2%, y2%, c$, MyArray() As String)
    Dim iLoop%
    Dim steep%: steep% = 0
    Dim ev%: ev% = 0
    Dim sx%
    Dim sy%
    Dim dx%
    Dim dy%
 
    If (x2% - x1%) > 0 Then
        sx% = 1
    Else
        sx% = -1
    End If
 
    dx% = Abs(x2% - x1%)
    If (y2% - y1%) > 0 Then
        sy% = 1
    Else
        sy% = -1
    End If
 
    dy% = Abs(y2% - y1%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x1%, y1%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
 
    ev% = 2 * dy% - dx%
    For iLoop% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y1%, x1%), c%:
            'LOCATE y1%, x1%
            'PRINT c$;
            PlotPoint y1%, x1%, c$, MyArray()
        Else
            ''PSET (x1%, y1%), c%
            'LOCATE x1%, y1%
            'PRINT c$;
            PlotPoint x1%, y1%, c$, MyArray()
        End If
 
        While ev% >= 0
            y1% = y1% + sy%
            ev% = ev% - 2 * dx%
        Wend
        x1% = x1% + sx%
        ev% = ev% + 2 * dy%
    Next iLoop%
    ''PSET (x2%, y2%), c%
    'LOCATE x2%, y2%
    'PRINT c$;
    PlotPoint x2%, y2%, c$, MyArray()
End Sub ' PlotLine
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotLineTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim in$
    Dim X1 As Integer
    Dim Y1 As Integer
    Dim X2 As Integer
    Dim Y2 As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot line with Bresenham Algorithm"
    Print "based on BRESNHAM.BAS by Kurt Kuzba (4/16/96)."
    Print
    Print ArrayToStringTest(MyArray())
    Do
        Print "Enter coordinate values for "
        Print "line start point x1, y1 (1-32, 1-32)"
        Print "line end   point x2, y2 (1-32, 1-32)"
        Input "ENTER X1,Y1,X2,Y2 OR 0 TO QUIT: "; X1, Y1, X2, Y2
        If X1 > 0 And Y1 > 0 And X2 > 0 And Y2 > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X1=" + cstr$(X1)
            Print "Y1=" + cstr$(Y1)
            Print "X2=" + cstr$(X2)
            Print "Y2=" + cstr$(Y2)
 
            PlotLine X1, Y1, X2, Y2, Chr$(iChar), MyArray()
 
            Print "Line plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotLineTest
 
' /////////////////////////////////////////////////////////////////////////////
' 3 shear method testing
 
' _PUT Rotation Help
' https://www.qb64.org/forum/index.php?topic=1959.0
 
' 3 Shear Rotation - rotates without any aliasing(holes)
' https://www.freebasic.net/forum/viewtopic.php?t=24557
 
' From: leopardpm
' Date: Apr 02, 2016 1:21
' Last edited by leopardpm on Apr 02, 2016 17:18, edited 1 time in total.
'
' This is just a little 3-shear rotation routine
' (I am using 3-shear because it leaves no gaps/aliasing)
' that I was wondering if anyone sees how to make it faster.
' Obviously, I am just thinking about inside the double loop.
 
' Thanks again to BasicCoder2 for linking me to this little routine, it is wonderful so far!
 
'''                      roto-zooming algorithm
'''                    coded by Michael S. Nissen
'''                        jernmager@yahoo.dk
'
''' ===============================================================
''' Recoded to run on FBC 32/64 bit WIN, Version 1.05.0, 2016, by MrSwiss
''' Heavy flickering before going Full-Screen on 64 Bit !!!
''' This seems NOT to be the Case on 32 Bit ...
''' ===============================================================
'
'Type Pixel
'  As Single   X, Y
'  As ULong    C
'End Type
'
'''  dim vars
'Dim shared as Any Ptr Img_Buffer
'''  write the name of the .bmp image you want to rotozoom here:
'''  (it has to be sqare ie. 100x100 pixels, 760x760 pixels or whatever)
'Dim As String Img_Name = "phobos.bmp"
'Dim shared as Integer X_Mid, Y_Mid, scrn_wid, scrn_hgt, P1, P2, P3, P4, C
'Dim shared as Short Img_Hgt, Img_Wid, Img_Lft, Img_Rgt, Img_Top, Img_Btm, X, Y
'Dim Shared As Single Cos_Ang, Sin_Ang, Rot_Fac_X, Rot_Fac_Y, Angle = 0, Scale = 1
'
''' changed Function to Sub (+ recoded arguments list)
'Sub Calc_rotozoom ( ByRef Cos_Ang As Single, _
'               ByRef Sin_Ang As Single, _
'               ByVal S_Fact  As Single, _
'               ByVal NewAng  As Single )
'  Cos_Ang = Cos(NewAng)*S_Fact
'  Sin_Ang = Sin(NewAng)*S_Fact
'End Sub
'
'''  full screen
'ScreenInfo scrn_wid, scrn_hgt
'screenRes scrn_wid, scrn_hgt, 32,,1
'
'''  dim screenpointer (has to be done after screenres)
'Dim As ULong Ptr Scrn_Ptr = Screenptr
'
'''  place image in center of screen
'X_Mid = scrn_wid\2
'Y_Mid = scrn_hgt\2
'Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'
'''  find image dimensions
'Open Img_Name For Binary As #1
'Get #1, 19, Img_Wid
'Get #1, 23, Img_Hgt
'Close #1
'
'''  prepare to dim the array that will hold the image.
'Img_Rgt = (Img_Wid-1)\2
'Img_Lft = -Img_Rgt
'Img_Btm = (Img_Hgt-1)\2
'Img_Top = -Img_Btm
'
'''  dim array to hold image. Note: pixel (0, 0) is in the center.
'Dim As Pixel Pixel(Img_Lft to Img_Rgt, Img_Top to Img_Btm)
'
'''  imagecreate sprite and load image to sprite
'Img_Buffer = ImageCreate (Img_Wid, Img_Hgt)
'Bload (Img_Name, Img_Buffer)
'
'''  load image from sprite to array with point command
'For Y = Img_Top to Img_Btm
'  For X = Img_Lft to Img_Rgt
'    With Pixel(X, Y)
'      .X = X_Mid+X
'      .Y = Y_Mid+Y
'      C = Point (X-Img_Top, Y-Img_Lft, Img_buffer)
'      If C <> RGB(255, 0, 255) Then
'        .C = C
'      Else
'        .C = RGB(0, 0, 0)
'      End If
'    End With
'  Next X
'Next Y
'
'''  we don't need the sprite anymore, kill it
'ImageDestroy Img_Buffer
'Img_Buffer = 0
'
'''  main program loop
'Do
'
'  ''  scale in/out with uparrow/downarrow
'  If Multikey(80) Then
'    Scale *= 1.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(72) Then
'    Scale *= 0.97
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  rotate left/right with leftarrow/rightarrow
'  If Multikey(77) Then
'    Angle -= 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(75) Then
'    Angle += 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  lock screen in order to use screen pointers
'  ScreenLock
'
'    ''  draw pixel in center of image
'    Scrn_Ptr[ X_Mid + Y_Mid * scrn_wid ] = Pixel(0, 0).C
'    ''  draw all other pixels - 4 at a time
'    For Y = Img_Top to 0
'      For X = Img_Lft to -1
'        ''  find pixel positions
'        P1 = (X_Mid+X) + (Y_Mid+Y) * scrn_wid
'        P2 = (X_Mid-X) + (Y_Mid-Y) * scrn_wid
'        P3 = (X_Mid+Y) + (Y_Mid-X) * scrn_wid
'        P4 = (X_Mid-Y) + (Y_Mid+X) * scrn_wid
'        ''  erase old pixels (paint them black)
'        Scrn_Ptr[P1] = 0
'        Scrn_Ptr[P2] = 0
'        Scrn_Ptr[P3] = 0
'        Scrn_Ptr[P4] = 0
'        ''  rotate and zoom
'        Rot_Fac_X = X*Cos_Ang - Y*Sin_Ang
'        Rot_Fac_Y = X*Sin_Ang + Y*Cos_Ang
'        If Rot_Fac_X < Img_Lft Or Rot_Fac_X > Img_Rgt Then Continue For
'        If Rot_Fac_Y < Img_Top Or Rot_Fac_Y > Img_Btm Then Continue For
'        ''  draw new pixels
'        Scrn_Ptr[P1] = Pixel(Rot_Fac_X, Rot_Fac_Y).C
'        Scrn_Ptr[P2] = Pixel(-Rot_Fac_X, -Rot_Fac_Y).C
'        Scrn_Ptr[P3] = Pixel(Rot_Fac_Y, -Rot_Fac_X).C
'        Scrn_Ptr[P4] = Pixel(-Rot_Fac_Y, Rot_Fac_X).C
'      Next X
'    Next Y
'
'  ScreenUnLock
'
'  Sleep 10, 1
'Loop Until InKey() = Chr(27)
 
' UPDATES:
' Fixed bug where values 135, 224, and 314 all resolve to -45 degrees.
' Fixed bug where an angle of 46-135 degrees caused the image to be flipped wrong.
 
' TODO:
' Fix issue where image looks bad at 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
Sub ShearRotate (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate
 
' /////////////////////////////////////////////////////////////////////////////
' Same as ShearRotate, except adds iOverwriteCount parameter,
' and counts how many points are overwriting existing points,
' and return that value byref in parameter iOverwriteCount.
 
Sub ShearRotate1 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iOverwriteCount As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    iOverwriteCount = 0
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
 
                    ' count points that will be overwritten
                    If NewArray(fx, fy, 0).c <> iEmpty Then
                        iOverwriteCount = iOverwriteCount + 1
                    End If
 
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate1
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate2 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iMissing As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the angle of rotation?
    ' perhaps if we divide the screen up into 4 zones:
    '
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '| 271-359 degrees)  | (1-89 degrees)   |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '| (181-269 degrees) | (91-179 degrees) |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   search direction (y,x)
    ' -------   ----------------------
    ' 1         up   + right
    ' 2         down + right
    ' 3         down + left
    ' 4         up   + left
 
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint%(arrLost(iLoop), angle1, iEmpty, x, y, NewArray())
        If bFound = TRUE Then
            If m_bDebug = TRUE Then
                _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        Else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        End If
    Next iLoop
 
End Sub ' ShearRotate2
 
' /////////////////////////////////////////////////////////////////////////////
' Receives
' FindMe (RotationType) = contains the starting location (.origx, .origy) to start looking from, and the value (.c) to write
' angle1 (Integer) = angle we were rotating to, to determine direction to look in
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint% (FindMe As RotationType, angle1 As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
 
    destX = 0
    destY = 0
 
    ' Choose search direction depending on the angle
    If angle1 > 0 And angle1 < 90 Then
        dirX = 1
        dirY = -1
    ElseIf angle1 > 90 And angle1 < 180 Then
        dirX = 1
        dirY = 1
    ElseIf angle1 > 180 And angle1 < 270 Then
        dirX = -1
        dirY = 1
    ElseIf angle1 > 270 And angle1 < 360 Then
        dirX = -1
        dirY = -1
    Else
        dirX = 0
        dirY = 0
    End If
 
    If dirX <> 0 Then
        x = FindMe.origx
        y = FindMe.origy
        Do
            ' quit if we're out of bounds
            If x < LBound(NewArray, 1) Then Exit Do
            If x > UBound(NewArray, 1) Then Exit Do
            If y < LBound(NewArray, 2) Then Exit Do
            If y > UBound(NewArray, 2) Then Exit Do
 
            ' =============================================================================
            ' BEGIN PRIMARY SEARCH
            ' =============================================================================
            ' look along y axis for a blank spot
            destX = x
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(destX, destY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look along x axis for a blank spot
            destX = x + dirX
            destY = y
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look diagonally for a blank spot
            destX = x + dirX
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
            ' =============================================================================
            ' END PRIMARY SEARCH
            ' =============================================================================
 
            ' =============================================================================
            ' BEGIN SECONDARY SEARCH
            ' =============================================================================
            'yoda
            ' =============================================================================
            ' END SECONDARY SEARCH
            ' =============================================================================
 
            ' Keep looking
            x = x + dirX
            y = y + dirY
        Loop
    End If
 
    ' Return result
    FindEmptyShearRotationPoint% = bResult
End Function ' FindEmptyShearRotationPoint%
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotateTest1
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim in$
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print
 
    sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
    Print "Initial contents of Rotation Array:"
    Print RotationArrayToStringTest(RoArray1())
    Print
 
    ' ROTATE THE SHAPE
    Do
        Print "Type degrees to rotate (0 TO 360) or non-numeric value to quit."
        Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
 
        Input "Degrees to rotate (q to quit)? "; in$
        If IsNum%(in$) Then
            D = Val(in$)
            If D >= 0 And D <= 360 Then
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
End Sub ' ShearRotateTest1
 
' /////////////////////////////////////////////////////////////////////////////
' Now receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotateTest2 TestSprite1$
 
Sub ShearRotateTest2 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iOverwriteCount As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotateTest2
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points.
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotateTest3 TestSprite1$
 
Sub ShearRotateTest3 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotateTest3
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "11111111111111111111111111111111" + Chr$(13) ' 1
    m$ = m$ + "4..............................2" + Chr$(13) ' 2
    m$ = m$ + "4....##.....#######.....####...2" + Chr$(13) ' 3
    m$ = m$ + "4...####....##...###...######..2" + Chr$(13) ' 4
    m$ = m$ + "4..##..##...##...###..##....##.2" + Chr$(13) ' 5
    m$ = m$ + "4.##....##..#######...##.......2" + Chr$(13) ' 6
    m$ = m$ + "4.########..#######...##.......2" + Chr$(13) ' 7
    m$ = m$ + "4.########..##...###..##....##.2" + Chr$(13) ' 8
    m$ = m$ + "4.##....##..##...###...######..2" + Chr$(13) ' 9
    m$ = m$ + "4.##....##..#######.....####...2" + Chr$(13) ' 10
    m$ = m$ + "4..............................2" + Chr$(13) ' 11
    m$ = m$ + "4..............................2" + Chr$(13) ' 12
    m$ = m$ + "4..ABBBBBBBBBBBBBBBBBBBBBBBBC..2" + Chr$(13) ' 13
    m$ = m$ + "4..A...........EE...........C..2" + Chr$(13) ' 14
    m$ = m$ + "4..A..........FFFF..........C..2" + Chr$(13) ' 15
    m$ = m$ + "4..A.........GGGGGG.........C..2" + Chr$(13) ' 16
    m$ = m$ + "4..A........HHHHHHHH........C..2" + Chr$(13) ' 17
    m$ = m$ + "4..A.......IIIIIIIIII.......C..2" + Chr$(13) ' 18
    m$ = m$ + "4..A......JJJJJJJJJJJJ......C..2" + Chr$(13) ' 19
    m$ = m$ + "4..DDDDDDDDDDDDDDDDDDDDDDDDDC..2" + Chr$(13) ' 20
    m$ = m$ + "4..............................2" + Chr$(13) ' 21
    m$ = m$ + "4..............................2" + Chr$(13) ' 22
    m$ = m$ + "4.######....########..########.2" + Chr$(13) ' 23
    m$ = m$ + "4.#######...########..########.2" + Chr$(13) ' 24
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 25
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 26
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 27
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 28
    m$ = m$ + "4.#######...##........##.......2" + Chr$(13) ' 29
    m$ = m$ + "4.######....########..##.......2" + Chr$(13) ' 30
    m$ = m$ + "4..............................2" + Chr$(13) ' 31
    m$ = m$ + "33333333333333333333333333333332" + Chr$(13) ' 32
    TestSprite1$ = m$
End Function ' TestSprite1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite2$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "...............AA..............." + Chr$(13) ' 1
    m$ = m$ + "..............//BB.............." + Chr$(13) ' 2
    m$ = m$ + ".............??..CC............." + Chr$(13) ' 3
    m$ = m$ + "............==....DD............" + Chr$(13) ' 4
    m$ = m$ + "...........++......EE..........." + Chr$(13) ' 5
    m$ = m$ + "..........&&........FF.........." + Chr$(13) ' 6
    m$ = m$ + ".........zz..........GG........." + Chr$(13) ' 7
    m$ = m$ + "........yy............HH........" + Chr$(13) ' 8
    m$ = m$ + ".......xx..............II......." + Chr$(13) ' 9
    m$ = m$ + "......ww................JJ......" + Chr$(13) ' 10
    m$ = m$ + ".....vv..................KK....." + Chr$(13) ' 11
    m$ = m$ + "....uu....................LL...." + Chr$(13) ' 12
    m$ = m$ + "...tt......DDAAAAAAA.......MM..." + Chr$(13) ' 13
    m$ = m$ + "..ss.......DDAAAAAAA........NN.." + Chr$(13) ' 14
    m$ = m$ + ".rr........DD.....BB.........OO." + Chr$(13) ' 15
    m$ = m$ + "qq.........DD.....BB..........PP" + Chr$(13) ' 16
    m$ = m$ + "pp.........DD.....BB..........QQ" + Chr$(13) ' 17
    m$ = m$ + ".oo........DD.....BB.........RR." + Chr$(13) ' 18
    m$ = m$ + "..nn.......CCCCCCCBB........SS.." + Chr$(13) ' 19
    m$ = m$ + "...mm......CCCCCCCBB.......TT..." + Chr$(13) ' 20
    m$ = m$ + "....ll....................UU...." + Chr$(13) ' 21
    m$ = m$ + ".....kk..................VV....." + Chr$(13) ' 22
    m$ = m$ + "......jj................WW......" + Chr$(13) ' 23
    m$ = m$ + ".......ii..............XX......." + Chr$(13) ' 24
    m$ = m$ + "........hh............YY........" + Chr$(13) ' 25
    m$ = m$ + ".........gg..........ZZ........." + Chr$(13) ' 26
    m$ = m$ + "..........ff........@@.........." + Chr$(13) ' 27
    m$ = m$ + "...........ee......##..........." + Chr$(13) ' 28
    m$ = m$ + "............dd....$$............" + Chr$(13) ' 29
    m$ = m$ + ".............cc..%%............." + Chr$(13) ' 30
    m$ = m$ + "..............bb\\.............." + Chr$(13) ' 31
    m$ = m$ + "...............aa..............." + Chr$(13) ' 32
    TestSprite2$ = m$
End Function ' TestSprite2$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function PetrText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "....It's a SCREEN resolution?..." + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    PetrText1$ = m$
End Function ' PetrText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToString$ (MyArray( 1 To 32 , 1 To 32) As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        MyString = MyString + sLine + Chr$(13)
    Next iY
    ArrayToString$ = MyString
End Function ' ArrayToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToStringTest$ (MyArray() As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
 
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    ArrayToStringTest$ = MyString
End Function ' ArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function RotationArrayToStringTest$ (RoArray() As RotationType)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    For iY = LBound(RoArray, 1) To UBound(RoArray, 1)
        sLine = ""
        sLine = sLine + Right$("    " + cstr$(iY), 3)
        For iX = LBound(RoArray, 2) To UBound(RoArray, 2)
            sLine = sLine + Chr$(RoArray(iX, iY, 0).c)
        Next iX
        sLine = sLine + Right$("   " + cstr$(iY), 3)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    RotationArrayToStringTest$ = MyString
End Function ' RotationArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
' 1. split string by line breaks CHR$(13)
' 2. split lines up to 1 column per char
' 3. count rows, columns
' 4. DIM array, making sure array has
'    a) an _ODD_ number of rows/columns, with a center point
'    b) index is in cartesian format, where center is (0,0)
' 5. populate array with contents of string
 
' dimension #1 = columns
' dimension #2 = rows
 
Sub StringToRotationArray (RoArray() As RotationType, MyString As String, EmptyChar As String)
    Dim RoutineName As String: RoutineName = "StringToRotationArray"
    ReDim arrLines$(0)
    Dim delim$
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iColCount As Integer
    Dim iRowCount As Integer
    Dim iCount As Integer
    Dim bAddedRow As Integer: bAddedRow = FALSE
    Dim bAddedColumn As Integer: bAddedColumn = FALSE
    Dim iHalf1 As Integer
    Dim iHalf2 As Integer
    Dim iFrom1 As Integer
    Dim iFrom2 As Integer
    Dim iTo1 As Integer
    Dim iTo2 As Integer
    Dim iEmpty As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
 
    iRowCount = UBound(arrLines$) + 1
 
    ' look at all the rows and find the max # of columns used
    iColCount = 0
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
 
        ' count the columns for this row
        iCount = 0
        For iCol% = 1 To Len(arrLines$(iRow%))
            iCount = iCount + 1
        Next iCol%
 
        ' if this row has the most so far, then set that to the max
        If iCount > iColCount Then
            iColCount = iCount
        End If
    Next iRow%
 
    ' adjust columns to be odd
    If IsEven%(iColCount) Then
        iColCount = iColCount + 1
        bAddedColumn = TRUE
    End If
 
    ' calculate array bounds for columns
    iHalf1 = (iColCount - 1) / 2
    iFrom1 = 0 - iHalf1
    iTo1 = iHalf1
 
    ' adjust rows to be odd
    If IsEven%(iRowCount) Then
        iRowCount = iRowCount + 1
        bAddedRow = TRUE
    End If
 
    ' calculate array bounds for rows
    iHalf2 = (iRowCount - 1) / 2
    iFrom2 = 0 - iHalf2
    iTo2 = iHalf2
 
    ' size array to new bounds
    ReDim RoArray(iFrom1 To iTo1, iFrom2 To iTo2, 127) As RotationType
 
    ' get value for empty
    If Len(EmptyChar) > 0 Then
        iEmpty = Asc(EmptyChar)
    Else
        iEmpty = 32 ' (use space as default)
    End If
 
    ' clear array
    For iY = LBound(RoArray, 2) To UBound(RoArray, 2)
        For iX = LBound(RoArray, 1) To UBound(RoArray, 1)
            RoArray(iX, iY, 0).c = iEmpty
            RoArray(iX, iY, 0).origx = iX
            RoArray(iX, iY, 0).origy = iY
        Next iX
    Next iY
 
    ' fill array
    iY = LBound(RoArray, 2) - 1
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        iY = iY + 1
        iX = LBound(RoArray, 1) - 1
        For iCol% = 1 To Len(arrLines$(iRow%))
            iX = iX + 1
            sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
            RoArray(iX, iY, 0).c = Asc(sChar$)
        Next iCol%
    Next iRow%
 
End Sub ' StringToRotationArray
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: SMcNeill on December 23, 2021, 02:33:44 pm

Now, let me start off by apologizing and saying that I haven't actually tried any of the code in this topic at all. Life has had me busy as heck the last few weeks, and all I've did is skim this topic and view the pretty images. From what I gather, is this the type of effect which you're trying to generate?

Code: QB64: [Select]

Width 80, 50
 
Do
    Cls
    Print Time$
    DrawText 5, 40, "Second Hand on Clock", (Timer Mod 60) * 6
    _Limit 60
Loop Until _KeyHit
 
 
 
Sub DrawText (x, y, Text$, angle)
    Dim ScreenArray(_Width, _Height) As _Byte
    A = _D2R(angle - 90)
    For i = 1 To Len(Text$)
        t = Asc(Text$, i)
        Do
            xPos = x + Sin(A) * radius: If xPos < 1 Or xPos > _Height Then Exit Do
            yPos = y + Cos(A) * radius: If yPos < 1 Or yPos > _Width Then Exit Do
 
            If ScreenArray(yPos, xPos) = 0 Then ScreenArray(yPos, xPos) = t: Exit Do
            radius = radius + 1
        Loop
    Next
    For x = 1 To _Width
        For y = 1 To _Height
            If ScreenArray(x, y) Then
                _PrintString (x, y), Chr$(ScreenArray(x, y))
            End If
        Next
    Next
End Sub

It's a pretty little SCREEN 0 clock hand! ;D

EDIT: Added some error checking for when the text might try to print off screen for us.

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 28, 2021, 03:46:49 pm

Quote from: SMcNeill on December 23, 2021, 02:33:44 pm

Now, let me start off by apologizing and saying that I haven't actually tried any of the code in this topic at all. Life has had me busy as heck the last few weeks, and all I've did is skim this topic and view the pretty images. From what I gather, is this the type of effect which you're trying to generate?

Code: QB64: [Select]
Width 80, 50

Do
Cls
Print Time$
DrawText 5, 40, "Second Hand on Clock", (Timer Mod 60) * 6
_Limit 60
Loop Until _KeyHit

Sub DrawText (x, y, Text$, angle)
Dim ScreenArray(_Width, _Height) As _Byte
A = _D2R(angle - 90)
For i = 1 To Len(Text$)
t = Asc(Text$, i)
Do
xPos = x + Sin(A) * radius: If xPos < 1 Or xPos > _Height Then Exit Do
yPos = y + Cos(A) * radius: If yPos < 1 Or yPos > _Width Then Exit Do

If ScreenArray(yPos, xPos) = 0 Then ScreenArray(yPos, xPos) = t: Exit Do
radius = radius + 1
Loop
Next
For x = 1 To _Width
For y = 1 To _Height
If ScreenArray(x, y) Then
_PrintString (x, y), Chr$(ScreenArray(x, y))
End If
Next
Next
End Sub

It's a pretty little SCREEN 0 clock hand! ;D

EDIT: Added some error checking for when the text might try to print off screen for us.

Thanks @SMcNeill for your reply.
So if I'm understanding the code right, it checks to see if the point we're rotating to is occupied, and if it is, it simply increases the radius by 1 and tries moving the point there?
That's so much easier than what I was trying and discussing with @STxAxTIC.
Very elegant... if I can get it to work!
The problem I'm having is when I try translating it to rotate a 2D array, it just stays stuck at 180 degrees...?
Your code didn't really declare the variables, am I maybe breaking something by declaring something the wrong type?
I'm sure it's due to some dumb error on my part...

Code: QB64: [Select]

' Uses SMcNeill's solution to rotation plotting 2 points to the same coordinates
' https://qb64forum.alephc.xyz/index.php?action=post;quote=139325;topic=4502.0
 
Const FALSE = 0
Const TRUE = Not FALSE
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug As Integer : m_bDebug = FALSE
Dim Shared m_iMapMinX As Integer: m_iMapMinX = 1
Dim Shared m_iMapMaxX As Integer: m_iMapMaxX = 32
Dim Shared m_iMapMinY As Integer: m_iMapMinY = 1
Dim Shared m_iMapMaxY As Integer: m_iMapMaxY = 32
Dim Shared m_arrText(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY) As String
Dim Shared m_arrNew(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY) As String
 
' ACTIVATE DEBUGGING WINDOW
IF m_bDebug = TRUE THEN
        $Console
        _Delay 4
        _Console On
        _Echo "Started " + m_ProgramName$
        _Echo "Debugging on..."
END IF
 
Dim in$
main
'input "PRESS <ENTER> TO EXIT";in$
 
' DISABLE DEBUGGING
IF m_bDebug = TRUE THEN
        _Console Off
END IF
end
 
' /////////////////////////////////////////////////////////////////////////////
 
sub main
        dim iAngle as integer
        Width 80, 80
        StringToArray m_arrText(), SteveText1$
        Do
                for iAngle = 0 to 360
                        DrawText iAngle
                        input "PRESS <ENTER> TO CONTINUE OR q TO QUIT";in$
                        if in$="q" then exit do
                next iAngle
                for iAngle = 360 to 0 step -1
                        DrawText iAngle
                        input "PRESS <ENTER> TO CONTINUE OR q TO QUIT";in$
                        if in$="q" then exit do
                next iAngle
                _Limit 1
        Loop Until _KeyHit
end sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub DrawText (angle)
        dim x as integer
        dim y as integer
    dim A
        dim i
        dim t as string
        dim xPos
        dim yPos
        dim radius
        dim sLine as string
        dim iBefore as integer
        dim iAfter as integer
        dim iMissing as integer
        dim in$
        
        ' init rotated matrix m_arrNew
        ' and count characters in original matrix m_arrText
        iBefore = 0
        for y = m_iMapMinY to m_iMapMaxY
                for x = m_iMapMinX to m_iMapMaxX
                        if m_arrText(x, y) <> "." then
                                iBefore = iBefore + 1
                        end if
                        m_arrNew(x, y) = "."
                next x
        next y
        
        ' rotate all points in matrix m_arrText
        ' plotting them to m_arrNew
        for y = m_iMapMinY to m_iMapMaxY
                for x = m_iMapMinX to m_iMapMaxX
                        A = _D2R(angle - 90) ' The _D2R function converts a degree value into a radian value.
                        t = m_arrText(x, y)
                        
                        IF m_bDebug = TRUE THEN 
                                _echo "rotating " + chr$(34) + t + chr$(34) + " from x=" + _Trim$(Str$(x)) + ", " + "y=" + _Trim$(Str$(y))
                        END IF
                        
                        radius = 0
                        Do
                                xPos = x + Sin(A) * radius
                                If xPos < m_iMapMinX Or xPos > m_iMapMaxX Then 
                                        IF m_bDebug = TRUE THEN 
                                                _echo "    illegal xPos: " + _Trim$(Str$(xPos))
                                        END IF
                                        Exit Do
                                end if
                                
                                yPos = y + Cos(A) * radius
                                If yPos < m_iMapMinY Or yPos > m_iMapMaxY Then 
                                        IF m_bDebug = TRUE THEN 
                                                _echo "    illegal yPos: " + _Trim$(Str$(yPos))
                                        END IF
                                        Exit Do
                                end if
                                
                                If m_arrNew(xPos, yPos) = "." Then 
                                        m_arrNew(xPos, yPos) = t
                                        IF m_bDebug = TRUE THEN 
                                                _echo "    rotated " + chr$(34) + t + chr$(34) + " to x=" + _Trim$(Str$(x)) + ", " + "y=" + _Trim$(Str$(y))
                                        END IF
                                        Exit Do
                                end if
                                
                                radius = radius + 1
                                IF m_bDebug = TRUE THEN 
                                        _echo "    increasing radius: " + _Trim$(Str$(radius))
                                END IF
                        Loop
                next x
        next y
        
        ' show the rotated matrix
        cls
        print "Angle: " + _Trim$(Str$(angle))
        iAfter = 0
        For y = m_iMapMinY To m_iMapMaxY
                sLine = ""
                For x = m_iMapMinX To m_iMapMaxX
                        sLine = sLine + m_arrNew(x,y)
                        ' count the characters in the new rotated matrix
                        if m_arrNew(x, y) <> "." then
                                iAfter = iAfter + 1
                        end if
                Next x
                print sLine
        Next y
        
        ' if any characters are missing, show how many
        iMissing = iBefore - iAfter
        if iMissing > 0 then
                print "# points missing: " + _Trim$(Str$(iMissing))
        end if
        
End Sub ' DrawText
 
' /////////////////////////////////////////////////////////////////////////////
 
Function SteveText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "......Second.Hand.on.Clock......" + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    SteveText1$ = m$
End Function ' SteveText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function PetrText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "....It's a SCREEN resolution?..." + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    PetrText1$ = m$
End Function ' PetrText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
' Modified to handle multi-character delimiters
 
Sub split (in$, delimiter$, result$())
    Dim start As Integer
    Dim finish As Integer
    Dim iDelimLen As Integer
    ReDim result$(-1)
 
    iDelimLen = Len(delimiter$)
 
    start = 1
    Do
        'While Mid$(in$, start, 1) = delimiter$
        While Mid$(in$, start, iDelimLen) = delimiter$
            'start = start + 1
            start = start + iDelimLen
            If start > Len(in$) Then
                Exit Sub
            End If
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then
            finish = Len(in$) + 1
        End If
 
        ReDim _Preserve result$(0 To UBound(result$) + 1)
 
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 28, 2021, 06:20:10 pm

Quote from: SMcNeill on December 23, 2021, 02:33:44 pm

Now, let me start off by apologizing and saying that I haven't actually tried any of the code in this topic at all. Life has had me busy as heck the last few weeks, and all I've did is skim this topic and view the pretty images. From what I gather, is this the type of effect which you're trying to generate?

Code: QB64: [Select]
Width 80, 50

Do
Cls
Print Time$
DrawText 5, 40, "Second Hand on Clock", (Timer Mod 60) * 6
_Limit 60
Loop Until _KeyHit

Sub DrawText (x, y, Text$, angle)
Dim ScreenArray(_Width, _Height) As _Byte
A = _D2R(angle - 90)
For i = 1 To Len(Text$)
t = Asc(Text$, i)
Do
xPos = x + Sin(A) * radius: If xPos < 1 Or xPos > _Height Then Exit Do
yPos = y + Cos(A) * radius: If yPos < 1 Or yPos > _Width Then Exit Do

If ScreenArray(yPos, xPos) = 0 Then ScreenArray(yPos, xPos) = t: Exit Do
radius = radius + 1
Loop
Next
For x = 1 To _Width
For y = 1 To _Height
If ScreenArray(x, y) Then
_PrintString (x, y), Chr$(ScreenArray(x, y))
End If
Next
Next
End Sub

It's a pretty little SCREEN 0 clock hand! ;D

EDIT: Added some error checking for when the text might try to print off screen for us.

In fact, I'm having trouble just using the formula to calculate any values at all...
What am I doing wrong?

Code: QB64: [Select]

dim angle as integer
dim x as integer
dim y as integer
dim A
dim radius
dim xPos
dim yPos
dim in$
 
radius = 0
x = 10
y = 10
For angle = 20 to 40
        A = _D2R(angle - 90) ' The _D2R function converts a degree value into a radian value.
        yPos = y + Cos(A) * radius
        xPos = x + Sin(A) * radius
        
        print _Trim$(Str$(x)) + "," + _Trim$(Str$(y)) + _ 
                " rotated to " + _Trim$(Str$(angle)) + " deg = " + _
                _Trim$(Str$(xPos)) + "," + _Trim$(Str$(yPos))
Next angle
 
input "PRESS <ENTER> TO CONTINUE";in$
end
 

Update: I tried changing everything to the same data type (tried double and single), but still no change.
This is one of those days where I feel like I can't program my way out of a wet paper bag! :-p

Code: QB64: [Select]

Width 80, 80
 
Dim angle As Double
Dim x As Double
Dim y As Double
Dim A As Double
Dim radius As Double
Dim xPos As Double
Dim yPos As Double
Dim in$
 
radius = 0
x = 10
y = 10
For angle = 0 To 45
    A = _D2R(angle - 90) ' The _D2R function converts a degree value into a radian value.
    yPos = y + Cos(A) * radius
    xPos = x + Sin(A) * radius
 
    print "" + _
        "A=" + _Trim$(Str$(A)) + _
        "Cos(A) = " + _Trim$(Str$(Cos(A))) + _
        _Trim$(Str$(x)) + "," + _Trim$(Str$(y)) + _
        " rotated to " + _Trim$(Str$(angle)) + " deg = " + _
        _Trim$(Str$(xPos)) + "," + _Trim$(Str$(yPos))
Next angle
 
Input "PRESS <ENTER> TO CONTINUE"; in$
End
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: SMcNeill on December 28, 2021, 10:35:47 pm

Let me just go through what I've got here, and I'll explain the process for you line by line (more or less).

The whole:

Code: [Select]

Sub DrawText (x, y, Text$, angle)
    Dim ScreenArray(_Width, _Height) As _Byte
    A = _D2R(angle - 90)
    For i = 1 To Len(Text$)
        t = Asc(Text$, i)
        Do
            xPos = x + Sin(A) * radius: If xPos < 1 Or xPos > _Height Then Exit Do
            yPos = y + Cos(A) * radius: If yPos < 1 Or yPos > _Width Then Exit Do

            If ScreenArray(yPos, xPos) = 0 Then ScreenArray(yPos, xPos) = t: Exit Do
            radius = radius + 1
        Loop
    Next
    For x = 1 To _Width
        For y = 1 To _Height
            If ScreenArray(x, y) Then
                _PrintString (x, y), Chr$(ScreenArray(x, y))
            End If
        Next
    Next
End Sub

And now to dissect that whole:

Sub DrawText (x, y, Text$, angle) --- X and Y here represent the center point of where we want to place our text. TEXT$ is what we want to place onto the screen, and ANGLE is the amount of rotation we want that text to have.

Dim ScreenArray(_Width, _Height) As _Byte --- This creates an array for us the same size as our text screen. All the work I[m doing is going to take place within this array, until I'm actually ready to draw onto the screen itself.

A = _D2R(angle - 90) --- This is our angle conversion from degrees to radians, with a correction to start in the top center of our circle, just as a clock starts with 12 o'clock as being up at the very top.

For i = 1 To Len(Text$) --- This line runs us a loop from the first letter in our text to the last letter of the text, so we can figure out where to place each character correctly.

t = Asc(Text$, i) --- Here, I'm just getting the character that I want to work with out of that whole length of text.

Do --- This starts the internal loop for determining proper positioning

xPos = x + Sin(A) * radius: If xPos < 1 Or xPos > _Height Then Exit Do --- A two part line. The first calculates where to put the text on the screen. x is our original center. SIN(A) is the angle we're rotating by. RADIUS is how far from the center we need to go to place this character. IF this calculated xPOSition is off the screen -- either by being off the top (less than 1) or off the right (greater than our _HEIGHT of the screen), we can now quit calculating as we can't actually plot this character. It's off the screen, after all!

yPos = y + Cos(A) * radius: If yPos < 1 Or yPos > _Width Then Exit Do --- This is basically the same as the line above, except it calculates our y position. (Remember, in SCREEN 0 x and y are reversed as they actually represent row and column rather than width and height.)

If ScreenArray(yPos, xPos) = 0 Then ScreenArray(yPos, xPos) = t: Exit Do --- Now, this line basically checks to see if we've plotted to this point already. Sometimes, as you've noticed yourself, characters might try to overlap. If this character wants to overlap with a previous one, we simply don't draw it yet and move on with the process to actually calculate where to draw it.

radius = radius + 1 --- If we haven't plotted our character yet, then we simply increase the radius by one to move it out another point to recalculate the proper spot.

Loop --- And then we repeat the process until we either find the right spot for this character, or we determine it's going to be off the screen.

Next --- If we've gotten to this point, we have now decided either where to place our specific character, or else we've decided that the character in question is going to off the screen. We can now move on to the next character, until we go through the process for the whole string of text.

For x = 1 To _Width
For y = 1 To _Height
If ScreenArray(x, y) Then
_PrintString (x, y), Chr$(ScreenArray(x, y))
End If
Next
Next
End Sub

And, I think I can more or less explain this whole batch of code here by simply saying, "This is where we actually check our finished array for our text values, and then simply print them to the corresponding spots on our text screen.

The whole process is actually rather simple, and here's the logic behind it:

Make a blank array the same size as the screen.

Since that array is blank, all the values for it default and start at zero.

Calculate the position for each character we want to plot to the screen.

Check that position vs our array. If the array is zero (blank) in the spot where we want to put our text, let the array hold the character value that we're going to print. Otherwise, simply move out another point on the radius and check again, until we find an empty spot in that array to put our text, or determine we've went off-screen.

Once we've did this for all our characters, all we have to do is simply run that array through a loop and LOCATE/PRINT to the screen in the corresponding positions to our array.

It's that simple of a process.

Calculate the position of a character centered at X/Y, with a radius of 0, at the desired angle.
Save that character's position
DO
Calculate the position of a character centered at X/Y, with a radius of 1, at the desired angle.
IF that position isn't already written to, save it. Otherwise, increase the radius by 1 and try again.
LOOP until we're done with all our characters.
Finally plot those saved positions to the screen.

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: SMcNeill on December 28, 2021, 10:54:06 pm

Quote from: madscijr on December 28, 2021, 06:20:10 pm

Update: I tried changing everything to the same data type (tried double and single), but still no change.
This is one of those days where I feel like I can't program my way out of a wet paper bag! :-p

Code: QB64: [Select]
Width 80, 80

Dim angle As Double
Dim x As Double
Dim y As Double
Dim A As Double
Dim radius As Double
Dim xPos As Double
Dim yPos As Double
Dim in$

radius = 0
x = 10
y = 10
For angle = 0 To 45
A = _D2R(angle - 90) ' The _D2R function converts a degree value into a radian value.
yPos = y + Cos(A) * radius
xPos = x + Sin(A) * radius

print "" + _
"A=" + _Trim$(Str$(A)) + _
"Cos(A) = " + _Trim$(Str$(Cos(A))) + _
_Trim$(Str$(x)) + "," + _Trim$(Str$(y)) + _
" rotated to " + _Trim$(Str$(angle)) + " deg = " + _
_Trim$(Str$(xPos)) + "," + _Trim$(Str$(yPos))
Next angle

Input "PRESS <ENTER> TO CONTINUE"; in$
End

Itis calculating exactly where you told it to calculate for you:

Centered at X/Y, rotated at ANGLE degrees, with a RADIUS of 0 from that center point. You're going around in circles at the center point of your circle!!

See how the values change when you increase the radius away from the center:

Code: [Select]

Screen _NewImage(800, 600, 32)

Dim angle As Integer
Dim x As Integer
Dim y As Integer
Dim A
Dim radius
Dim xPos
Dim yPos
Dim in$

For radius = 0 To 10
    Cls
    x = 10
    y = 10
    For angle = 20 To 40
        A = _D2R(angle - 90) ' The _D2R function converts a degree value into a radian value.
        yPos = y + Cos(A) * radius
        xPos = x + Sin(A) * radius
        Print Using "(###/###) rotated to ## degrees with a radius of ## = ###/###"; x, y, angle, radius, xPos, yPos
    Next angle

    Input "PRESS <ENTER> TO CONTINUE"; in$

Next

For a quick illustration of what you're doing, grab a pencil. Stick it onto the piece of paper with the pencil completely vertical to a single point. Now, rotate that pencil... You're turning it, but there's no change in the point where it's located, now is there??

That's why a compass has two points on it -- one with the sharp looking little needle end, and the other with the pencil itself. The sharp point goes into the center of your circle, you adjust your compass to the desired length (radius), and then rotate from the desired angles to either create your circle, or the arc of a circle.

Your code is working fine. Well, it is, as long as you simply want it to rotate that single point which makes the center of a one pixel circle (point) at 10, 10. ;)

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 28, 2021, 11:13:31 pm

Quote from: SMcNeill on December 28, 2021, 10:54:06 pm

Itis calculating exactly where you told it to calculate for you:

Centered at X/Y, rotated at ANGLE degrees, with a RADIUS of 0 from that center point. You're going around in circles at the center point of your circle!!

See how the values change when you increase the radius away from the center:

...

For a quick illustration of what you're doing, grab a pencil. Stick it onto the piece of paper with the pencil completely vertical to a single point. Now, rotate that pencil... You're turning it, but there's no change in the point where it's located, now is there??

That's why a compass has two points on it -- one with the sharp looking little needle end, and the other with the pencil itself. The sharp point goes into the center of your circle, you adjust your compass to the desired length (radius), and then rotate from the desired angles to either create your circle, or the arc of a circle.

Your code is working fine. Well, it is, as long as you simply want it to rotate that single point which makes the center of a one pixel circle (point) at 10, 10. ;)

OK that makes sense... Silly me!
Thanks for explaining.
I still need to figure out how to translate this to work for a 64x64 (or whatever size) grid, but at least I'm not going around in circles (pun intended).

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 29, 2021, 09:17:04 am

re: @SMcNeill and @STxAxTIC

Here's the latest monster in this series,
see options 19 + 20 from the menu to try ShearRotate4,
which only looks for missing pixels if the angle
of rotation is 30, 60, 120, 150, 210, 240, 300, 330,
and finds an empty space based on which quarter of the screen
and whether rotation is clockwise / counter-clockwise.

Maybe @SMcNeill 's little rotation algorithm can help simplify this,
or @STxAxTIC 's idea of combining the adjacent angle-1 and angle+1,
but my attention is currently divided and I'm a little busy to wrap my head around these
(this is where "I'm not a math person" starts to become a challenge!)

The output of ShearRotate2, ShearRotate3, and ShearRotate4 all look identical in the tests, but
ShearRotate2 does more calculations (inefficient) and the logic to find points is not great,
ShearRotate3 does less calculations but the logic wrongly uses the angle not the _direction_ or screen area,
and ShearRotate4 seems to be the most accurate logic.

Anyway, here it is if you want to try it, now includes semicircles and plot circles to top/left x,y:

Plot a point
Plot a square
Plot a circle (specifying center x,y)
Plot a circle (specifying top left x,y)
Plot a semicircle
Plot a solid circle (specifying center x,y)
Plot a solid circle (specifying top left x,y)
Plot a solid semicircle
Plot an ellipse
Plot a solid ellipse
Plot a line
Rotate (4 different variations)

Enjoy...

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Basic 2D plotting functions
' Version 1.00 by madscijr
' with help from various (sources cited below).
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS
' =============================================================================
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' rotational constants
Const cCounterClockwise = -1
Const cClockwise = 1
 
' -----------------------------------------------------------------------------
' USER DEFINED TYPES
' -----------------------------------------------------------------------------
Type RotationType
    origx As Integer
    origy As Integer
    c As Integer
    z as integer ' which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
End Type ' RotationType
 
' -----------------------------------------------------------------------------
' GLOBAL VARIABLES
' -----------------------------------------------------------------------------
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug: m_bDebug = TRUE
 
' =============================================================================
' BEGIN MAIN PROGRAM
' =============================================================================
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' START THE MENU
main
 
' -----------------------------------------------------------------------------
' DONE
Print m_ProgramName$ + " finished."
'Screen 0
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' EXIT
System ' return control to the operating system
End
 
' =============================================================================
' END MAIN PROGRAM
' =============================================================================
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
 
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Some basic 2D plotting"
        Print
        Print " 1. PlotPointTest"
        Print " 2. PlotSquareTest"
        Print " 3. PlotCircleTest"
                Print " 4. PlotCircleTopLeftTest"
        Print " 5. PlotSemicircleTest"
        Print " 6. CircleFillTest"
        Print " 7. CircleFillTopLeftTest"
                Print " 8. SemiCircleFillTest"
                Print " 9. EllipseTest"
        Print "10. EllipseFillTest"
        Print "11. PlotLineTest"
        Print "12. ShearRotate1Test1"
        Print "13. ShearRotate1Test2 (auto advances 0-360 degrees)"
        Print "14. ShearRotate1Test2 (auto advances 0-360 degrees) (uses Petr's text)"
        Print "15. ShearRotate2Test1 (correct for missing points logic v1)"
        Print "16. ShearRotate2Test1 (correct for missing points logic v1) (uses Petr's text)"
        Print "17. ShearRotate3Test1 (correct for missing points logic v2)"
        Print "18. ShearRotate3Test1 (correct for missing points logic v2) (uses Petr's text)"
        Print "19. ShearRotate4Test1 (correct for missing points logic v3)"
        Print "20. ShearRotate4Test1 (correct for missing points logic v3) (uses Petr's text)"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(_Trim$(in$))
        
        If in$ = "1" Then
            PlotPointTest
        ElseIf in$ = "2" Then
            PlotSquareTest
        ElseIf in$ = "3" Then
            PlotCircleTest
        ElseIf in$ = "4" Then
            PlotCircleTopLeftTest
        ElseIf in$ = "5" Then
            PlotSemicircleTest
                ElseIf in$ = "6" Then
            CircleFillTest
        ElseIf in$ = "7" Then
            CircleFillTopLeftTest
                Elseif in$ = "8" then
                        SemiCircleFillTest
        ElseIf in$ = "9" Then
            EllipseTest
        ElseIf in$ = "10" Then
            EllipseFillTest
        ElseIf in$ = "11" Then
            PlotLineTest
        ElseIf in$ = "12" Then
            ShearRotate1Test1
        ElseIf in$ = "13" Then
            ShearRotate1Test2 TestSprite1$
        ElseIf in$ = "14" Then
            ShearRotate1Test2 PetrText1$
        ElseIf in$ = "15" Then
            ShearRotate2Test1 TestSprite1$
        ElseIf in$ = "16" Then
            ShearRotate2Test1 PetrText1$
        ElseIf in$ = "17" Then
            ShearRotate3Test1 TestSprite1$
        ElseIf in$ = "18" Then
            ShearRotate3Test1 PetrText1$
        ElseIf in$ = "19" Then
            ShearRotate4Test1 TestSprite1$
        ElseIf in$ = "20" Then
            ShearRotate4Test1 PetrText1$
        End If
    Loop Until in$ = "q"
End Sub ' main
 
 
 
 
 
 
 
 
 
 
 
' /////////////////////////////////////////////////////////////////////////////
' MyArray(1 To 32, 1 To 32) AS STRING
' where index is MyArray(Y, X)
 
Sub PlotPoint (X As Integer, Y As Integer, S As String, MyArray() As String)
_echo "PlotPoint X=" + cstr$(X) + ", Y=" + cstr$(Y) + ", S=" + chr$(34) + S + chr$(34) + ", MyArray()"
    If (X >= LBound(MyArray, 2)) Then
        If (X <= UBound(MyArray, 2)) Then
            If (Y >= LBound(MyArray, 1)) Then
                If (Y <= UBound(MyArray, 1)) Then
                    If Len(S) = 1 Then
                        MyArray(Y, X) = S
                    Else
                        If Len(S) > 1 Then
                            MyArray(Y, X) = Left$(S, 1)
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub ' PlotPoint
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotPointTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a point."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type x,y (1-32, 1-32) coordinate to plot point at."
        Input "X,Y OR 0 TO QUIT? "; X, Y
        If X > 0 And Y > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X) + ", Y=" + cstr$(Y)
            PlotPoint X, Y, chr$(iChar), MyArray()
 
            Print "Current point plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
            
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotPointTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquare (X1 As Integer, Y1 As Integer, L As Integer, S As String, MyArray() As String)
    Dim X As Integer
    Dim X2 As Integer
    Dim Y As Integer
    Dim Y2 As Integer
    Dim sChar$
 
    If Len(S) = 1 Then
        sChar$ = S
    Else
        If Len(S) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(S, 1)
        End If
    End If
 
    X2 = (X1 + L) - 1
    Y2 = (Y1 + L) - 1
    For X = X1 To X2
        For Y = Y1 To Y2
            PlotPoint X, Y, sChar$, MyArray()
        Next Y
    Next X
End Sub ' PlotSquare
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquareTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Enter parameters to draw a square."
    Print ArrayToStringTest(MyArray())
    Print
    Do
        Print "Type top left x,y (1-32, 1-32) coordinate to plot square,"
        Print "and size (1-32) of square."
        Input "X,Y,L OR 0 TO QUIT? "; X, Y, L
        If X>0 AND Y>0 AND L > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "L=" + cstr$(L)
            Print 
            PlotSquare X, Y, L, chr$(iChar), MyArray()
            
            Print "Square plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotSquareTest
 
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
 
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
 
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
 
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM  : FAST CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
 
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
 
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
 
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM  : SLOW CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
 
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK   1 (drawing a pixel), 0 (erasing a pixel)
' X     X coordinate of the pixel
' Y     Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
 
' More on plotting circles:
'     Drawing a circle in BASIC - fast
'     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
 
' X,Y     = center point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircle (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        B = R
        C = 0
        A = R - 1
        Do
            PlotPoint X + C, Y + B, S2, MyArray()
            PlotPoint X + C, Y - B, S2, MyArray()
            PlotPoint X - C, Y - B, S2, MyArray()
            PlotPoint X - C, Y + B, S2, MyArray()
            PlotPoint X + B, Y + C, S2, MyArray()
            PlotPoint X + B, Y - C, S2, MyArray()
            PlotPoint X - B, Y - C, S2, MyArray()
            PlotPoint X - B, Y + C, S2, MyArray()
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then ' IF A>=0 THEN 190
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do ' 190 IF B>=C THEN 60
        Loop
    End If
End Sub ' PlotCircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a raster circle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            PlotCircle X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' PlotCircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' X,Y     = top left point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircleTopLeft (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim RoutineName As String : RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
    
    ' Get total width
    W = (R * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
    
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
            PlotPoint R + C, R + B, S2, arrTemp() ' 1
            PlotPoint R + C, R - B, S2, arrTemp() ' 2
            PlotPoint R - C, R - B, S2, arrTemp() ' 3
            PlotPoint R - C, R + B, S2, arrTemp() ' 4
            PlotPoint R + B, R + C, S2, arrTemp() ' 5
            PlotPoint R + B, R - C, S2, arrTemp() ' 6
            PlotPoint R - B, R - C, S2, arrTemp() ' 7
            PlotPoint R - B, R + C, S2, arrTemp() ' 8
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
        
        ' Copy circle to destination Y,X
        For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
            For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
                IF LEN(arrTemp(DY, DX)) > 0 THEN
                                        TY = Y + DY
                                        If TY >= MinY Then
                                                If TY <= MaxY Then
                                                        TX = X + DX
                                                        If TX >= MinX Then
                                                                If TX <= MaxX Then
                                                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                                                End If
                                                        End If
                                                End If
                                        End If
                                        
                END IF
            Next DX
        Next DY
    End If
End Sub ' PlotCircleTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a raster circle, specifying top left x,y position"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            PlotCircleTopLeft X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' PlotCircleTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on PlotCircleTopLeft.
 
' X,Y     = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
            ' .......4444111.......
            ' .....44.......11.....
            ' ....4...........1....
            ' ...4.............1...
            ' ..4...............1..
            ' .4.................1.
            ' .4.................1.
            ' 4...................1
            ' 4...................1
            ' 4...................1
            ' 3...................1
            ' 3...................2
            ' 3...................2
            ' 3...................2
            ' .3.................2.
            ' .3.................2.
            ' ..3...............2..
            ' ...3.............2...
            ' ....3...........2....
            ' .....33.......22.....
            ' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotSemicircle (X As Integer, Y As Integer, R As Integer, Q As Integer, S As String, MyArray() As String)
    Dim RoutineName As String : RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
    
    ' Get total width
    W = (R * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
    
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
            
            ' JUST PLOT SELECTED QUADRANT:
            Select Case Q
                Case 1:
                    ' quadrant #1
                    PlotPoint C, R - B, S2, arrTemp() ' 2
                    PlotPoint B, R - C, S2, arrTemp() ' 6
                Case 2:
                    ' quadrant #2
                    PlotPoint B, C, S2, arrTemp() ' 5
                    PlotPoint C, B, S2, arrTemp() ' 1
                Case 3:
                    ' quadrant #3
                    PlotPoint R - C, B, S2, arrTemp() ' 4
                    PlotPoint R - B, C, S2, arrTemp() ' 8
                Case 4:
                    ' quadrant #4
                    PlotPoint R - B, R - C, S2, arrTemp() ' 7
                    PlotPoint R - C, R - B, S2, arrTemp() ' 3
                Case Else:
                    ' (DO NOTHING)
            End Select
            
            '' PLOT CIRCLE:
            '' quadrant #1
            'PlotPoint R + C, R - B, S2, arrTemp() ' 2
            'PlotPoint R + B, R - C, S2, arrTemp() ' 6
            '
            '' quadrant #2
            'PlotPoint R + B, R + C, S2, arrTemp() ' 5
            'PlotPoint R + C, R + B, S2, arrTemp() ' 1
            '
            '' quadrant #3
            'PlotPoint R - C, R + B, S2, arrTemp() ' 4
            'PlotPoint R - B, R + C, S2, arrTemp() ' 8
            '
            '' quadrant #4
            'PlotPoint R - B, R - C, S2, arrTemp() ' 7
            'PlotPoint R - C, R - B, S2, arrTemp() ' 3
            
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
        
        ' Copy semicircle to destination Y,X
        For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
            For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
                IF LEN(arrTemp(DY, DX)) > 0 THEN
                                        TY = Y + DY
                                        If TY >= MinY Then
                                                If TY <= MaxY Then
                                                        TX = X + DX
                                                        If TX >= MinX Then
                                                                If TX <= MaxX Then
                                                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                                                End If
                                                        End If
                                                End If
                                        End If
                END IF
            Next DX
        Next DY
    End If
End Sub ' PlotSemicircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSemicircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a semicircle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print 
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            PlotSemicircle X, Y, R, Q, Chr$(iChar), MyArray()
            
            Print "Semicircle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' PlotSemicircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg1913#msg1913
 
' From: SMcNeill
' Date: « Reply #30 on: June 26, 2018, 03:34:18 pm »
' 
' Sometimes, computers do things that are completely counter-intuitive to us, and 
' we find ourselves having to step back as programmers and simply say, "WOW!!"   
' Here's a perfect example of that:
' Here we look at two different circle fill routines -- one, which I'd assume to 
' be faster, which precalculates the offset needed to find the endpoints for each 
' line which composes a circle, and another, which is the same old CircleFill 
' program which I've shared countless times over the years with people on various 
' QB64 forums.
' 
' When all is said and done though, CircleFill is STILL even faster than 
' CircleFillFast, which pregenerates those end-points for us!
 
' CX,CY     = center point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, S As String, MyArray() As String)
    DIM Radius AS INTEGER
    Dim RadiusError AS INTEGER
    DIM X AS INTEGER
    Dim Y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    
    IF Radius = 0 THEN 
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        EXIT SUB
    END IF
    
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    FOR iLoopX = CX - X TO CX + X
        PlotPoint iLoopX, CY, S, MyArray()
    NEXT iLoopX
    
    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
                iLoopY = CY - X
                FOR iLoopX = CX - Y TO CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                NEXT iLoopX
                
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                iLoopY = CY + X
                FOR iLoopX = CX - Y TO CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                NEXT iLoopX
            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
        iLoopY = CY - Y
        FOR iLoopX = CX - X TO CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopX
        
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        iLoopY = CY + Y
        FOR iLoopX = CX - X TO CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopX
    WEND
END SUB ' CircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a filled circle"
    Print "Based on CircleFill by SMcNeill."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            'PlotCircle X, Y, R, Chr$(iChar), MyArray()
            CircleFill X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' CircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotCircleTopLeft.
' CX,CY     = top left point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
SUB CircleFillTopLeft (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, S As String, MyArray() As String)
    DIM Radius AS INTEGER
    Dim RadiusError AS INTEGER
    DIM X AS INTEGER
    Dim Y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    DIM W As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
    
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    
    IF Radius = 0 THEN 
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        EXIT SUB
    END IF
    
    ' Get total width
    W = (Radius * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    FOR iLoopX = R - X TO R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    NEXT iLoopX
    
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
                
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
        
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
    WEND
    
    ' Copy circle to destination Y,X
    For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
        For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
            IF LEN(arrTemp(DY, DX)) > 0 THEN
                TY = DY + CY
                                If TY >= MinY Then
                                        If TY <= MaxY Then
                                                TX = DX + CX
                                                If TX >= MinX Then
                                                        If TX <= MaxX Then
                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                        End If
                                                End If
                                        End If
                                End If
            END IF
        Next DX
    Next DY
    
END SUB ' CircleFillTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a solid circle, specifying top left x,y position"
    Print "Based on CircleFill by SMcNeill."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            CircleFillTopLeft X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' CircleFillTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotSemiCircle
 
' CX,CY   = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return semicircle from
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
            ' .......4444111.......
            ' .....44444411111.....
            ' ....4444444111111....
            ' ...444444441111111...
            ' ..44444444411111111..
            ' .4444444444111111111.
            ' .4444444444111111111.
            ' 444444444441111111111
            ' 444444444441111111111
            ' 444444444441111111111
            ' 333333333331111111111
            ' 333333333332222222222
            ' 333333333332222222222
            ' 333333333332222222222
            ' .3333333333222222222.
            ' .3333333333222222222.
            ' ..33333333322222222..
            ' ...333333332222222...
            ' ....3333333222222....
            ' .....33333322222.....
            ' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot semicircle in
 
SUB SemiCircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, Q AS INTEGER, S As String, MyArray() As String)
    DIM Radius AS INTEGER
    Dim RadiusError AS INTEGER
    DIM X AS INTEGER
    Dim Y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    DIM W As Integer
    DIM AX As Integer
        DIM AY As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
        
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    
    IF Radius = 0 THEN 
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        EXIT SUB
    END IF
    
    ' Get total width
    W = (Radius * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
        ' Temp array's lbound is 0
        ' Calculate difference from MyArray the indices of arrTemp are
        AY = 0 - MinY
        AX = 0 - MinX
        
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    FOR iLoopX = R - X TO R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    NEXT iLoopX
    
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
                
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
        
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
    WEND
        
        '_echo "MyArray(" + _Trim$(Str$(lbound(MyArray,1))) + " To " + _Trim$(Str$(ubound(MyArray,1))) + ", " + _Trim$(Str$(lbound(MyArray,2))) + " To " + _Trim$(Str$(ubound(MyArray,2))) + ")"
        
    ' Copy semicircle to destination Y,X
        ' JUST COPY SELECTED QUADRANT:
        Select Case Q
                Case 1:
                        ' quadrant #1
                        For DY = 0 to Radius
                                For DX = Radius to W
                                        '_echo "DY=" + cstr$(DY) + ", DX=" + cstr$(DX)
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY + CY) - (AY+1)
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX - Radius) - AX
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case 2:
                        ' quadrant #2
                        For DY = Radius to W
                                For DX = Radius to W
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY - Radius) - AY
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX - Radius) - AX
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case 3:
                        ' quadrant #3
                        For DY = Radius to W
                                For DX = 0 to Radius
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY - Radius) - AY
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX + CX) - (AX+1)
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case 4:
                        ' quadrant #4
                        For DY = 0 to Radius
                                For DX = 0 to Radius
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY + CY) - (AY+1)
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX + CX) - (AX+1)
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case Else:
                        ' (DO NOTHING)
        End Select
    
        '' Copy circle to destination:
        'For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
    '    For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
    '        IF LEN(arrTemp(DY, DX)) > 0 THEN
    '            MyArray(DY + CY, DX + CX) = arrTemp(DY, DX)
    '        END IF
    '    Next DX
    'Next DY
    
END SUB ' SemiCircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SemiCircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a solid semicircle"
    Print "Based on CircleFill by SMcNeill."
    Print 
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            SemiCircleFill X, Y, R, Q, Chr$(iChar), MyArray()
            
            Print "Semicircle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' SemiCircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
 
SUB Ellipse (CX AS INTEGER, CY AS INTEGER, xRadius AS INTEGER, yRadius AS INTEGER, S As String, MyArray() As String)
    DIM scale AS SINGLE
    DIM xs AS INTEGER
    DIM x AS INTEGER
    DIM y AS INTEGER
    DIM lastx AS INTEGER
    DIM lasty AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    
    scale = yRadius / xRadius
    xs = xRadius * xRadius
    
    'PSET (CX, CY - yRadius)
    PlotPoint CX, CY - yRadius, S, MyArray()
    
    'PSET (CX, CY + yRadius)
    PlotPoint CX, CY + yRadius, S, MyArray()
    
    lastx = 0: lasty = yRadius
    FOR x = 1 TO xRadius
        y = scale * SQR(xs - x * x)
        'LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)
        PlotLine CX + lastx, CY - lasty, CX + x, CY - y, S, MyArray()
        
        'LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)
        PlotLine CX + lastx, CY + lasty, CX + x, CY + y, S, MyArray()
        
        'LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)
        PlotLine CX - lastx, CY - lasty, CX - x, CY - y, S, MyArray()
        
        'LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)
        PlotLine CX - lastx, CY + lasty, CX - x, CY + y, S, MyArray()
        
        lastx = x
        lasty = y
    NEXT x
END SUB ' Ellipse
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot an ellipse"
    Print "Based on ellipse by bplus."
    Print 
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 AND Y > 0 AND RX > 0 AND RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
            
            Ellipse X, Y, RX, RY, Chr$(iChar), MyArray()
            
            Print "Ellipse plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' EllipseTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
' 
' Here is my ellipse and filled ellipse routines, no where near 
' Steve's level of performance. The speed is cut in half at 
' least because you probably have to do a whole quadrants worth 
' of calculations (ellipse not as symmetric as circle).
' 
' But I am sure this code can be optimized more than it is:
 
SUB EllipseFill (CX AS INTEGER, CY AS INTEGER, xRadius AS INTEGER, yRadius AS INTEGER, S As String, MyArray() As String)
    DIM scale AS SINGLE
    DIM x AS INTEGER
    DIM y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    
    scale = yRadius / xRadius
    
    'LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    FOR iLoopY = CY - yRadius TO CY + yRadius
        PlotPoint CX, iLoopY, S, MyArray()
    NEXT iLoopY
    
    FOR x = 1 TO xRadius
        y = scale * SQR(xRadius * xRadius - x * x)
        
        'LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
        iLoopX = CX + x
        FOR iLoopY = CY - y TO  CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopY
        
        'LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
        iLoopX = CX - x
        FOR iLoopY = CY - y TO CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopY
    NEXT x
END SUB ' EllipseFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a filled ellipse"
    Print "Based on fellipse by bplus."
    Print 
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 AND Y > 0 AND RX > 0 AND RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
            
            EllipseFill X, Y, RX, RY, Chr$(iChar), MyArray()
            
            Print "Ellipse plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' EllipseFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
' From: http://www.thedubber.altervista.org/qbsrc.htm
 
Sub PlotLine (x1%, y1%, x2%, y2%, c$, MyArray() As String)
    Dim iLoop%
    Dim steep%: steep% = 0
    Dim ev%: ev% = 0
    Dim sx%
    Dim sy%
    Dim dx%
    Dim dy%
    
    If (x2% - x1%) > 0 Then
        sx% = 1
    Else
        sx% = -1
    End If
 
    dx% = Abs(x2% - x1%)
    If (y2% - y1%) > 0 Then
        sy% = 1
    Else
        sy% = -1
    End If
 
    dy% = Abs(y2% - y1%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x1%, y1%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
 
    ev% = 2 * dy% - dx%
    For iLoop% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y1%, x1%), c%:
            'LOCATE y1%, x1%
            'PRINT c$;
            PlotPoint y1%, x1%, c$, MyArray()
        Else
            ''PSET (x1%, y1%), c%
            'LOCATE x1%, y1%
            'PRINT c$;
            PlotPoint x1%, y1%, c$, MyArray()
        End If
 
        While ev% >= 0
            y1% = y1% + sy%
            ev% = ev% - 2 * dx%
        Wend
        x1% = x1% + sx%
        ev% = ev% + 2 * dy%
    Next iLoop%
    ''PSET (x2%, y2%), c%
    'LOCATE x2%, y2%
    'PRINT c$;
    PlotPoint x2%, y2%, c$, MyArray()
End Sub ' PlotLine
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotLineTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim in$
    Dim X1 As Integer
    Dim Y1 As Integer
    Dim X2 As Integer
    Dim Y2 As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot line with Bresenham Algorithm"
    Print "based on BRESNHAM.BAS by Kurt Kuzba (4/16/96)."
    Print 
    Print ArrayToStringTest(MyArray())
    Do
        Print "Enter coordinate values for "
        Print "line start point x1, y1 (1-32, 1-32)"
        Print "line end   point x2, y2 (1-32, 1-32)"
        Input "ENTER X1,Y1,X2,Y2 OR 0 TO QUIT: "; X1, Y1, X2, Y2
        If X1 > 0 And Y1 > 0 And X2 > 0 And Y2 > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X1=" + cstr$(X1)
            Print "Y1=" + cstr$(Y1)
            Print "X2=" + cstr$(X2)
            Print "Y2=" + cstr$(Y2)
            
            PlotLine X1, Y1, X2, Y2, Chr$(iChar), MyArray()
            
            Print "Line plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotLineTest
 
' /////////////////////////////////////////////////////////////////////////////
' 3 shear method testing
 
' _PUT Rotation Help
' https://www.qb64.org/forum/index.php?topic=1959.0
 
' 3 Shear Rotation - rotates without any aliasing(holes)
' https://www.freebasic.net/forum/viewtopic.php?t=24557
 
' From: leopardpm
' Date: Apr 02, 2016 1:21
' Last edited by leopardpm on Apr 02, 2016 17:18, edited 1 time in total.
'
' This is just a little 3-shear rotation routine
' (I am using 3-shear because it leaves no gaps/aliasing)
' that I was wondering if anyone sees how to make it faster.
' Obviously, I am just thinking about inside the double loop.
 
' Thanks again to BasicCoder2 for linking me to this little routine, it is wonderful so far!
 
'''                      roto-zooming algorithm
'''                    coded by Michael S. Nissen
'''                        jernmager@yahoo.dk
'
''' ===============================================================
''' Recoded to run on FBC 32/64 bit WIN, Version 1.05.0, 2016, by MrSwiss
''' Heavy flickering before going Full-Screen on 64 Bit !!!
''' This seems NOT to be the Case on 32 Bit ...
''' ===============================================================
'
'Type Pixel
'  As Single   X, Y
'  As ULong    C
'End Type
'
'''  dim vars
'Dim shared as Any Ptr Img_Buffer
'''  write the name of the .bmp image you want to rotozoom here:
'''  (it has to be sqare ie. 100x100 pixels, 760x760 pixels or whatever)
'Dim As String Img_Name = "phobos.bmp"
'Dim shared as Integer X_Mid, Y_Mid, scrn_wid, scrn_hgt, P1, P2, P3, P4, C
'Dim shared as Short Img_Hgt, Img_Wid, Img_Lft, Img_Rgt, Img_Top, Img_Btm, X, Y
'Dim Shared As Single Cos_Ang, Sin_Ang, Rot_Fac_X, Rot_Fac_Y, Angle = 0, Scale = 1
'
''' changed Function to Sub (+ recoded arguments list)
'Sub Calc_rotozoom ( ByRef Cos_Ang As Single, _
'               ByRef Sin_Ang As Single, _
'               ByVal S_Fact  As Single, _
'               ByVal NewAng  As Single )
'  Cos_Ang = Cos(NewAng)*S_Fact
'  Sin_Ang = Sin(NewAng)*S_Fact
'End Sub
'
'''  full screen
'ScreenInfo scrn_wid, scrn_hgt
'screenRes scrn_wid, scrn_hgt, 32,,1
'
'''  dim screenpointer (has to be done after screenres)
'Dim As ULong Ptr Scrn_Ptr = Screenptr
'
'''  place image in center of screen
'X_Mid = scrn_wid\2
'Y_Mid = scrn_hgt\2
'Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'
'''  find image dimensions
'Open Img_Name For Binary As #1
'Get #1, 19, Img_Wid
'Get #1, 23, Img_Hgt
'Close #1
'
'''  prepare to dim the array that will hold the image.
'Img_Rgt = (Img_Wid-1)\2
'Img_Lft = -Img_Rgt
'Img_Btm = (Img_Hgt-1)\2
'Img_Top = -Img_Btm
'
'''  dim array to hold image. Note: pixel (0, 0) is in the center.
'Dim As Pixel Pixel(Img_Lft to Img_Rgt, Img_Top to Img_Btm)
'
'''  imagecreate sprite and load image to sprite
'Img_Buffer = ImageCreate (Img_Wid, Img_Hgt)
'Bload (Img_Name, Img_Buffer)
'
'''  load image from sprite to array with point command
'For Y = Img_Top to Img_Btm
'  For X = Img_Lft to Img_Rgt
'    With Pixel(X, Y)
'      .X = X_Mid+X
'      .Y = Y_Mid+Y
'      C = Point (X-Img_Top, Y-Img_Lft, Img_buffer)
'      If C <> RGB(255, 0, 255) Then
'        .C = C
'      Else
'        .C = RGB(0, 0, 0)
'      End If
'    End With
'  Next X
'Next Y
'
'''  we don't need the sprite anymore, kill it
'ImageDestroy Img_Buffer
'Img_Buffer = 0
'
'''  main program loop
'Do
'
'  ''  scale in/out with uparrow/downarrow
'  If Multikey(80) Then
'    Scale *= 1.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(72) Then
'    Scale *= 0.97
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  rotate left/right with leftarrow/rightarrow
'  If Multikey(77) Then
'    Angle -= 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(75) Then
'    Angle += 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  lock screen in order to use screen pointers
'  ScreenLock
'
'    ''  draw pixel in center of image
'    Scrn_Ptr[ X_Mid + Y_Mid * scrn_wid ] = Pixel(0, 0).C
'    ''  draw all other pixels - 4 at a time
'    For Y = Img_Top to 0
'      For X = Img_Lft to -1
'        ''  find pixel positions
'        P1 = (X_Mid+X) + (Y_Mid+Y) * scrn_wid
'        P2 = (X_Mid-X) + (Y_Mid-Y) * scrn_wid
'        P3 = (X_Mid+Y) + (Y_Mid-X) * scrn_wid
'        P4 = (X_Mid-Y) + (Y_Mid+X) * scrn_wid
'        ''  erase old pixels (paint them black)
'        Scrn_Ptr[P1] = 0
'        Scrn_Ptr[P2] = 0
'        Scrn_Ptr[P3] = 0
'        Scrn_Ptr[P4] = 0
'        ''  rotate and zoom
'        Rot_Fac_X = X*Cos_Ang - Y*Sin_Ang
'        Rot_Fac_Y = X*Sin_Ang + Y*Cos_Ang
'        If Rot_Fac_X < Img_Lft Or Rot_Fac_X > Img_Rgt Then Continue For
'        If Rot_Fac_Y < Img_Top Or Rot_Fac_Y > Img_Btm Then Continue For
'        ''  draw new pixels
'        Scrn_Ptr[P1] = Pixel(Rot_Fac_X, Rot_Fac_Y).C
'        Scrn_Ptr[P2] = Pixel(-Rot_Fac_X, -Rot_Fac_Y).C
'        Scrn_Ptr[P3] = Pixel(Rot_Fac_Y, -Rot_Fac_X).C
'        Scrn_Ptr[P4] = Pixel(-Rot_Fac_Y, Rot_Fac_X).C
'      Next X
'    Next Y
'
'  ScreenUnLock
'
'  Sleep 10, 1
'Loop Until InKey() = Chr(27)
 
' UPDATES:
' Fixed bug where values 135, 224, and 314 all resolve to -45 degrees.
' Fixed bug where an angle of 46-135 degrees caused the image to be flipped wrong.
 
' TODO:
' Fix issue where image looks bad at 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
Sub ShearRotate (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate
 
' /////////////////////////////////////////////////////////////////////////////
' Same as ShearRotate, except adds iOverwriteCount parameter, 
' and counts how many points are overwriting existing points, 
' and return that value byref in parameter iOverwriteCount.
 
Sub ShearRotate1 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iOverwriteCount As Integer)
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    iOverwriteCount = 0
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    
                    ' count points that will be overwritten
                    if NewArray(fx, fy, 0).c <> iEmpty then
                        iOverwriteCount = iOverwriteCount + 1
                    end if
                    
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate1
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotate1Test1
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim in$
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print
    
    sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
    Print "Initial contents of Rotation Array:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    
    ' ROTATE THE SHAPE
    Do
        Print "Type degrees to rotate (0 TO 360) or non-numeric value to quit."
        Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
 
        Input "Degrees to rotate (q to quit)? "; in$
        If IsNum%(in$) Then
            D = Val(in$)
            If D >= 0 And D <= 360 Then
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
End Sub ' ShearRotate1Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Now receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate1Test2 TestSprite1$
 
Sub ShearRotate1Test2(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iOverwriteCount As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate1Test2
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v2
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate2 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iMissing As Integer)
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    if NewArray(fx, fy, 0).c = iEmpty then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                    end if
                End If
            End If
        Next x
    Next y
    
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the angle of rotation? 
    ' perhaps if we divide the screen up into 4 zones:
    ' 
    ' -------------------------------------- 
    '|                   |                  |
    '| zone 4            | zone 1           |
    '| 271-359 degrees)  | (1-89 degrees)   |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '| (181-269 degrees) | (91-179 degrees) |
    '|                   |                  |
    ' -------------------------------------- 
    
    ' in zone   search direction (y,x)
    ' -------   ----------------------
    ' 1         up   + right
    ' 2         down + right
    ' 3         down + left
    ' 4         up   + left
    
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint2%(arrLost(iLoop), angle1, iEmpty, x, y, NewArray())
        if bFound = TRUE then
            If m_bDebug = TRUE Then
                _echo "Plotted  missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _echo "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        end if
    Next iLoop
    
End Sub ' ShearRotate2
 
' /////////////////////////////////////////////////////////////////////////////
' Receives
' FindMe (RotationType) = contains the starting location (.origx, .origy) to start looking from, and the value (.c) to write
' angle1 (Integer) = angle we were rotating to, to determine direction to look in
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint2%(FindMe As RotationType, angle1 As Integer, iEmpty as Integer, destX as integer, destY as integer, NewArray() As RotationType)
    Dim bResult as Integer : bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    
    destX = 0
    destY = 0
    
    ' Choose search direction depending on the angle
    If angle1 > 0 And angle1 < 90 Then
        dirX = 1
        dirY = -1
    ElseIf angle1 > 90 And angle1 < 180 Then
        dirX = 1
        dirY = 1
    ElseIf angle1 > 180 And angle1 < 270 Then
        dirX = -1
        dirY = 1
    ElseIf angle1 > 270 And angle1 < 360 Then
        dirX = -1
        dirY = -1
    Else
        dirX = 0
        dirY = 0
    End If
    
    If dirX <> 0 Then
        x = FindMe.origx
        y = FindMe.origy
        Do
            ' quit if we're out of bounds
            if x < LBound(NewArray, 1) then Exit Do
            if x > UBound(NewArray, 1) then Exit do
            if y < LBound(NewArray, 2) then Exit Do
            if y > UBound(NewArray, 2) then Exit do
            
            ' =============================================================================
            ' BEGIN PRIMARY SEARCH
            ' =============================================================================
            ' look along y axis for a blank spot
            destX = x
            destY = y + dirY
            if destX >= LBound(NewArray, 1) then
                if destX <= UBound(NewArray, 1) then 
                    if destY >= LBound(NewArray, 2) then
                        if destY <= UBound(NewArray, 2) then 
                            if NewArray(destX, destY, 0).c = iEmpty then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            end if
                        end if
                    end if
                end if
            end if
            
            ' look along x axis for a blank spot
            destX = x + dirX
            destY = y
            if destX >= LBound(NewArray, 1) then
                if destX <= UBound(NewArray, 1) then 
                    if destY >= LBound(NewArray, 2) then
                        if destY <= UBound(NewArray, 2) then 
                            if NewArray(x + dirX, y, 0).c = iEmpty then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            end if
                        end if
                    end if
                end if
            end if
            
            ' look diagonally for a blank spot
            destX = x + dirX
            destY = y + dirY
            if destX >= LBound(NewArray, 1) then
                if destX <= UBound(NewArray, 1) then 
                    if destY >= LBound(NewArray, 2) then
                        if destY <= UBound(NewArray, 2) then 
                            if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            end if
                        end if
                    end if
                end if
            end if
            ' =============================================================================
            ' END PRIMARY SEARCH
            ' =============================================================================
            
            ' =============================================================================
            ' BEGIN SECONDARY SEARCH
            ' =============================================================================
'yoda
            ' =============================================================================
            ' END SECONDARY SEARCH
            ' =============================================================================
            
            ' Keep looking
            x = x + dirX
            y = y + dirY
        Loop
    End If
    
    ' Return result
    FindEmptyShearRotationPoint2% = bResult
End Sub ' FindEmptyShearRotationPoint2%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points.
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate2Test1 TestSprite1$
 
Sub ShearRotate2Test1(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
                
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate2Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v3
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' a little more accurately, using iDirection parameter 
' (which can be cClockwise or cCounterClockwise) 
' together with which quarter of the screen the point is in, 
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate3 ( _ 
        OldArray() As RotationType, _ 
        NewArray() As RotationType, _ 
        angle1 As Integer, _ 
        iDirection As Integer, _ 
        iEmpty As Integer, _ 
        iMissing As Integer)
        
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
        Dim iMidX As Integer
        Dim iMidY As Integer
        
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
        ' find midpoints
        iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
        iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
        
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            
                        ' find which part of screen the current point is in
                        if y > iMidY then
                                ' bottom half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 2
                                else
                                        ' left half of screen
                                        iScreenZone = 3
                                end if
                        else
                                ' top half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 1
                                else
                                        ' left half of screen
                                        iScreenZone = 4
                                end if
                        end if
                        
                        ' calculate directions
                        Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    if NewArray(fx, fy, 0).c = iEmpty then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                                                
                                                ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                                                arrLost(UBound(arrLost)).z = iScreenZone
                    end if
                End If
            End If
        Next x
    Next y
    
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
        ' together with which quarter of the screen the point is in (iScreenZone) 
    ' where we divide the screen up into 4 zones:
    
    ' -------------------------------------- 
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' -------------------------------------- 
    
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
        ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
    
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint3%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
        if bFound = TRUE then
            If m_bDebug = TRUE Then
                _echo "Plotted  missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _echo "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        end if
    Next iLoop
    
End Sub ' ShearRotate3
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter 
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains 
'                         .origx, .origy = the starting location to start looking from, 
'                         .z = which area of the screen the point is in 
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left) 
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint3%(FindMe As RotationType, iDirection As Integer, iEmpty as Integer, destX as integer, destY as integer, NewArray() As RotationType)
    Dim bResult as Integer : bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
        
        ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
        
    ' Choose search direction based on the quadrant of the screen
        ' and the direction of rotation:
        
        ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
        ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
        
    If     FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
    
        ' Quit if we're out of bounds
    If bContinue = TRUE Then
                bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
                if x >= LBound(NewArray, 1) then 
                        if x <= UBound(NewArray, 1) then 
                                if y >= LBound(NewArray, 2) then 
                                        if y <= UBound(NewArray, 2) then 
                                                bContinue = TRUE
                                        end if
                                end if
                        end if
                end if
        End If
        
        ' look along y axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(destX, destY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look along x axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look diagonally for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
    End If
        
    ' Return result
    FindEmptyShearRotationPoint3% = bResult
End Sub ' FindEmptyShearRotationPoint3%
 
' /////////////////////////////////////////////////////////////////////////////
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate3Test1 TestSprite1$
 
Sub ShearRotate3Test1(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                                
                ShearRotate3 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
                
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate3 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate3Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v4
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' using a different approach, by just looking at the problem angles:
' 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
' (which can be cClockwise or cCounterClockwise) 
' together with which quarter of the screen the point is in, 
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate4 ( _ 
        OldArray() As RotationType, _ 
        NewArray() As RotationType, _ 
        angle1 As Integer, _ 
        iDirection As Integer, _ 
        iEmpty As Integer, _ 
        iMissing As Integer)
        
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
        Dim iMidX As Integer
        Dim iMidY As Integer
        
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
        ' find midpoints
        iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
        iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
        
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            
                        ' find which part of screen the current point is in
                        if y > iMidY then
                                ' bottom half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 2
                                else
                                        ' left half of screen
                                        iScreenZone = 3
                                end if
                        else
                                ' top half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 1
                                else
                                        ' left half of screen
                                        iScreenZone = 4
                                end if
                        end if
                        
                        ' calculate directions
                        Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    if NewArray(fx, fy, 0).c = iEmpty then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                                                
                                                ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                                                arrLost(UBound(arrLost)).z = iScreenZone
                    end if
                End If
            End If
        Next x
    Next y
    
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
        ' together with which quarter of the screen the point is in (iScreenZone) 
    ' where we divide the screen up into 4 zones:
    
    ' -------------------------------------- 
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' -------------------------------------- 
    
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
        ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
    
        if IsProblemAngle%(angle1) then
                iMissing = 0
                For iLoop = 0 To UBound(arrLost)
                        bFound = FindEmptyShearRotationPoint4%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
                        if bFound = TRUE then
                                If m_bDebug = TRUE Then
                                        _echo "Plotted  missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                                End If
                        else
                                iMissing = iMissing + 1
                                If m_bDebug = TRUE Then
                                        _echo "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                                End If
                        end if
                Next iLoop
    end if
End Sub ' ShearRotate4
 
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
function IsProblemAngle%(angle as integer)
        dim bResult as integer : bResult = FALSE
        Dim i%
        For i% = 0 To 360 Step 30
                If i% Mod 90 <> 0 Then
                        if angle = i% then
                                bResult = TRUE
                                exit for
                        end if
                End If
        Next i%
        IsProblemAngle% = bResult
end function ' IsProblemAngle%
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter 
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains 
'                         .origx, .origy = the starting location to start looking from, 
'                         .z = which area of the screen the point is in 
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left) 
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint4%(FindMe As RotationType, iDirection As Integer, iEmpty as Integer, destX as integer, destY as integer, NewArray() As RotationType)
    Dim bResult as Integer : bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
        
        ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
        
    ' Choose search direction based on the quadrant of the screen
        ' and the direction of rotation:
        
        ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
        ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
        
    If     FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
    
        ' Quit if we're out of bounds
    If bContinue = TRUE Then
                bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
                if x >= LBound(NewArray, 1) then 
                        if x <= UBound(NewArray, 1) then 
                                if y >= LBound(NewArray, 2) then 
                                        if y <= UBound(NewArray, 2) then 
                                                bContinue = TRUE
                                        end if
                                end if
                        end if
                end if
        End If
        
        ' look along y axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(destX, destY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look along x axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look diagonally for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
    End If
        
'       ' look (in the opposite direction) along y axis for an available adjacent point
'       If bContinue = TRUE Then
'               destX = x
'               destY = y - dirY
'               if destX >= LBound(NewArray, 1) then
'                       if destX <= UBound(NewArray, 1) then 
'                               if destY >= LBound(NewArray, 2) then
'                                       if destY <= UBound(NewArray, 2) then 
'                                               if NewArray(destX, destY, 0).c = iEmpty then
'                                                       NewArray(destX, destY, 0).c = FindMe.c
'                                                       bResult = TRUE
'                                                       bContinue = FALSE
'                                               end if
'                                       end if
'                               end if
'                       end if
'               end if
'       end if
'       
'       ' look (in the opposite direction) along x axis for an available adjacent point
'       If bContinue = TRUE Then
'               destX = x - dirX
'               destY = y
'               if destX >= LBound(NewArray, 1) then
'                       if destX <= UBound(NewArray, 1) then 
'                               if destY >= LBound(NewArray, 2) then
'                                       if destY <= UBound(NewArray, 2) then 
'                                               if NewArray(x + dirX, y, 0).c = iEmpty then
'                                                       NewArray(destX, destY, 0).c = FindMe.c
'                                                       bResult = TRUE
'                                                       bContinue = FALSE
'                                               end if
'                                       end if
'                               end if
'                       end if
'               end if
'       end if
'       
'       ' look (in the opposite direction) diagonally for an available adjacent point
'       If bContinue = TRUE Then
'               destX = x - dirX
'               destY = y - dirY
'               if destX >= LBound(NewArray, 1) then
'                       if destX <= UBound(NewArray, 1) then 
'                               if destY >= LBound(NewArray, 2) then
'                                       if destY <= UBound(NewArray, 2) then 
'                                               if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
'                                                       NewArray(destX, destY, 0).c = FindMe.c
'                                                       bResult = TRUE
'                                                       bContinue = FALSE
'                                               end if
'                                       end if
'                               end if
'                       end if
'               end if
'    End If
        
    ' Return result
    FindEmptyShearRotationPoint4% = bResult
End Sub ' FindEmptyShearRotationPoint4%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points with improved logic v3
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate4Test1 TestSprite1$
 
Sub ShearRotate4Test1(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                                
                ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
                
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate4Test1
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "11111111111111111111111111111111" + Chr$(13) ' 1
    m$ = m$ + "4..............................2" + Chr$(13) ' 2
    m$ = m$ + "4....##.....#######.....####...2" + Chr$(13) ' 3
    m$ = m$ + "4...####....##...###...######..2" + Chr$(13) ' 4
    m$ = m$ + "4..##..##...##...###..##....##.2" + Chr$(13) ' 5
    m$ = m$ + "4.##....##..#######...##.......2" + Chr$(13) ' 6
    m$ = m$ + "4.########..#######...##.......2" + Chr$(13) ' 7
    m$ = m$ + "4.########..##...###..##....##.2" + Chr$(13) ' 8
    m$ = m$ + "4.##....##..##...###...######..2" + Chr$(13) ' 9
    m$ = m$ + "4.##....##..#######.....####...2" + Chr$(13) ' 10
    m$ = m$ + "4..............................2" + Chr$(13) ' 11
    m$ = m$ + "4..............................2" + Chr$(13) ' 12
    m$ = m$ + "4..ABBBBBBBBBBBBBBBBBBBBBBBBC..2" + Chr$(13) ' 13
    m$ = m$ + "4..A...........EE...........C..2" + Chr$(13) ' 14
    m$ = m$ + "4..A..........FFFF..........C..2" + Chr$(13) ' 15
    m$ = m$ + "4..A.........GGGGGG.........C..2" + Chr$(13) ' 16
    m$ = m$ + "4..A........HHHHHHHH........C..2" + Chr$(13) ' 17
    m$ = m$ + "4..A.......IIIIIIIIII.......C..2" + Chr$(13) ' 18
    m$ = m$ + "4..A......JJJJJJJJJJJJ......C..2" + Chr$(13) ' 19
    m$ = m$ + "4..DDDDDDDDDDDDDDDDDDDDDDDDDC..2" + Chr$(13) ' 20
    m$ = m$ + "4..............................2" + Chr$(13) ' 21
    m$ = m$ + "4..............................2" + Chr$(13) ' 22
    m$ = m$ + "4.######....########..########.2" + Chr$(13) ' 23
    m$ = m$ + "4.#######...########..########.2" + Chr$(13) ' 24
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 25
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 26
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 27
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 28
    m$ = m$ + "4.#######...##........##.......2" + Chr$(13) ' 29
    m$ = m$ + "4.######....########..##.......2" + Chr$(13) ' 30
    m$ = m$ + "4..............................2" + Chr$(13) ' 31
    m$ = m$ + "33333333333333333333333333333332" + Chr$(13) ' 32
    TestSprite1$ = m$
End Function ' TestSprite1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite2$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "...............AA..............." + Chr$(13) ' 1
    m$ = m$ + "..............//BB.............." + Chr$(13) ' 2
    m$ = m$ + ".............??..CC............." + Chr$(13) ' 3
    m$ = m$ + "............==....DD............" + Chr$(13) ' 4
    m$ = m$ + "...........++......EE..........." + Chr$(13) ' 5
    m$ = m$ + "..........&&........FF.........." + Chr$(13) ' 6
    m$ = m$ + ".........zz..........GG........." + Chr$(13) ' 7
    m$ = m$ + "........yy............HH........" + Chr$(13) ' 8
    m$ = m$ + ".......xx..............II......." + Chr$(13) ' 9
    m$ = m$ + "......ww................JJ......" + Chr$(13) ' 10
    m$ = m$ + ".....vv..................KK....." + Chr$(13) ' 11
    m$ = m$ + "....uu....................LL...." + Chr$(13) ' 12
    m$ = m$ + "...tt......DDAAAAAAA.......MM..." + Chr$(13) ' 13
    m$ = m$ + "..ss.......DDAAAAAAA........NN.." + Chr$(13) ' 14
    m$ = m$ + ".rr........DD.....BB.........OO." + Chr$(13) ' 15
    m$ = m$ + "qq.........DD.....BB..........PP" + Chr$(13) ' 16
    m$ = m$ + "pp.........DD.....BB..........QQ" + Chr$(13) ' 17
    m$ = m$ + ".oo........DD.....BB.........RR." + Chr$(13) ' 18
    m$ = m$ + "..nn.......CCCCCCCBB........SS.." + Chr$(13) ' 19
    m$ = m$ + "...mm......CCCCCCCBB.......TT..." + Chr$(13) ' 20
    m$ = m$ + "....ll....................UU...." + Chr$(13) ' 21
    m$ = m$ + ".....kk..................VV....." + Chr$(13) ' 22
    m$ = m$ + "......jj................WW......" + Chr$(13) ' 23
    m$ = m$ + ".......ii..............XX......." + Chr$(13) ' 24
    m$ = m$ + "........hh............YY........" + Chr$(13) ' 25
    m$ = m$ + ".........gg..........ZZ........." + Chr$(13) ' 26
    m$ = m$ + "..........ff........@@.........." + Chr$(13) ' 27
    m$ = m$ + "...........ee......##..........." + Chr$(13) ' 28
    m$ = m$ + "............dd....$$............" + Chr$(13) ' 29
    m$ = m$ + ".............cc..%%............." + Chr$(13) ' 30
    m$ = m$ + "..............bb\\.............." + Chr$(13) ' 31
    m$ = m$ + "...............aa..............." + Chr$(13) ' 32
    TestSprite2$ = m$
End Function ' TestSprite2$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function PetrText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "....It's a SCREEN resolution?..." + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    PetrText1$ = m$
End Function ' PetrText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToString$ (MyArray( 1 To 32 , 1 To 32) As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        MyString = MyString + sLine + Chr$(13)
    Next iY
    ArrayToString$ = MyString
End Function ' ArrayToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToStringTest$ (MyArray() As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
 
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    ArrayToStringTest$ = MyString
End Function ' ArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function RotationArrayToStringTest$ (RoArray() As RotationType)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    For iY = LBound(RoArray, 1) To UBound(RoArray, 1)
        sLine = ""
        sLine = sLine + Right$("    " + cstr$(iY), 3)
        For iX = LBound(RoArray, 2) To UBound(RoArray, 2)
            sLine = sLine + Chr$(RoArray(iX, iY, 0).c)
        Next iX
        sLine = sLine + Right$("   " + cstr$(iY), 3)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    RotationArrayToStringTest$ = MyString
End Function ' RotationArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
' 1. split string by line breaks CHR$(13)
' 2. split lines up to 1 column per char
' 3. count rows, columns
' 4. DIM array, making sure array has
'    a) an _ODD_ number of rows/columns, with a center point
'    b) index is in cartesian format, where center is (0,0)
' 5. populate array with contents of string
 
' dimension #1 = columns
' dimension #2 = rows
 
Sub StringToRotationArray (RoArray() As RotationType, MyString As String, EmptyChar As String)
    Dim RoutineName As String: RoutineName = "StringToRotationArray"
    ReDim arrLines$(0)
    Dim delim$
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iColCount As Integer
    Dim iRowCount As Integer
    Dim iCount As Integer
    Dim bAddedRow As Integer: bAddedRow = FALSE
    Dim bAddedColumn As Integer: bAddedColumn = FALSE
    Dim iHalf1 As Integer
    Dim iHalf2 As Integer
    Dim iFrom1 As Integer
    Dim iFrom2 As Integer
    Dim iTo1 As Integer
    Dim iTo2 As Integer
    Dim iEmpty As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
 
    iRowCount = UBound(arrLines$) + 1
 
    ' look at all the rows and find the max # of columns used
    iColCount = 0
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
 
        ' count the columns for this row
        iCount = 0
        For iCol% = 1 To Len(arrLines$(iRow%))
            iCount = iCount + 1
        Next iCol%
 
        ' if this row has the most so far, then set that to the max
        If iCount > iColCount Then
            iColCount = iCount
        End If
    Next iRow%
 
    ' adjust columns to be odd
    If IsEven%(iColCount) Then
        iColCount = iColCount + 1
        bAddedColumn = TRUE
    End If
 
    ' calculate array bounds for columns
    iHalf1 = (iColCount - 1) / 2
    iFrom1 = 0 - iHalf1
    iTo1 = iHalf1
 
    ' adjust rows to be odd
    If IsEven%(iRowCount) Then
        iRowCount = iRowCount + 1
        bAddedRow = TRUE
    End If
 
    ' calculate array bounds for rows
    iHalf2 = (iRowCount - 1) / 2
    iFrom2 = 0 - iHalf2
    iTo2 = iHalf2
 
    ' size array to new bounds
    ReDim RoArray(iFrom1 To iTo1, iFrom2 To iTo2, 127) As RotationType
 
    ' get value for empty
    If Len(EmptyChar) > 0 Then
        iEmpty = Asc(EmptyChar)
    Else
        iEmpty = 32 ' (use space as default)
    End If
 
    ' clear array
    For iY = LBound(RoArray, 2) To UBound(RoArray, 2)
        For iX = LBound(RoArray, 1) To UBound(RoArray, 1)
            RoArray(iX, iY, 0).c = iEmpty
            RoArray(iX, iY, 0).origx = iX
            RoArray(iX, iY, 0).origy = iY
        Next iX
    Next iY
 
    ' fill array
    iY = LBound(RoArray, 2) - 1
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        iY = iY + 1
        iX = LBound(RoArray, 1) - 1
        For iCol% = 1 To Len(arrLines$(iRow%))
            iX = iX + 1
            sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
            RoArray(iX, iY, 0).c = Asc(sChar$)
        Next iCol%
    Next iRow%
 
End Sub ' StringToRotationArray
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBOUND(result$)) = MID$(in$, start, finish - start)
        start = finish + 1
    LOOP WHILE start <= LEN(in$)
END SUB ' split
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: STxAxTIC on December 29, 2021, 10:24:13 am

So I have to do a bunch of reading to catch up to where the discussion is, but I never mentioned how a certain experiment went the other day so I recreated it just now. This is quick and dirty, not a solution, but maybe it'll inspire.

1) Take a screenshot at 29 degrees, save.
2) Take a screenshot at 31 degrees, save.
3) Invert colors on each image (for paint.exe's convenience)
4) With transparent selection enabled, paste one picture over the other as shown.

The result is basically what you want, but in bold. This is the pictorial version of binary ANDing the two images. All you would need to do is de-bold the final image, which could come from using the original skeleton that is angle 30's image, with perhaps an OR instead - or something. Alright, just wanted to share that before too much time goes by.

[ This attachment cannot be displayed inline in 'Print Page' view ]

EDIT:

Here's a scheme. Three definitions:
[29] = image at 29 degrees
[30] = image at 30 degrees
[31] = image at 31 degrees

If rotating the positive direction, use [29] AND [30]
If rotating in the negative direction, use [31] AND [30]
If not moving at all, use [29] AND [31].

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 29, 2021, 11:33:34 am

Quote from: STxAxTIC on December 29, 2021, 10:24:13 am

So I have to do a bunch of reading to catch up to where the discussion is, but I never mentioned how a certain experiment went the other day so I recreated it just now. This is quick and dirty, not a solution, but maybe it'll inspire.

1) Take a screenshot at 29 degrees, save.
2) Take a screenshot at 31 degrees, save.
3) Invert colors on each image (for paint.exe's convenience)
4) With transparent selection enabled, paste one picture over the other as shown.

The result is basically what you want, but in bold. This is the pictorial version of binary ANDing the two images. All you would need to do is de-bold the final image, which could come from using the original skeleton that is angle 30's image, with perhaps an OR instead - or something. Alright, just wanted to share that before too much time goes by.

EDIT:

Here's a scheme. Three definitions:
[29] = image at 29 degrees
[30] = image at 30 degrees
[31] = image at 31 degrees

If rotating the positive direction, use [29] AND [30]
If rotating in the negative direction, use [31] AND [30]
If not moving at all, use [29] AND [31].

Thanks for sharing this idea - I just gave it a try.

Here's what we get at 29 degrees:
[ This attachment cannot be displayed inline in 'Print Page' view ]

Here is 31 degrees:
[ This attachment cannot be displayed inline in 'Print Page' view ]

And here is what we get when we try merging:
[ This attachment cannot be displayed inline in 'Print Page' view ]

I think the problem is how to determine if a point has been duplicated.
If we duplicate a point, the result is a sort of "blur".
With text characters like in the above example, it's easy to see the problem.

We can check to see if a point gets overwritten (like ShearRotate4 does)
but if it does, how do we identify which is the equivalent point from the previous/next angle?

I suppose we could substitute a "mask" array, which uses unique values for each point,
and it can then locate the given point in its new position:

Copy the unrotated array OriginalArray to MaskArray, where each point gets a unique value
Rotate MaskArray to the desired angle, result is RotatedMaskArray, checking for overwritten points.
Rotate MaskArray counter-clockwise to angle-1, result is CCWMaskArray. Locate overwritten points.
Plot any overwritten points found in CCWMaskArray to RotatedMaskArray _if_ not occupied.
If any overwritten points remain to be found, rotate MaskArray clockwise to angle+1, result is CWMaskArray. Locate overwritten points.
Plot any overwritten points found in CWMaskArray to RotatedMaskArray _if_ not occupied.
Finally, use RotatedMaskArray as a guide to construct RotatedArray from the actual values in OriginalArray

^^ or something like that?

That would probably work actually, although it's costly -
we would have to copy our array 2 or more times, and iterate over it.
But if what we want is accuracy, that might do it?

Here is the code, use option 22 from the menu:

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Basic 2D plotting functions
' Version 1.00 by madscijr
' with help from various (sources cited below).
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS
' =============================================================================
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' rotational constants
Const cCounterClockwise = -1
Const cClockwise = 1
 
' -----------------------------------------------------------------------------
' USER DEFINED TYPES
' -----------------------------------------------------------------------------
Type RotationType
    origx As Integer
    origy As Integer
    c As Integer
    z as integer ' which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
End Type ' RotationType
 
' -----------------------------------------------------------------------------
' GLOBAL VARIABLES
' -----------------------------------------------------------------------------
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug: m_bDebug = TRUE
 
' =============================================================================
' BEGIN MAIN PROGRAM
' =============================================================================
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' START THE MENU
main
 
' -----------------------------------------------------------------------------
' DONE
Print m_ProgramName$ + " finished."
'Screen 0
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' EXIT
System ' return control to the operating system
End
 
' =============================================================================
' END MAIN PROGRAM
' =============================================================================
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
 
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Some basic 2D plotting"
        Print
        Print " 1. PlotPointTest"
        Print " 2. PlotSquareTest"
        Print " 3. PlotCircleTest"
                Print " 4. PlotCircleTopLeftTest"
        Print " 5. PlotSemicircleTest"
        Print " 6. CircleFillTest"
        Print " 7. CircleFillTopLeftTest"
                Print " 8. SemiCircleFillTest"
                Print " 9. EllipseTest"
        Print "10. EllipseFillTest"
        Print "11. PlotLineTest"
        Print "12. ShearRotate1Test1"
        Print "13. ShearRotate1Test2 (auto advances 0-360 degrees)"
        Print "14. ShearRotate1Test2 (auto advances 0-360 degrees) (uses Petr's text)"
        Print "15. ShearRotate2Test1 (correct for missing points logic v1)"
        Print "16. ShearRotate2Test1 (correct for missing points logic v1) (uses Petr's text)"
        Print "17. ShearRotate3Test1 (correct for missing points logic v2)"
        Print "18. ShearRotate3Test1 (correct for missing points logic v2) (uses Petr's text)"
        Print "19. ShearRotate4Test1 (correct for missing points logic v3)"
        Print "20. ShearRotate4Test1 (correct for missing points logic v3) (uses Petr's text)"
        Print "21. ShearRotate5Test1 (correct for missing points, STxAxTIC logic)"
        Print "22. ShearRotate5Test1 (correct for missing points, STxAxTIC logic) (uses Petr's text)"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(_Trim$(in$))
        
        If in$ = "1" Then
            PlotPointTest
        ElseIf in$ = "2" Then
            PlotSquareTest
        ElseIf in$ = "3" Then
            PlotCircleTest
        ElseIf in$ = "4" Then
            PlotCircleTopLeftTest
        ElseIf in$ = "5" Then
            PlotSemicircleTest
                ElseIf in$ = "6" Then
            CircleFillTest
        ElseIf in$ = "7" Then
            CircleFillTopLeftTest
                Elseif in$ = "8" then
                        SemiCircleFillTest
        ElseIf in$ = "9" Then
            EllipseTest
        ElseIf in$ = "10" Then
            EllipseFillTest
        ElseIf in$ = "11" Then
            PlotLineTest
        ElseIf in$ = "12" Then
            ShearRotate1Test1
        ElseIf in$ = "13" Then
            ShearRotate1Test2 TestSprite1$
        ElseIf in$ = "14" Then
            ShearRotate1Test2 PetrText1$
        ElseIf in$ = "15" Then
            ShearRotate2Test1 TestSprite1$
        ElseIf in$ = "16" Then
            ShearRotate2Test1 PetrText1$
        ElseIf in$ = "17" Then
            ShearRotate3Test1 TestSprite1$
        ElseIf in$ = "18" Then
            ShearRotate3Test1 PetrText1$
        ElseIf in$ = "19" Then
            ShearRotate4Test1 TestSprite1$
        ElseIf in$ = "20" Then
            ShearRotate4Test1 PetrText1$
        ElseIf in$ = "21" Then
            ShearRotate5Test1 TestSprite1$
        ElseIf in$ = "22" Then
            ShearRotate5Test1 PetrText1$
        End If
    Loop Until in$ = "q"
End Sub ' main
 
 
 
 
 
 
 
 
 
 
 
' /////////////////////////////////////////////////////////////////////////////
' MyArray(1 To 32, 1 To 32) AS STRING
' where index is MyArray(Y, X)
 
Sub PlotPoint (X As Integer, Y As Integer, S As String, MyArray() As String)
_echo "PlotPoint X=" + cstr$(X) + ", Y=" + cstr$(Y) + ", S=" + chr$(34) + S + chr$(34) + ", MyArray()"
    If (X >= LBound(MyArray, 2)) Then
        If (X <= UBound(MyArray, 2)) Then
            If (Y >= LBound(MyArray, 1)) Then
                If (Y <= UBound(MyArray, 1)) Then
                    If Len(S) = 1 Then
                        MyArray(Y, X) = S
                    Else
                        If Len(S) > 1 Then
                            MyArray(Y, X) = Left$(S, 1)
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub ' PlotPoint
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotPointTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a point."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type x,y (1-32, 1-32) coordinate to plot point at."
        Input "X,Y OR 0 TO QUIT? "; X, Y
        If X > 0 And Y > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X) + ", Y=" + cstr$(Y)
            PlotPoint X, Y, chr$(iChar), MyArray()
 
            Print "Current point plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
            
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotPointTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquare (X1 As Integer, Y1 As Integer, L As Integer, S As String, MyArray() As String)
    Dim X As Integer
    Dim X2 As Integer
    Dim Y As Integer
    Dim Y2 As Integer
    Dim sChar$
 
    If Len(S) = 1 Then
        sChar$ = S
    Else
        If Len(S) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(S, 1)
        End If
    End If
 
    X2 = (X1 + L) - 1
    Y2 = (Y1 + L) - 1
    For X = X1 To X2
        For Y = Y1 To Y2
            PlotPoint X, Y, sChar$, MyArray()
        Next Y
    Next X
End Sub ' PlotSquare
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquareTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Enter parameters to draw a square."
    Print ArrayToStringTest(MyArray())
    Print
    Do
        Print "Type top left x,y (1-32, 1-32) coordinate to plot square,"
        Print "and size (1-32) of square."
        Input "X,Y,L OR 0 TO QUIT? "; X, Y, L
        If X>0 AND Y>0 AND L > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "L=" + cstr$(L)
            Print 
            PlotSquare X, Y, L, chr$(iChar), MyArray()
            
            Print "Square plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotSquareTest
 
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
 
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
 
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
 
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM  : FAST CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
 
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
 
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
 
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM  : SLOW CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
 
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK   1 (drawing a pixel), 0 (erasing a pixel)
' X     X coordinate of the pixel
' Y     Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
 
' More on plotting circles:
'     Drawing a circle in BASIC - fast
'     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
 
' X,Y     = center point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircle (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        B = R
        C = 0
        A = R - 1
        Do
            PlotPoint X + C, Y + B, S2, MyArray()
            PlotPoint X + C, Y - B, S2, MyArray()
            PlotPoint X - C, Y - B, S2, MyArray()
            PlotPoint X - C, Y + B, S2, MyArray()
            PlotPoint X + B, Y + C, S2, MyArray()
            PlotPoint X + B, Y - C, S2, MyArray()
            PlotPoint X - B, Y - C, S2, MyArray()
            PlotPoint X - B, Y + C, S2, MyArray()
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then ' IF A>=0 THEN 190
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do ' 190 IF B>=C THEN 60
        Loop
    End If
End Sub ' PlotCircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a raster circle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            PlotCircle X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' PlotCircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' X,Y     = top left point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircleTopLeft (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim RoutineName As String : RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
    
    ' Get total width
    W = (R * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
    
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
            PlotPoint R + C, R + B, S2, arrTemp() ' 1
            PlotPoint R + C, R - B, S2, arrTemp() ' 2
            PlotPoint R - C, R - B, S2, arrTemp() ' 3
            PlotPoint R - C, R + B, S2, arrTemp() ' 4
            PlotPoint R + B, R + C, S2, arrTemp() ' 5
            PlotPoint R + B, R - C, S2, arrTemp() ' 6
            PlotPoint R - B, R - C, S2, arrTemp() ' 7
            PlotPoint R - B, R + C, S2, arrTemp() ' 8
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
        
        ' Copy circle to destination Y,X
        For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
            For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
                IF LEN(arrTemp(DY, DX)) > 0 THEN
                                        TY = Y + DY
                                        If TY >= MinY Then
                                                If TY <= MaxY Then
                                                        TX = X + DX
                                                        If TX >= MinX Then
                                                                If TX <= MaxX Then
                                                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                                                End If
                                                        End If
                                                End If
                                        End If
                                        
                END IF
            Next DX
        Next DY
    End If
End Sub ' PlotCircleTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a raster circle, specifying top left x,y position"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            PlotCircleTopLeft X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' PlotCircleTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on PlotCircleTopLeft.
 
' X,Y     = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
            ' .......4444111.......
            ' .....44.......11.....
            ' ....4...........1....
            ' ...4.............1...
            ' ..4...............1..
            ' .4.................1.
            ' .4.................1.
            ' 4...................1
            ' 4...................1
            ' 4...................1
            ' 3...................1
            ' 3...................2
            ' 3...................2
            ' 3...................2
            ' .3.................2.
            ' .3.................2.
            ' ..3...............2..
            ' ...3.............2...
            ' ....3...........2....
            ' .....33.......22.....
            ' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotSemicircle (X As Integer, Y As Integer, R As Integer, Q As Integer, S As String, MyArray() As String)
    Dim RoutineName As String : RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
    
    ' Get total width
    W = (R * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
    
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
            
            ' JUST PLOT SELECTED QUADRANT:
            Select Case Q
                Case 1:
                    ' quadrant #1
                    PlotPoint C, R - B, S2, arrTemp() ' 2
                    PlotPoint B, R - C, S2, arrTemp() ' 6
                Case 2:
                    ' quadrant #2
                    PlotPoint B, C, S2, arrTemp() ' 5
                    PlotPoint C, B, S2, arrTemp() ' 1
                Case 3:
                    ' quadrant #3
                    PlotPoint R - C, B, S2, arrTemp() ' 4
                    PlotPoint R - B, C, S2, arrTemp() ' 8
                Case 4:
                    ' quadrant #4
                    PlotPoint R - B, R - C, S2, arrTemp() ' 7
                    PlotPoint R - C, R - B, S2, arrTemp() ' 3
                Case Else:
                    ' (DO NOTHING)
            End Select
            
            '' PLOT CIRCLE:
            '' quadrant #1
            'PlotPoint R + C, R - B, S2, arrTemp() ' 2
            'PlotPoint R + B, R - C, S2, arrTemp() ' 6
            '
            '' quadrant #2
            'PlotPoint R + B, R + C, S2, arrTemp() ' 5
            'PlotPoint R + C, R + B, S2, arrTemp() ' 1
            '
            '' quadrant #3
            'PlotPoint R - C, R + B, S2, arrTemp() ' 4
            'PlotPoint R - B, R + C, S2, arrTemp() ' 8
            '
            '' quadrant #4
            'PlotPoint R - B, R - C, S2, arrTemp() ' 7
            'PlotPoint R - C, R - B, S2, arrTemp() ' 3
            
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
        
        ' Copy semicircle to destination Y,X
        For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
            For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
                IF LEN(arrTemp(DY, DX)) > 0 THEN
                                        TY = Y + DY
                                        If TY >= MinY Then
                                                If TY <= MaxY Then
                                                        TX = X + DX
                                                        If TX >= MinX Then
                                                                If TX <= MaxX Then
                                                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                                                End If
                                                        End If
                                                End If
                                        End If
                END IF
            Next DX
        Next DY
    End If
End Sub ' PlotSemicircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSemicircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a semicircle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print 
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            PlotSemicircle X, Y, R, Q, Chr$(iChar), MyArray()
            
            Print "Semicircle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' PlotSemicircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg1913#msg1913
 
' From: SMcNeill
' Date: « Reply #30 on: June 26, 2018, 03:34:18 pm »
' 
' Sometimes, computers do things that are completely counter-intuitive to us, and 
' we find ourselves having to step back as programmers and simply say, "WOW!!"   
' Here's a perfect example of that:
' Here we look at two different circle fill routines -- one, which I'd assume to 
' be faster, which precalculates the offset needed to find the endpoints for each 
' line which composes a circle, and another, which is the same old CircleFill 
' program which I've shared countless times over the years with people on various 
' QB64 forums.
' 
' When all is said and done though, CircleFill is STILL even faster than 
' CircleFillFast, which pregenerates those end-points for us!
 
' CX,CY     = center point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, S As String, MyArray() As String)
    DIM Radius AS INTEGER
    Dim RadiusError AS INTEGER
    DIM X AS INTEGER
    Dim Y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    
    IF Radius = 0 THEN 
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        EXIT SUB
    END IF
    
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    FOR iLoopX = CX - X TO CX + X
        PlotPoint iLoopX, CY, S, MyArray()
    NEXT iLoopX
    
    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
                iLoopY = CY - X
                FOR iLoopX = CX - Y TO CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                NEXT iLoopX
                
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                iLoopY = CY + X
                FOR iLoopX = CX - Y TO CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                NEXT iLoopX
            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
        iLoopY = CY - Y
        FOR iLoopX = CX - X TO CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopX
        
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        iLoopY = CY + Y
        FOR iLoopX = CX - X TO CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopX
    WEND
END SUB ' CircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a filled circle"
    Print "Based on CircleFill by SMcNeill."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            'PlotCircle X, Y, R, Chr$(iChar), MyArray()
            CircleFill X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' CircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotCircleTopLeft.
' CX,CY     = top left point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
SUB CircleFillTopLeft (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, S As String, MyArray() As String)
    DIM Radius AS INTEGER
    Dim RadiusError AS INTEGER
    DIM X AS INTEGER
    Dim Y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    DIM W As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
    
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    
    IF Radius = 0 THEN 
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        EXIT SUB
    END IF
    
    ' Get total width
    W = (Radius * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    FOR iLoopX = R - X TO R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    NEXT iLoopX
    
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
                
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
        
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
    WEND
    
    ' Copy circle to destination Y,X
    For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
        For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
            IF LEN(arrTemp(DY, DX)) > 0 THEN
                TY = DY + CY
                                If TY >= MinY Then
                                        If TY <= MaxY Then
                                                TX = DX + CX
                                                If TX >= MinX Then
                                                        If TX <= MaxX Then
                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                        End If
                                                End If
                                        End If
                                End If
            END IF
        Next DX
    Next DY
    
END SUB ' CircleFillTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a solid circle, specifying top left x,y position"
    Print "Based on CircleFill by SMcNeill."
    Print 
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            CircleFillTopLeft X, Y, R, Chr$(iChar), MyArray()
            
            Print "Circle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' CircleFillTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotSemiCircle
 
' CX,CY   = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return semicircle from
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
            ' .......4444111.......
            ' .....44444411111.....
            ' ....4444444111111....
            ' ...444444441111111...
            ' ..44444444411111111..
            ' .4444444444111111111.
            ' .4444444444111111111.
            ' 444444444441111111111
            ' 444444444441111111111
            ' 444444444441111111111
            ' 333333333331111111111
            ' 333333333332222222222
            ' 333333333332222222222
            ' 333333333332222222222
            ' .3333333333222222222.
            ' .3333333333222222222.
            ' ..33333333322222222..
            ' ...333333332222222...
            ' ....3333333222222....
            ' .....33333322222.....
            ' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot semicircle in
 
SUB SemiCircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, Q AS INTEGER, S As String, MyArray() As String)
    DIM Radius AS INTEGER
    Dim RadiusError AS INTEGER
    DIM X AS INTEGER
    Dim Y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    DIM W As Integer
    DIM AX As Integer
        DIM AY As Integer
        DIM TX As Integer
        DIM TY As Integer
        Dim MinY As Integer
        Dim MaxY As Integer
        Dim MinX As Integer
        Dim MaxX As Integer
        
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    
    IF Radius = 0 THEN 
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        EXIT SUB
    END IF
    
    ' Get total width
    W = (Radius * 2) + 1
    
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
    
        ' Get minimum X, Y of target array
        MinY = lbound(MyArray, 1)
        MaxY = ubound(MyArray, 1)
        MinX = lbound(MyArray, 2)
        MaxX = ubound(MyArray, 2)
        
        ' Temp array's lbound is 0
        ' Calculate difference from MyArray the indices of arrTemp are
        AY = 0 - MinY
        AX = 0 - MinX
        
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    FOR iLoopX = R - X TO R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    NEXT iLoopX
    
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
                
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                FOR iLoopX = R - Y TO R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                NEXT iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
        
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        FOR iLoopX = R - X TO R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        NEXT iLoopX
    WEND
        
        '_echo "MyArray(" + _Trim$(Str$(lbound(MyArray,1))) + " To " + _Trim$(Str$(ubound(MyArray,1))) + ", " + _Trim$(Str$(lbound(MyArray,2))) + " To " + _Trim$(Str$(ubound(MyArray,2))) + ")"
        
    ' Copy semicircle to destination Y,X
        ' JUST COPY SELECTED QUADRANT:
        Select Case Q
                Case 1:
                        ' quadrant #1
                        For DY = 0 to Radius
                                For DX = Radius to W
                                        '_echo "DY=" + cstr$(DY) + ", DX=" + cstr$(DX)
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY + CY) - (AY+1)
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX - Radius) - AX
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case 2:
                        ' quadrant #2
                        For DY = Radius to W
                                For DX = Radius to W
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY - Radius) - AY
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX - Radius) - AX
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case 3:
                        ' quadrant #3
                        For DY = Radius to W
                                For DX = 0 to Radius
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY - Radius) - AY
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX + CX) - (AX+1)
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case 4:
                        ' quadrant #4
                        For DY = 0 to Radius
                                For DX = 0 to Radius
                                        IF LEN(arrTemp(DY, DX)) > 0 THEN
                                                TY = (DY + CY) - (AY+1)
                                                If TY >= MinY Then
                                                        If TY <= MaxY Then
                                                                TX = (DX + CX) - (AX+1)
                                                                If TX >= MinX Then
                                                                        If TX <= MaxX Then
                                                                                MyArray(TY, TX) = arrTemp(DY, DX)
                                                                        End If
                                                                End If
                                                        End If
                                                End If
                                        END IF
                                Next DX
                        Next DY
                Case Else:
                        ' (DO NOTHING)
        End Select
    
        '' Copy circle to destination:
        'For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
    '    For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
    '        IF LEN(arrTemp(DY, DX)) > 0 THEN
    '            MyArray(DY + CY, DX + CX) = arrTemp(DY, DX)
    '        END IF
    '    Next DX
    'Next DY
    
END SUB ' SemiCircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SemiCircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a solid semicircle"
    Print "Based on CircleFill by SMcNeill."
    Print 
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 AND Y > 0 AND R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
            
            SemiCircleFill X, Y, R, Q, Chr$(iChar), MyArray()
            
            Print "Semicircle plotted (from top left), drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' SemiCircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
 
SUB Ellipse (CX AS INTEGER, CY AS INTEGER, xRadius AS INTEGER, yRadius AS INTEGER, S As String, MyArray() As String)
    DIM scale AS SINGLE
    DIM xs AS INTEGER
    DIM x AS INTEGER
    DIM y AS INTEGER
    DIM lastx AS INTEGER
    DIM lasty AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    
    scale = yRadius / xRadius
    xs = xRadius * xRadius
    
    'PSET (CX, CY - yRadius)
    PlotPoint CX, CY - yRadius, S, MyArray()
    
    'PSET (CX, CY + yRadius)
    PlotPoint CX, CY + yRadius, S, MyArray()
    
    lastx = 0: lasty = yRadius
    FOR x = 1 TO xRadius
        y = scale * SQR(xs - x * x)
        'LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)
        PlotLine CX + lastx, CY - lasty, CX + x, CY - y, S, MyArray()
        
        'LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)
        PlotLine CX + lastx, CY + lasty, CX + x, CY + y, S, MyArray()
        
        'LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)
        PlotLine CX - lastx, CY - lasty, CX - x, CY - y, S, MyArray()
        
        'LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)
        PlotLine CX - lastx, CY + lasty, CX - x, CY + y, S, MyArray()
        
        lastx = x
        lasty = y
    NEXT x
END SUB ' Ellipse
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot an ellipse"
    Print "Based on ellipse by bplus."
    Print 
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 AND Y > 0 AND RX > 0 AND RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
            
            Ellipse X, Y, RX, RY, Chr$(iChar), MyArray()
            
            Print "Ellipse plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' EllipseTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
' 
' Here is my ellipse and filled ellipse routines, no where near 
' Steve's level of performance. The speed is cut in half at 
' least because you probably have to do a whole quadrants worth 
' of calculations (ellipse not as symmetric as circle).
' 
' But I am sure this code can be optimized more than it is:
 
SUB EllipseFill (CX AS INTEGER, CY AS INTEGER, xRadius AS INTEGER, yRadius AS INTEGER, S As String, MyArray() As String)
    DIM scale AS SINGLE
    DIM x AS INTEGER
    DIM y AS INTEGER
    Dim iLoopX as INTEGER
    Dim iLoopY as INTEGER
    
    scale = yRadius / xRadius
    
    'LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    FOR iLoopY = CY - yRadius TO CY + yRadius
        PlotPoint CX, iLoopY, S, MyArray()
    NEXT iLoopY
    
    FOR x = 1 TO xRadius
        y = scale * SQR(xRadius * xRadius - x * x)
        
        'LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
        iLoopX = CX + x
        FOR iLoopY = CY - y TO  CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopY
        
        'LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
        iLoopX = CX - x
        FOR iLoopY = CY - y TO CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        NEXT iLoopY
    NEXT x
END SUB ' EllipseFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot a filled ellipse"
    Print "Based on fellipse by bplus."
    Print 
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
    
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 AND Y > 0 AND RX > 0 AND RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
            
            EllipseFill X, Y, RX, RY, Chr$(iChar), MyArray()
            
            Print "Ellipse plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
    
End Sub ' EllipseFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
' From: http://www.thedubber.altervista.org/qbsrc.htm
 
Sub PlotLine (x1%, y1%, x2%, y2%, c$, MyArray() As String)
    Dim iLoop%
    Dim steep%: steep% = 0
    Dim ev%: ev% = 0
    Dim sx%
    Dim sy%
    Dim dx%
    Dim dy%
    
    If (x2% - x1%) > 0 Then
        sx% = 1
    Else
        sx% = -1
    End If
 
    dx% = Abs(x2% - x1%)
    If (y2% - y1%) > 0 Then
        sy% = 1
    Else
        sy% = -1
    End If
 
    dy% = Abs(y2% - y1%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x1%, y1%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
 
    ev% = 2 * dy% - dx%
    For iLoop% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y1%, x1%), c%:
            'LOCATE y1%, x1%
            'PRINT c$;
            PlotPoint y1%, x1%, c$, MyArray()
        Else
            ''PSET (x1%, y1%), c%
            'LOCATE x1%, y1%
            'PRINT c$;
            PlotPoint x1%, y1%, c$, MyArray()
        End If
 
        While ev% >= 0
            y1% = y1% + sy%
            ev% = ev% - 2 * dx%
        Wend
        x1% = x1% + sx%
        ev% = ev% + 2 * dy%
    Next iLoop%
    ''PSET (x2%, y2%), c%
    'LOCATE x2%, y2%
    'PRINT c$;
    PlotPoint x2%, y2%, c$, MyArray()
End Sub ' PlotLine
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotLineTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim in$
    Dim X1 As Integer
    Dim Y1 As Integer
    Dim X2 As Integer
    Dim Y2 As Integer
    Dim iChar As Integer
    
    ClearArray MyArray(), "."
    iChar = 64
    
    Cls
    Print "Plot line with Bresenham Algorithm"
    Print "based on BRESNHAM.BAS by Kurt Kuzba (4/16/96)."
    Print 
    Print ArrayToStringTest(MyArray())
    Do
        Print "Enter coordinate values for "
        Print "line start point x1, y1 (1-32, 1-32)"
        Print "line end   point x2, y2 (1-32, 1-32)"
        Input "ENTER X1,Y1,X2,Y2 OR 0 TO QUIT: "; X1, Y1, X2, Y2
        If X1 > 0 And Y1 > 0 And X2 > 0 And Y2 > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
            
            Print "X1=" + cstr$(X1)
            Print "Y1=" + cstr$(Y1)
            Print "X2=" + cstr$(X2)
            Print "Y2=" + cstr$(Y2)
            
            PlotLine X1, Y1, X2, Y2, Chr$(iChar), MyArray()
            
            Print "Line plotted, drawn with " + chr$(34) + chr$(iChar) + chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotLineTest
 
' /////////////////////////////////////////////////////////////////////////////
' 3 shear method testing
 
' _PUT Rotation Help
' https://www.qb64.org/forum/index.php?topic=1959.0
 
' 3 Shear Rotation - rotates without any aliasing(holes)
' https://www.freebasic.net/forum/viewtopic.php?t=24557
 
' From: leopardpm
' Date: Apr 02, 2016 1:21
' Last edited by leopardpm on Apr 02, 2016 17:18, edited 1 time in total.
'
' This is just a little 3-shear rotation routine
' (I am using 3-shear because it leaves no gaps/aliasing)
' that I was wondering if anyone sees how to make it faster.
' Obviously, I am just thinking about inside the double loop.
 
' Thanks again to BasicCoder2 for linking me to this little routine, it is wonderful so far!
 
'''                      roto-zooming algorithm
'''                    coded by Michael S. Nissen
'''                        jernmager@yahoo.dk
'
''' ===============================================================
''' Recoded to run on FBC 32/64 bit WIN, Version 1.05.0, 2016, by MrSwiss
''' Heavy flickering before going Full-Screen on 64 Bit !!!
''' This seems NOT to be the Case on 32 Bit ...
''' ===============================================================
'
'Type Pixel
'  As Single   X, Y
'  As ULong    C
'End Type
'
'''  dim vars
'Dim shared as Any Ptr Img_Buffer
'''  write the name of the .bmp image you want to rotozoom here:
'''  (it has to be sqare ie. 100x100 pixels, 760x760 pixels or whatever)
'Dim As String Img_Name = "phobos.bmp"
'Dim shared as Integer X_Mid, Y_Mid, scrn_wid, scrn_hgt, P1, P2, P3, P4, C
'Dim shared as Short Img_Hgt, Img_Wid, Img_Lft, Img_Rgt, Img_Top, Img_Btm, X, Y
'Dim Shared As Single Cos_Ang, Sin_Ang, Rot_Fac_X, Rot_Fac_Y, Angle = 0, Scale = 1
'
''' changed Function to Sub (+ recoded arguments list)
'Sub Calc_rotozoom ( ByRef Cos_Ang As Single, _
'               ByRef Sin_Ang As Single, _
'               ByVal S_Fact  As Single, _
'               ByVal NewAng  As Single )
'  Cos_Ang = Cos(NewAng)*S_Fact
'  Sin_Ang = Sin(NewAng)*S_Fact
'End Sub
'
'''  full screen
'ScreenInfo scrn_wid, scrn_hgt
'screenRes scrn_wid, scrn_hgt, 32,,1
'
'''  dim screenpointer (has to be done after screenres)
'Dim As ULong Ptr Scrn_Ptr = Screenptr
'
'''  place image in center of screen
'X_Mid = scrn_wid\2
'Y_Mid = scrn_hgt\2
'Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'
'''  find image dimensions
'Open Img_Name For Binary As #1
'Get #1, 19, Img_Wid
'Get #1, 23, Img_Hgt
'Close #1
'
'''  prepare to dim the array that will hold the image.
'Img_Rgt = (Img_Wid-1)\2
'Img_Lft = -Img_Rgt
'Img_Btm = (Img_Hgt-1)\2
'Img_Top = -Img_Btm
'
'''  dim array to hold image. Note: pixel (0, 0) is in the center.
'Dim As Pixel Pixel(Img_Lft to Img_Rgt, Img_Top to Img_Btm)
'
'''  imagecreate sprite and load image to sprite
'Img_Buffer = ImageCreate (Img_Wid, Img_Hgt)
'Bload (Img_Name, Img_Buffer)
'
'''  load image from sprite to array with point command
'For Y = Img_Top to Img_Btm
'  For X = Img_Lft to Img_Rgt
'    With Pixel(X, Y)
'      .X = X_Mid+X
'      .Y = Y_Mid+Y
'      C = Point (X-Img_Top, Y-Img_Lft, Img_buffer)
'      If C <> RGB(255, 0, 255) Then
'        .C = C
'      Else
'        .C = RGB(0, 0, 0)
'      End If
'    End With
'  Next X
'Next Y
'
'''  we don't need the sprite anymore, kill it
'ImageDestroy Img_Buffer
'Img_Buffer = 0
'
'''  main program loop
'Do
'
'  ''  scale in/out with uparrow/downarrow
'  If Multikey(80) Then
'    Scale *= 1.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(72) Then
'    Scale *= 0.97
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  rotate left/right with leftarrow/rightarrow
'  If Multikey(77) Then
'    Angle -= 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(75) Then
'    Angle += 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  lock screen in order to use screen pointers
'  ScreenLock
'
'    ''  draw pixel in center of image
'    Scrn_Ptr[ X_Mid + Y_Mid * scrn_wid ] = Pixel(0, 0).C
'    ''  draw all other pixels - 4 at a time
'    For Y = Img_Top to 0
'      For X = Img_Lft to -1
'        ''  find pixel positions
'        P1 = (X_Mid+X) + (Y_Mid+Y) * scrn_wid
'        P2 = (X_Mid-X) + (Y_Mid-Y) * scrn_wid
'        P3 = (X_Mid+Y) + (Y_Mid-X) * scrn_wid
'        P4 = (X_Mid-Y) + (Y_Mid+X) * scrn_wid
'        ''  erase old pixels (paint them black)
'        Scrn_Ptr[P1] = 0
'        Scrn_Ptr[P2] = 0
'        Scrn_Ptr[P3] = 0
'        Scrn_Ptr[P4] = 0
'        ''  rotate and zoom
'        Rot_Fac_X = X*Cos_Ang - Y*Sin_Ang
'        Rot_Fac_Y = X*Sin_Ang + Y*Cos_Ang
'        If Rot_Fac_X < Img_Lft Or Rot_Fac_X > Img_Rgt Then Continue For
'        If Rot_Fac_Y < Img_Top Or Rot_Fac_Y > Img_Btm Then Continue For
'        ''  draw new pixels
'        Scrn_Ptr[P1] = Pixel(Rot_Fac_X, Rot_Fac_Y).C
'        Scrn_Ptr[P2] = Pixel(-Rot_Fac_X, -Rot_Fac_Y).C
'        Scrn_Ptr[P3] = Pixel(Rot_Fac_Y, -Rot_Fac_X).C
'        Scrn_Ptr[P4] = Pixel(-Rot_Fac_Y, Rot_Fac_X).C
'      Next X
'    Next Y
'
'  ScreenUnLock
'
'  Sleep 10, 1
'Loop Until InKey() = Chr(27)
 
' UPDATES:
' Fixed bug where values 135, 224, and 314 all resolve to -45 degrees.
' Fixed bug where an angle of 46-135 degrees caused the image to be flipped wrong.
 
' TODO:
' Fix issue where image looks bad at 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
Sub ShearRotate (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate
 
' /////////////////////////////////////////////////////////////////////////////
' Same as ShearRotate, except adds iOverwriteCount parameter, 
' and counts how many points are overwriting existing points, 
' and return that value byref in parameter iOverwriteCount.
 
Sub ShearRotate1 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iOverwriteCount As Integer)
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    iOverwriteCount = 0
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    
                    ' count points that will be overwritten
                    if NewArray(fx, fy, 0).c <> iEmpty then
                        iOverwriteCount = iOverwriteCount + 1
                    end if
                    
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate1
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotate1Test1
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim in$
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print
    
    sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
    Print "Initial contents of Rotation Array:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    
    ' ROTATE THE SHAPE
    Do
        Print "Type degrees to rotate (0 TO 360) or non-numeric value to quit."
        Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
 
        Input "Degrees to rotate (q to quit)? "; in$
        If IsNum%(in$) Then
            D = Val(in$)
            If D >= 0 And D <= 360 Then
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
End Sub ' ShearRotate1Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Now receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate1Test2 TestSprite1$
 
Sub ShearRotate1Test2(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iOverwriteCount As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate1Test2
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v2
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate2 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iMissing As Integer)
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    if NewArray(fx, fy, 0).c = iEmpty then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                    end if
                End If
            End If
        Next x
    Next y
    
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the angle of rotation? 
    ' perhaps if we divide the screen up into 4 zones:
    ' 
    ' -------------------------------------- 
    '|                   |                  |
    '| zone 4            | zone 1           |
    '| 271-359 degrees)  | (1-89 degrees)   |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '| (181-269 degrees) | (91-179 degrees) |
    '|                   |                  |
    ' -------------------------------------- 
    
    ' in zone   search direction (y,x)
    ' -------   ----------------------
    ' 1         up   + right
    ' 2         down + right
    ' 3         down + left
    ' 4         up   + left
    
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint2%(arrLost(iLoop), angle1, iEmpty, x, y, NewArray())
        if bFound = TRUE then
            If m_bDebug = TRUE Then
                _echo "Plotted  missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _echo "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        end if
    Next iLoop
    
End Sub ' ShearRotate2
 
' /////////////////////////////////////////////////////////////////////////////
' Receives
' FindMe (RotationType) = contains the starting location (.origx, .origy) to start looking from, and the value (.c) to write
' angle1 (Integer) = angle we were rotating to, to determine direction to look in
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint2%(FindMe As RotationType, angle1 As Integer, iEmpty as Integer, destX as integer, destY as integer, NewArray() As RotationType)
    Dim bResult as Integer : bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    
    destX = 0
    destY = 0
    
    ' Choose search direction depending on the angle
    If angle1 > 0 And angle1 < 90 Then
        dirX = 1
        dirY = -1
    ElseIf angle1 > 90 And angle1 < 180 Then
        dirX = 1
        dirY = 1
    ElseIf angle1 > 180 And angle1 < 270 Then
        dirX = -1
        dirY = 1
    ElseIf angle1 > 270 And angle1 < 360 Then
        dirX = -1
        dirY = -1
    Else
        dirX = 0
        dirY = 0
    End If
    
    If dirX <> 0 Then
        x = FindMe.origx
        y = FindMe.origy
        Do
            ' quit if we're out of bounds
            if x < LBound(NewArray, 1) then Exit Do
            if x > UBound(NewArray, 1) then Exit do
            if y < LBound(NewArray, 2) then Exit Do
            if y > UBound(NewArray, 2) then Exit do
            
            ' =============================================================================
            ' BEGIN SEARCH
            ' =============================================================================
            ' look along y axis for a blank spot
            destX = x
            destY = y + dirY
            if destX >= LBound(NewArray, 1) then
                if destX <= UBound(NewArray, 1) then 
                    if destY >= LBound(NewArray, 2) then
                        if destY <= UBound(NewArray, 2) then 
                            if NewArray(destX, destY, 0).c = iEmpty then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            end if
                        end if
                    end if
                end if
            end if
            
            ' look along x axis for a blank spot
            destX = x + dirX
            destY = y
            if destX >= LBound(NewArray, 1) then
                if destX <= UBound(NewArray, 1) then 
                    if destY >= LBound(NewArray, 2) then
                        if destY <= UBound(NewArray, 2) then 
                            if NewArray(x + dirX, y, 0).c = iEmpty then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            end if
                        end if
                    end if
                end if
            end if
            
            ' look diagonally for a blank spot
            destX = x + dirX
            destY = y + dirY
            if destX >= LBound(NewArray, 1) then
                if destX <= UBound(NewArray, 1) then 
                    if destY >= LBound(NewArray, 2) then
                        if destY <= UBound(NewArray, 2) then 
                            if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            end if
                        end if
                    end if
                end if
            end if
            ' =============================================================================
            ' END SEARCH
            ' =============================================================================
            
            ' Keep looking
            x = x + dirX
            y = y + dirY
        Loop
    End If
    
    ' Return result
    FindEmptyShearRotationPoint2% = bResult
End Sub ' FindEmptyShearRotationPoint2%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points.
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate2Test1 TestSprite1$
 
Sub ShearRotate2Test1(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
                
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate2Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v3
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' a little more accurately, using iDirection parameter 
' (which can be cClockwise or cCounterClockwise) 
' together with which quarter of the screen the point is in, 
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate3 ( _ 
        OldArray() As RotationType, _ 
        NewArray() As RotationType, _ 
        angle1 As Integer, _ 
        iDirection As Integer, _ 
        iEmpty As Integer, _ 
        iMissing As Integer)
        
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
        Dim iMidX As Integer
        Dim iMidY As Integer
        
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
        ' find midpoints
        iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
        iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
        
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            
                        ' find which part of screen the current point is in
                        if y > iMidY then
                                ' bottom half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 2
                                else
                                        ' left half of screen
                                        iScreenZone = 3
                                end if
                        else
                                ' top half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 1
                                else
                                        ' left half of screen
                                        iScreenZone = 4
                                end if
                        end if
                        
                        ' calculate directions
                        Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    if NewArray(fx, fy, 0).c = iEmpty then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                                                
                                                ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                                                arrLost(UBound(arrLost)).z = iScreenZone
                    end if
                End If
            End If
        Next x
    Next y
    
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
        ' together with which quarter of the screen the point is in (iScreenZone) 
    ' where we divide the screen up into 4 zones:
    
    ' -------------------------------------- 
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' -------------------------------------- 
    
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
        ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
    
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint3%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
        if bFound = TRUE then
            If m_bDebug = TRUE Then
                _echo "Plotted  missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _echo "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        end if
    Next iLoop
    
End Sub ' ShearRotate3
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter 
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains 
'                         .origx, .origy = the starting location to start looking from, 
'                         .z = which area of the screen the point is in 
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left) 
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint3%(FindMe As RotationType, iDirection As Integer, iEmpty as Integer, destX as integer, destY as integer, NewArray() As RotationType)
    Dim bResult as Integer : bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
        
        ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
        
    ' Choose search direction based on the quadrant of the screen
        ' and the direction of rotation:
        
        ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
        ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
        
    If     FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
    
        ' Quit if we're out of bounds
    If bContinue = TRUE Then
                bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
                if x >= LBound(NewArray, 1) then 
                        if x <= UBound(NewArray, 1) then 
                                if y >= LBound(NewArray, 2) then 
                                        if y <= UBound(NewArray, 2) then 
                                                bContinue = TRUE
                                        end if
                                end if
                        end if
                end if
        End If
        
        ' look along y axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(destX, destY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look along x axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look diagonally for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
    End If
        
    ' Return result
    FindEmptyShearRotationPoint3% = bResult
End Sub ' FindEmptyShearRotationPoint3%
 
' /////////////////////////////////////////////////////////////////////////////
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate3Test1 TestSprite1$
 
Sub ShearRotate3Test1(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                                
                ShearRotate3 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
                
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate3 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate3Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v4
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' using a different approach, by just looking at the problem angles:
' 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
' (which can be cClockwise or cCounterClockwise) 
' together with which quarter of the screen the point is in, 
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate4 ( _ 
        OldArray() As RotationType, _ 
        NewArray() As RotationType, _ 
        angle1 As Integer, _ 
        iDirection As Integer, _ 
        iEmpty As Integer, _ 
        iMissing As Integer)
        
    Const Pi = 4 * Atn(1)
    
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
        Dim iMidX As Integer
        Dim iMidY As Integer
        
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
    
        ' find midpoints
        iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
        iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
        
    ' angle is reversed
    angle = 360 - angle1
    
    ' Shearing each element 3 times in one shot
    nangle = angle
    
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
    
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
    
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
    
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
    
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            
                        ' find which part of screen the current point is in
                        if y > iMidY then
                                ' bottom half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 2
                                else
                                        ' left half of screen
                                        iScreenZone = 3
                                end if
                        else
                                ' top half of screen
                                if x > iMidX then
                                        ' right half of screen
                                        iScreenZone = 1
                                else
                                        ' left half of screen
                                        iScreenZone = 4
                                end if
                        end if
                        
                        ' calculate directions
                        Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
            
            clr = OldArray(nx, ny, 0).c
            
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
            
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    if NewArray(fx, fy, 0).c = iEmpty then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                                                
                                                ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                                                arrLost(UBound(arrLost)).z = iScreenZone
                    end if
                End If
            End If
        Next x
    Next y
    
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
        ' together with which quarter of the screen the point is in (iScreenZone) 
    ' where we divide the screen up into 4 zones:
    
    ' -------------------------------------- 
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' -------------------------------------- 
    
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
        ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
    
        if IsProblemAngle%(angle1) then
                iMissing = 0
                For iLoop = 0 To UBound(arrLost)
                        bFound = FindEmptyShearRotationPoint4%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
                        if bFound = TRUE then
                                If m_bDebug = TRUE Then
                                        _echo "Plotted  missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                                End If
                        else
                                iMissing = iMissing + 1
                                If m_bDebug = TRUE Then
                                        _echo "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).c) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                                End If
                        end if
                Next iLoop
    end if
End Sub ' ShearRotate4
 
' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if angle is any of 
' 30, 60, 120, 150, 210, 240, 300, 330
 
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
 
function IsProblemAngle%(angle as integer)
        dim bResult as integer : bResult = FALSE
        Dim i%
        For i% = 0 To 360 Step 30
                If i% Mod 90 <> 0 Then
                        if angle = i% then
                                bResult = TRUE
                                exit for
                        end if
                End If
        Next i%
        IsProblemAngle% = bResult
end function ' IsProblemAngle%
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter 
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains 
'                         .origx, .origy = the starting location to start looking from, 
'                         .z = which area of the screen the point is in 
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left) 
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint4%(FindMe As RotationType, iDirection As Integer, iEmpty as Integer, destX as integer, destY as integer, NewArray() As RotationType)
    Dim bResult as Integer : bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
        
        ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
        
    ' Choose search direction based on the quadrant of the screen
        ' and the direction of rotation:
        
        ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
        ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
        
    If     FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
    
        ' Quit if we're out of bounds
    If bContinue = TRUE Then
                bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
                if x >= LBound(NewArray, 1) then 
                        if x <= UBound(NewArray, 1) then 
                                if y >= LBound(NewArray, 2) then 
                                        if y <= UBound(NewArray, 2) then 
                                                bContinue = TRUE
                                        end if
                                end if
                        end if
                end if
        End If
        
        ' look along y axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(destX, destY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look along x axis for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
        end if
        
        ' look diagonally for an available adjacent point
        If bContinue = TRUE Then
                destX = x + dirX
                destY = y + dirY
                if destX >= LBound(NewArray, 1) then
                        if destX <= UBound(NewArray, 1) then 
                                if destY >= LBound(NewArray, 2) then
                                        if destY <= UBound(NewArray, 2) then 
                                                if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
                                                        NewArray(destX, destY, 0).c = FindMe.c
                                                        bResult = TRUE
                                                        bContinue = FALSE
                                                end if
                                        end if
                                end if
                        end if
                end if
    End If
        
'       ' look (in the opposite direction) along y axis for an available adjacent point
'       If bContinue = TRUE Then
'               destX = x
'               destY = y - dirY
'               if destX >= LBound(NewArray, 1) then
'                       if destX <= UBound(NewArray, 1) then 
'                               if destY >= LBound(NewArray, 2) then
'                                       if destY <= UBound(NewArray, 2) then 
'                                               if NewArray(destX, destY, 0).c = iEmpty then
'                                                       NewArray(destX, destY, 0).c = FindMe.c
'                                                       bResult = TRUE
'                                                       bContinue = FALSE
'                                               end if
'                                       end if
'                               end if
'                       end if
'               end if
'       end if
'       
'       ' look (in the opposite direction) along x axis for an available adjacent point
'       If bContinue = TRUE Then
'               destX = x - dirX
'               destY = y
'               if destX >= LBound(NewArray, 1) then
'                       if destX <= UBound(NewArray, 1) then 
'                               if destY >= LBound(NewArray, 2) then
'                                       if destY <= UBound(NewArray, 2) then 
'                                               if NewArray(x + dirX, y, 0).c = iEmpty then
'                                                       NewArray(destX, destY, 0).c = FindMe.c
'                                                       bResult = TRUE
'                                                       bContinue = FALSE
'                                               end if
'                                       end if
'                               end if
'                       end if
'               end if
'       end if
'       
'       ' look (in the opposite direction) diagonally for an available adjacent point
'       If bContinue = TRUE Then
'               destX = x - dirX
'               destY = y - dirY
'               if destX >= LBound(NewArray, 1) then
'                       if destX <= UBound(NewArray, 1) then 
'                               if destY >= LBound(NewArray, 2) then
'                                       if destY <= UBound(NewArray, 2) then 
'                                               if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
'                                                       NewArray(destX, destY, 0).c = FindMe.c
'                                                       bResult = TRUE
'                                                       bContinue = FALSE
'                                               end if
'                                       end if
'                               end if
'                       end if
'               end if
'    End If
        
    ' Return result
    FindEmptyShearRotationPoint4% = bResult
End Sub ' FindEmptyShearRotationPoint4%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points with improved logic v3
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate4Test1 TestSprite1$
 
Sub ShearRotate4Test1(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                                
                ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
                
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate4Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Correct for overwriting points issue 
' (happens at 30, 60, 120, 150, 210, 240, 300, 330 degrees)
' using STxAxTIC's method of merging array rotated to angle-1 and angle+1
 
Sub ShearRotate5 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    ReDim arrCW(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    ReDim arrCCW(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
        
        ' If rotation is 30, 60, 120, 150, 210, 240, 300, 330 degrees
        ' then try correcting for overwriting.
        if IsProblemAngle%(angle1) then
                ' get array rotated to angle-1
                ShearRotate OldArray(), arrCW(), angle1-1, iEmpty
                
                ' get array rotated to angle
                ShearRotate OldArray(), NewArray(), angle1-1, iEmpty
                
                ' get array rotated to angle=1
                ShearRotate OldArray(), arrCCW(), angle1+1, iEmpty
                
                ' merge the results
                For x = LBound(NewArray, 1) To UBound(NewArray, 1)
                        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
                                ' is point empty?
                                if NewArray(x, y, 0).c = iEmpty then
                                        ' see if point is occupied 1 deg. counter-clockwise
                                        if arrCCW(x, y, 0).c <> iEmpty then
                                                NewArray(x, y, 0).c = arrCCW(x, y, 0).c
                                        ' see if point is occupied 1 deg. clockwise
                                        elseif arrCW(x, y, 0).c <> iEmpty then
                                                NewArray(x, y, 0).c = arrCW(x, y, 0).c
                                        end if
                                end if
                        Next y
                Next x
        ' Otherwise rotate without correcting.
        else
                ShearRotate OldArray(), NewArray(), angle1, iEmpty
        end if
End Sub ' ShearRotate5
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing (overwritten) points
' using STxAxTIC's method to correct for overwritten points
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate5Test1 TestSprite1$
 
Sub ShearRotate5Test1(sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    'Dim iMissing As Integer
    
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
        Print "using STxAxTIC's method to correct for overwritten points"
    'sMap = TestSprite1$
    
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                                
                'ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                                ShearRotate5 RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                'Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
                
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
            
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                'ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                                ShearRotate5 RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                'Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
                
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate5Test1
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "11111111111111111111111111111111" + Chr$(13) ' 1
    m$ = m$ + "4..............................2" + Chr$(13) ' 2
    m$ = m$ + "4....##.....#######.....####...2" + Chr$(13) ' 3
    m$ = m$ + "4...####....##...###...######..2" + Chr$(13) ' 4
    m$ = m$ + "4..##..##...##...###..##....##.2" + Chr$(13) ' 5
    m$ = m$ + "4.##....##..#######...##.......2" + Chr$(13) ' 6
    m$ = m$ + "4.########..#######...##.......2" + Chr$(13) ' 7
    m$ = m$ + "4.########..##...###..##....##.2" + Chr$(13) ' 8
    m$ = m$ + "4.##....##..##...###...######..2" + Chr$(13) ' 9
    m$ = m$ + "4.##....##..#######.....####...2" + Chr$(13) ' 10
    m$ = m$ + "4..............................2" + Chr$(13) ' 11
    m$ = m$ + "4..............................2" + Chr$(13) ' 12
    m$ = m$ + "4..ABBBBBBBBBBBBBBBBBBBBBBBBC..2" + Chr$(13) ' 13
    m$ = m$ + "4..A...........EE...........C..2" + Chr$(13) ' 14
    m$ = m$ + "4..A..........FFFF..........C..2" + Chr$(13) ' 15
    m$ = m$ + "4..A.........GGGGGG.........C..2" + Chr$(13) ' 16
    m$ = m$ + "4..A........HHHHHHHH........C..2" + Chr$(13) ' 17
    m$ = m$ + "4..A.......IIIIIIIIII.......C..2" + Chr$(13) ' 18
    m$ = m$ + "4..A......JJJJJJJJJJJJ......C..2" + Chr$(13) ' 19
    m$ = m$ + "4..DDDDDDDDDDDDDDDDDDDDDDDDDC..2" + Chr$(13) ' 20
    m$ = m$ + "4..............................2" + Chr$(13) ' 21
    m$ = m$ + "4..............................2" + Chr$(13) ' 22
    m$ = m$ + "4.######....########..########.2" + Chr$(13) ' 23
    m$ = m$ + "4.#######...########..########.2" + Chr$(13) ' 24
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 25
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 26
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 27
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 28
    m$ = m$ + "4.#######...##........##.......2" + Chr$(13) ' 29
    m$ = m$ + "4.######....########..##.......2" + Chr$(13) ' 30
    m$ = m$ + "4..............................2" + Chr$(13) ' 31
    m$ = m$ + "33333333333333333333333333333332" + Chr$(13) ' 32
    TestSprite1$ = m$
End Function ' TestSprite1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite2$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "...............AA..............." + Chr$(13) ' 1
    m$ = m$ + "..............//BB.............." + Chr$(13) ' 2
    m$ = m$ + ".............??..CC............." + Chr$(13) ' 3
    m$ = m$ + "............==....DD............" + Chr$(13) ' 4
    m$ = m$ + "...........++......EE..........." + Chr$(13) ' 5
    m$ = m$ + "..........&&........FF.........." + Chr$(13) ' 6
    m$ = m$ + ".........zz..........GG........." + Chr$(13) ' 7
    m$ = m$ + "........yy............HH........" + Chr$(13) ' 8
    m$ = m$ + ".......xx..............II......." + Chr$(13) ' 9
    m$ = m$ + "......ww................JJ......" + Chr$(13) ' 10
    m$ = m$ + ".....vv..................KK....." + Chr$(13) ' 11
    m$ = m$ + "....uu....................LL...." + Chr$(13) ' 12
    m$ = m$ + "...tt......DDAAAAAAA.......MM..." + Chr$(13) ' 13
    m$ = m$ + "..ss.......DDAAAAAAA........NN.." + Chr$(13) ' 14
    m$ = m$ + ".rr........DD.....BB.........OO." + Chr$(13) ' 15
    m$ = m$ + "qq.........DD.....BB..........PP" + Chr$(13) ' 16
    m$ = m$ + "pp.........DD.....BB..........QQ" + Chr$(13) ' 17
    m$ = m$ + ".oo........DD.....BB.........RR." + Chr$(13) ' 18
    m$ = m$ + "..nn.......CCCCCCCBB........SS.." + Chr$(13) ' 19
    m$ = m$ + "...mm......CCCCCCCBB.......TT..." + Chr$(13) ' 20
    m$ = m$ + "....ll....................UU...." + Chr$(13) ' 21
    m$ = m$ + ".....kk..................VV....." + Chr$(13) ' 22
    m$ = m$ + "......jj................WW......" + Chr$(13) ' 23
    m$ = m$ + ".......ii..............XX......." + Chr$(13) ' 24
    m$ = m$ + "........hh............YY........" + Chr$(13) ' 25
    m$ = m$ + ".........gg..........ZZ........." + Chr$(13) ' 26
    m$ = m$ + "..........ff........@@.........." + Chr$(13) ' 27
    m$ = m$ + "...........ee......##..........." + Chr$(13) ' 28
    m$ = m$ + "............dd....$$............" + Chr$(13) ' 29
    m$ = m$ + ".............cc..%%............." + Chr$(13) ' 30
    m$ = m$ + "..............bb\\.............." + Chr$(13) ' 31
    m$ = m$ + "...............aa..............." + Chr$(13) ' 32
    TestSprite2$ = m$
End Function ' TestSprite2$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function PetrText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "....It's a SCREEN resolution?..." + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    PetrText1$ = m$
End Function ' PetrText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToString$ (MyArray( 1 To 32 , 1 To 32) As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        MyString = MyString + sLine + Chr$(13)
    Next iY
    ArrayToString$ = MyString
End Function ' ArrayToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToStringTest$ (MyArray() As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
 
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    ArrayToStringTest$ = MyString
End Function ' ArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function RotationArrayToStringTest$ (RoArray() As RotationType)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    For iY = LBound(RoArray, 1) To UBound(RoArray, 1)
        sLine = ""
        sLine = sLine + Right$("    " + cstr$(iY), 3)
        For iX = LBound(RoArray, 2) To UBound(RoArray, 2)
            sLine = sLine + Chr$(RoArray(iX, iY, 0).c)
        Next iX
        sLine = sLine + Right$("   " + cstr$(iY), 3)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    RotationArrayToStringTest$ = MyString
End Function ' RotationArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
' 1. split string by line breaks CHR$(13)
' 2. split lines up to 1 column per char
' 3. count rows, columns
' 4. DIM array, making sure array has
'    a) an _ODD_ number of rows/columns, with a center point
'    b) index is in cartesian format, where center is (0,0)
' 5. populate array with contents of string
 
' dimension #1 = columns
' dimension #2 = rows
 
Sub StringToRotationArray (RoArray() As RotationType, MyString As String, EmptyChar As String)
    Dim RoutineName As String: RoutineName = "StringToRotationArray"
    ReDim arrLines$(0)
    Dim delim$
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iColCount As Integer
    Dim iRowCount As Integer
    Dim iCount As Integer
    Dim bAddedRow As Integer: bAddedRow = FALSE
    Dim bAddedColumn As Integer: bAddedColumn = FALSE
    Dim iHalf1 As Integer
    Dim iHalf2 As Integer
    Dim iFrom1 As Integer
    Dim iFrom2 As Integer
    Dim iTo1 As Integer
    Dim iTo2 As Integer
    Dim iEmpty As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
 
    iRowCount = UBound(arrLines$) + 1
 
    ' look at all the rows and find the max # of columns used
    iColCount = 0
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
 
        ' count the columns for this row
        iCount = 0
        For iCol% = 1 To Len(arrLines$(iRow%))
            iCount = iCount + 1
        Next iCol%
 
        ' if this row has the most so far, then set that to the max
        If iCount > iColCount Then
            iColCount = iCount
        End If
    Next iRow%
 
    ' adjust columns to be odd
    If IsEven%(iColCount) Then
        iColCount = iColCount + 1
        bAddedColumn = TRUE
    End If
 
    ' calculate array bounds for columns
    iHalf1 = (iColCount - 1) / 2
    iFrom1 = 0 - iHalf1
    iTo1 = iHalf1
 
    ' adjust rows to be odd
    If IsEven%(iRowCount) Then
        iRowCount = iRowCount + 1
        bAddedRow = TRUE
    End If
 
    ' calculate array bounds for rows
    iHalf2 = (iRowCount - 1) / 2
    iFrom2 = 0 - iHalf2
    iTo2 = iHalf2
 
    ' size array to new bounds
    ReDim RoArray(iFrom1 To iTo1, iFrom2 To iTo2, 127) As RotationType
 
    ' get value for empty
    If Len(EmptyChar) > 0 Then
        iEmpty = Asc(EmptyChar)
    Else
        iEmpty = 32 ' (use space as default)
    End If
 
    ' clear array
    For iY = LBound(RoArray, 2) To UBound(RoArray, 2)
        For iX = LBound(RoArray, 1) To UBound(RoArray, 1)
            RoArray(iX, iY, 0).c = iEmpty
            RoArray(iX, iY, 0).origx = iX
            RoArray(iX, iY, 0).origy = iY
        Next iX
    Next iY
 
    ' fill array
    iY = LBound(RoArray, 2) - 1
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        iY = iY + 1
        iX = LBound(RoArray, 1) - 1
        For iCol% = 1 To Len(arrLines$(iRow%))
            iX = iX + 1
            sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
            RoArray(iX, iY, 0).c = Asc(sChar$)
        Next iCol%
    Next iRow%
 
End Sub ' StringToRotationArray
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBOUND(result$)) = MID$(in$, start, finish - start)
        start = finish + 1
    LOOP WHILE start <= LEN(in$)
END SUB ' split
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 29, 2021, 12:06:08 pm

Quote from: STxAxTIC on December 29, 2021, 10:24:13 am

So I have to do a bunch of reading to catch up to where the discussion is,

After some further thinking on it, I had another idea - what if the mask arrays were precalculated? For a given size 2D array, we could precalculate the rotation for all of the problem angles (there are only 8 of them) and the adjacent angles (angle-1, angle+1), so that would be 24 copies of the array, which can even be hardcoded since they're just arrays of numbers. That eliminates the bulk of the copying of arrays work, so you get accuracy and the performance hit is much less. The main cost becomes the memory to store those 24 arrays, which depends on how big a sprite or screen or grid you want to rotate. A 32x32 sprite would be 32x32x24 times whatever it is you're storing as a "point", whether a byte, integer, unsigned long (for an rgb color), a text character, user defined type, etc.

Thoughts?

Update: I started on some code to try above, code below. Option 23 from the menu...

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Basic 2D plotting functions
' Version 1.00 by madscijr
' with help from various (sources cited below).
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS
' =============================================================================
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' rotational constants
Const cCounterClockwise = -1
Const cClockwise = 1
 
' -----------------------------------------------------------------------------
' USER DEFINED TYPES
' -----------------------------------------------------------------------------
Type RotationType
    origx As Integer
    origy As Integer
    c As Integer
    z As Integer ' which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
End Type ' RotationType
 
' -----------------------------------------------------------------------------
' GLOBAL VARIABLES
' -----------------------------------------------------------------------------
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug: m_bDebug = TRUE
 
' =============================================================================
' BEGIN MAIN PROGRAM
' =============================================================================
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' START THE MENU
main
 
' -----------------------------------------------------------------------------
' DONE
Print m_ProgramName$ + " finished."
'Screen 0
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' EXIT
System ' return control to the operating system
End
 
' =============================================================================
' END MAIN PROGRAM
' =============================================================================
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
 
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Some basic 2D plotting"
        Print
        Print " 1. PlotPointTest"
        Print " 2. PlotSquareTest"
        Print " 3. PlotCircleTest"
        Print " 4. PlotCircleTopLeftTest"
        Print " 5. PlotSemicircleTest"
        Print " 6. CircleFillTest"
        Print " 7. CircleFillTopLeftTest"
        Print " 8. SemiCircleFillTest"
        Print " 9. EllipseTest"
        Print "10. EllipseFillTest"
        Print "11. PlotLineTest"
        Print "12. ShearRotate1Test1"
        Print "13. ShearRotate1Test2 (auto advances 0-360 degrees)"
        Print "14. ShearRotate1Test2 (auto advances 0-360 degrees) (uses Petr's text)"
        Print "15. ShearRotate2Test1 (correct for missing points logic v1)"
        Print "16. ShearRotate2Test1 (correct for missing points logic v1) (uses Petr's text)"
        Print "17. ShearRotate3Test1 (correct for missing points logic v2)"
        Print "18. ShearRotate3Test1 (correct for missing points logic v2) (uses Petr's text)"
        Print "19. ShearRotate4Test1 (correct for missing points logic v3)"
        Print "20. ShearRotate4Test1 (correct for missing points logic v3) (uses Petr's text)"
        Print "21. ShearRotate5Test1 (correct for missing points, STxAxTIC logic)"
        Print "22. ShearRotate5Test1 (correct for missing points, STxAxTIC logic) (uses Petr's text)"
        Print "23. GetRotationMaskTest"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(_Trim$(in$))
 
        If in$ = "1" Then
            PlotPointTest
        ElseIf in$ = "2" Then
            PlotSquareTest
        ElseIf in$ = "3" Then
            PlotCircleTest
        ElseIf in$ = "4" Then
            PlotCircleTopLeftTest
        ElseIf in$ = "5" Then
            PlotSemicircleTest
        ElseIf in$ = "6" Then
            CircleFillTest
        ElseIf in$ = "7" Then
            CircleFillTopLeftTest
        ElseIf in$ = "8" Then
            SemiCircleFillTest
        ElseIf in$ = "9" Then
            EllipseTest
        ElseIf in$ = "10" Then
            EllipseFillTest
        ElseIf in$ = "11" Then
            PlotLineTest
        ElseIf in$ = "12" Then
            ShearRotate1Test1
        ElseIf in$ = "13" Then
            ShearRotate1Test2 TestSprite1$
        ElseIf in$ = "14" Then
            ShearRotate1Test2 PetrText1$
        ElseIf in$ = "15" Then
            ShearRotate2Test1 TestSprite1$
        ElseIf in$ = "16" Then
            ShearRotate2Test1 PetrText1$
        ElseIf in$ = "17" Then
            ShearRotate3Test1 TestSprite1$
        ElseIf in$ = "18" Then
            ShearRotate3Test1 PetrText1$
        ElseIf in$ = "19" Then
            ShearRotate4Test1 TestSprite1$
        ElseIf in$ = "20" Then
            ShearRotate4Test1 PetrText1$
        ElseIf in$ = "21" Then
            ShearRotate5Test1 TestSprite1$
        ElseIf in$ = "22" Then
            ShearRotate5Test1 PetrText1$
        ElseIf in$ = "23" Then
            GetRotationMaskTest
        End If
    Loop Until in$ = "q"
End Sub ' main
 
 
 
 
 
 
 
 
 
 
 
' /////////////////////////////////////////////////////////////////////////////
' MyArray(1 To 32, 1 To 32) AS STRING
' where index is MyArray(Y, X)
 
Sub PlotPoint (X As Integer, Y As Integer, S As String, MyArray() As String)
    _Echo "PlotPoint X=" + cstr$(X) + ", Y=" + cstr$(Y) + ", S=" + Chr$(34) + S + Chr$(34) + ", MyArray()"
    If (X >= LBound(MyArray, 2)) Then
        If (X <= UBound(MyArray, 2)) Then
            If (Y >= LBound(MyArray, 1)) Then
                If (Y <= UBound(MyArray, 1)) Then
                    If Len(S) = 1 Then
                        MyArray(Y, X) = S
                    Else
                        If Len(S) > 1 Then
                            MyArray(Y, X) = Left$(S, 1)
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub ' PlotPoint
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotPointTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a point."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type x,y (1-32, 1-32) coordinate to plot point at."
        Input "X,Y OR 0 TO QUIT? "; X, Y
        If X > 0 And Y > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X) + ", Y=" + cstr$(Y)
            PlotPoint X, Y, Chr$(iChar), MyArray()
 
            Print "Current point plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotPointTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquare (X1 As Integer, Y1 As Integer, L As Integer, S As String, MyArray() As String)
    Dim X As Integer
    Dim X2 As Integer
    Dim Y As Integer
    Dim Y2 As Integer
    Dim sChar$
 
    If Len(S) = 1 Then
        sChar$ = S
    Else
        If Len(S) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(S, 1)
        End If
    End If
 
    X2 = (X1 + L) - 1
    Y2 = (Y1 + L) - 1
    For X = X1 To X2
        For Y = Y1 To Y2
            PlotPoint X, Y, sChar$, MyArray()
        Next Y
    Next X
End Sub ' PlotSquare
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquareTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Enter parameters to draw a square."
    Print ArrayToStringTest(MyArray())
    Print
    Do
        Print "Type top left x,y (1-32, 1-32) coordinate to plot square,"
        Print "and size (1-32) of square."
        Input "X,Y,L OR 0 TO QUIT? "; X, Y, L
        If X > 0 And Y > 0 And L > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "L=" + cstr$(L)
            Print
            PlotSquare X, Y, L, Chr$(iChar), MyArray()
 
            Print "Square plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotSquareTest
 
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
 
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
 
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
 
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM  : FAST CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
 
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
 
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
 
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM  : SLOW CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
 
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK   1 (drawing a pixel), 0 (erasing a pixel)
' X     X coordinate of the pixel
' Y     Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
 
' More on plotting circles:
'     Drawing a circle in BASIC - fast
'     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
 
' X,Y     = center point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircle (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        B = R
        C = 0
        A = R - 1
        Do
            PlotPoint X + C, Y + B, S2, MyArray()
            PlotPoint X + C, Y - B, S2, MyArray()
            PlotPoint X - C, Y - B, S2, MyArray()
            PlotPoint X - C, Y + B, S2, MyArray()
            PlotPoint X + B, Y + C, S2, MyArray()
            PlotPoint X + B, Y - C, S2, MyArray()
            PlotPoint X - B, Y - C, S2, MyArray()
            PlotPoint X - B, Y + C, S2, MyArray()
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then ' IF A>=0 THEN 190
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do ' 190 IF B>=C THEN 60
        Loop
    End If
End Sub ' PlotCircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a raster circle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotCircle X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotCircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' X,Y     = top left point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircleTopLeft (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim RoutineName As String: RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    ' Get total width
    W = (R * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
            PlotPoint R + C, R + B, S2, arrTemp() ' 1
            PlotPoint R + C, R - B, S2, arrTemp() ' 2
            PlotPoint R - C, R - B, S2, arrTemp() ' 3
            PlotPoint R - C, R + B, S2, arrTemp() ' 4
            PlotPoint R + B, R + C, S2, arrTemp() ' 5
            PlotPoint R + B, R - C, S2, arrTemp() ' 6
            PlotPoint R - B, R - C, S2, arrTemp() ' 7
            PlotPoint R - B, R + C, S2, arrTemp() ' 8
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
 
        ' Copy circle to destination Y,X
        For DY = LBound(arrTemp, 1) To UBound(arrTemp, 1)
            For DX = LBound(arrTemp, 2) To UBound(arrTemp, 2)
                If Len(arrTemp(DY, DX)) > 0 Then
                    TY = Y + DY
                    If TY >= MinY Then
                        If TY <= MaxY Then
                            TX = X + DX
                            If TX >= MinX Then
                                If TX <= MaxX Then
                                    MyArray(TY, TX) = arrTemp(DY, DX)
                                End If
                            End If
                        End If
                    End If
 
                End If
            Next DX
        Next DY
    End If
End Sub ' PlotCircleTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a raster circle, specifying top left x,y position"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotCircleTopLeft X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotCircleTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on PlotCircleTopLeft.
 
' X,Y     = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
' .......4444111.......
' .....44.......11.....
' ....4...........1....
' ...4.............1...
' ..4...............1..
' .4.................1.
' .4.................1.
' 4...................1
' 4...................1
' 4...................1
' 3...................1
' 3...................2
' 3...................2
' 3...................2
' .3.................2.
' .3.................2.
' ..3...............2..
' ...3.............2...
' ....3...........2....
' .....33.......22.....
' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotSemicircle (X As Integer, Y As Integer, R As Integer, Q As Integer, S As String, MyArray() As String)
    Dim RoutineName As String: RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    ' Get total width
    W = (R * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
 
            ' JUST PLOT SELECTED QUADRANT:
            Select Case Q
                Case 1:
                    ' quadrant #1
                    PlotPoint C, R - B, S2, arrTemp() ' 2
                    PlotPoint B, R - C, S2, arrTemp() ' 6
                Case 2:
                    ' quadrant #2
                    PlotPoint B, C, S2, arrTemp() ' 5
                    PlotPoint C, B, S2, arrTemp() ' 1
                Case 3:
                    ' quadrant #3
                    PlotPoint R - C, B, S2, arrTemp() ' 4
                    PlotPoint R - B, C, S2, arrTemp() ' 8
                Case 4:
                    ' quadrant #4
                    PlotPoint R - B, R - C, S2, arrTemp() ' 7
                    PlotPoint R - C, R - B, S2, arrTemp() ' 3
                Case Else:
                    ' (DO NOTHING)
            End Select
 
            '' PLOT CIRCLE:
            '' quadrant #1
            'PlotPoint R + C, R - B, S2, arrTemp() ' 2
            'PlotPoint R + B, R - C, S2, arrTemp() ' 6
            '
            '' quadrant #2
            'PlotPoint R + B, R + C, S2, arrTemp() ' 5
            'PlotPoint R + C, R + B, S2, arrTemp() ' 1
            '
            '' quadrant #3
            'PlotPoint R - C, R + B, S2, arrTemp() ' 4
            'PlotPoint R - B, R + C, S2, arrTemp() ' 8
            '
            '' quadrant #4
            'PlotPoint R - B, R - C, S2, arrTemp() ' 7
            'PlotPoint R - C, R - B, S2, arrTemp() ' 3
 
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
 
        ' Copy semicircle to destination Y,X
        For DY = LBound(arrTemp, 1) To UBound(arrTemp, 1)
            For DX = LBound(arrTemp, 2) To UBound(arrTemp, 2)
                If Len(arrTemp(DY, DX)) > 0 Then
                    TY = Y + DY
                    If TY >= MinY Then
                        If TY <= MaxY Then
                            TX = X + DX
                            If TX >= MinX Then
                                If TX <= MaxX Then
                                    MyArray(TY, TX) = arrTemp(DY, DX)
                                End If
                            End If
                        End If
                    End If
                End If
            Next DX
        Next DY
    End If
End Sub ' PlotSemicircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSemicircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a semicircle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotSemicircle X, Y, R, Q, Chr$(iChar), MyArray()
 
            Print "Semicircle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotSemicircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg1913#msg1913
 
' From: SMcNeill
' Date: « Reply #30 on: June 26, 2018, 03:34:18 pm »
'
' Sometimes, computers do things that are completely counter-intuitive to us, and
' we find ourselves having to step back as programmers and simply say, "WOW!!"
' Here's a perfect example of that:
' Here we look at two different circle fill routines -- one, which I'd assume to
' be faster, which precalculates the offset needed to find the endpoints for each
' line which composes a circle, and another, which is the same old CircleFill
' program which I've shared countless times over the years with people on various
' QB64 forums.
'
' When all is said and done though, CircleFill is STILL even faster than
' CircleFillFast, which pregenerates those end-points for us!
 
' CX,CY     = center point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, S As String, MyArray() As String)
    Dim Radius As Integer
    Dim RadiusError As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
 
    If Radius = 0 Then
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        Exit Sub
    End If
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    For iLoopX = CX - X To CX + X
        PlotPoint iLoopX, CY, S, MyArray()
    Next iLoopX
 
    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
                iLoopY = CY - X
                For iLoopX = CX - Y To CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                Next iLoopX
 
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                iLoopY = CY + X
                For iLoopX = CX - Y To CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                Next iLoopX
            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
        iLoopY = CY - Y
        For iLoopX = CX - X To CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopX
 
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        iLoopY = CY + Y
        For iLoopX = CX - X To CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopX
    Wend
End Sub ' CircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a filled circle"
    Print "Based on CircleFill by SMcNeill."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            'PlotCircle X, Y, R, Chr$(iChar), MyArray()
            CircleFill X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' CircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotCircleTopLeft.
' CX,CY     = top left point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
Sub CircleFillTopLeft (CX As Integer, CY As Integer, R As Integer, S As String, MyArray() As String)
    Dim Radius As Integer
    Dim RadiusError As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim W As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
 
    If Radius = 0 Then
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        Exit Sub
    End If
 
    ' Get total width
    W = (Radius * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    For iLoopX = R - X To R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    Next iLoopX
 
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
 
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
 
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
    Wend
 
    ' Copy circle to destination Y,X
    For DY = LBound(arrTemp, 1) To UBound(arrTemp, 1)
        For DX = LBound(arrTemp, 2) To UBound(arrTemp, 2)
            If Len(arrTemp(DY, DX)) > 0 Then
                TY = DY + CY
                If TY >= MinY Then
                    If TY <= MaxY Then
                        TX = DX + CX
                        If TX >= MinX Then
                            If TX <= MaxX Then
                                MyArray(TY, TX) = arrTemp(DY, DX)
                            End If
                        End If
                    End If
                End If
            End If
        Next DX
    Next DY
 
End Sub ' CircleFillTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a solid circle, specifying top left x,y position"
    Print "Based on CircleFill by SMcNeill."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            CircleFillTopLeft X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' CircleFillTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotSemiCircle
 
' CX,CY   = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return semicircle from
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
' .......4444111.......
' .....44444411111.....
' ....4444444111111....
' ...444444441111111...
' ..44444444411111111..
' .4444444444111111111.
' .4444444444111111111.
' 444444444441111111111
' 444444444441111111111
' 444444444441111111111
' 333333333331111111111
' 333333333332222222222
' 333333333332222222222
' 333333333332222222222
' .3333333333222222222.
' .3333333333222222222.
' ..33333333322222222..
' ...333333332222222...
' ....3333333222222....
' .....33333322222.....
' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot semicircle in
 
Sub SemiCircleFill (CX As Integer, CY As Integer, R As Integer, Q As Integer, S As String, MyArray() As String)
    Dim Radius As Integer
    Dim RadiusError As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim W As Integer
    Dim AX As Integer
    Dim AY As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
 
    If Radius = 0 Then
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        Exit Sub
    End If
 
    ' Get total width
    W = (Radius * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    ' Temp array's lbound is 0
    ' Calculate difference from MyArray the indices of arrTemp are
    AY = 0 - MinY
    AX = 0 - MinX
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    For iLoopX = R - X To R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    Next iLoopX
 
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
 
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
 
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
    Wend
 
    '_echo "MyArray(" + _Trim$(Str$(lbound(MyArray,1))) + " To " + _Trim$(Str$(ubound(MyArray,1))) + ", " + _Trim$(Str$(lbound(MyArray,2))) + " To " + _Trim$(Str$(ubound(MyArray,2))) + ")"
 
    ' Copy semicircle to destination Y,X
    ' JUST COPY SELECTED QUADRANT:
    Select Case Q
        Case 1:
            ' quadrant #1
            For DY = 0 To Radius
                For DX = Radius To W
                    '_echo "DY=" + cstr$(DY) + ", DX=" + cstr$(DX)
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY + CY) - (AY + 1)
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX - Radius) - AX
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case 2:
            ' quadrant #2
            For DY = Radius To W
                For DX = Radius To W
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY - Radius) - AY
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX - Radius) - AX
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case 3:
            ' quadrant #3
            For DY = Radius To W
                For DX = 0 To Radius
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY - Radius) - AY
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX + CX) - (AX + 1)
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case 4:
            ' quadrant #4
            For DY = 0 To Radius
                For DX = 0 To Radius
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY + CY) - (AY + 1)
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX + CX) - (AX + 1)
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case Else:
            ' (DO NOTHING)
    End Select
 
    '' Copy circle to destination:
    'For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
    '    For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
    '        IF LEN(arrTemp(DY, DX)) > 0 THEN
    '            MyArray(DY + CY, DX + CX) = arrTemp(DY, DX)
    '        END IF
    '    Next DX
    'Next DY
 
End Sub ' SemiCircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SemiCircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a solid semicircle"
    Print "Based on CircleFill by SMcNeill."
    Print
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            SemiCircleFill X, Y, R, Q, Chr$(iChar), MyArray()
 
            Print "Semicircle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' SemiCircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
 
Sub Ellipse (CX As Integer, CY As Integer, xRadius As Integer, yRadius As Integer, S As String, MyArray() As String)
    Dim scale As Single
    Dim xs As Integer
    Dim x As Integer
    Dim y As Integer
    Dim lastx As Integer
    Dim lasty As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    scale = yRadius / xRadius
    xs = xRadius * xRadius
 
    'PSET (CX, CY - yRadius)
    PlotPoint CX, CY - yRadius, S, MyArray()
 
    'PSET (CX, CY + yRadius)
    PlotPoint CX, CY + yRadius, S, MyArray()
 
    lastx = 0: lasty = yRadius
    For x = 1 To xRadius
        y = scale * Sqr(xs - x * x)
        'LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)
        PlotLine CX + lastx, CY - lasty, CX + x, CY - y, S, MyArray()
 
        'LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)
        PlotLine CX + lastx, CY + lasty, CX + x, CY + y, S, MyArray()
 
        'LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)
        PlotLine CX - lastx, CY - lasty, CX - x, CY - y, S, MyArray()
 
        'LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)
        PlotLine CX - lastx, CY + lasty, CX - x, CY + y, S, MyArray()
 
        lastx = x
        lasty = y
    Next x
End Sub ' Ellipse
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot an ellipse"
    Print "Based on ellipse by bplus."
    Print
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 And Y > 0 And RX > 0 And RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
 
            Ellipse X, Y, RX, RY, Chr$(iChar), MyArray()
 
            Print "Ellipse plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' EllipseTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
'
' Here is my ellipse and filled ellipse routines, no where near
' Steve's level of performance. The speed is cut in half at
' least because you probably have to do a whole quadrants worth
' of calculations (ellipse not as symmetric as circle).
'
' But I am sure this code can be optimized more than it is:
 
Sub EllipseFill (CX As Integer, CY As Integer, xRadius As Integer, yRadius As Integer, S As String, MyArray() As String)
    Dim scale As Single
    Dim x As Integer
    Dim y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    scale = yRadius / xRadius
 
    'LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    For iLoopY = CY - yRadius To CY + yRadius
        PlotPoint CX, iLoopY, S, MyArray()
    Next iLoopY
 
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
 
        'LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
        iLoopX = CX + x
        For iLoopY = CY - y To CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopY
 
        'LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
        iLoopX = CX - x
        For iLoopY = CY - y To CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopY
    Next x
End Sub ' EllipseFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a filled ellipse"
    Print "Based on fellipse by bplus."
    Print
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 And Y > 0 And RX > 0 And RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
 
            EllipseFill X, Y, RX, RY, Chr$(iChar), MyArray()
 
            Print "Ellipse plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' EllipseFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
' From: http://www.thedubber.altervista.org/qbsrc.htm
 
Sub PlotLine (x1%, y1%, x2%, y2%, c$, MyArray() As String)
    Dim iLoop%
    Dim steep%: steep% = 0
    Dim ev%: ev% = 0
    Dim sx%
    Dim sy%
    Dim dx%
    Dim dy%
 
    If (x2% - x1%) > 0 Then
        sx% = 1
    Else
        sx% = -1
    End If
 
    dx% = Abs(x2% - x1%)
    If (y2% - y1%) > 0 Then
        sy% = 1
    Else
        sy% = -1
    End If
 
    dy% = Abs(y2% - y1%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x1%, y1%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
 
    ev% = 2 * dy% - dx%
    For iLoop% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y1%, x1%), c%:
            'LOCATE y1%, x1%
            'PRINT c$;
            PlotPoint y1%, x1%, c$, MyArray()
        Else
            ''PSET (x1%, y1%), c%
            'LOCATE x1%, y1%
            'PRINT c$;
            PlotPoint x1%, y1%, c$, MyArray()
        End If
 
        While ev% >= 0
            y1% = y1% + sy%
            ev% = ev% - 2 * dx%
        Wend
        x1% = x1% + sx%
        ev% = ev% + 2 * dy%
    Next iLoop%
    ''PSET (x2%, y2%), c%
    'LOCATE x2%, y2%
    'PRINT c$;
    PlotPoint x2%, y2%, c$, MyArray()
End Sub ' PlotLine
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotLineTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim in$
    Dim X1 As Integer
    Dim Y1 As Integer
    Dim X2 As Integer
    Dim Y2 As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot line with Bresenham Algorithm"
    Print "based on BRESNHAM.BAS by Kurt Kuzba (4/16/96)."
    Print
    Print ArrayToStringTest(MyArray())
    Do
        Print "Enter coordinate values for "
        Print "line start point x1, y1 (1-32, 1-32)"
        Print "line end   point x2, y2 (1-32, 1-32)"
        Input "ENTER X1,Y1,X2,Y2 OR 0 TO QUIT: "; X1, Y1, X2, Y2
        If X1 > 0 And Y1 > 0 And X2 > 0 And Y2 > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X1=" + cstr$(X1)
            Print "Y1=" + cstr$(Y1)
            Print "X2=" + cstr$(X2)
            Print "Y2=" + cstr$(Y2)
 
            PlotLine X1, Y1, X2, Y2, Chr$(iChar), MyArray()
 
            Print "Line plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotLineTest
 
' /////////////////////////////////////////////////////////////////////////////
' 3 shear method testing
 
' _PUT Rotation Help
' https://www.qb64.org/forum/index.php?topic=1959.0
 
' 3 Shear Rotation - rotates without any aliasing(holes)
' https://www.freebasic.net/forum/viewtopic.php?t=24557
 
' From: leopardpm
' Date: Apr 02, 2016 1:21
' Last edited by leopardpm on Apr 02, 2016 17:18, edited 1 time in total.
'
' This is just a little 3-shear rotation routine
' (I am using 3-shear because it leaves no gaps/aliasing)
' that I was wondering if anyone sees how to make it faster.
' Obviously, I am just thinking about inside the double loop.
 
' Thanks again to BasicCoder2 for linking me to this little routine, it is wonderful so far!
 
'''                      roto-zooming algorithm
'''                    coded by Michael S. Nissen
'''                        jernmager@yahoo.dk
'
''' ===============================================================
''' Recoded to run on FBC 32/64 bit WIN, Version 1.05.0, 2016, by MrSwiss
''' Heavy flickering before going Full-Screen on 64 Bit !!!
''' This seems NOT to be the Case on 32 Bit ...
''' ===============================================================
'
'Type Pixel
'  As Single   X, Y
'  As ULong    C
'End Type
'
'''  dim vars
'Dim shared as Any Ptr Img_Buffer
'''  write the name of the .bmp image you want to rotozoom here:
'''  (it has to be sqare ie. 100x100 pixels, 760x760 pixels or whatever)
'Dim As String Img_Name = "phobos.bmp"
'Dim shared as Integer X_Mid, Y_Mid, scrn_wid, scrn_hgt, P1, P2, P3, P4, C
'Dim shared as Short Img_Hgt, Img_Wid, Img_Lft, Img_Rgt, Img_Top, Img_Btm, X, Y
'Dim Shared As Single Cos_Ang, Sin_Ang, Rot_Fac_X, Rot_Fac_Y, Angle = 0, Scale = 1
'
''' changed Function to Sub (+ recoded arguments list)
'Sub Calc_rotozoom ( ByRef Cos_Ang As Single, _
'               ByRef Sin_Ang As Single, _
'               ByVal S_Fact  As Single, _
'               ByVal NewAng  As Single )
'  Cos_Ang = Cos(NewAng)*S_Fact
'  Sin_Ang = Sin(NewAng)*S_Fact
'End Sub
'
'''  full screen
'ScreenInfo scrn_wid, scrn_hgt
'screenRes scrn_wid, scrn_hgt, 32,,1
'
'''  dim screenpointer (has to be done after screenres)
'Dim As ULong Ptr Scrn_Ptr = Screenptr
'
'''  place image in center of screen
'X_Mid = scrn_wid\2
'Y_Mid = scrn_hgt\2
'Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'
'''  find image dimensions
'Open Img_Name For Binary As #1
'Get #1, 19, Img_Wid
'Get #1, 23, Img_Hgt
'Close #1
'
'''  prepare to dim the array that will hold the image.
'Img_Rgt = (Img_Wid-1)\2
'Img_Lft = -Img_Rgt
'Img_Btm = (Img_Hgt-1)\2
'Img_Top = -Img_Btm
'
'''  dim array to hold image. Note: pixel (0, 0) is in the center.
'Dim As Pixel Pixel(Img_Lft to Img_Rgt, Img_Top to Img_Btm)
'
'''  imagecreate sprite and load image to sprite
'Img_Buffer = ImageCreate (Img_Wid, Img_Hgt)
'Bload (Img_Name, Img_Buffer)
'
'''  load image from sprite to array with point command
'For Y = Img_Top to Img_Btm
'  For X = Img_Lft to Img_Rgt
'    With Pixel(X, Y)
'      .X = X_Mid+X
'      .Y = Y_Mid+Y
'      C = Point (X-Img_Top, Y-Img_Lft, Img_buffer)
'      If C <> RGB(255, 0, 255) Then
'        .C = C
'      Else
'        .C = RGB(0, 0, 0)
'      End If
'    End With
'  Next X
'Next Y
'
'''  we don't need the sprite anymore, kill it
'ImageDestroy Img_Buffer
'Img_Buffer = 0
'
'''  main program loop
'Do
'
'  ''  scale in/out with uparrow/downarrow
'  If Multikey(80) Then
'    Scale *= 1.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(72) Then
'    Scale *= 0.97
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  rotate left/right with leftarrow/rightarrow
'  If Multikey(77) Then
'    Angle -= 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(75) Then
'    Angle += 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  lock screen in order to use screen pointers
'  ScreenLock
'
'    ''  draw pixel in center of image
'    Scrn_Ptr[ X_Mid + Y_Mid * scrn_wid ] = Pixel(0, 0).C
'    ''  draw all other pixels - 4 at a time
'    For Y = Img_Top to 0
'      For X = Img_Lft to -1
'        ''  find pixel positions
'        P1 = (X_Mid+X) + (Y_Mid+Y) * scrn_wid
'        P2 = (X_Mid-X) + (Y_Mid-Y) * scrn_wid
'        P3 = (X_Mid+Y) + (Y_Mid-X) * scrn_wid
'        P4 = (X_Mid-Y) + (Y_Mid+X) * scrn_wid
'        ''  erase old pixels (paint them black)
'        Scrn_Ptr[P1] = 0
'        Scrn_Ptr[P2] = 0
'        Scrn_Ptr[P3] = 0
'        Scrn_Ptr[P4] = 0
'        ''  rotate and zoom
'        Rot_Fac_X = X*Cos_Ang - Y*Sin_Ang
'        Rot_Fac_Y = X*Sin_Ang + Y*Cos_Ang
'        If Rot_Fac_X < Img_Lft Or Rot_Fac_X > Img_Rgt Then Continue For
'        If Rot_Fac_Y < Img_Top Or Rot_Fac_Y > Img_Btm Then Continue For
'        ''  draw new pixels
'        Scrn_Ptr[P1] = Pixel(Rot_Fac_X, Rot_Fac_Y).C
'        Scrn_Ptr[P2] = Pixel(-Rot_Fac_X, -Rot_Fac_Y).C
'        Scrn_Ptr[P3] = Pixel(Rot_Fac_Y, -Rot_Fac_X).C
'        Scrn_Ptr[P4] = Pixel(-Rot_Fac_Y, Rot_Fac_X).C
'      Next X
'    Next Y
'
'  ScreenUnLock
'
'  Sleep 10, 1
'Loop Until InKey() = Chr(27)
 
' UPDATES:
' Fixed bug where values 135, 224, and 314 all resolve to -45 degrees.
' Fixed bug where an angle of 46-135 degrees caused the image to be flipped wrong.
 
' TODO:
' Fix issue where image looks bad at 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
Sub ShearRotate (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate
 
' /////////////////////////////////////////////////////////////////////////////
' Same as ShearRotate, except adds iOverwriteCount parameter,
' and counts how many points are overwriting existing points,
' and return that value byref in parameter iOverwriteCount.
 
Sub ShearRotate1 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iOverwriteCount As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    iOverwriteCount = 0
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
 
                    ' count points that will be overwritten
                    If NewArray(fx, fy, 0).c <> iEmpty Then
                        iOverwriteCount = iOverwriteCount + 1
                    End If
 
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate1
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotate1Test1
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim in$
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print
 
    sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
    Print "Initial contents of Rotation Array:"
    Print RotationArrayToStringTest(RoArray1())
    Print
 
    ' ROTATE THE SHAPE
    Do
        Print "Type degrees to rotate (0 TO 360) or non-numeric value to quit."
        Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
 
        Input "Degrees to rotate (q to quit)? "; in$
        If IsNum%(in$) Then
            D = Val(in$)
            If D >= 0 And D <= 360 Then
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
End Sub ' ShearRotate1Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Now receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate1Test2 TestSprite1$
 
Sub ShearRotate1Test2 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iOverwriteCount As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate1Test2
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v2
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate2 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iMissing As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the angle of rotation?
    ' perhaps if we divide the screen up into 4 zones:
    '
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '| 271-359 degrees)  | (1-89 degrees)   |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '| (181-269 degrees) | (91-179 degrees) |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   search direction (y,x)
    ' -------   ----------------------
    ' 1         up   + right
    ' 2         down + right
    ' 3         down + left
    ' 4         up   + left
 
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint2%(arrLost(iLoop), angle1, iEmpty, x, y, NewArray())
        If bFound = TRUE Then
            If m_bDebug = TRUE Then
                _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        Else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        End If
    Next iLoop
 
End Sub ' ShearRotate2
 
' /////////////////////////////////////////////////////////////////////////////
' Receives
' FindMe (RotationType) = contains the starting location (.origx, .origy) to start looking from, and the value (.c) to write
' angle1 (Integer) = angle we were rotating to, to determine direction to look in
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint2% (FindMe As RotationType, angle1 As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
 
    destX = 0
    destY = 0
 
    ' Choose search direction depending on the angle
    If angle1 > 0 And angle1 < 90 Then
        dirX = 1
        dirY = -1
    ElseIf angle1 > 90 And angle1 < 180 Then
        dirX = 1
        dirY = 1
    ElseIf angle1 > 180 And angle1 < 270 Then
        dirX = -1
        dirY = 1
    ElseIf angle1 > 270 And angle1 < 360 Then
        dirX = -1
        dirY = -1
    Else
        dirX = 0
        dirY = 0
    End If
 
    If dirX <> 0 Then
        x = FindMe.origx
        y = FindMe.origy
        Do
            ' quit if we're out of bounds
            If x < LBound(NewArray, 1) Then Exit Do
            If x > UBound(NewArray, 1) Then Exit Do
            If y < LBound(NewArray, 2) Then Exit Do
            If y > UBound(NewArray, 2) Then Exit Do
 
            ' =============================================================================
            ' BEGIN SEARCH
            ' =============================================================================
            ' look along y axis for a blank spot
            destX = x
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(destX, destY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look along x axis for a blank spot
            destX = x + dirX
            destY = y
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look diagonally for a blank spot
            destX = x + dirX
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
            ' =============================================================================
            ' END SEARCH
            ' =============================================================================
 
            ' Keep looking
            x = x + dirX
            y = y + dirY
        Loop
    End If
 
    ' Return result
    FindEmptyShearRotationPoint2% = bResult
End Function ' FindEmptyShearRotationPoint2%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points.
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate2Test1 TestSprite1$
 
Sub ShearRotate2Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate2Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v3
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' a little more accurately, using iDirection parameter
' (which can be cClockwise or cCounterClockwise)
' together with which quarter of the screen the point is in,
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate3 ( _
    OldArray() As RotationType, _
    NewArray() As RotationType, _
    angle1 As Integer, _
    iDirection As Integer, _
    iEmpty As Integer, _
    iMissing As Integer)
 
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
    Dim iMidX As Integer
    Dim iMidY As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' find midpoints
    iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
    iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
 
            ' find which part of screen the current point is in
            If y > iMidY Then
                ' bottom half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 2
                Else
                    ' left half of screen
                    iScreenZone = 3
                End If
            Else
                ' top half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 1
                Else
                    ' left half of screen
                    iScreenZone = 4
                End If
            End If
 
            ' calculate directions
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
 
                        ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                        arrLost(UBound(arrLost)).z = iScreenZone
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
    ' together with which quarter of the screen the point is in (iScreenZone)
    ' where we divide the screen up into 4 zones:
 
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
    ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
 
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint3%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
        If bFound = TRUE Then
            If m_bDebug = TRUE Then
                _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        Else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        End If
    Next iLoop
 
End Sub ' ShearRotate3
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains
'                         .origx, .origy = the starting location to start looking from,
'                         .z = which area of the screen the point is in
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left)
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint3% (FindMe As RotationType, iDirection As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
 
    ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
 
    ' Choose search direction based on the quadrant of the screen
    ' and the direction of rotation:
 
    ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
    ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
 
    If FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
 
    ' Quit if we're out of bounds
    If bContinue = TRUE Then
        bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
        If x >= LBound(NewArray, 1) Then
            If x <= UBound(NewArray, 1) Then
                If y >= LBound(NewArray, 2) Then
                    If y <= UBound(NewArray, 2) Then
                        bContinue = TRUE
                    End If
                End If
            End If
        End If
    End If
 
    ' look along y axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(destX, destY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look along x axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look diagonally for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' Return result
    FindEmptyShearRotationPoint3% = bResult
End Function ' FindEmptyShearRotationPoint3%
 
' /////////////////////////////////////////////////////////////////////////////
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate3Test1 TestSprite1$
 
Sub ShearRotate3Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
 
                ShearRotate3 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate3 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate3Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v4
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' using a different approach, by just looking at the problem angles:
' 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
' (which can be cClockwise or cCounterClockwise)
' together with which quarter of the screen the point is in,
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate4 ( _
    OldArray() As RotationType, _
    NewArray() As RotationType, _
    angle1 As Integer, _
    iDirection As Integer, _
    iEmpty As Integer, _
    iMissing As Integer)
 
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
    Dim iMidX As Integer
    Dim iMidY As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' find midpoints
    iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
    iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
 
            ' find which part of screen the current point is in
            If y > iMidY Then
                ' bottom half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 2
                Else
                    ' left half of screen
                    iScreenZone = 3
                End If
            Else
                ' top half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 1
                Else
                    ' left half of screen
                    iScreenZone = 4
                End If
            End If
 
            ' calculate directions
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
 
                        ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                        arrLost(UBound(arrLost)).z = iScreenZone
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
    ' together with which quarter of the screen the point is in (iScreenZone)
    ' where we divide the screen up into 4 zones:
 
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
    ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
 
    If IsProblemAngle%(angle1) Then
        iMissing = 0
        For iLoop = 0 To UBound(arrLost)
            bFound = FindEmptyShearRotationPoint4%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
            If bFound = TRUE Then
                If m_bDebug = TRUE Then
                    _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                End If
            Else
                iMissing = iMissing + 1
                If m_bDebug = TRUE Then
                    _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                End If
            End If
        Next iLoop
    End If
End Sub ' ShearRotate4
 
' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if angle is any of
' 30, 60, 120, 150, 210, 240, 300, 330
 
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
 
Function IsProblemAngle% (angle As Integer)
    Dim bResult As Integer: bResult = FALSE
    Dim i%
    For i% = 0 To 360 Step 30
        If i% Mod 90 <> 0 Then
            If angle = i% Then
                bResult = TRUE
                Exit For
            End If
        End If
    Next i%
    IsProblemAngle% = bResult
End Function ' IsProblemAngle%
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains
'                         .origx, .origy = the starting location to start looking from,
'                         .z = which area of the screen the point is in
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left)
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint4% (FindMe As RotationType, iDirection As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
 
    ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
 
    ' Choose search direction based on the quadrant of the screen
    ' and the direction of rotation:
 
    ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
    ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
 
    If FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
 
    ' Quit if we're out of bounds
    If bContinue = TRUE Then
        bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
        If x >= LBound(NewArray, 1) Then
            If x <= UBound(NewArray, 1) Then
                If y >= LBound(NewArray, 2) Then
                    If y <= UBound(NewArray, 2) Then
                        bContinue = TRUE
                    End If
                End If
            End If
        End If
    End If
 
    ' look along y axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(destX, destY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look along x axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look diagonally for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    '   ' look (in the opposite direction) along y axis for an available adjacent point
    '   If bContinue = TRUE Then
    '       destX = x
    '       destY = y - dirY
    '       if destX >= LBound(NewArray, 1) then
    '           if destX <= UBound(NewArray, 1) then
    '               if destY >= LBound(NewArray, 2) then
    '                   if destY <= UBound(NewArray, 2) then
    '                       if NewArray(destX, destY, 0).c = iEmpty then
    '                           NewArray(destX, destY, 0).c = FindMe.c
    '                           bResult = TRUE
    '                           bContinue = FALSE
    '                       end if
    '                   end if
    '               end if
    '           end if
    '       end if
    '   end if
    '
    '   ' look (in the opposite direction) along x axis for an available adjacent point
    '   If bContinue = TRUE Then
    '       destX = x - dirX
    '       destY = y
    '       if destX >= LBound(NewArray, 1) then
    '           if destX <= UBound(NewArray, 1) then
    '               if destY >= LBound(NewArray, 2) then
    '                   if destY <= UBound(NewArray, 2) then
    '                       if NewArray(x + dirX, y, 0).c = iEmpty then
    '                           NewArray(destX, destY, 0).c = FindMe.c
    '                           bResult = TRUE
    '                           bContinue = FALSE
    '                       end if
    '                   end if
    '               end if
    '           end if
    '       end if
    '   end if
    '
    '   ' look (in the opposite direction) diagonally for an available adjacent point
    '   If bContinue = TRUE Then
    '       destX = x - dirX
    '       destY = y - dirY
    '       if destX >= LBound(NewArray, 1) then
    '           if destX <= UBound(NewArray, 1) then
    '               if destY >= LBound(NewArray, 2) then
    '                   if destY <= UBound(NewArray, 2) then
    '                       if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
    '                           NewArray(destX, destY, 0).c = FindMe.c
    '                           bResult = TRUE
    '                           bContinue = FALSE
    '                       end if
    '                   end if
    '               end if
    '           end if
    '       end if
    '    End If
 
    ' Return result
    FindEmptyShearRotationPoint4% = bResult
End Function ' FindEmptyShearRotationPoint4%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points with improved logic v3
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate4Test1 TestSprite1$
 
Sub ShearRotate4Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
 
                ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate4Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Correct for overwriting points issue
' (happens at 30, 60, 120, 150, 210, 240, 300, 330 degrees)
' using STxAxTIC's method of merging array rotated to angle-1 and angle+1
 
Sub ShearRotate5 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    ReDim arrCW(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    ReDim arrCCW(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
 
    ' If rotation is 30, 60, 120, 150, 210, 240, 300, 330 degrees
    ' then try correcting for overwriting.
    If IsProblemAngle%(angle1) Then
        ' get array rotated to angle-1
        ShearRotate OldArray(), arrCW(), angle1 - 1, iEmpty
 
        ' get array rotated to angle
        ShearRotate OldArray(), NewArray(), angle1 - 1, iEmpty
 
        ' get array rotated to angle=1
        ShearRotate OldArray(), arrCCW(), angle1 + 1, iEmpty
 
        ' merge the results
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            For y = LBound(NewArray, 2) To UBound(NewArray, 2)
                ' is point empty?
                If NewArray(x, y, 0).c = iEmpty Then
                    ' see if point is occupied 1 deg. counter-clockwise
                    If arrCCW(x, y, 0).c <> iEmpty Then
                        NewArray(x, y, 0).c = arrCCW(x, y, 0).c
                        ' see if point is occupied 1 deg. clockwise
                    ElseIf arrCW(x, y, 0).c <> iEmpty Then
                        NewArray(x, y, 0).c = arrCW(x, y, 0).c
                    End If
                End If
            Next y
        Next x
        ' Otherwise rotate without correcting.
    Else
        ShearRotate OldArray(), NewArray(), angle1, iEmpty
    End If
End Sub ' ShearRotate5
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing (overwritten) points
' using STxAxTIC's method to correct for overwritten points
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate5Test1 TestSprite1$
 
Sub ShearRotate5Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    'Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print "using STxAxTIC's method to correct for overwritten points"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
 
                'ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                ShearRotate5 RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                'Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                'ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                ShearRotate5 RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                'Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate5Test1
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub GetRotationMaskTest
    Dim RoutineName As String: RoutineName = "GetRotationMaskTest"
    ReDim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    'ReDim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    ReDim arrMaskIndex(-1) As Integer
    ReDim arrMasks(-1, -1, -1) As RotationType
    Dim iLoop%
    Dim x As Integer
    Dim y As Integer
    Dim sLine As String
    Dim iIndex%
    Dim in$
 
    Width 180, 100
 
    ' Get index
    GetMaskIndex arrMaskIndex()
 
    Cls
    Print "Contents of arrMaskIndex:"
    For iLoop% = LBound(arrMaskIndex) To UBound(arrMaskIndex)
        If arrMaskIndex(iLoop%) > 0 Then
            Print "arrMaskIndex(" + cstr$(iLoop%) + ") = " + cstr$(arrMaskIndex(iLoop%))
        End If
    Next iLoop%
    Print
    Input "PRESS <ENTER> TO CONTINUE OR q TO QUIT"; in$
    If in$ = "q" Then GoTo CleanupAndExit
 
    ' Get rotation masks
    GetRotationMasks RoArray1(), arrMasks()
 
    ' Show unrotated mask
    Cls
    Print "Unrotated mask:"
    iIndex% = 0
    For y = LBound(arrMasks, 3) To UBound(arrMasks, 3)
        sLine = ""
        For x = LBound(arrMasks, 2) To UBound(arrMasks, 2)
            sLine = sLine + IIFSTR$(Len(sLine) = 0, "", ",") + Right$("    " + cstr$(arrMasks(iIndex%, x, y).c), 4)
        Next x
        Print sLine
    Next y
    Print
    Input "PRESS <ENTER> TO CONTINUE OR q TO QUIT"; in$
    If in$ = "q" Then GoTo CleanupAndExit
 
    ' Show what we have
    For iLoop% = 0 To 360
        iIndex% = arrMaskIndex(iLoop%)
        'print "arrMaskIndex(" + cstr$(iLoop%) + ") = " + cstr$(iIndex%)
        If iIndex% > 0 Then
            Cls
            Print "arrMaskIndex(" + cstr$(iLoop%) + ") = " + cstr$(iIndex%)
            For y = LBound(arrMasks, 3) To UBound(arrMasks, 3)
                sLine = ""
                For x = LBound(arrMasks, 2) To UBound(arrMasks, 2)
                    sLine = sLine + IIFSTR$(Len(sLine) = 0, "", ",") + Right$("    " + cstr$(arrMasks(iIndex%, x, y).c), 4)
                Next x
                Print sLine
            Next y
            Print
            Input "PRESS <ENTER> TO CONTINUE OR q TO QUIT"; in$
            If in$ = "q" Then GoTo CleanupAndExit
        End If
    Next iLoop%
 
    Print
    Print RoutineName + " finished."
    Input "PRESS <ENTER> TO CONTINUE"; in$
 
    CleanupAndExit:
    'Screen 0
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
End Sub ' GetRotationMaskTest
 
' /////////////////////////////////////////////////////////////////////////////
' Returns array with rotation masks
' NewArray(index, x, y) of RotationType
 
Sub GetRotationMasks (OldArray() As RotationType, NewArray() As RotationType)
    ReDim arrMask(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    ReDim arrNext(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    ReDim arrMaskIndex(-1) As Integer
    Dim x As Integer
    Dim y As Integer
    Dim iValue As Integer
    Dim angle As Integer
    Dim iIndex As Integer
 
    ' Get index
    GetMaskIndex arrMaskIndex()
 
    ' Size array
    ReDim NewArray(0 To UBound(arrMaskIndex), LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2)) As RotationType
 
    ' create the original mask
    iValue = 0
    For y = LBound(OldArray, 2) To UBound(OldArray, 2)
        For x = LBound(OldArray, 1) To UBound(OldArray, 1)
            iValue = iValue + 1
            arrMask(x, y, 0).c = iValue
            arrMask(x, y, 0).origx = x
            arrMask(x, y, 0).origy = y
 
            NewArray(0, x, y).c = iValue
            NewArray(0, x, y).origx = x
            NewArray(0, x, y).origy = y
        Next x
    Next y
 
    ' create rotated masks
    For angle = 30 To 330
        ' If angle is 30, 60, 120, 150, 210, 240, 300, 330 degrees
        ' then precalculate rotation masks for angle-1, angle, angle+1
        ' and store in NewArray
        If IsProblemAngle%(angle) Then
            ' get array rotated to angle-1
            ShearRotate arrMask(), arrNext(), angle - 1, iEmpty
 
            ' copy to mask array
            iIndex = arrMaskIndex(angle - 1)
            For x = LBound(arrNext, 1) To UBound(arrNext, 1)
                For y = LBound(arrNext, 2) To UBound(arrNext, 2)
                    NewArray(iIndex, x, y).c = arrNext(x, y, 0).c
                    NewArray(iIndex, x, y).origx = arrNext(x, y, 0).origx
                    NewArray(iIndex, x, y).origy = arrNext(x, y, 0).origy
                Next y
            Next x
 
            ' get array rotated to angle
            ShearRotate arrMask(), arrNext(), angle, iEmpty
 
            ' copy to mask array
            iIndex = arrMaskIndex(angle)
            For x = LBound(arrNext, 1) To UBound(arrNext, 1)
                For y = LBound(arrNext, 2) To UBound(arrNext, 2)
                    NewArray(iIndex, x, y).c = arrNext(x, y, 0).c
                    NewArray(iIndex, x, y).origx = arrNext(x, y, 0).origx
                    NewArray(iIndex, x, y).origy = arrNext(x, y, 0).origy
                Next y
            Next x
 
            ' get array rotated to angle+1
            ShearRotate arrMask(), arrNext(), angle + 1, iEmpty
 
            ' copy to mask array
            iIndex = arrMaskIndex(angle + 1)
            For x = LBound(arrNext, 1) To UBound(arrNext, 1)
                For y = LBound(arrNext, 2) To UBound(arrNext, 2)
                    NewArray(iIndex, x, y).c = arrNext(x, y, 0).c
                    NewArray(iIndex, x, y).origx = arrNext(x, y, 0).origx
                    NewArray(iIndex, x, y).origy = arrNext(x, y, 0).origy
                Next y
            Next x
 
        End If
    Next angle
 
End Sub ' GetRotationMasks
 
' /////////////////////////////////////////////////////////////////////////////
' Returns an array 0 to 360
' that returns the index of the mask array for the given angle
' for looking up the mask for a given angle in the mask array
' (a value 0 means no entry exists in the mask array)
 
' The values that matter are:
' arrMaskIndex( 29) = 1
' arrMaskIndex( 30) = 2
' arrMaskIndex( 31) = 3
' arrMaskIndex( 59) = 4
' arrMaskIndex( 60) = 5
' arrMaskIndex( 61) = 6
' arrMaskIndex(119) = 7
' arrMaskIndex(120) = 8
' arrMaskIndex(121) = 9
' arrMaskIndex(149) = 10
' arrMaskIndex(150) = 11
' arrMaskIndex(151) = 12
' arrMaskIndex(209) = 13
' arrMaskIndex(210) = 14
' arrMaskIndex(211) = 15
' arrMaskIndex(239) = 16
' arrMaskIndex(240) = 17
' arrMaskIndex(241) = 18
' arrMaskIndex(299) = 19
' arrMaskIndex(300) = 20
' arrMaskIndex(301) = 21
' arrMaskIndex(329) = 22
' arrMaskIndex(330) = 23
' arrMaskIndex(331) = 24
 
Sub GetMaskIndex (arrMaskIndex() As Integer)
    Dim iLoop%
    Dim iCount%
    ReDim arrMaskIndex(0 To 360) As Integer
 
    iCount% = -1
 
    For iLoop% = 0 To 360
        arrMaskIndex(iLoop%) = 0
    Next iLoop%
 
    For iLoop% = 0 To 359 Step 30
        If iLoop% Mod 90 <> 0 Then
            iCount% = iCount% + 3
            arrMaskIndex(iLoop% - 1) = iCount% - 1
            arrMaskIndex(iLoop% + 0) = iCount% + 0
            arrMaskIndex(iLoop% + 1) = iCount% + 1
        End If
    Next iLoop%
End Sub ' GetMaskIndex
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub GetMaskIndexTest
    Dim in$
    Dim iLoop%
    ReDim arrMaskIndex(-1) As Integer
 
    'Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    'Width 80, 80
 
    Print "Testing GetMaskIndex"
    GetMaskIndex arrMaskIndex()
    Print
    Print "GetMaskIndex arrMaskIndex()"
    Print "    LBound(arrMaskIndex) = " + cstr$(LBound(arrmaskindex))
    Print "    UBound(arrMaskIndex) = " + cstr$(UBound(arrmaskindex))
    Print
 
    Print "Testing problem angles:"
 
    For iLoop% = 0 To 360
        If IsProblemAngle%(iLoop%) Then
            If iLoop% - 1 >= LBound(arrmaskindex) And iLoop% + 1 <= UBound(arrmaskindex) Then
                Print "   angle-1, arrMaskIndex(" + cstr$(iLoop% - 1) + ") = " + cstr$(arrMaskIndex(iLoop% - 1))
                Print "   angle  , arrMaskIndex(" + cstr$(iLoop% + 0) + ") = " + cstr$(arrMaskIndex(iLoop% + 0))
                Print "   angle+1, arrMaskIndex(" + cstr$(iLoop% + 1) + ") = " + cstr$(arrMaskIndex(iLoop% + 1))
                Print
            Else
                Print "   angle " + cstr$(iLoop%) + "is  out of range."
                Print
            End If
        End If
    Next iLoop%
 
    Input "PRESS <ENTER> TO CONTINUE"; in$
End Sub ' GetMaskIndexTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "11111111111111111111111111111111" + Chr$(13) ' 1
    m$ = m$ + "4..............................2" + Chr$(13) ' 2
    m$ = m$ + "4....##.....#######.....####...2" + Chr$(13) ' 3
    m$ = m$ + "4...####....##...###...######..2" + Chr$(13) ' 4
    m$ = m$ + "4..##..##...##...###..##....##.2" + Chr$(13) ' 5
    m$ = m$ + "4.##....##..#######...##.......2" + Chr$(13) ' 6
    m$ = m$ + "4.########..#######...##.......2" + Chr$(13) ' 7
    m$ = m$ + "4.########..##...###..##....##.2" + Chr$(13) ' 8
    m$ = m$ + "4.##....##..##...###...######..2" + Chr$(13) ' 9
    m$ = m$ + "4.##....##..#######.....####...2" + Chr$(13) ' 10
    m$ = m$ + "4..............................2" + Chr$(13) ' 11
    m$ = m$ + "4..............................2" + Chr$(13) ' 12
    m$ = m$ + "4..ABBBBBBBBBBBBBBBBBBBBBBBBC..2" + Chr$(13) ' 13
    m$ = m$ + "4..A...........EE...........C..2" + Chr$(13) ' 14
    m$ = m$ + "4..A..........FFFF..........C..2" + Chr$(13) ' 15
    m$ = m$ + "4..A.........GGGGGG.........C..2" + Chr$(13) ' 16
    m$ = m$ + "4..A........HHHHHHHH........C..2" + Chr$(13) ' 17
    m$ = m$ + "4..A.......IIIIIIIIII.......C..2" + Chr$(13) ' 18
    m$ = m$ + "4..A......JJJJJJJJJJJJ......C..2" + Chr$(13) ' 19
    m$ = m$ + "4..DDDDDDDDDDDDDDDDDDDDDDDDDC..2" + Chr$(13) ' 20
    m$ = m$ + "4..............................2" + Chr$(13) ' 21
    m$ = m$ + "4..............................2" + Chr$(13) ' 22
    m$ = m$ + "4.######....########..########.2" + Chr$(13) ' 23
    m$ = m$ + "4.#######...########..########.2" + Chr$(13) ' 24
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 25
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 26
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 27
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 28
    m$ = m$ + "4.#######...##........##.......2" + Chr$(13) ' 29
    m$ = m$ + "4.######....########..##.......2" + Chr$(13) ' 30
    m$ = m$ + "4..............................2" + Chr$(13) ' 31
    m$ = m$ + "33333333333333333333333333333332" + Chr$(13) ' 32
    TestSprite1$ = m$
End Function ' TestSprite1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite2$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "...............AA..............." + Chr$(13) ' 1
    m$ = m$ + "..............//BB.............." + Chr$(13) ' 2
    m$ = m$ + ".............??..CC............." + Chr$(13) ' 3
    m$ = m$ + "............==....DD............" + Chr$(13) ' 4
    m$ = m$ + "...........++......EE..........." + Chr$(13) ' 5
    m$ = m$ + "..........&&........FF.........." + Chr$(13) ' 6
    m$ = m$ + ".........zz..........GG........." + Chr$(13) ' 7
    m$ = m$ + "........yy............HH........" + Chr$(13) ' 8
    m$ = m$ + ".......xx..............II......." + Chr$(13) ' 9
    m$ = m$ + "......ww................JJ......" + Chr$(13) ' 10
    m$ = m$ + ".....vv..................KK....." + Chr$(13) ' 11
    m$ = m$ + "....uu....................LL...." + Chr$(13) ' 12
    m$ = m$ + "...tt......DDAAAAAAA.......MM..." + Chr$(13) ' 13
    m$ = m$ + "..ss.......DDAAAAAAA........NN.." + Chr$(13) ' 14
    m$ = m$ + ".rr........DD.....BB.........OO." + Chr$(13) ' 15
    m$ = m$ + "qq.........DD.....BB..........PP" + Chr$(13) ' 16
    m$ = m$ + "pp.........DD.....BB..........QQ" + Chr$(13) ' 17
    m$ = m$ + ".oo........DD.....BB.........RR." + Chr$(13) ' 18
    m$ = m$ + "..nn.......CCCCCCCBB........SS.." + Chr$(13) ' 19
    m$ = m$ + "...mm......CCCCCCCBB.......TT..." + Chr$(13) ' 20
    m$ = m$ + "....ll....................UU...." + Chr$(13) ' 21
    m$ = m$ + ".....kk..................VV....." + Chr$(13) ' 22
    m$ = m$ + "......jj................WW......" + Chr$(13) ' 23
    m$ = m$ + ".......ii..............XX......." + Chr$(13) ' 24
    m$ = m$ + "........hh............YY........" + Chr$(13) ' 25
    m$ = m$ + ".........gg..........ZZ........." + Chr$(13) ' 26
    m$ = m$ + "..........ff........@@.........." + Chr$(13) ' 27
    m$ = m$ + "...........ee......##..........." + Chr$(13) ' 28
    m$ = m$ + "............dd....$$............" + Chr$(13) ' 29
    m$ = m$ + ".............cc..%%............." + Chr$(13) ' 30
    m$ = m$ + "..............bb\\.............." + Chr$(13) ' 31
    m$ = m$ + "...............aa..............." + Chr$(13) ' 32
    TestSprite2$ = m$
End Function ' TestSprite2$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function PetrText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "....It's a SCREEN resolution?..." + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    PetrText1$ = m$
End Function ' PetrText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToString$ (MyArray( 1 To 32 , 1 To 32) As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        MyString = MyString + sLine + Chr$(13)
    Next iY
    ArrayToString$ = MyString
End Function ' ArrayToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToStringTest$ (MyArray() As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
 
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    ArrayToStringTest$ = MyString
End Function ' ArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function RotationArrayToStringTest$ (RoArray() As RotationType)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    For iY = LBound(RoArray, 1) To UBound(RoArray, 1)
        sLine = ""
        sLine = sLine + Right$("    " + cstr$(iY), 3)
        For iX = LBound(RoArray, 2) To UBound(RoArray, 2)
            sLine = sLine + Chr$(RoArray(iX, iY, 0).c)
        Next iX
        sLine = sLine + Right$("   " + cstr$(iY), 3)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    RotationArrayToStringTest$ = MyString
End Function ' RotationArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
' 1. split string by line breaks CHR$(13)
' 2. split lines up to 1 column per char
' 3. count rows, columns
' 4. DIM array, making sure array has
'    a) an _ODD_ number of rows/columns, with a center point
'    b) index is in cartesian format, where center is (0,0)
' 5. populate array with contents of string
 
' dimension #1 = columns
' dimension #2 = rows
 
Sub StringToRotationArray (RoArray() As RotationType, MyString As String, EmptyChar As String)
    Dim RoutineName As String: RoutineName = "StringToRotationArray"
    ReDim arrLines$(0)
    Dim delim$
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iColCount As Integer
    Dim iRowCount As Integer
    Dim iCount As Integer
    Dim bAddedRow As Integer: bAddedRow = FALSE
    Dim bAddedColumn As Integer: bAddedColumn = FALSE
    Dim iHalf1 As Integer
    Dim iHalf2 As Integer
    Dim iFrom1 As Integer
    Dim iFrom2 As Integer
    Dim iTo1 As Integer
    Dim iTo2 As Integer
    Dim iEmpty As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
 
    iRowCount = UBound(arrLines$) + 1
 
    ' look at all the rows and find the max # of columns used
    iColCount = 0
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
 
        ' count the columns for this row
        iCount = 0
        For iCol% = 1 To Len(arrLines$(iRow%))
            iCount = iCount + 1
        Next iCol%
 
        ' if this row has the most so far, then set that to the max
        If iCount > iColCount Then
            iColCount = iCount
        End If
    Next iRow%
 
    ' adjust columns to be odd
    If IsEven%(iColCount) Then
        iColCount = iColCount + 1
        bAddedColumn = TRUE
    End If
 
    ' calculate array bounds for columns
    iHalf1 = (iColCount - 1) / 2
    iFrom1 = 0 - iHalf1
    iTo1 = iHalf1
 
    ' adjust rows to be odd
    If IsEven%(iRowCount) Then
        iRowCount = iRowCount + 1
        bAddedRow = TRUE
    End If
 
    ' calculate array bounds for rows
    iHalf2 = (iRowCount - 1) / 2
    iFrom2 = 0 - iHalf2
    iTo2 = iHalf2
 
    ' size array to new bounds
    ReDim RoArray(iFrom1 To iTo1, iFrom2 To iTo2, 127) As RotationType
 
    ' get value for empty
    If Len(EmptyChar) > 0 Then
        iEmpty = Asc(EmptyChar)
    Else
        iEmpty = 32 ' (use space as default)
    End If
 
    ' clear array
    For iY = LBound(RoArray, 2) To UBound(RoArray, 2)
        For iX = LBound(RoArray, 1) To UBound(RoArray, 1)
            RoArray(iX, iY, 0).c = iEmpty
            RoArray(iX, iY, 0).origx = iX
            RoArray(iX, iY, 0).origy = iY
        Next iX
    Next iY
 
    ' fill array
    iY = LBound(RoArray, 2) - 1
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        iY = iY + 1
        iX = LBound(RoArray, 1) - 1
        For iCol% = 1 To Len(arrLines$(iRow%))
            iX = iX + 1
            sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
            RoArray(iX, iY, 0).c = Asc(sChar$)
        Next iCol%
    Next iRow%
 
End Sub ' StringToRotationArray
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 29, 2021, 04:54:01 pm

Quote from: STxAxTIC on December 29, 2021, 10:24:13 am

So I have to do a bunch of reading to catch up to where the discussion is,
but I never mentioned how a certain experiment went the other day so I recreated it just now.
This is quick and dirty, not a solution, but maybe it'll inspire.

Final update for today, this adds ShearRotate6 (options 24 + 25 on the menu),
which uses precalculated matrices with a unique value for each point,
rotated to each problem angle (eg 30, 60, 120, etc.)
as well as the adjacent angles 29, 31, 59, 61, etc.)

If the rotation angle is the a problem angle,
it verifies for each unique point in the unrotated
matrix is found in the prerotated matrix for the desired angle.

If a point is NOT found,
it looks for it in the prerotated matrix
for angle-1 (if rotating counter-clockwise)
or angle +1 (if clockwise),
and if found, uses that coordinate to copy the point to in the destination.

If not found, it looks in the other direction (if clockwise, angle-1, etc.)
and uses that location if found.

If not found at all, it adds 1 to the count of total points not found.

It appears to work without errors, but the interesting thing is,
the results look worse than the earlier logic (SheerRotate4)
and it counts a lot more missing points (160 missing for SheerRotate6
vs 3 missing for SheerRotate4).

I'm not 100% sure there aren't errors in it somewhere,
or that the total is even correct, but the way it looks now,
the simpler dumber logic seems to work better...

Here is the code if you want to give it a try...

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Basic 2D plotting functions
' Version 1.00 by madscijr
' with help from various (sources cited below).
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS
' =============================================================================
 
' boolean constants
Const FALSE = 0
Const TRUE = Not FALSE
 
' rotational constants
Const cCounterClockwise = -1
Const cClockwise = 1
 
' -----------------------------------------------------------------------------
' USER DEFINED TYPES
' -----------------------------------------------------------------------------
Type RotationType
    origx As Integer
    origy As Integer
    c As Integer
    z As Integer ' which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
End Type ' RotationType
 
' -----------------------------------------------------------------------------
' GLOBAL VARIABLES
' -----------------------------------------------------------------------------
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_bDebug: m_bDebug = TRUE
 
' =============================================================================
' BEGIN MAIN PROGRAM
' =============================================================================
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' START THE MENU
main
 
' -----------------------------------------------------------------------------
' DONE
Print m_ProgramName$ + " finished."
'Screen 0
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
' -----------------------------------------------------------------------------
' EXIT
System ' return control to the operating system
End
 
' =============================================================================
' END MAIN PROGRAM
' =============================================================================
 
' /////////////////////////////////////////////////////////////////////////////
' MAIN MENU
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
 
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Some basic 2D plotting"
        Print
        Print " 1. PlotPointTest"
        Print " 2. PlotSquareTest"
        Print " 3. PlotCircleTest"
        Print " 4. PlotCircleTopLeftTest"
        Print " 5. PlotSemicircleTest"
        Print " 6. CircleFillTest"
        Print " 7. CircleFillTopLeftTest"
        Print " 8. SemiCircleFillTest"
        Print " 9. EllipseTest"
        Print "10. EllipseFillTest"
        Print "11. PlotLineTest"
        Print "12. ShearRotate1Test1"
        Print "13. ShearRotate1Test2 (auto advances 0-360 degrees)"
        Print "14. ShearRotate1Test2 (auto advances 0-360 degrees) (uses Petr's text)"
        Print "15. ShearRotate2Test1 (correct for missing points logic v1)"
        Print "16. ShearRotate2Test1 (correct for missing points logic v1) (uses Petr's text)"
        Print "17. ShearRotate3Test1 (correct for missing points logic v2)"
        Print "18. ShearRotate3Test1 (correct for missing points logic v2) (uses Petr's text)"
        Print "19. ShearRotate4Test1 (correct for missing points logic v3)"
        Print "20. ShearRotate4Test1 (correct for missing points logic v3) (uses Petr's text)"
        Print "21. ShearRotate5Test1 (correct for missing points, STxAxTIC logic)"
        Print "22. ShearRotate5Test1 (correct for missing points, STxAxTIC logic) (uses Petr's text)"
        Print "23. GetRotationMaskTest"
        Print "24. ShearRotate6Test1 (corrects for missing points using precalculated v1)"
        Print "25. ShearRotate6Test1 (corrects for missing points using precalculated v1) (uses Petr's text)"
 
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(_Trim$(in$))
 
        If in$ = "1" Then
            PlotPointTest
        ElseIf in$ = "2" Then
            PlotSquareTest
        ElseIf in$ = "3" Then
            PlotCircleTest
        ElseIf in$ = "4" Then
            PlotCircleTopLeftTest
        ElseIf in$ = "5" Then
            PlotSemicircleTest
        ElseIf in$ = "6" Then
            CircleFillTest
        ElseIf in$ = "7" Then
            CircleFillTopLeftTest
        ElseIf in$ = "8" Then
            SemiCircleFillTest
        ElseIf in$ = "9" Then
            EllipseTest
        ElseIf in$ = "10" Then
            EllipseFillTest
        ElseIf in$ = "11" Then
            PlotLineTest
        ElseIf in$ = "12" Then
            ShearRotate1Test1
        ElseIf in$ = "13" Then
            ShearRotate1Test2 TestSprite1$
        ElseIf in$ = "14" Then
            ShearRotate1Test2 PetrText1$
        ElseIf in$ = "15" Then
            ShearRotate2Test1 TestSprite1$
        ElseIf in$ = "16" Then
            ShearRotate2Test1 PetrText1$
        ElseIf in$ = "17" Then
            ShearRotate3Test1 TestSprite1$
        ElseIf in$ = "18" Then
            ShearRotate3Test1 PetrText1$
        ElseIf in$ = "19" Then
            ShearRotate4Test1 TestSprite1$
        ElseIf in$ = "20" Then
            ShearRotate4Test1 PetrText1$
        ElseIf in$ = "21" Then
            ShearRotate5Test1 TestSprite1$
        ElseIf in$ = "22" Then
            ShearRotate5Test1 PetrText1$
        ElseIf in$ = "23" Then
            GetRotationMaskTest
        ElseIf in$ = "24" Then
            ShearRotate6Test1 TestSprite1$
        ElseIf in$ = "25" Then
            ShearRotate6Test1 PetrText1$
        End If
    Loop Until in$ = "q"
End Sub ' main
 
 
 
 
 
 
 
 
 
 
 
' /////////////////////////////////////////////////////////////////////////////
' MyArray(1 To 32, 1 To 32) AS STRING
' where index is MyArray(Y, X)
 
Sub PlotPoint (X As Integer, Y As Integer, S As String, MyArray() As String)
    _Echo "PlotPoint X=" + cstr$(X) + ", Y=" + cstr$(Y) + ", S=" + Chr$(34) + S + Chr$(34) + ", MyArray()"
    If (X >= LBound(MyArray, 2)) Then
        If (X <= UBound(MyArray, 2)) Then
            If (Y >= LBound(MyArray, 1)) Then
                If (Y <= UBound(MyArray, 1)) Then
                    If Len(S) = 1 Then
                        MyArray(Y, X) = S
                    Else
                        If Len(S) > 1 Then
                            MyArray(Y, X) = Left$(S, 1)
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub ' PlotPoint
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotPointTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a point."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type x,y (1-32, 1-32) coordinate to plot point at."
        Input "X,Y OR 0 TO QUIT? "; X, Y
        If X > 0 And Y > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X) + ", Y=" + cstr$(Y)
            PlotPoint X, Y, Chr$(iChar), MyArray()
 
            Print "Current point plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotPointTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquare (X1 As Integer, Y1 As Integer, L As Integer, S As String, MyArray() As String)
    Dim X As Integer
    Dim X2 As Integer
    Dim Y As Integer
    Dim Y2 As Integer
    Dim sChar$
 
    If Len(S) = 1 Then
        sChar$ = S
    Else
        If Len(S) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(S, 1)
        End If
    End If
 
    X2 = (X1 + L) - 1
    Y2 = (Y1 + L) - 1
    For X = X1 To X2
        For Y = Y1 To Y2
            PlotPoint X, Y, sChar$, MyArray()
        Next Y
    Next X
End Sub ' PlotSquare
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSquareTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim L As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Enter parameters to draw a square."
    Print ArrayToStringTest(MyArray())
    Print
    Do
        Print "Type top left x,y (1-32, 1-32) coordinate to plot square,"
        Print "and size (1-32) of square."
        Input "X,Y,L OR 0 TO QUIT? "; X, Y, L
        If X > 0 And Y > 0 And L > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "L=" + cstr$(L)
            Print
            PlotSquare X, Y, L, Chr$(iChar), MyArray()
 
            Print "Square plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotSquareTest
 
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
 
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
 
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
 
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM  : FAST CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
 
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
 
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
 
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM  : SLOW CIRCLE DRAWING
'3 REM AUTHOR   : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
 
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK   1 (drawing a pixel), 0 (erasing a pixel)
' X     X coordinate of the pixel
' Y     Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
 
' More on plotting circles:
'     Drawing a circle in BASIC - fast
'     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
 
' X,Y     = center point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircle (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        B = R
        C = 0
        A = R - 1
        Do
            PlotPoint X + C, Y + B, S2, MyArray()
            PlotPoint X + C, Y - B, S2, MyArray()
            PlotPoint X - C, Y - B, S2, MyArray()
            PlotPoint X - C, Y + B, S2, MyArray()
            PlotPoint X + B, Y + C, S2, MyArray()
            PlotPoint X + B, Y - C, S2, MyArray()
            PlotPoint X - B, Y - C, S2, MyArray()
            PlotPoint X - B, Y + C, S2, MyArray()
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then ' IF A>=0 THEN 190
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do ' 190 IF B>=C THEN 60
        Loop
    End If
End Sub ' PlotCircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a raster circle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotCircle X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotCircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' X,Y     = top left point of circle
' R       = radius
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotCircleTopLeft (X As Integer, Y As Integer, R As Integer, S As String, MyArray() As String)
    Dim RoutineName As String: RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    ' Get total width
    W = (R * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
            PlotPoint R + C, R + B, S2, arrTemp() ' 1
            PlotPoint R + C, R - B, S2, arrTemp() ' 2
            PlotPoint R - C, R - B, S2, arrTemp() ' 3
            PlotPoint R - C, R + B, S2, arrTemp() ' 4
            PlotPoint R + B, R + C, S2, arrTemp() ' 5
            PlotPoint R + B, R - C, S2, arrTemp() ' 6
            PlotPoint R - B, R - C, S2, arrTemp() ' 7
            PlotPoint R - B, R + C, S2, arrTemp() ' 8
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
 
        ' Copy circle to destination Y,X
        For DY = LBound(arrTemp, 1) To UBound(arrTemp, 1)
            For DX = LBound(arrTemp, 2) To UBound(arrTemp, 2)
                If Len(arrTemp(DY, DX)) > 0 Then
                    TY = Y + DY
                    If TY >= MinY Then
                        If TY <= MaxY Then
                            TX = X + DX
                            If TX >= MinX Then
                                If TX <= MaxX Then
                                    MyArray(TY, TX) = arrTemp(DY, DX)
                                End If
                            End If
                        End If
                    End If
 
                End If
            Next DX
        Next DY
    End If
End Sub ' PlotCircleTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotCircleTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a raster circle, specifying top left x,y position"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotCircleTopLeft X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotCircleTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on PlotCircleTopLeft.
 
' X,Y     = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
' .......4444111.......
' .....44.......11.....
' ....4...........1....
' ...4.............1...
' ..4...............1..
' .4.................1.
' .4.................1.
' 4...................1
' 4...................1
' 4...................1
' 3...................1
' 3...................2
' 3...................2
' 3...................2
' .3.................2.
' .3.................2.
' ..3...............2..
' ...3.............2...
' ....3...........2....
' .....33.......22.....
' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot circle in
 
Sub PlotSemicircle (X As Integer, Y As Integer, R As Integer, Q As Integer, S As String, MyArray() As String)
    Dim RoutineName As String: RoutineName = "PlotCircleTopLeft"
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim S2 As String
    Dim W As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    ' Get total width
    W = (R * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    If Len(S) = 1 Then
        S2 = S
    Else
        If Len(S) = 0 Then
            S2 = " "
        Else
            S2 = Left$(S, 1)
        End If
    End If
 
    If R > 0 Then
        ' Draw circle to temporary array
        B = R
        C = 0
        A = R - 1
        Do
            ' PORTIONS OF CIRCLE:
            ' .......3333222.......
            ' .....33.......22.....
            ' ....3...........2....
            ' ...7.............6...
            ' ..7...............6..
            ' .7.................6.
            ' .7.................6.
            ' 7...................6
            ' 7...................6
            ' 7...................6
            ' 8...................6
            ' 8...................5
            ' 8...................5
            ' 8...................5
            ' .8.................5.
            ' .8.................5.
            ' ..8...............5..
            ' ...8.............5...
            ' ....4...........1....
            ' .....44.......11.....
            ' .......4444111.......
 
            ' JUST PLOT SELECTED QUADRANT:
            Select Case Q
                Case 1:
                    ' quadrant #1
                    PlotPoint C, R - B, S2, arrTemp() ' 2
                    PlotPoint B, R - C, S2, arrTemp() ' 6
                Case 2:
                    ' quadrant #2
                    PlotPoint B, C, S2, arrTemp() ' 5
                    PlotPoint C, B, S2, arrTemp() ' 1
                Case 3:
                    ' quadrant #3
                    PlotPoint R - C, B, S2, arrTemp() ' 4
                    PlotPoint R - B, C, S2, arrTemp() ' 8
                Case 4:
                    ' quadrant #4
                    PlotPoint R - B, R - C, S2, arrTemp() ' 7
                    PlotPoint R - C, R - B, S2, arrTemp() ' 3
                Case Else:
                    ' (DO NOTHING)
            End Select
 
            '' PLOT CIRCLE:
            '' quadrant #1
            'PlotPoint R + C, R - B, S2, arrTemp() ' 2
            'PlotPoint R + B, R - C, S2, arrTemp() ' 6
            '
            '' quadrant #2
            'PlotPoint R + B, R + C, S2, arrTemp() ' 5
            'PlotPoint R + C, R + B, S2, arrTemp() ' 1
            '
            '' quadrant #3
            'PlotPoint R - C, R + B, S2, arrTemp() ' 4
            'PlotPoint R - B, R + C, S2, arrTemp() ' 8
            '
            '' quadrant #4
            'PlotPoint R - B, R - C, S2, arrTemp() ' 7
            'PlotPoint R - C, R - B, S2, arrTemp() ' 3
 
            C = C + 1
            A = A + 1 - C - C
            If A < 0 Then
                B = B - 1
                A = A + B + B
            End If
            If B < C Then Exit Do
        Loop
 
        ' Copy semicircle to destination Y,X
        For DY = LBound(arrTemp, 1) To UBound(arrTemp, 1)
            For DX = LBound(arrTemp, 2) To UBound(arrTemp, 2)
                If Len(arrTemp(DY, DX)) > 0 Then
                    TY = Y + DY
                    If TY >= MinY Then
                        If TY <= MaxY Then
                            TX = X + DX
                            If TX >= MinX Then
                                If TX <= MaxX Then
                                    MyArray(TY, TX) = arrTemp(DY, DX)
                                End If
                            End If
                        End If
                    End If
                End If
            Next DX
        Next DY
    End If
End Sub ' PlotSemicircle
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotSemicircleTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a semicircle"
    Print "Based on Fast circle drawing in pure Atari BASIC by Zlatko Bleha."
    Print
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            PlotSemicircle X, Y, R, Q, Chr$(iChar), MyArray()
 
            Print "Semicircle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' PlotSemicircleTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg1913#msg1913
 
' From: SMcNeill
' Date: « Reply #30 on: June 26, 2018, 03:34:18 pm »
'
' Sometimes, computers do things that are completely counter-intuitive to us, and
' we find ourselves having to step back as programmers and simply say, "WOW!!"
' Here's a perfect example of that:
' Here we look at two different circle fill routines -- one, which I'd assume to
' be faster, which precalculates the offset needed to find the endpoints for each
' line which composes a circle, and another, which is the same old CircleFill
' program which I've shared countless times over the years with people on various
' QB64 forums.
'
' When all is said and done though, CircleFill is STILL even faster than
' CircleFillFast, which pregenerates those end-points for us!
 
' CX,CY     = center point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, S As String, MyArray() As String)
    Dim Radius As Integer
    Dim RadiusError As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
 
    If Radius = 0 Then
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        Exit Sub
    End If
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    For iLoopX = CX - X To CX + X
        PlotPoint iLoopX, CY, S, MyArray()
    Next iLoopX
 
    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
                iLoopY = CY - X
                For iLoopX = CX - Y To CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                Next iLoopX
 
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                iLoopY = CY + X
                For iLoopX = CX - Y To CX + Y
                    PlotPoint iLoopX, iLoopY, S, MyArray()
                Next iLoopX
            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
        iLoopY = CY - Y
        For iLoopX = CX - X To CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopX
 
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        iLoopY = CY + Y
        For iLoopX = CX - X To CX + X
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopX
    Wend
End Sub ' CircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a filled circle"
    Print "Based on CircleFill by SMcNeill."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            'PlotCircle X, Y, R, Chr$(iChar), MyArray()
            CircleFill X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' CircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotCircleTopLeft.
' CX,CY     = top left point of circle
' R         = radius
' S         = char to draw
' MyArray = 2D string array to plot circle in
 
Sub CircleFillTopLeft (CX As Integer, CY As Integer, R As Integer, S As String, MyArray() As String)
    Dim Radius As Integer
    Dim RadiusError As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim W As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
 
    If Radius = 0 Then
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        Exit Sub
    End If
 
    ' Get total width
    W = (Radius * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    For iLoopX = R - X To R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    Next iLoopX
 
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
 
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
 
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
    Wend
 
    ' Copy circle to destination Y,X
    For DY = LBound(arrTemp, 1) To UBound(arrTemp, 1)
        For DX = LBound(arrTemp, 2) To UBound(arrTemp, 2)
            If Len(arrTemp(DY, DX)) > 0 Then
                TY = DY + CY
                If TY >= MinY Then
                    If TY <= MaxY Then
                        TX = DX + CX
                        If TX >= MinX Then
                            If TX <= MaxX Then
                                MyArray(TY, TX) = arrTemp(DY, DX)
                            End If
                        End If
                    End If
                End If
            End If
        Next DX
    Next DY
 
End Sub ' CircleFillTopLeft
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub CircleFillTopLeftTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a solid circle, specifying top left x,y position"
    Print "Based on CircleFill by SMcNeill."
    Print
    Print "Enter parameters to draw a circle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot circle,"
        Print "and radius (1-32) of circle."
        Input "X,Y,R OR 0 TO QUIT: "; X, Y, R
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            CircleFillTopLeft X, Y, R, Chr$(iChar), MyArray()
 
            Print "Circle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' CircleFillTopLeftTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on CircleFill and PlotSemiCircle
 
' CX,CY   = top left point of circle
' R       = radius
' Q       = which quarter of the circle to return semicircle from
'           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
'           like this:
' .......4444111.......
' .....44444411111.....
' ....4444444111111....
' ...444444441111111...
' ..44444444411111111..
' .4444444444111111111.
' .4444444444111111111.
' 444444444441111111111
' 444444444441111111111
' 444444444441111111111
' 333333333331111111111
' 333333333332222222222
' 333333333332222222222
' 333333333332222222222
' .3333333333222222222.
' .3333333333222222222.
' ..33333333322222222..
' ...333333332222222...
' ....3333333222222....
' .....33333322222.....
' .......3333222.......
' S       = char to draw
' MyArray = 2D string array to plot semicircle in
 
Sub SemiCircleFill (CX As Integer, CY As Integer, R As Integer, Q As Integer, S As String, MyArray() As String)
    Dim Radius As Integer
    Dim RadiusError As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
    ReDim arrTemp(0, 0) As String
    Dim DY As Integer
    Dim DX As Integer
    Dim W As Integer
    Dim AX As Integer
    Dim AY As Integer
    Dim TX As Integer
    Dim TY As Integer
    Dim MinY As Integer
    Dim MaxY As Integer
    Dim MinX As Integer
    Dim MaxX As Integer
 
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
 
    If Radius = 0 Then
        'PSET (CX, CY), C
        'PlotPoint CX, CY, S, MyArray()
        Exit Sub
    End If
 
    ' Get total width
    W = (Radius * 2) + 1
 
    ' Define a temp array
    ReDim arrTemp(0 To W, 0 To W) As String
 
    ' Get minimum X, Y of target array
    MinY = LBound(MyArray, 1)
    MaxY = UBound(MyArray, 1)
    MinX = LBound(MyArray, 2)
    MaxX = UBound(MyArray, 2)
 
    ' Temp array's lbound is 0
    ' Calculate difference from MyArray the indices of arrTemp are
    AY = 0 - MinY
    AX = 0 - MinX
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    'LINE (CX - X, CY)-(CX + X, CY), C, BF
    'FOR iLoopX = CX - X TO CX + X
    For iLoopX = R - X To R + X
        'PlotPoint iLoopX, CY, S, MyArray()
        'PlotPoint iLoopX, CY, S, arrTemp()
        PlotPoint iLoopX, R, S, arrTemp()
    Next iLoopX
 
    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
                'iLoopY = CY - X
                iLoopY = R - X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
 
                'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
                'iLoopY = CY + X
                iLoopY = R + X
                'FOR iLoopX = CX - Y TO CX + Y
                For iLoopX = R - Y To R + Y
                    'PlotPoint iLoopX, iLoopY, S, MyArray()
                    PlotPoint iLoopX, iLoopY, S, arrTemp()
                Next iLoopX
            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
        'iLoopY = CY - Y
        iLoopY = R - Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
 
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
        'iLoopY = CY + Y
        iLoopY = R + Y
        'FOR iLoopX = CX - X TO CX + X
        For iLoopX = R - X To R + X
            'PlotPoint iLoopX, iLoopY, S, MyArray()
            PlotPoint iLoopX, iLoopY, S, arrTemp()
        Next iLoopX
    Wend
 
    '_echo "MyArray(" + _Trim$(Str$(lbound(MyArray,1))) + " To " + _Trim$(Str$(ubound(MyArray,1))) + ", " + _Trim$(Str$(lbound(MyArray,2))) + " To " + _Trim$(Str$(ubound(MyArray,2))) + ")"
 
    ' Copy semicircle to destination Y,X
    ' JUST COPY SELECTED QUADRANT:
    Select Case Q
        Case 1:
            ' quadrant #1
            For DY = 0 To Radius
                For DX = Radius To W
                    '_echo "DY=" + cstr$(DY) + ", DX=" + cstr$(DX)
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY + CY) - (AY + 1)
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX - Radius) - AX
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case 2:
            ' quadrant #2
            For DY = Radius To W
                For DX = Radius To W
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY - Radius) - AY
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX - Radius) - AX
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case 3:
            ' quadrant #3
            For DY = Radius To W
                For DX = 0 To Radius
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY - Radius) - AY
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX + CX) - (AX + 1)
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case 4:
            ' quadrant #4
            For DY = 0 To Radius
                For DX = 0 To Radius
                    If Len(arrTemp(DY, DX)) > 0 Then
                        TY = (DY + CY) - (AY + 1)
                        If TY >= MinY Then
                            If TY <= MaxY Then
                                TX = (DX + CX) - (AX + 1)
                                If TX >= MinX Then
                                    If TX <= MaxX Then
                                        MyArray(TY, TX) = arrTemp(DY, DX)
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next DX
            Next DY
        Case Else:
            ' (DO NOTHING)
    End Select
 
    '' Copy circle to destination:
    'For DY = lbound(arrTemp, 1) to ubound(arrTemp, 1)
    '    For DX = lbound(arrTemp, 2) to ubound(arrTemp, 2)
    '        IF LEN(arrTemp(DY, DX)) > 0 THEN
    '            MyArray(DY + CY, DX + CX) = arrTemp(DY, DX)
    '        END IF
    '    Next DX
    'Next DY
 
End Sub ' SemiCircleFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SemiCircleFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim Q As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a solid semicircle"
    Print "Based on CircleFill by SMcNeill."
    Print
    Print "Enter parameters to draw a semicircle."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type top left point x,y (1-32, 1-32) coordinate to plot semicircle,"
        Print "radius (1-32) of semicircle, and quadrant of circle to use:"
        Print "41"
        Print "32"
        Input "X,Y,R,Q OR 0 TO QUIT: "; X, Y, R, Q
        If X > 0 And Y > 0 And R > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X=" + cstr$(X)
            Print "Y=" + cstr$(Y)
            Print "R=" + cstr$(R)
 
            SemiCircleFill X, Y, R, Q, Chr$(iChar), MyArray()
 
            Print "Semicircle plotted (from top left), drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' SemiCircleFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
 
Sub Ellipse (CX As Integer, CY As Integer, xRadius As Integer, yRadius As Integer, S As String, MyArray() As String)
    Dim scale As Single
    Dim xs As Integer
    Dim x As Integer
    Dim y As Integer
    Dim lastx As Integer
    Dim lasty As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    scale = yRadius / xRadius
    xs = xRadius * xRadius
 
    'PSET (CX, CY - yRadius)
    PlotPoint CX, CY - yRadius, S, MyArray()
 
    'PSET (CX, CY + yRadius)
    PlotPoint CX, CY + yRadius, S, MyArray()
 
    lastx = 0: lasty = yRadius
    For x = 1 To xRadius
        y = scale * Sqr(xs - x * x)
        'LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)
        PlotLine CX + lastx, CY - lasty, CX + x, CY - y, S, MyArray()
 
        'LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)
        PlotLine CX + lastx, CY + lasty, CX + x, CY + y, S, MyArray()
 
        'LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)
        PlotLine CX - lastx, CY - lasty, CX - x, CY - y, S, MyArray()
 
        'LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)
        PlotLine CX - lastx, CY + lasty, CX - x, CY + y, S, MyArray()
 
        lastx = x
        lasty = y
    Next x
End Sub ' Ellipse
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot an ellipse"
    Print "Based on ellipse by bplus."
    Print
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 And Y > 0 And RX > 0 And RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
 
            Ellipse X, Y, RX, RY, Chr$(iChar), MyArray()
 
            Print "Ellipse plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' EllipseTest
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg3588#msg3588
 
' From: bplus
' Date: « Reply #59 on: August 30, 2018, 09:18:34 am »
'
' Here is my ellipse and filled ellipse routines, no where near
' Steve's level of performance. The speed is cut in half at
' least because you probably have to do a whole quadrants worth
' of calculations (ellipse not as symmetric as circle).
'
' But I am sure this code can be optimized more than it is:
 
Sub EllipseFill (CX As Integer, CY As Integer, xRadius As Integer, yRadius As Integer, S As String, MyArray() As String)
    Dim scale As Single
    Dim x As Integer
    Dim y As Integer
    Dim iLoopX As Integer
    Dim iLoopY As Integer
 
    scale = yRadius / xRadius
 
    'LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    For iLoopY = CY - yRadius To CY + yRadius
        PlotPoint CX, iLoopY, S, MyArray()
    Next iLoopY
 
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
 
        'LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
        iLoopX = CX + x
        For iLoopY = CY - y To CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopY
 
        'LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
        iLoopX = CX - x
        For iLoopY = CY - y To CY + y
            PlotPoint iLoopX, iLoopY, S, MyArray()
        Next iLoopY
    Next x
End Sub ' EllipseFill
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub EllipseFillTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim iX As Integer
    Dim iY As Integer
    Dim in$
    Dim X As Integer
    Dim Y As Integer
    Dim RX As Integer
    Dim RY As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot a filled ellipse"
    Print "Based on fellipse by bplus."
    Print
    Print "Enter parameters to draw an ellipse."
    Print ArrayToStringTest(MyArray())
    Print
 
    Do
        Print "Type center point x,y (1-32, 1-32) coordinate to plot ellipse,"
        Print "and x radius (1-32) and y radius (1-32) of ellipse."
        Input "X,Y,RX,RY OR 0 TO QUIT: "; X, Y, RX, RY
        If X > 0 And Y > 0 And RX > 0 And RY > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X =" + cstr$(X)
            Print "Y =" + cstr$(Y)
            Print "RX=" + cstr$(RX)
            Print "RY=" + cstr$(RY)
 
            EllipseFill X, Y, RX, RY, Chr$(iChar), MyArray()
 
            Print "Ellipse plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
            Print
        Else
            Exit Do
        End If
    Loop
 
End Sub ' EllipseFillTest
 
' /////////////////////////////////////////////////////////////////////////////
' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
' From: http://www.thedubber.altervista.org/qbsrc.htm
 
Sub PlotLine (x1%, y1%, x2%, y2%, c$, MyArray() As String)
    Dim iLoop%
    Dim steep%: steep% = 0
    Dim ev%: ev% = 0
    Dim sx%
    Dim sy%
    Dim dx%
    Dim dy%
 
    If (x2% - x1%) > 0 Then
        sx% = 1
    Else
        sx% = -1
    End If
 
    dx% = Abs(x2% - x1%)
    If (y2% - y1%) > 0 Then
        sy% = 1
    Else
        sy% = -1
    End If
 
    dy% = Abs(y2% - y1%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x1%, y1%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
 
    ev% = 2 * dy% - dx%
    For iLoop% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y1%, x1%), c%:
            'LOCATE y1%, x1%
            'PRINT c$;
            PlotPoint y1%, x1%, c$, MyArray()
        Else
            ''PSET (x1%, y1%), c%
            'LOCATE x1%, y1%
            'PRINT c$;
            PlotPoint x1%, y1%, c$, MyArray()
        End If
 
        While ev% >= 0
            y1% = y1% + sy%
            ev% = ev% - 2 * dx%
        Wend
        x1% = x1% + sx%
        ev% = ev% + 2 * dy%
    Next iLoop%
    ''PSET (x2%, y2%), c%
    'LOCATE x2%, y2%
    'PRINT c$;
    PlotPoint x2%, y2%, c$, MyArray()
End Sub ' PlotLine
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub PlotLineTest
    Dim MyArray(1 To 32, 1 To 32) As String
    Dim in$
    Dim X1 As Integer
    Dim Y1 As Integer
    Dim X2 As Integer
    Dim Y2 As Integer
    Dim iChar As Integer
 
    ClearArray MyArray(), "."
    iChar = 64
 
    Cls
    Print "Plot line with Bresenham Algorithm"
    Print "based on BRESNHAM.BAS by Kurt Kuzba (4/16/96)."
    Print
    Print ArrayToStringTest(MyArray())
    Do
        Print "Enter coordinate values for "
        Print "line start point x1, y1 (1-32, 1-32)"
        Print "line end   point x2, y2 (1-32, 1-32)"
        Input "ENTER X1,Y1,X2,Y2 OR 0 TO QUIT: "; X1, Y1, X2, Y2
        If X1 > 0 And Y1 > 0 And X2 > 0 And Y2 > 0 Then
            iChar = iChar + 1
            If iChar > 90 Then iChar = 65
 
            Print "X1=" + cstr$(X1)
            Print "Y1=" + cstr$(Y1)
            Print "X2=" + cstr$(X2)
            Print "Y2=" + cstr$(Y2)
 
            PlotLine X1, Y1, X2, Y2, Chr$(iChar), MyArray()
 
            Print "Line plotted, drawn with " + Chr$(34) + Chr$(iChar) + Chr$(34) + ":"
            Print ArrayToStringTest(MyArray())
 
        Else
            Exit Do
        End If
    Loop
End Sub ' PlotLineTest
 
' /////////////////////////////////////////////////////////////////////////////
' 3 shear method testing
 
' _PUT Rotation Help
' https://www.qb64.org/forum/index.php?topic=1959.0
 
' 3 Shear Rotation - rotates without any aliasing(holes)
' https://www.freebasic.net/forum/viewtopic.php?t=24557
 
' From: leopardpm
' Date: Apr 02, 2016 1:21
' Last edited by leopardpm on Apr 02, 2016 17:18, edited 1 time in total.
'
' This is just a little 3-shear rotation routine
' (I am using 3-shear because it leaves no gaps/aliasing)
' that I was wondering if anyone sees how to make it faster.
' Obviously, I am just thinking about inside the double loop.
 
' Thanks again to BasicCoder2 for linking me to this little routine, it is wonderful so far!
 
'''                      roto-zooming algorithm
'''                    coded by Michael S. Nissen
'''                        jernmager@yahoo.dk
'
''' ===============================================================
''' Recoded to run on FBC 32/64 bit WIN, Version 1.05.0, 2016, by MrSwiss
''' Heavy flickering before going Full-Screen on 64 Bit !!!
''' This seems NOT to be the Case on 32 Bit ...
''' ===============================================================
'
'Type Pixel
'  As Single   X, Y
'  As ULong    C
'End Type
'
'''  dim vars
'Dim shared as Any Ptr Img_Buffer
'''  write the name of the .bmp image you want to rotozoom here:
'''  (it has to be sqare ie. 100x100 pixels, 760x760 pixels or whatever)
'Dim As String Img_Name = "phobos.bmp"
'Dim shared as Integer X_Mid, Y_Mid, scrn_wid, scrn_hgt, P1, P2, P3, P4, C
'Dim shared as Short Img_Hgt, Img_Wid, Img_Lft, Img_Rgt, Img_Top, Img_Btm, X, Y
'Dim Shared As Single Cos_Ang, Sin_Ang, Rot_Fac_X, Rot_Fac_Y, Angle = 0, Scale = 1
'
''' changed Function to Sub (+ recoded arguments list)
'Sub Calc_rotozoom ( ByRef Cos_Ang As Single, _
'               ByRef Sin_Ang As Single, _
'               ByVal S_Fact  As Single, _
'               ByVal NewAng  As Single )
'  Cos_Ang = Cos(NewAng)*S_Fact
'  Sin_Ang = Sin(NewAng)*S_Fact
'End Sub
'
'''  full screen
'ScreenInfo scrn_wid, scrn_hgt
'screenRes scrn_wid, scrn_hgt, 32,,1
'
'''  dim screenpointer (has to be done after screenres)
'Dim As ULong Ptr Scrn_Ptr = Screenptr
'
'''  place image in center of screen
'X_Mid = scrn_wid\2
'Y_Mid = scrn_hgt\2
'Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'
'''  find image dimensions
'Open Img_Name For Binary As #1
'Get #1, 19, Img_Wid
'Get #1, 23, Img_Hgt
'Close #1
'
'''  prepare to dim the array that will hold the image.
'Img_Rgt = (Img_Wid-1)\2
'Img_Lft = -Img_Rgt
'Img_Btm = (Img_Hgt-1)\2
'Img_Top = -Img_Btm
'
'''  dim array to hold image. Note: pixel (0, 0) is in the center.
'Dim As Pixel Pixel(Img_Lft to Img_Rgt, Img_Top to Img_Btm)
'
'''  imagecreate sprite and load image to sprite
'Img_Buffer = ImageCreate (Img_Wid, Img_Hgt)
'Bload (Img_Name, Img_Buffer)
'
'''  load image from sprite to array with point command
'For Y = Img_Top to Img_Btm
'  For X = Img_Lft to Img_Rgt
'    With Pixel(X, Y)
'      .X = X_Mid+X
'      .Y = Y_Mid+Y
'      C = Point (X-Img_Top, Y-Img_Lft, Img_buffer)
'      If C <> RGB(255, 0, 255) Then
'        .C = C
'      Else
'        .C = RGB(0, 0, 0)
'      End If
'    End With
'  Next X
'Next Y
'
'''  we don't need the sprite anymore, kill it
'ImageDestroy Img_Buffer
'Img_Buffer = 0
'
'''  main program loop
'Do
'
'  ''  scale in/out with uparrow/downarrow
'  If Multikey(80) Then
'    Scale *= 1.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(72) Then
'    Scale *= 0.97
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  rotate left/right with leftarrow/rightarrow
'  If Multikey(77) Then
'    Angle -= 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  ElseIf Multikey(75) Then
'    Angle += 0.03
'    Calc_rotozoom(Cos_Ang, Sin_Ang, Scale, Angle)
'  End If
'
'  ''  lock screen in order to use screen pointers
'  ScreenLock
'
'    ''  draw pixel in center of image
'    Scrn_Ptr[ X_Mid + Y_Mid * scrn_wid ] = Pixel(0, 0).C
'    ''  draw all other pixels - 4 at a time
'    For Y = Img_Top to 0
'      For X = Img_Lft to -1
'        ''  find pixel positions
'        P1 = (X_Mid+X) + (Y_Mid+Y) * scrn_wid
'        P2 = (X_Mid-X) + (Y_Mid-Y) * scrn_wid
'        P3 = (X_Mid+Y) + (Y_Mid-X) * scrn_wid
'        P4 = (X_Mid-Y) + (Y_Mid+X) * scrn_wid
'        ''  erase old pixels (paint them black)
'        Scrn_Ptr[P1] = 0
'        Scrn_Ptr[P2] = 0
'        Scrn_Ptr[P3] = 0
'        Scrn_Ptr[P4] = 0
'        ''  rotate and zoom
'        Rot_Fac_X = X*Cos_Ang - Y*Sin_Ang
'        Rot_Fac_Y = X*Sin_Ang + Y*Cos_Ang
'        If Rot_Fac_X < Img_Lft Or Rot_Fac_X > Img_Rgt Then Continue For
'        If Rot_Fac_Y < Img_Top Or Rot_Fac_Y > Img_Btm Then Continue For
'        ''  draw new pixels
'        Scrn_Ptr[P1] = Pixel(Rot_Fac_X, Rot_Fac_Y).C
'        Scrn_Ptr[P2] = Pixel(-Rot_Fac_X, -Rot_Fac_Y).C
'        Scrn_Ptr[P3] = Pixel(Rot_Fac_Y, -Rot_Fac_X).C
'        Scrn_Ptr[P4] = Pixel(-Rot_Fac_Y, Rot_Fac_X).C
'      Next X
'    Next Y
'
'  ScreenUnLock
'
'  Sleep 10, 1
'Loop Until InKey() = Chr(27)
 
' UPDATES:
' Fixed bug where values 135, 224, and 314 all resolve to -45 degrees.
' Fixed bug where an angle of 46-135 degrees caused the image to be flipped wrong.
 
' TODO:
' Fix issue where image looks bad at 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
Sub ShearRotate (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate
 
' /////////////////////////////////////////////////////////////////////////////
' Same as ShearRotate, except adds iOverwriteCount parameter,
' and counts how many points are overwriting existing points,
' and return that value byref in parameter iOverwriteCount.
 
Sub ShearRotate1 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iOverwriteCount As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    iOverwriteCount = 0
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
 
                    ' count points that will be overwritten
                    If NewArray(fx, fy, 0).c <> iEmpty Then
                        iOverwriteCount = iOverwriteCount + 1
                    End If
 
                    NewArray(fx, fy, 0).c = clr
                    NewArray(fx, fy, 0).origx = fx
                    NewArray(fx, fy, 0).origy = fy
                End If
            End If
        Next x
    Next y
End Sub ' ShearRotate1
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ShearRotate1Test1
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    Dim sMap As String
    Dim D As Integer
    Dim in$
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print
 
    sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
    Print "Initial contents of Rotation Array:"
    Print RotationArrayToStringTest(RoArray1())
    Print
 
    ' ROTATE THE SHAPE
    Do
        Print "Type degrees to rotate (0 TO 360) or non-numeric value to quit."
        Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
 
        Input "Degrees to rotate (q to quit)? "; in$
        If IsNum%(in$) Then
            D = Val(in$)
            If D >= 0 And D <= 360 Then
                ShearRotate RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                Print RotationArrayToStringTest(RoArray2())
                Print
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
End Sub ' ShearRotate1Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Now receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate1Test2 TestSprite1$
 
Sub ShearRotate1Test2 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iOverwriteCount As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate1 RoArray1(), RoArray2(), D, Asc("."), iOverwriteCount
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iOverwriteCount = 0, "", " (" + cstr$(iOverwriteCount) + " points overwritten)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate1Test2
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v2
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate2 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer, iMissing As Integer)
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the angle of rotation?
    ' perhaps if we divide the screen up into 4 zones:
    '
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '| 271-359 degrees)  | (1-89 degrees)   |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '| (181-269 degrees) | (91-179 degrees) |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   search direction (y,x)
    ' -------   ----------------------
    ' 1         up   + right
    ' 2         down + right
    ' 3         down + left
    ' 4         up   + left
 
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint2%(arrLost(iLoop), angle1, iEmpty, x, y, NewArray())
        If bFound = TRUE Then
            If m_bDebug = TRUE Then
                _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        Else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        End If
    Next iLoop
 
End Sub ' ShearRotate2
 
' /////////////////////////////////////////////////////////////////////////////
' Receives
' FindMe (RotationType) = contains the starting location (.origx, .origy) to start looking from, and the value (.c) to write
' angle1 (Integer) = angle we were rotating to, to determine direction to look in
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint2% (FindMe As RotationType, angle1 As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
 
    destX = 0
    destY = 0
 
    ' Choose search direction depending on the angle
    If angle1 > 0 And angle1 < 90 Then
        dirX = 1
        dirY = -1
    ElseIf angle1 > 90 And angle1 < 180 Then
        dirX = 1
        dirY = 1
    ElseIf angle1 > 180 And angle1 < 270 Then
        dirX = -1
        dirY = 1
    ElseIf angle1 > 270 And angle1 < 360 Then
        dirX = -1
        dirY = -1
    Else
        dirX = 0
        dirY = 0
    End If
 
    If dirX <> 0 Then
        x = FindMe.origx
        y = FindMe.origy
        Do
            ' quit if we're out of bounds
            If x < LBound(NewArray, 1) Then Exit Do
            If x > UBound(NewArray, 1) Then Exit Do
            If y < LBound(NewArray, 2) Then Exit Do
            If y > UBound(NewArray, 2) Then Exit Do
 
            ' =============================================================================
            ' BEGIN SEARCH
            ' =============================================================================
            ' look along y axis for a blank spot
            destX = x
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(destX, destY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look along x axis for a blank spot
            destX = x + dirX
            destY = y
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
 
            ' look diagonally for a blank spot
            destX = x + dirX
            destY = y + dirY
            If destX >= LBound(NewArray, 1) Then
                If destX <= UBound(NewArray, 1) Then
                    If destY >= LBound(NewArray, 2) Then
                        If destY <= UBound(NewArray, 2) Then
                            If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                                NewArray(destX, destY, 0).c = FindMe.c
                                bResult = TRUE
                                Exit Do
                            End If
                        End If
                    End If
                End If
            End If
            ' =============================================================================
            ' END SEARCH
            ' =============================================================================
 
            ' Keep looking
            x = x + dirX
            y = y + dirY
        Loop
    End If
 
    ' Return result
    FindEmptyShearRotationPoint2% = bResult
End Function ' FindEmptyShearRotationPoint2%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points.
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate2Test1 TestSprite1$
 
Sub ShearRotate2Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate2 RoArray1(), RoArray2(), D, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate2Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v3
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' a little more accurately, using iDirection parameter
' (which can be cClockwise or cCounterClockwise)
' together with which quarter of the screen the point is in,
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate3 ( _
    OldArray() As RotationType, _
    NewArray() As RotationType, _
    angle1 As Integer, _
    iDirection As Integer, _
    iEmpty As Integer, _
    iMissing As Integer)
 
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
    Dim iMidX As Integer
    Dim iMidY As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' find midpoints
    iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
    iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
 
            ' find which part of screen the current point is in
            If y > iMidY Then
                ' bottom half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 2
                Else
                    ' left half of screen
                    iScreenZone = 3
                End If
            Else
                ' top half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 1
                Else
                    ' left half of screen
                    iScreenZone = 4
                End If
            End If
 
            ' calculate directions
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
 
                        ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                        arrLost(UBound(arrLost)).z = iScreenZone
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
    ' together with which quarter of the screen the point is in (iScreenZone)
    ' where we divide the screen up into 4 zones:
 
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
    ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
 
    iMissing = 0
    For iLoop = 0 To UBound(arrLost)
        bFound = FindEmptyShearRotationPoint3%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
        If bFound = TRUE Then
            If m_bDebug = TRUE Then
                _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        Else
            iMissing = iMissing + 1
            If m_bDebug = TRUE Then
                _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
            End If
        End If
    Next iLoop
 
End Sub ' ShearRotate3
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains
'                         .origx, .origy = the starting location to start looking from,
'                         .z = which area of the screen the point is in
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left)
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint3% (FindMe As RotationType, iDirection As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
 
    ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
 
    ' Choose search direction based on the quadrant of the screen
    ' and the direction of rotation:
 
    ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
    ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
 
    If FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
 
    ' Quit if we're out of bounds
    If bContinue = TRUE Then
        bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
        If x >= LBound(NewArray, 1) Then
            If x <= UBound(NewArray, 1) Then
                If y >= LBound(NewArray, 2) Then
                    If y <= UBound(NewArray, 2) Then
                        bContinue = TRUE
                    End If
                End If
            End If
        End If
    End If
 
    ' look along y axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(destX, destY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look along x axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look diagonally for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' Return result
    FindEmptyShearRotationPoint3% = bResult
End Function ' FindEmptyShearRotationPoint3%
 
' /////////////////////////////////////////////////////////////////////////////
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate3Test1 TestSprite1$
 
Sub ShearRotate3Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
 
                ShearRotate3 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate3 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate3Test1
 
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v4
 
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' using a different approach, by just looking at the problem angles:
' 30, 60, 120, 150, 210, 240, 300, 330 degrees
 
' (which can be cClockwise or cCounterClockwise)
' together with which quarter of the screen the point is in,
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Returns # points missing (that could not be corrected) in iMissing parameter.
 
Sub ShearRotate4 ( _
    OldArray() As RotationType, _
    NewArray() As RotationType, _
    angle1 As Integer, _
    iDirection As Integer, _
    iEmpty As Integer, _
    iMissing As Integer)
 
    Const Pi = 4 * Atn(1)
 
    Dim angle As Integer
    Dim TwoPi As Double: TwoPi = 8 * Atn(1)
    Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
    Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
    Dim x As Integer
    Dim y As Integer
    Dim nangle As Integer
    Dim nx As Integer
    Dim ny As Integer
    Dim flipper As Integer
    Dim rotr As Double
    Dim shear1 As Double
    Dim shear2 As Double
    Dim clr As Integer
    Dim y1 As _Byte
    Dim xy1 As _Byte
    Dim fy As _Byte
    Dim fx As _Byte
    Dim in$
    Dim sLine As String
    ReDim arrLost(-1) As RotationType
    Dim iLoop As Integer
    Dim bFound As Integer
    Dim iScreenZone As Integer
    Dim iMidX As Integer
    Dim iMidY As Integer
 
    ' initialize new with empty
    ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    For x = LBound(NewArray, 1) To UBound(NewArray, 1)
        For y = LBound(NewArray, 2) To UBound(NewArray, 2)
            NewArray(x, y, 0).origx = x
            NewArray(x, y, 0).origy = y
            NewArray(x, y, 0).c = iEmpty
        Next y
    Next x
 
    ' find midpoints
    iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
    iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
 
    ' angle is reversed
    angle = 360 - angle1
 
    ' Shearing each element 3 times in one shot
    nangle = angle
 
    ' this pre-processing portion basically rotates by 90 to get
    ' between -45 and 45 degrees, where the 3-shear routine works correctly...
    If angle > 45 And angle < 225 Then
        If angle < 135 Then
            nangle = angle - 90
        Else
            nangle = angle - 180
        End If
    End If
    If angle > 135 And angle < 315 Then
        If angle < 225 Then
            nangle = angle - 180
        Else
            nangle = angle - 270
        End If
    End If
    If nangle < 0 Then
        nangle = nangle + 360
    End If
    If nangle > 359 Then
        nangle = nangle - 360
    End If
 
    rotr = nangle * DtoR
    shear1 = Tan(rotr / 2) ' correct way
    shear2 = Sin(rotr)
 
    ' *** NOTE: this had a bug where the values 135, 224, and 314
    ' ***       all resolve to -45 degrees.
    ' ***       Fixed by changing < to <=
 
    'if angle >  45 and angle < 134 then
    If angle > 45 And angle <= 134 Then
        flipper = 1
    ElseIf angle > 134 And angle <= 224 Then
        flipper = 2
    ElseIf angle > 224 And angle <= 314 Then
        ' *** NOTE: this had a bug where this flipper was wrong
        '           Fixed by adding case 7
        'flipper = 3
        flipper = 7
    Else
        flipper = 0
    End If
 
    ' Here is where it needs some optimizing possibly... kinda slow...
    For y = LBound(NewArray, 2) To UBound(NewArray, 2)
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
 
            ' find which part of screen the current point is in
            If y > iMidY Then
                ' bottom half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 2
                Else
                    ' left half of screen
                    iScreenZone = 3
                End If
            Else
                ' top half of screen
                If x > iMidX Then
                    ' right half of screen
                    iScreenZone = 1
                Else
                    ' left half of screen
                    iScreenZone = 4
                End If
            End If
 
            ' calculate directions
            Select Case flipper
                Case 1:
                    nx = -y
                    ny = x
                Case 2:
                    nx = -x
                    ny = -y
                Case 3:
                    nx = -y
                    ny = -x
                Case 4:
                    nx = -x
                    ny = y
                Case 5:
                    nx = x
                    ny = -y
                Case 6:
                    nx = y
                    ny = x
                Case 7:
                    nx = y
                    ny = -x
                Case Else:
                    nx = x
                    ny = y
            End Select
 
            clr = OldArray(nx, ny, 0).c
 
            y1 = y * shear1
            xy1 = x + y1
            fy = (y - xy1 * shear2)
            fx = xy1 + fy * shear1
 
            If fx >= -16 And fx <= 16 Then
                If fy >= -16 And fy <= 16 Then
                    ' only draw here if this spot is empty
                    If NewArray(fx, fy, 0).c = iEmpty Then
                        NewArray(fx, fy, 0).c = clr
                        NewArray(fx, fy, 0).origx = fx
                        NewArray(fx, fy, 0).origy = fy
                    Else
                        ' don't draw, but save it to a list to handle later
                        ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
                        arrLost(UBound(arrLost)).c = clr
                        arrLost(UBound(arrLost)).origx = fx
                        arrLost(UBound(arrLost)).origy = fy
 
                        ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
                        arrLost(UBound(arrLost)).z = iScreenZone
                    End If
                End If
            End If
        Next x
    Next y
 
    ' try to place any points that would have overwritten to a spot nearby
    ' can nearby be determined by the direction of rotation  (iDirection)
    ' together with which quarter of the screen the point is in (iScreenZone)
    ' where we divide the screen up into 4 zones:
 
    ' --------------------------------------
    '|                   |                  |
    '| zone 4            | zone 1           |
    '|                   |                  |
    '|--------------------------------------|
    '|                   |                  |
    '| zone 3            | zone 2           |
    '|                   |                  |
    '|                   |                  |
    ' --------------------------------------
 
    ' in zone   rotation direction   search direction (y,x)
    ' -------   ------------------   ----------------------
    ' 1         clockwise            down + right
    ' 1         counter-clockwise    up   + left
    ' 2         clockwise            down + left
    ' 2         counter-clockwise    up   + right
    ' 3         clockwise            up   + left
    ' 3         counter-clockwise    down + right
    ' 4         clockwise            up   + right
    ' 4         counter-clockwise    down + left
 
    If IsProblemAngle%(angle1) Then
        iMissing = 0
        For iLoop = 0 To UBound(arrLost)
            bFound = FindEmptyShearRotationPoint4%(arrLost(iLoop), iDirection, iEmpty, x, y, NewArray())
            If bFound = TRUE Then
                If m_bDebug = TRUE Then
                    _Echo "Plotted  missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                End If
            Else
                iMissing = iMissing + 1
                If m_bDebug = TRUE Then
                    _Echo "Detected missing point " + Chr$(34) + Chr$(arrLost(iLoop).c) + Chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
                End If
            End If
        Next iLoop
    End If
End Sub ' ShearRotate4
 
' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if angle is any of
' 30, 60, 120, 150, 210, 240, 300, 330
 
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
 
Function IsProblemAngle% (angle As Integer)
    Dim bResult As Integer: bResult = FALSE
    Dim i%
    For i% = 0 To 360 Step 30
        If i% Mod 90 <> 0 Then
            If angle = i% Then
                bResult = TRUE
                Exit For
            End If
        End If
    Next i%
    IsProblemAngle% = bResult
End Function ' IsProblemAngle%
 
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter
' which can be cClockwise or cCounterClockwise.
 
' Note: cClockwise and cCounterClockwise constants must be declared globally.
 
' Receives
' FindMe (RotationType) = contains
'                         .origx, .origy = the starting location to start looking from,
'                         .z = which area of the screen the point is in
'                              (1=top right, 2=bottom right, 3=bottom left, 4=top left)
'                              to determine direction to look in
'                         .c = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' iEmpty (Integer) = value to test against for empty
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
 
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y location returned byref in destX,destY parameters
 
Function FindEmptyShearRotationPoint4% (FindMe As RotationType, iDirection As Integer, iEmpty As Integer, destX As Integer, destY As Integer, NewArray() As RotationType)
    Dim bResult As Integer: bResult = FALSE
    Dim x As Integer
    Dim y As Integer
    Dim dirX As Integer
    Dim dirY As Integer
    Dim bContinue As Integer
 
    ' Initialize
    destX = 0
    destY = 0
    bContinue = TRUE
 
    ' Choose search direction based on the quadrant of the screen
    ' and the direction of rotation:
 
    ' iScreenZone   iDirection           search direction (y,x)
    ' -----------   ------------------   ----------------------
    ' 1             cClockwise           down + right ( 1, 1)
    ' 1             cCounterClockwise    up   + left  (-1,-1)
    ' 2             cClockwise           down + left  ( 1,-1)
    ' 2             cCounterClockwise    up   + right (-1, 1)
    ' 3             cClockwise           up   + left  (-1,-1)
    ' 3             cCounterClockwise    down + right ( 1, 1)
    ' 4             cClockwise           up   + right (-1, 1)
    ' 4             cCounterClockwise    down + left  ( 1,-1)
 
    If FindMe.z = 1 And iDirection = cClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 1 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cClockwise Then
        dirY = 1
        dirX = -1
    ElseIf FindMe.z = 2 And iDirection = cCounterClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 3 And iDirection = cClockwise Then
        dirY = -1
        dirX = -1
    ElseIf FindMe.z = 3 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cClockwise Then
        dirY = -1
        dirX = 1
    ElseIf FindMe.z = 4 And iDirection = cCounterClockwise Then
        dirY = 1
        dirX = -1
    Else
        bContinue = FALSE
    End If
 
    ' Quit if we're out of bounds
    If bContinue = TRUE Then
        bContinue = FALSE
        x = FindMe.origx
        y = FindMe.origy
        If x >= LBound(NewArray, 1) Then
            If x <= UBound(NewArray, 1) Then
                If y >= LBound(NewArray, 2) Then
                    If y <= UBound(NewArray, 2) Then
                        bContinue = TRUE
                    End If
                End If
            End If
        End If
    End If
 
    ' look along y axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(destX, destY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look along x axis for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    ' look diagonally for an available adjacent point
    If bContinue = TRUE Then
        destX = x + dirX
        destY = y + dirY
        If destX >= LBound(NewArray, 1) Then
            If destX <= UBound(NewArray, 1) Then
                If destY >= LBound(NewArray, 2) Then
                    If destY <= UBound(NewArray, 2) Then
                        If NewArray(x + dirX, y + dirY, 0).c = iEmpty Then
                            NewArray(destX, destY, 0).c = FindMe.c
                            bResult = TRUE
                            bContinue = FALSE
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    '   ' look (in the opposite direction) along y axis for an available adjacent point
    '   If bContinue = TRUE Then
    '       destX = x
    '       destY = y - dirY
    '       if destX >= LBound(NewArray, 1) then
    '           if destX <= UBound(NewArray, 1) then
    '               if destY >= LBound(NewArray, 2) then
    '                   if destY <= UBound(NewArray, 2) then
    '                       if NewArray(destX, destY, 0).c = iEmpty then
    '                           NewArray(destX, destY, 0).c = FindMe.c
    '                           bResult = TRUE
    '                           bContinue = FALSE
    '                       end if
    '                   end if
    '               end if
    '           end if
    '       end if
    '   end if
    '
    '   ' look (in the opposite direction) along x axis for an available adjacent point
    '   If bContinue = TRUE Then
    '       destX = x - dirX
    '       destY = y
    '       if destX >= LBound(NewArray, 1) then
    '           if destX <= UBound(NewArray, 1) then
    '               if destY >= LBound(NewArray, 2) then
    '                   if destY <= UBound(NewArray, 2) then
    '                       if NewArray(x + dirX, y, 0).c = iEmpty then
    '                           NewArray(destX, destY, 0).c = FindMe.c
    '                           bResult = TRUE
    '                           bContinue = FALSE
    '                       end if
    '                   end if
    '               end if
    '           end if
    '       end if
    '   end if
    '
    '   ' look (in the opposite direction) diagonally for an available adjacent point
    '   If bContinue = TRUE Then
    '       destX = x - dirX
    '       destY = y - dirY
    '       if destX >= LBound(NewArray, 1) then
    '           if destX <= UBound(NewArray, 1) then
    '               if destY >= LBound(NewArray, 2) then
    '                   if destY <= UBound(NewArray, 2) then
    '                       if NewArray(x + dirX, y + dirY, 0).c = iEmpty then
    '                           NewArray(destX, destY, 0).c = FindMe.c
    '                           bResult = TRUE
    '                           bContinue = FALSE
    '                       end if
    '                   end if
    '               end if
    '           end if
    '       end if
    '    End If
 
    ' Return result
    FindEmptyShearRotationPoint4% = bResult
End Function ' FindEmptyShearRotationPoint4%
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing points with improved logic v3
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate4Test1 TestSprite1$
 
Sub ShearRotate4Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
 
                ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate4Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Correct for overwriting points issue
' (happens at 30, 60, 120, 150, 210, 240, 300, 330 degrees)
' using STxAxTIC's method of merging array rotated to angle-1 and angle+1
 
Sub ShearRotate5 (OldArray() As RotationType, NewArray() As RotationType, angle1 As Integer, iEmpty As Integer)
    ReDim arrCW(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    ReDim arrCCW(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
 
    ' If rotation is 30, 60, 120, 150, 210, 240, 300, 330 degrees
    ' then try correcting for overwriting.
    If IsProblemAngle%(angle1) Then
        ' get array rotated to angle-1
        ShearRotate OldArray(), arrCW(), angle1 - 1, iEmpty
 
        ' get array rotated to angle
        ShearRotate OldArray(), NewArray(), angle1 - 1, iEmpty
 
        ' get array rotated to angle=1
        ShearRotate OldArray(), arrCCW(), angle1 + 1, iEmpty
 
        ' merge the results
        For x = LBound(NewArray, 1) To UBound(NewArray, 1)
            For y = LBound(NewArray, 2) To UBound(NewArray, 2)
                ' is point empty?
                If NewArray(x, y, 0).c = iEmpty Then
                    ' see if point is occupied 1 deg. counter-clockwise
                    If arrCCW(x, y, 0).c <> iEmpty Then
                        NewArray(x, y, 0).c = arrCCW(x, y, 0).c
                        ' see if point is occupied 1 deg. clockwise
                    ElseIf arrCW(x, y, 0).c <> iEmpty Then
                        NewArray(x, y, 0).c = arrCW(x, y, 0).c
                    End If
                End If
            Next y
        Next x
        ' Otherwise rotate without correcting.
    Else
        ShearRotate OldArray(), NewArray(), angle1, iEmpty
    End If
End Sub ' ShearRotate5
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing (overwritten) points
' using STxAxTIC's method to correct for overwritten points
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate5Test1 TestSprite1$
 
Sub ShearRotate5Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    'Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print "using STxAxTIC's method to correct for overwritten points"
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            For D = D1 To 360
                Cls
 
                'ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                ShearRotate5 RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                'Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            For D = 360 To D1 Step -1
                Cls
                'ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                ShearRotate5 RoArray1(), RoArray2(), D, Asc(".")
                Print
                Print "Rotated by " + cstr$(D) + " degrees:"
                'Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$ (iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate5Test1
 
' /////////////////////////////////////////////////////////////////////////////
' Correct for overwriting points issue
' (happens at 30, 60, 120, 150, 210, 240, 300, 330 degrees)
' using STxAxTIC's method of merging array rotated to angle-1 and angle+1
' updated with using precalculated arrays to find the exact location
' a given point should rotate to.
 
' Receives:
' OldArray = array to rotate
' NewArray = rotated array returned here
' angle = angle to rotate to
' iDirection = cClockwise or cCounterClockwise (cClockwise and cCounterClockwise constants must be declared globally)
' iEmpty = value for empty
' iMissing = return value (byref), number of points not found
 
Sub ShearRotate6 (OldArray() As RotationType, NewArray() As RotationType, angle As Integer, iDirection As Integer, iEmpty As Integer, iMissing As Integer)
    Dim iValue As Integer
    Dim iMaxValue As Integer
    Dim sLine As String
    Dim oSearch As RotationType
 
    ' *****************************************************************************
    ' NOTE: THESE WOULD BE SHARED ARRAYS, PRE-POPULATED AHEAD OF TIME
    ReDim arrMaskIndex(-1) As Integer
    ReDim arrMasks(-1, -1, -1) As RotationType
 
    ' Initialize
    iMissing = 0
 
    ' Get index
    GetMaskIndex arrMaskIndex()
 
    ' Get rotation masks
    GetRotationMasks OldArray(), arrMasks(), iMaxValue
    ' *****************************************************************************
 
    ' If rotation is 30, 60, 120, 150, 210, 240, 300, 330 degrees
    ' then try correcting for overwriting.
    If IsProblemAngle%(angle) Then
 
        ' do we have a mask index for this angle?
        If arrMaskIndex(angle) > 0 Then
 
            ' initialize new with empty
            ReDim NewArray(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
            For x = LBound(NewArray, 1) To UBound(NewArray, 1)
                For y = LBound(NewArray, 2) To UBound(NewArray, 2)
                    NewArray(x, y, 0).origx = x
                    NewArray(x, y, 0).origy = y
                    NewArray(x, y, 0).c = iEmpty
                Next y
            Next x
 
            ' first do basic rotate
            For y = LBound(OldArray, 2) To UBound(OldArray, 2)
                For x = LBound(OldArray, 1) To UBound(OldArray, 1)
                    ' get the mask value from unrotated
                    iValue = arrMasks(arrMaskIndex(0), x, y).c
 
                    ' is mask value in the rotated?
                    FindValueInMask arrMasks(), arrMaskIndex(angle), iValue, oSearch
                    If oSearch.c = TRUE Then
                        ' found, copy point
                        NewArray(oSearch.origx, oSearch.origy, 0).c = OldArray(x, y, 0).c
                    Else
                        ' not found, try get from adjacent angles
 
                        If iDirection = cCounterClockwise Then
                            ' is mask value in the rotated -1 ?
                            FindValueInMask arrMasks(), arrMaskIndex(angle - 1), iValue, oSearch
                            If oSearch.c = TRUE Then
                                ' found, copy point
                                NewArray(oSearch.origx, oSearch.origy, 0).c = OldArray(x, y, 0).c
                            Else
                                ' not found, try to get from rotated +1
                                FindValueInMask arrMasks(), arrMaskIndex(angle + 1), iValue, oSearch
                                If oSearch.c = TRUE Then
                                    ' found, copy point
                                    NewArray(oSearch.origx, oSearch.origy, 0).c = OldArray(x, y, 0).c
                                Else
                                    ' not found, oh well
                                    iMissing = iMissing + 1
                                End If
                            End If
                        Else ' assume iDirection = cClockwise
                            ' is mask value in the rotated +1 ?
                            FindValueInMask arrMasks(), arrMaskIndex(angle + 1), iValue, oSearch
                            If oSearch.c = TRUE Then
                                ' found, copy point
                                NewArray(oSearch.origx, oSearch.origy, 0).c = OldArray(x, y, 0).c
                            Else
                                ' not found, try to get from rotated -1
                                FindValueInMask arrMasks(), arrMaskIndex(angle - 1), iValue, oSearch
                                If oSearch.c = TRUE Then
                                    ' found, copy point
                                    NewArray(oSearch.origx, oSearch.origy, 0).c = OldArray(x, y, 0).c
                                Else
                                    ' not found, oh well
                                    iMissing = iMissing + 1
                                End If
                            End If
                        End If
                    End If
                Next x
            Next y
        End If
        ' Otherwise rotate without correcting.
    Else
        ShearRotate OldArray(), NewArray(), angle, iEmpty
    End If
End Sub ' ShearRotate6
 
' /////////////////////////////////////////////////////////////////////////////
' looks for value iValue in arrMasks(iIndex, [x], [y])
' and returns results in oResult (RotationType):
' * if found, returns oResult.c = TRUE, and x,y found at in oResult.origx, oResult.origy
' * if not found, returns oResult.c = FALSE
 
'   FindValueInMask arrMasks(), arrMaskIndex(angle), iValue, c
 
Sub FindValueInMask (arrMasks() As RotationType, iIndex As Integer, iValue As Integer, oResult As RotationType)
    Dim iLoopY As Integer
    Dim iLoopX As Integer
    Dim bFound As Integer
    oResult.c = FALSE
    bFound = FALSE
    For iLoopY = LBound(arrMasks, 3) To UBound(arrMasks, 3)
        For iLoopX = LBound(arrMasks, 2) To UBound(arrMasks, 2)
            If arrMasks(iIndex, iLoopX, iLoopY).c = iValue Then
                oResult.c = TRUE
                oResult.origx = iLoopX
                oResult.origy = iLoopY
                'iLoopY = ubound(arrMasks, 3)+1
                bFound = TRUE
                Exit For
            End If
        Next iLoopX
        If bFound = TRUE Then Exit For
    Next iLoopY
End Sub ' FindValueInMask
 
' /////////////////////////////////////////////////////////////////////////////
' Tries to correct for missing (overwritten) points
' using STxAxTIC's method to correct for overwritten points
' updated with using precalculated arrays to find the exact location
' a given point should rotate to.
 
' Receives parameter sMap
' which comes from TestSprite1$, TestSprite2$, TestSprite3$, etc.
 
' e.g. ShearRotate6Test1 TestSprite1$
 
Sub ShearRotate6Test1 (sMap As String)
    Dim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    Dim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    'Dim sMap As String
    Dim D As Integer
    Dim D1 As Integer
    Dim in$
    Dim bFinished As Integer
    Dim iDirection As Integer
    Dim iMissing As Integer
 
    ' GET A SHAPE TO BE ROTATED
    Cls
    Print "3 shear rotation based on code by leopardpm"
    Print "using STxAxTIC's method to correct for overwritten points"
    Print "updated with using precalculated arrays to find the exact location"
    Print "a given point should rotate to."
 
    'sMap = TestSprite1$
 
    ' CONVERT SHAPE TO ARRAY
    StringToRotationArray RoArray1(), sMap, "."
 
    ' GET START ANGLE
    D = 0
    Print
    Print "Rotated by " + cstr$(D) + " degrees:"
    Print RotationArrayToStringTest(RoArray1())
    Print
    Print "Type an angle (-360 to 360) to rotate to, "
    Print "or blank to increase by 1 degree, or q to quit."
    Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
    Print "Hold down <ENTER> to rotate continually."
    Input "Angle (q to quit)? ", in$
    If Len(in$) > 0 Then
        If IsNum%(in$) Then
            D1 = Val(in$)
        Else
            D1 = -500
        End If
    Else
        D1 = 1
    End If
 
    ' ROTATE TO EACH ANGLE
    If D1 >= -360 And D1 <= 360 Then
        bFinished = FALSE
        Do
            ' ROTATE CLOCKWISE
            iDirection = cClockwise
            For D = D1 To 360
                Cls
 
                'ShearRotate4 RoArray1(), RoArray2(), D, cClockwise, Asc("."), iMissing
                ShearRotate6 RoArray1(), RoArray2(), D, iDirection, Asc("."), iMissing
 
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (-360 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Tries to fix for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D - 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
 
            ' ROTATE COUNTER-CLOCKWISE
            iDirection = cCounterClockwise
            For D = 360 To D1 Step -1
                Cls
                'ShearRotate4 RoArray1(), RoArray2(), D, cCounterClockwise, Asc("."), iMissing
                ShearRotate6 RoArray1(), RoArray2(), D, iDirection, Asc("."), iMissing
 
                Print
                'Print "Rotated by " + cstr$(D) + " degrees:"
                Print "Rotated by " + cstr$(D) + " degrees" + IIFSTR$(iMissing = 0, "", " (" + cstr$(iMissing) + " points missing)") + ":"
 
                Print RotationArrayToStringTest(RoArray2())
                Print
 
                Print "Type an angle (0 to 360) to rotate to, "
                Print "or blank to increase by 1 degree, or q to quit."
                Print "Note: Need to fix code for 30,60,120,150,210,240,300,330 degrees (looks bad)."
                Print "Hold down <ENTER> to rotate continually."
                Input "Angle (q to quit)? ", in$
                If Len(in$) > 0 Then
                    If IsNum%(in$) Then
                        D = Val(in$)
                        If D >= 0 And D <= 360 Then
                            D = D + 1
                        Else
                            bFinished = TRUE
                            Exit For
                        End If
                    Else
                        bFinished = TRUE
                        Exit For
                    End If
                End If
            Next D
            If bFinished = TRUE Then Exit Do
        Loop
    End If
End Sub ' ShearRotate6Test1
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub GetRotationMaskTest
    Dim RoutineName As String: RoutineName = "GetRotationMaskTest"
    ReDim RoArray1(-16 To 16, -16 To 16, 127) As RotationType
    'ReDim RoArray2(-16 To 16, -16 To 16, 127) As RotationType
    ReDim arrMaskIndex(-1) As Integer
    ReDim arrMasks(-1, -1, -1) As RotationType
    Dim iLoop%
    Dim x As Integer
    Dim y As Integer
    Dim sLine As String
    Dim iIndex%
    Dim iMaxValue%
    Dim in$
 
    Width 180, 100
 
    ' Get index
    GetMaskIndex arrMaskIndex()
 
    Cls
    Print "Contents of arrMaskIndex:"
    For iLoop% = LBound(arrMaskIndex) To UBound(arrMaskIndex)
        If arrMaskIndex(iLoop%) > 0 Then
            Print "arrMaskIndex(" + cstr$(iLoop%) + ") = " + cstr$(arrMaskIndex(iLoop%))
        End If
    Next iLoop%
    Print
    Input "PRESS <ENTER> TO CONTINUE OR q TO QUIT"; in$
    If in$ = "q" Then GoTo CleanupAndExit
 
    ' Get rotation masks
    GetRotationMasks RoArray1(), arrMasks(), iMaxValue%
 
    ' Show unrotated mask
    Cls
    Print "Unrotated mask, containing unique values 1-" + cstr$(iMaxValue%) + ":"
    iIndex% = 0
    For y = LBound(arrMasks, 3) To UBound(arrMasks, 3)
        sLine = ""
        For x = LBound(arrMasks, 2) To UBound(arrMasks, 2)
            sLine = sLine + IIFSTR$(Len(sLine) = 0, "", ",") + Right$("    " + cstr$(arrMasks(iIndex%, x, y).c), 4)
        Next x
        Print sLine
    Next y
    Print
    Input "PRESS <ENTER> TO CONTINUE OR q TO QUIT"; in$
    If in$ = "q" Then GoTo CleanupAndExit
 
    ' Show what we have
    For iLoop% = 0 To 360
        iIndex% = arrMaskIndex(iLoop%)
        'print "arrMaskIndex(" + cstr$(iLoop%) + ") = " + cstr$(iIndex%)
        If iIndex% > 0 Then
            Cls
            Print "arrMaskIndex(" + cstr$(iLoop%) + ") = " + cstr$(iIndex%)
            For y = LBound(arrMasks, 3) To UBound(arrMasks, 3)
                sLine = ""
                For x = LBound(arrMasks, 2) To UBound(arrMasks, 2)
                    sLine = sLine + IIFSTR$(Len(sLine) = 0, "", ",") + Right$("    " + cstr$(arrMasks(iIndex%, x, y).c), 4)
                Next x
                Print sLine
            Next y
            Print
            Input "PRESS <ENTER> TO CONTINUE OR q TO QUIT"; in$
            If in$ = "q" Then GoTo CleanupAndExit
        End If
    Next iLoop%
 
    Print
    Print RoutineName + " finished."
    Input "PRESS <ENTER> TO CONTINUE"; in$
 
    CleanupAndExit:
    'Screen 0
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
End Sub ' GetRotationMaskTest
 
' /////////////////////////////////////////////////////////////////////////////
' Returns array with rotation masks
' NewArray(index, x, y) of RotationType
' and maximum unique value iValue.
' (Values range from 1 to iValue.)
 
Sub GetRotationMasks (OldArray() As RotationType, NewArray() As RotationType, iValue As Integer)
    ReDim arrMask(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    ReDim arrNext(LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2), 127) As RotationType
    ReDim arrMaskIndex(-1) As Integer
    Dim x As Integer
    Dim y As Integer
    Dim angle As Integer
    Dim iIndex As Integer
 
    ' Get index
    GetMaskIndex arrMaskIndex()
 
    ' Size array
    ReDim NewArray(0 To UBound(arrMaskIndex), LBound(OldArray, 1) To UBound(OldArray, 1), LBound(OldArray, 2) To UBound(OldArray, 2)) As RotationType
 
    ' create the original mask
    iValue = 0
    For y = LBound(OldArray, 2) To UBound(OldArray, 2)
        For x = LBound(OldArray, 1) To UBound(OldArray, 1)
            iValue = iValue + 1
            arrMask(x, y, 0).c = iValue
            arrMask(x, y, 0).origx = x
            arrMask(x, y, 0).origy = y
 
            NewArray(0, x, y).c = iValue
            NewArray(0, x, y).origx = x
            NewArray(0, x, y).origy = y
        Next x
    Next y
 
    ' create rotated masks
    For angle = 30 To 330
        ' If angle is 30, 60, 120, 150, 210, 240, 300, 330 degrees
        ' then precalculate rotation masks for angle-1, angle, angle+1
        ' and store in NewArray
        If IsProblemAngle%(angle) Then
            ' get array rotated to angle-1
            ShearRotate arrMask(), arrNext(), angle - 1, iEmpty
 
            ' copy to mask array
            iIndex = arrMaskIndex(angle - 1)
            For x = LBound(arrNext, 1) To UBound(arrNext, 1)
                For y = LBound(arrNext, 2) To UBound(arrNext, 2)
                    NewArray(iIndex, x, y).c = arrNext(x, y, 0).c
                    NewArray(iIndex, x, y).origx = arrNext(x, y, 0).origx
                    NewArray(iIndex, x, y).origy = arrNext(x, y, 0).origy
                Next y
            Next x
 
            ' get array rotated to angle
            ShearRotate arrMask(), arrNext(), angle, iEmpty
 
            ' copy to mask array
            iIndex = arrMaskIndex(angle)
            For x = LBound(arrNext, 1) To UBound(arrNext, 1)
                For y = LBound(arrNext, 2) To UBound(arrNext, 2)
                    NewArray(iIndex, x, y).c = arrNext(x, y, 0).c
                    NewArray(iIndex, x, y).origx = arrNext(x, y, 0).origx
                    NewArray(iIndex, x, y).origy = arrNext(x, y, 0).origy
                Next y
            Next x
 
            ' get array rotated to angle+1
            ShearRotate arrMask(), arrNext(), angle + 1, iEmpty
 
            ' copy to mask array
            iIndex = arrMaskIndex(angle + 1)
            For x = LBound(arrNext, 1) To UBound(arrNext, 1)
                For y = LBound(arrNext, 2) To UBound(arrNext, 2)
                    NewArray(iIndex, x, y).c = arrNext(x, y, 0).c
                    NewArray(iIndex, x, y).origx = arrNext(x, y, 0).origx
                    NewArray(iIndex, x, y).origy = arrNext(x, y, 0).origy
                Next y
            Next x
 
        End If
    Next angle
 
End Sub ' GetRotationMasks
 
' /////////////////////////////////////////////////////////////////////////////
' Returns an array 0 to 360
' that returns the index of the mask array for the given angle
' for looking up the mask for a given angle in the mask array
' (a value 0 means no entry exists in the mask array)
 
' The values that matter are:
' arrMaskIndex( 29) = 1
' arrMaskIndex( 30) = 2
' arrMaskIndex( 31) = 3
' arrMaskIndex( 59) = 4
' arrMaskIndex( 60) = 5
' arrMaskIndex( 61) = 6
' arrMaskIndex(119) = 7
' arrMaskIndex(120) = 8
' arrMaskIndex(121) = 9
' arrMaskIndex(149) = 10
' arrMaskIndex(150) = 11
' arrMaskIndex(151) = 12
' arrMaskIndex(209) = 13
' arrMaskIndex(210) = 14
' arrMaskIndex(211) = 15
' arrMaskIndex(239) = 16
' arrMaskIndex(240) = 17
' arrMaskIndex(241) = 18
' arrMaskIndex(299) = 19
' arrMaskIndex(300) = 20
' arrMaskIndex(301) = 21
' arrMaskIndex(329) = 22
' arrMaskIndex(330) = 23
' arrMaskIndex(331) = 24
 
Sub GetMaskIndex (arrMaskIndex() As Integer)
    Dim iLoop%
    Dim iCount%
    ReDim arrMaskIndex(0 To 360) As Integer
 
    iCount% = -1
 
    For iLoop% = 0 To 360
        arrMaskIndex(iLoop%) = 0
    Next iLoop%
 
    For iLoop% = 0 To 359 Step 30
        If iLoop% Mod 90 <> 0 Then
            iCount% = iCount% + 3
            arrMaskIndex(iLoop% - 1) = iCount% - 1
            arrMaskIndex(iLoop% + 0) = iCount% + 0
            arrMaskIndex(iLoop% + 1) = iCount% + 1
        End If
    Next iLoop%
End Sub ' GetMaskIndex
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub GetMaskIndexTest
    Dim in$
    Dim iLoop%
    ReDim arrMaskIndex(-1) As Integer
 
    'Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    'Width 80, 80
 
    Print "Testing GetMaskIndex"
    GetMaskIndex arrMaskIndex()
    Print
    Print "GetMaskIndex arrMaskIndex()"
    Print "    LBound(arrMaskIndex) = " + cstr$(LBound(arrmaskindex))
    Print "    UBound(arrMaskIndex) = " + cstr$(UBound(arrmaskindex))
    Print
 
    Print "Testing problem angles:"
 
    For iLoop% = 0 To 360
        If IsProblemAngle%(iLoop%) Then
            If iLoop% - 1 >= LBound(arrmaskindex) And iLoop% + 1 <= UBound(arrmaskindex) Then
                Print "   angle-1, arrMaskIndex(" + cstr$(iLoop% - 1) + ") = " + cstr$(arrMaskIndex(iLoop% - 1))
                Print "   angle  , arrMaskIndex(" + cstr$(iLoop% + 0) + ") = " + cstr$(arrMaskIndex(iLoop% + 0))
                Print "   angle+1, arrMaskIndex(" + cstr$(iLoop% + 1) + ") = " + cstr$(arrMaskIndex(iLoop% + 1))
                Print
            Else
                Print "   angle " + cstr$(iLoop%) + "is  out of range."
                Print
            End If
        End If
    Next iLoop%
 
    Input "PRESS <ENTER> TO CONTINUE"; in$
End Sub ' GetMaskIndexTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "11111111111111111111111111111111" + Chr$(13) ' 1
    m$ = m$ + "4..............................2" + Chr$(13) ' 2
    m$ = m$ + "4....##.....#######.....####...2" + Chr$(13) ' 3
    m$ = m$ + "4...####....##...###...######..2" + Chr$(13) ' 4
    m$ = m$ + "4..##..##...##...###..##....##.2" + Chr$(13) ' 5
    m$ = m$ + "4.##....##..#######...##.......2" + Chr$(13) ' 6
    m$ = m$ + "4.########..#######...##.......2" + Chr$(13) ' 7
    m$ = m$ + "4.########..##...###..##....##.2" + Chr$(13) ' 8
    m$ = m$ + "4.##....##..##...###...######..2" + Chr$(13) ' 9
    m$ = m$ + "4.##....##..#######.....####...2" + Chr$(13) ' 10
    m$ = m$ + "4..............................2" + Chr$(13) ' 11
    m$ = m$ + "4..............................2" + Chr$(13) ' 12
    m$ = m$ + "4..ABBBBBBBBBBBBBBBBBBBBBBBBC..2" + Chr$(13) ' 13
    m$ = m$ + "4..A...........EE...........C..2" + Chr$(13) ' 14
    m$ = m$ + "4..A..........FFFF..........C..2" + Chr$(13) ' 15
    m$ = m$ + "4..A.........GGGGGG.........C..2" + Chr$(13) ' 16
    m$ = m$ + "4..A........HHHHHHHH........C..2" + Chr$(13) ' 17
    m$ = m$ + "4..A.......IIIIIIIIII.......C..2" + Chr$(13) ' 18
    m$ = m$ + "4..A......JJJJJJJJJJJJ......C..2" + Chr$(13) ' 19
    m$ = m$ + "4..DDDDDDDDDDDDDDDDDDDDDDDDDC..2" + Chr$(13) ' 20
    m$ = m$ + "4..............................2" + Chr$(13) ' 21
    m$ = m$ + "4..............................2" + Chr$(13) ' 22
    m$ = m$ + "4.######....########..########.2" + Chr$(13) ' 23
    m$ = m$ + "4.#######...########..########.2" + Chr$(13) ' 24
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 25
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 26
    m$ = m$ + "4.##....##..########..#######..2" + Chr$(13) ' 27
    m$ = m$ + "4.##...###..##........##.......2" + Chr$(13) ' 28
    m$ = m$ + "4.#######...##........##.......2" + Chr$(13) ' 29
    m$ = m$ + "4.######....########..##.......2" + Chr$(13) ' 30
    m$ = m$ + "4..............................2" + Chr$(13) ' 31
    m$ = m$ + "33333333333333333333333333333332" + Chr$(13) ' 32
    TestSprite1$ = m$
End Function ' TestSprite1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestSprite2$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "...............AA..............." + Chr$(13) ' 1
    m$ = m$ + "..............//BB.............." + Chr$(13) ' 2
    m$ = m$ + ".............??..CC............." + Chr$(13) ' 3
    m$ = m$ + "............==....DD............" + Chr$(13) ' 4
    m$ = m$ + "...........++......EE..........." + Chr$(13) ' 5
    m$ = m$ + "..........&&........FF.........." + Chr$(13) ' 6
    m$ = m$ + ".........zz..........GG........." + Chr$(13) ' 7
    m$ = m$ + "........yy............HH........" + Chr$(13) ' 8
    m$ = m$ + ".......xx..............II......." + Chr$(13) ' 9
    m$ = m$ + "......ww................JJ......" + Chr$(13) ' 10
    m$ = m$ + ".....vv..................KK....." + Chr$(13) ' 11
    m$ = m$ + "....uu....................LL...." + Chr$(13) ' 12
    m$ = m$ + "...tt......DDAAAAAAA.......MM..." + Chr$(13) ' 13
    m$ = m$ + "..ss.......DDAAAAAAA........NN.." + Chr$(13) ' 14
    m$ = m$ + ".rr........DD.....BB.........OO." + Chr$(13) ' 15
    m$ = m$ + "qq.........DD.....BB..........PP" + Chr$(13) ' 16
    m$ = m$ + "pp.........DD.....BB..........QQ" + Chr$(13) ' 17
    m$ = m$ + ".oo........DD.....BB.........RR." + Chr$(13) ' 18
    m$ = m$ + "..nn.......CCCCCCCBB........SS.." + Chr$(13) ' 19
    m$ = m$ + "...mm......CCCCCCCBB.......TT..." + Chr$(13) ' 20
    m$ = m$ + "....ll....................UU...." + Chr$(13) ' 21
    m$ = m$ + ".....kk..................VV....." + Chr$(13) ' 22
    m$ = m$ + "......jj................WW......" + Chr$(13) ' 23
    m$ = m$ + ".......ii..............XX......." + Chr$(13) ' 24
    m$ = m$ + "........hh............YY........" + Chr$(13) ' 25
    m$ = m$ + ".........gg..........ZZ........." + Chr$(13) ' 26
    m$ = m$ + "..........ff........@@.........." + Chr$(13) ' 27
    m$ = m$ + "...........ee......##..........." + Chr$(13) ' 28
    m$ = m$ + "............dd....$$............" + Chr$(13) ' 29
    m$ = m$ + ".............cc..%%............." + Chr$(13) ' 30
    m$ = m$ + "..............bb\\.............." + Chr$(13) ' 31
    m$ = m$ + "...............aa..............." + Chr$(13) ' 32
    TestSprite2$ = m$
End Function ' TestSprite2$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function PetrText1$
    Dim m$
    m$ = ""
    '                   11111111112222222222333
    '          12345678901234567890123456789012
    m$ = m$ + "................................" + Chr$(13) ' 1
    m$ = m$ + "................................" + Chr$(13) ' 2
    m$ = m$ + "................................" + Chr$(13) ' 3
    m$ = m$ + "................................" + Chr$(13) ' 4
    m$ = m$ + "................................" + Chr$(13) ' 5
    m$ = m$ + "................................" + Chr$(13) ' 6
    m$ = m$ + "................................" + Chr$(13) ' 7
    m$ = m$ + "................................" + Chr$(13) ' 8
    m$ = m$ + "................................" + Chr$(13) ' 9
    m$ = m$ + "................................" + Chr$(13) ' 10
    m$ = m$ + "................................" + Chr$(13) ' 11
    m$ = m$ + "................................" + Chr$(13) ' 12
    m$ = m$ + "................................" + Chr$(13) ' 13
    m$ = m$ + "................................" + Chr$(13) ' 14
    m$ = m$ + "....It's a SCREEN resolution?..." + Chr$(13) ' 15
    m$ = m$ + "................................" + Chr$(13) ' 16
    m$ = m$ + "................................" + Chr$(13) ' 17
    m$ = m$ + "................................" + Chr$(13) ' 18
    m$ = m$ + "................................" + Chr$(13) ' 19
    m$ = m$ + "................................" + Chr$(13) ' 20
    m$ = m$ + "................................" + Chr$(13) ' 21
    m$ = m$ + "................................" + Chr$(13) ' 22
    m$ = m$ + "................................" + Chr$(13) ' 23
    m$ = m$ + "................................" + Chr$(13) ' 24
    m$ = m$ + "................................" + Chr$(13) ' 25
    m$ = m$ + "................................" + Chr$(13) ' 26
    m$ = m$ + "................................" + Chr$(13) ' 27
    m$ = m$ + "................................" + Chr$(13) ' 28
    m$ = m$ + "................................" + Chr$(13) ' 29
    m$ = m$ + "................................" + Chr$(13) ' 30
    m$ = m$ + "................................" + Chr$(13) ' 31
    m$ = m$ + "................................" + Chr$(13) ' 32
    PetrText1$ = m$
End Function ' PetrText1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToString$ (MyArray( 1 To 32 , 1 To 32) As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        MyString = MyString + sLine + Chr$(13)
    Next iY
    ArrayToString$ = MyString
End Function ' ArrayToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ArrayToStringTest$ (MyArray() As String)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
 
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    For iY = LBound(MyArray, 1) To UBound(MyArray, 1)
        sLine = ""
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        For iX = LBound(MyArray, 2) To UBound(MyArray, 2)
            sLine = sLine + MyArray(iY, iX)
        Next iX
        sLine = sLine + Right$("  " + cstr$(iY), 2)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "  12345678901234567890123456789012" + Chr$(13)
    MyString = MyString + "           11111111112222222222333" + Chr$(13)
    ArrayToStringTest$ = MyString
End Function ' ArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function RotationArrayToStringTest$ (RoArray() As RotationType)
    Dim MyString As String
    Dim iY As Integer
    Dim iX As Integer
    Dim sLine As String
    MyString = ""
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    For iY = LBound(RoArray, 1) To UBound(RoArray, 1)
        sLine = ""
        sLine = sLine + Right$("    " + cstr$(iY), 3)
        For iX = LBound(RoArray, 2) To UBound(RoArray, 2)
            sLine = sLine + Chr$(RoArray(iX, iY, 0).c)
        Next iX
        sLine = sLine + Right$("   " + cstr$(iY), 3)
        MyString = MyString + sLine + Chr$(13)
    Next iY
    MyString = MyString + "   654321098765432101234567890123456" + Chr$(13)
    MyString = MyString + "   1111111                   1111111" + Chr$(13)
    MyString = MyString + "   ---------------- ++++++++++++++++" + Chr$(13)
    RotationArrayToStringTest$ = MyString
End Function ' RotationArrayToStringTest$
 
' /////////////////////////////////////////////////////////////////////////////
' 1. split string by line breaks CHR$(13)
' 2. split lines up to 1 column per char
' 3. count rows, columns
' 4. DIM array, making sure array has
'    a) an _ODD_ number of rows/columns, with a center point
'    b) index is in cartesian format, where center is (0,0)
' 5. populate array with contents of string
 
' dimension #1 = columns
' dimension #2 = rows
 
Sub StringToRotationArray (RoArray() As RotationType, MyString As String, EmptyChar As String)
    Dim RoutineName As String: RoutineName = "StringToRotationArray"
    ReDim arrLines$(0)
    Dim delim$
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iColCount As Integer
    Dim iRowCount As Integer
    Dim iCount As Integer
    Dim bAddedRow As Integer: bAddedRow = FALSE
    Dim bAddedColumn As Integer: bAddedColumn = FALSE
    Dim iHalf1 As Integer
    Dim iHalf2 As Integer
    Dim iFrom1 As Integer
    Dim iFrom2 As Integer
    Dim iTo1 As Integer
    Dim iTo2 As Integer
    Dim iEmpty As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
 
    iRowCount = UBound(arrLines$) + 1
 
    ' look at all the rows and find the max # of columns used
    iColCount = 0
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
 
        ' count the columns for this row
        iCount = 0
        For iCol% = 1 To Len(arrLines$(iRow%))
            iCount = iCount + 1
        Next iCol%
 
        ' if this row has the most so far, then set that to the max
        If iCount > iColCount Then
            iColCount = iCount
        End If
    Next iRow%
 
    ' adjust columns to be odd
    If IsEven%(iColCount) Then
        iColCount = iColCount + 1
        bAddedColumn = TRUE
    End If
 
    ' calculate array bounds for columns
    iHalf1 = (iColCount - 1) / 2
    iFrom1 = 0 - iHalf1
    iTo1 = iHalf1
 
    ' adjust rows to be odd
    If IsEven%(iRowCount) Then
        iRowCount = iRowCount + 1
        bAddedRow = TRUE
    End If
 
    ' calculate array bounds for rows
    iHalf2 = (iRowCount - 1) / 2
    iFrom2 = 0 - iHalf2
    iTo2 = iHalf2
 
    ' size array to new bounds
    ReDim RoArray(iFrom1 To iTo1, iFrom2 To iTo2, 127) As RotationType
 
    ' get value for empty
    If Len(EmptyChar) > 0 Then
        iEmpty = Asc(EmptyChar)
    Else
        iEmpty = 32 ' (use space as default)
    End If
 
    ' clear array
    For iY = LBound(RoArray, 2) To UBound(RoArray, 2)
        For iX = LBound(RoArray, 1) To UBound(RoArray, 1)
            RoArray(iX, iY, 0).c = iEmpty
            RoArray(iX, iY, 0).origx = iX
            RoArray(iX, iY, 0).origy = iY
        Next iX
    Next iY
 
    ' fill array
    iY = LBound(RoArray, 2) - 1
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        iY = iY + 1
        iX = LBound(RoArray, 1) - 1
        For iCol% = 1 To Len(arrLines$(iRow%))
            iX = iX + 1
            sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
            RoArray(iX, iY, 0).c = Asc(sChar$)
        Next iCol%
    Next iRow%
 
End Sub ' StringToRotationArray
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub StringToArray (MyArray() As String, MyString As String)
    Dim delim$
    ReDim arrLines$(0)
    Dim iRow%
    Dim iCol%
    Dim sChar$
    Dim iDim1 As Integer
    Dim iDim2 As Integer
    iDim1 = LBound(MyArray, 1)
    iDim2 = LBound(MyArray, 2)
    delim$ = Chr$(13)
    split MyString, delim$, arrLines$()
    For iRow% = LBound(arrLines$) To UBound(arrLines$)
        If iRow% <= UBound(MyArray, 2) Then
            For iCol% = 1 To Len(arrLines$(iRow%))
                If iCol% <= UBound(MyArray, 1) Then
                    sChar$ = Mid$(arrLines$(iRow%), iCol%, 1)
 
                    If Len(sChar$) > 1 Then
                        sChar$ = Left$(sChar$, 1)
                    Else
                        If Len(sChar$) = 0 Then
                            sChar$ = "."
                        End If
                    End If
                    MyArray(iRow% + iDim1, (iCol% - 1) + iDim2) = sChar$
                Else
                    ' Exit if out of bounds
                    Exit For
                End If
            Next iCol%
        Else
            ' Exit if out of bounds
            Exit For
        End If
    Next iRow%
End Sub ' StringToArray
 
' /////////////////////////////////////////////////////////////////////////////
 
'SUB ClearArray (MyArray(1 To 32, 1 To 32) AS STRING, MyString As String)
Sub ClearArray (MyArray() As String, MyString As String)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar$
    If Len(MyString) = 1 Then
        sChar$ = MyString
    Else
        If Len(MyString) = 0 Then
            sChar$ = " "
        Else
            sChar$ = Left$(MyString, 1)
        End If
    End If
    For iRow = LBound(MyArray, 1) To UBound(MyArray, 1)
        For iCol = LBound(MyArray, 2) To UBound(MyArray, 2)
            MyArray(iRow, iCol) = sChar$
        Next iCol
    Next iRow
End Sub ' ClearArray
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TrueFalse$ (myValue)
    If myValue = TRUE Then
        TrueFalse$ = "TRUE"
    Else
        TrueFalse$ = "FALSE"
    End If
End Function ' TrueFalse$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Title: Re: 3-shear rotation issue rotating to 30, 60, 120, 150, 210, 240, 300, 330 degrees
Post by: madscijr on December 29, 2021, 05:01:41 pm

SheerRotate4 vs SheerRotate6:

29 degrees (same for all versions):
[ This attachment cannot be displayed inline in 'Print Page' view ]

30 degrees with SheerRotate4:
[ This attachment cannot be displayed inline in 'Print Page' view ]

30 degrees with SheerRotate6:
[ This attachment cannot be displayed inline in 'Print Page' view ]

31 degrees (same for all versions):
[ This attachment cannot be displayed inline in 'Print Page' view ]

Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: madscijr on December 20, 2021, 06:33:02 pm