' version 02-05-2016
' compile with: fbc -s console

#Macro header
    Print
    Print "      a      b      c      s   area"
    Print "-----------------------------------"
#EndMacro

Type triangle
    Dim As UInteger a
    Dim As UInteger b
    Dim As UInteger c
    Dim As UInteger s
    Dim As UInteger area
End Type

Function gcd(x As UInteger, y As UInteger) As UInteger

    Dim As UInteger t

    While y
        t = y
        y = x Mod y
        x = t
    Wend

    Return x

End Function

Function Heronian_triangles(a_max As UInteger, b_max As UInteger, _
            c_max As UInteger, result() As triangle) As UInteger

    Dim As UInteger a, b, c
    Dim As UInteger s, sqroot, total, temp

    For a = 1 To a_max
        For b = a To b_max
            ' make sure that a + b + c is even
            For c = b + (a And 1) To c_max Step 2
                ' to form a triangle a + b must be greater then c
                If (a + b) <= c Then Exit For
                ' check if a, b and c have a common divisor
                If (gcd(c, b) <> 1 And gcd(c, a) <> 1) Then
                    Continue For
                End If
                s = (a + b + c) \ 2
                temp = s * (s - a) * (s - b) * (s - c)
                sqroot = Sqr(temp)
                If (sqroot * sqroot) = temp Then
                    total += 1
                    With result(total)
                        .a = a
                        .b = b
                        .c = c
                        .s = s
                        .area = sqroot
                    End With
                End If
            Next
        Next
    Next

    Return total

End Function


Sub sort_tri(result() As triangle, total As UInteger)
    ' shell sort
    ' sort order: area, s, c

    Dim As UInteger x, y, inc, done

    inc = total
    Do
        inc = IIf(inc > 1, inc \ 2, 1)
        Do
            done = 0
            For x = 1 To total - inc
                y = x + inc
                If result(x).area > result(y).area Then
                    Swap result(x), result(y)
                    done = 1
                Else
                    If result(x).area = result(y).area Then
                        If result(x).s > result(y).s Then
                            Swap result(x), result(y)
                            done = 1
                        Else
                            If result(x).s = result(y).s Then
                                If result(x).c > result(y).c Then
                                    Swap result(x), result(y)
                                    done = 1
                                End If
                            End If
                        End If
                    End If
                End If
            Next
        Loop Until done = 0
    Loop Until inc = 1

End Sub


' ------=< MAIN >=------

ReDim result(1 To 1000) As triangle
Dim As UInteger x, y, total

total = Heronian_triangles(200, 200, 200, result() )

' trim the array by removing empty entries
ReDim Preserve result(1 To total ) As triangle

sort_tri(result(), total)

Print "There are ";total;" Heronian triangles with sides <= 200"
Print

Print "First ten sorted entries"
header   ' print header
For x = 1 To IIf(total > 9, 10, total)
    With result(x)
        Print Using "  #####"; .a; .b; .c; .s; .area
    End With
Next
Print
Print

Print "Entries with a area = 210"
header   ' print header
For x = 1 To UBound(result)
    With result(x)
        If .area = 210 Then
            Print Using "  #####"; .a; .b; .c; .s; .area
        End If
    End With
Next

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End