Theodorus Spiral

[Roland Chastain]

Hello everybody!

Here is a simple Theodorus spiral.

Code: Select all

' vectors.bi

type TVector
  x as double
  y as double
end type

declare function Rotate(byval AVector as TVector, byval ATheta as double) as TVector
declare function Perpendicular(byval AVector as TVector, byval AClockWise as boolean = FALSE) as TVector
declare function Normalize(byval AVector as TVector) as TVector
declare function Add(byval AVector1 as TVector, byval AVector2 as TVector) as TVector
declare function Scale(byval AVector as TVector, byval AFactor as double) as TVector
declare function Mirror(byval AVector as TVector) as TVector

function Rotate(byval AVector as TVector, byval ATheta as double) as TVector
/'
  x' = x cos θ − y sin θ
  y' = x sin θ + y cos θ
'/
  dim result as TVector
  with AVector
    result.x = .x * Cos(ATheta) - .y * Sin(ATheta)
    result.y = .x * Sin(ATheta) + .y * Cos(ATheta)
  end with
  return result
end function

function Perpendicular(byval AVector as TVector, byval AClockWise as boolean) as TVector
/'
  x' = x cos θ − y sin θ
  y' = x sin θ + y cos θ
'/
  dim result as TVector
  dim as integer LSign = IIf(AClockWise, -1, 1)
  with AVector
    result.x = -.y * LSign
    result.y =  .x * LSign
  end with
  return result
end function

function Normalize(byval AVector as TVector) as TVector
  dim result as TVector
  dim LLength as double
  with AVector
    LLength = Sqr(.x * .x + .y * .y)
    result.x = .x / LLength
    result.y = .y / LLength
  end with
  return result
end function

function Add(byval AVector1 as TVector, byval AVector2 as TVector) as TVector
  dim result as TVector
  result.x = AVector1.x + AVector2.x
  result.y = AVector1.y + AVector2.y
  return result
end function

function Scale(byval AVector as TVector, byval AFactor as double) as TVector
  dim result as TVector
  with AVector
    result.x = .x * AFactor
    result.y = .y * AFactor
  end with
  return result
end function

function Mirror(byval AVector as TVector) as TVector
  dim result as TVector
  with AVector
    result.x =  .x
    result.y = -.y
  end with
  return result
end function

Code: Select all

' theodorus.bas

#include "vectors.bi"

const SW = 640
const SH = SW
const CNumTriangles = 16
const CScale = 72

dim shared LCenter as TVector = (SW / 2, SH / 2)
dim shared LColor as uinteger = rgb(0, 255, 0)

sub DrawLine(byval APoint1 as TVector, byval APoint2 as TVector)
  
  APoint1 = Add(LCenter, Mirror(Scale(APoint1, CScale)))
  APoint2 = Add(LCenter, Mirror(Scale(APoint2, CScale)))
  
  line(APoint1.x, APoint1.y)-(APoint2.x, APoint2.y), LColor
end sub

screenres SW, SH, 32
windowtitle "Theodorus Spiral"

dim A as TVector = (0.0, 0.0)
dim B as TVector = (1.0, 0.0)
dim C as TVector

for i as integer = 1 to CNumTriangles
  C = Add(B, Normalize(Perpendicular(B)))
  
  DrawLine(A, B)
  DrawLine(B, C)

  B = C
next

' Close the last triangle
DrawLine(C, A)

sleep

[neil]

Maybe you could try to make something like this?
Colored extended spiral of Theodorus with 110 triangles.
https://en.wikipedia.org/wiki/Spiral_of ... tended.svg

[Roland Chastain]

Here is a Cairo version.

Code: Select all

' color.bi

type TColor
  r as double
  g as double
  b as double
  a as double
  declare constructor(as uinteger)
  declare constructor(as double, as double, as double, as double = 1.0)
end type

constructor TColor(rgba_ as uinteger)
  r = (rgba_ and &hFF000000) / &hFF000000
  g = (rgba_ and &h00FF0000) / &h00FF0000
  b = (rgba_ and &h0000FF00) / &h0000FF00
  a = (rgba_ and &h000000FF) / &h000000FF
