Const PI As Double = 3.1415926535897932
Const ScrW = 320, ScrH = 240

Type HoughParams
    ntx As Integer = 460
    mry As Integer = 360
End Type
Dim params As HoughParams

Screenres params.ntx, params.mry, 32
Windowtitle "Hough Transform"

Function HoughTransform(imagen As Any Ptr, params As HoughParams) As Any Ptr
    Dim As Integer nimx, mimy, bypp
    Imageinfo imagen, nimx, mimy, , bypp

    Dim him As Any Ptr = Imagecreate(params.ntx, params.mry, Rgb(255,255,255), 32)

	Dim As Double rmax = Sqr(nimx * nimx + mimy * mimy)
    Dim As Double dr = rmax / (params.mry / 2)
    Dim As Double dth = PI / params.ntx
    	
	For jx As Integer = 0 To nimx - 1
        For iy As Integer = 0 To mimy - 1

            Dim As Ulong col = Point(jx, iy, imagen)
            Dim As Integer r = (col Shr 16) And 255
            Dim As Integer g = (col Shr 8) And 255
            Dim As Integer b = col And 255
            Dim As Integer gray = (r + g + b) \ 3

            If gray > 128 Then Continue For

            ' Hough transform
            For t As Integer = 0 To params.ntx - 1
                Dim As Double th = dth * t
                Dim As Double rho = jx * Cos(th) + iy * Sin(th)
                Dim As Integer ir = params.mry \ 2 - Int(rho / dr + 0.5)

                If ir >= 0 And ir < params.mry Then
                    Dim As Ulong oldcol = Point(t, ir, him)
                    Dim As Integer v = (oldcol Shr 16) And 255
                    If v > 0 Then v -= 1
                    Pset him, (t, ir), Rgb(v, v, v)
                End If
            Next
        Next
    Next

    Return him
End Function

Dim As Any Ptr imagen = Imagecreate(ScrW, ScrH)
Bload("Pentagon.bmp", imagen)

Dim resultado As Any Ptr = HoughTransform(imagen, params)
BSave "hough.bmp", resultado
Put (0,0), resultado, PSet

Sleep