Optimizing for Speed

[TarotRedhand]

And the flood fill routine that makes use of a simple stack. TBH, I was actually quite proud of this one. Only problem is that modern machines are so fast that (oh irony of ironies) you'll have to add in delays to see how it works like in the old 8/16 bit days. 

Fill.BAS

Code: (Select All)

Const TRUE = -1
Const FALSE = Not TRUE

Const MaxX% = 319 'SCREEN 13
Const MaxY% = 199 'SCREEN 13

Screen 13
_FullScreen _SquarePixels
Line (50, 50)-(250, 140), 14, B
Line (100, 70)-(200, 125), 14, B
Line (60, 60)-(90, 90), 14, B
Line (70, 100)-(95, 120), 14, B
Circle (225, 75), 20, 14
Sleep
SeedFill 225, 100, 12, 14
Sleep
End

Sub InitialiseStack (MyStack%(), TopOfStack%, StackEmpty%)
    For Index% = 1 To 200
        MyStack%(Index%, 1) = 0
        MyStack%(Index%, 2) = 0
    Next
    TopOfStack% = 0
    StackEmpty% = TRUE
End Sub

Sub Push (X%, Y%, MyStack%(), TopOfStack%, StackEmpty%)
    TopOfStack% = TopOfStack% + 1
    MyStack%(TopOfStack%, 1) = X%
    MyStack%(TopOfStack%, 2) = Y%
    StackEmpty% = FALSE
End Sub

Sub Pop (X%, Y%, MyStack%(), TopOfStack%, StackEmpty%)
    X% = MyStack%(TopOfStack%, 1)
    Y% = MyStack%(TopOfStack%, 2)
    TopOfStack% = TopOfStack% - 1
    StackEmpty% = (TopOfStack% = 0)
End Sub

Sub SeedFill (SeedX%, SeedY%, FillColour%, BorderColour%)
    Dim MyStack%(1 To 200, 1 To 2)
    InitialiseStack MyStack%(), TopOfStack%, StackEmpty%
    Push SeedX%, SeedY%, MyStack%(), TopOfStack%, StackEmpty%
    Do While Not StackEmpty%
        Pop X%, Y%, MyStack%(), TopOfStack%, StackEmpty%
        PSet (X%, Y%), FillColour%
        SaveX% = X%
        SaveY% = Y%
        X% = X% + 1
        Do
            If X% > MaxX% Then Exit Do
            Colour% = Point(X%, Y%)
            If Colour% = BorderColour% Then Exit Do
            PSet (X%, Y%), FillColour%
            X% = X% + 1
        Loop
        RightX% = X% - 1
        X% = SaveX%
        If X% > 0 Then
            X% = X% - 1
            Do
                Colour% = Point(X%, Y%)
                If Colour% = BorderColour% Then Exit Do
                PSet (X%, Y%), FillColour%
                If X% = 0 Then Exit Do
                X% = X% - 1
            Loop
        End If
        If X% = 0 Then
            LeftX% = X%
        Else
            X% = X% + 1
            LeftX% = X%
        End If
        Y% = Y% + 1
        If Y% <= MaxY% Then
            Do While X% <= RightX%
                Colour% = Point(X%, Y%)
                If ((Colour% = FillColour%) Or (Colour% = BorderColour%)) Then
                    Do
                        X% = X% + 1
                        If X% >= RightX% Then Exit Do
                        Colour% = Point(X%, Y%)
                        If ((Colour% <> FillColour%) And (Colour% <> BorderColour%)) Then Exit Do
                    Loop
                Else
                    Push X%, Y%, MyStack%(), TopOfStack%, StackEmpty%
                    Do
                        X% = X% + 1
                        If X% >= RightX% Then Exit Do
                        Colour% = Point(X%, Y%)
                        If ((Colour% = FillColour%) Or (Colour% = BorderColour%)) Then Exit Do
                    Loop
                End If
            Loop
        End If
        X% = LeftX%
        Y% = SaveY% - 1
        If ((Y% >= 0) And (Y% < MaxY%)) Then
            Do While X% <= RightX%
                Colour% = Point(X%, Y%)
                If ((Colour% = FillColour%) Or (Colour% = BorderColour%)) Then
                    Do
                        X% = X% + 1
                        If X% >= RightX% Then Exit Do
                        Colour% = Point(X%, Y%)
                        If ((Colour% <> FillColour%) And (Colour% <> BorderColour%)) Then Exit Do
                    Loop
                Else
                    Push X%, Y%, MyStack%(), TopOfStack%, StackEmpty%
                    Do
                        X% = X% + 1
                        If X% >= RightX% Then Exit Do
                        Colour% = Point(X%, Y%)
                        If ((Colour% = FillColour%) Or (Colour% = BorderColour%)) Then Exit Do
                    Loop
                End If
            Loop
        End If
    Loop
End Sub

TR