end constructor

constructor TColor(r_ as double, g_ as double, b_ as double, a_ as double)
  r = r_
  g = g_
  b = b_
  a = a_
end constructor

/'
dim c1 as TColor = TColor(&hFF00FF80)

with c1
  print(.r)
  print(.g)
  print(.b)
  print(.a)
end with

dim c2 as TColor = TColor(1.0, 1.0, 1.0, 0.5)

with c2
  print(.r)
  print(.g)
  print(.b)
  print(.a)
end with
'/

Code: Select all

' command.bi

' https://www.freebasic.net/forum/viewtopic.php?p=206588#p206588

'  Tested with the passed parameters:
'  "+3 --option1 -4 --option2=-5 foo.bas --option3=file.ext"

type TCommandLineOption
  public:
    key as string ' option name
    value as string
end type

type TCommandLine
  public:
    declare constructor ()
    declare function HasOption(byref aOptionName as const string) as integer
    declare function GetOptionValue(byref aOptionName as const string) as string
    declare function GetAloneValueNth(byval n as integer) as string
  private:
    dim aOptions(any) as TCommandLineOption
End Type

function SameString(byref aLeft as const string, byref aRight as const string, byref aCaseSensitive as const boolean) as boolean
  if aCaseSensitive then
    return aLeft = aRight
  else
    return lcase(aLeft) = lcase(aRight)
  end if
end function

dim shared caseSensitive as boolean = false

constructor TCommandLine ()
  erase(aOptions)
  dim i as integer = 0
  do while command(i + 1) <> ""
    redim preserve aOptions(i)
    if left(command(i + 1), 2) = "--" then
      dim n as integer = instr(3, command(i + 1), "=")
      if n = 0 then
        aOptions(i).key = mid(command(i + 1), 3)
      else
        aOptions(i).key = mid(command(i + 1), 3, n - 3)
        aOptions(i).value = mid(command(i + 1), n + 1)
      end if
    else
      aOptions(i).value = command(i + 1)
    end if
    i += 1
  loop
end constructor

function TCommandLine.HasOption(byref aOptionName as const string) as integer
  for i as integer = LBound(aOptions) to UBound(aOptions)
    if (aOptions(i).key <> "") andalso SameString(aOptions(i).key, aOptionName, caseSensitive) then
      return -1
    end if
  next i
  return 0
end function

function TCommandLine.GetOptionValue(byref aOptionName as const string) as string
  for i as integer = LBound(aOptions) to UBound(aOptions)
    if (aOptions(i).key <> "") andalso SameString(aOptions(i).key, aOptionName, caseSensitive) then
      return aOptions(i).value
    end if
  next i
  return ""
end function

function TCommandLine.GetAloneValueNth(byval n as integer) as string
  dim k as integer = 0
  for i as integer = LBound(aOptions) to UBound(aOptions)
    if aOptions(i).key = "" then
      k += 1
      if k = n then
        return aOptions(i).value
      end if
    end if 
  next i
  return ""
end function

/'
dim myOptions as TCommandLine

print(myOptions.HasOption("option1"))
print("[" & myOptions.GetOptionValue("option2") & "]")

dim n as integer = 1
var s = myOptions.GetAloneValueNth(n)
do while s <> ""
  print("[" & s & "]")
  n += 1
  s = myOptions.GetAloneValueNth(n)
loop
'/

Code: Select all

' theodorus.bas

' Theodorus spiral

#include "cairo/cairo.bi"
#include "color.bi"
#include "command.bi"
#include "vectors.bi"

#define EXPAND_TCOLOR(c) c.r, c.g, c.b, c.a

dim as integer scrWidth = 640
dim as integer scrHeight = scrWidth
dim as integer numTriangles = 16
dim shared as double scale_ = 64

sub DrawTriangle(byval APoint1 as TVector, byval APoint2 as TVector, byval APoint3 as TVector, byval cr as cairo_t ptr, pen as TColor, fill as TColor)
  
  dim as TVector LPoint4, LPoint5, LPoint6
  
  APoint1 = Scale(APoint1, scale_)
  APoint2 = Scale(APoint2, scale_)
  APoint3 = Scale(APoint3, scale_)

  cairo_move_to(cr, APoint1.x, APoint1.y)
  cairo_line_to(cr, APoint2.x, APoint2.y)
  cairo_line_to(cr, APoint3.x, APoint3.y)
  cairo_close_path(cr)
  
  cairo_set_source_rgba(cr, EXPAND_TCOLOR(fill))
  cairo_fill_preserve(cr)
  cairo_set_source_rgba(cr, EXPAND_TCOLOR(pen))
  cairo_stroke(cr)
  
  LPoint4 = Scale(Normalize(Perpendicular(APoint2)), 8)
  LPoint5 = Perpendicular(LPoint4)
  LPoint6 = Perpendicular(LPoint5)
  
  LPoint4 = Add(APoint2, LPoint4)
  
  cairo_move_to(cr, LPoint4.x, LPoint4.y)
  cairo_rel_line_to(cr, LPoint5.x, LPoint5.y)
  cairo_rel_line_to(cr, LPoint6.x, LPoint6.y)
  cairo_set_source_rgba(cr, EXPAND_TCOLOR(pen))
  cairo_stroke(cr)
end sub

screenres scrWidth, scrHeight, 32
windowtitle "Theodorus Spiral"

dim cl as TCommandLine

dim as TColor bkColor = TColor(0.0, 0.0, 0.0, 0.0)
dim as TColor penColor = TColor(0.0, 0.3, 0.0, 1.0)
dim as TColor fillColor = TColor(0.0, 0.5, 0.0, 1.0)

if cl.HasOption("bkcolor") then
  bkColor = TColor(valint("&h" & cl.GetOptionValue("bkcolor")))
end if
if cl.HasOption("pencolor") then
  penColor = TColor(valint("&h" & cl.GetOptionValue("pencolor")))
end if
if cl.HasOption("fillcolor") then
  fillColor = TColor(valint("&h" & cl.GetOptionValue("fillcolor")))
end if
if cl.HasOption("triangles") then
  numTriangles = valint(cl.GetOptionValue("triangles"))
end if

dim as any ptr image = imagecreate(scrWidth, scrHeight, rgba(0, 0, 0, 0))
dim as any ptr pixels
imageinfo(image, scrWidth, scrHeight,,, pixels)
dim as cairo_surface_t ptr sf = cairo_image_surface_create_for_data(pixels, CAIRO_FORMAT_ARGB32, scrWidth, scrHeight, scrWidth * 4)
dim as cairo_t ptr cr = cairo_create(sf)

cairo_set_source_rgba(cr, EXPAND_TCOLOR(bkColor))
cairo_paint(cr)
cairo_translate(cr, scrWidth / 2, scrHeight / 2)
cairo_scale(cr, 1, -1)
cairo_set_line_cap(cr, CAIRO_LINE_CAP_ROUND)
cairo_set_line_width(cr, 0.8)

dim LPoint1 as TVector = (0.0, 0.0)
dim LPoint2 as TVector = (1.0, 0.0)
dim LPoint3 as TVector

for i as integer = 1 to numTriangles
  LPoint3 = Add(LPoint2, Normalize(Perpendicular(LPoint2)))

  DrawTriangle(LPoint1, LPoint2, LPoint3, cr, penColor, fillColor)

  LPoint2 = LPoint3
next

cairo_destroy(cr)
cairo_surface_write_to_png(sf, "image.png")
cairo_surface_destroy(sf)

screenlock()
put (0, 0), image, pset
screenunlock()

imagedestroy image

sleep

You can find vectors.bi in the first post.

Usage example (under Linux):

./theodorus --bkcolor=EBF7E3FF --pencolor=1B3409FF --fillcolor=9BD770FF --triangles=16

Maybe you could try to make something like this?

Thanks for the idea. I imagine we should store all points in memory and draw the triangles in the reverse order.

P.-S. Made little improvements in the program, and created a git repository.

[dafhi]

thanks for providing the image. that's beautiful.

[Roland Chastain]

thanks for providing the image. that's beautiful.

Thank you for the compliment.