Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Circles.bas                     by Jordi Vallès      version 1a     04/09/2008
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' In a rectangular area filled with a number of non-intersecting circles with
' radius variable or fixed, find the biggest possible circle to fit in without
' intersecting other circles or draw outside the boundary of the space.
'
' This kind of problems are titled as "kissing circles" or "kissing coins" by
' several authors.
'
' Interesting information about 2D Circle Packing can be found on:
'   Mathworld Wolfram CirclePacking
'
' Operation:
' Click 'Reset' to sow at random graphic area with circles. This button only
'    is needed if 'Number of Circles' or 'Fixed Circle Size' have been changed.
' Click 'Start' to start the search cycle.
' After some moments, depending of accuracy selected, a red circle will appear,
' that is the best and biggest circle the program has found so far.
' Click 'Cancel' to cancel the current search and return to wait for a new
'    action operator.
' Tooltips are available on all controls to help operation.
'
' See statistics and compare with different parameter values with same
' map of circles.
'
' All relevant data is displayed on Log window. This window can be erased
' and saved as text file with unique name in current directory. Also
' contents can be selected, totally or partial, with mouse and set on
' clipboard for general use.
'
' This program can be used as "framework" to experiment with algorithms and
' methods to play with packing problems. Several math refinements can be
' explored. On a future a revised version of this program can use more
' elaborated search methods.
'
' At start time the data collected on InitialData procedure is used and shown.
' This data can be set by user to experiment with specific combinations and
' parameters.
'
' Part of source used here comes from:
' Dave Navarro, Borje Hagsten, Eros Olmi, Petr Schreiber, Erik Christensen,
' Eddy Van Esch, Chris Holbrook, etc.
' Additionally, thanks to Michael Mattias and Semen Matusovski for explanations
' on several old PB forum entries related with PB Threads on Graphics.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  - Program developed and tested with PowerBASIC for Windows (PB/Win 8.04) on
'    PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium.
'  - Only PB Graphic package is used to show information generated by program.
'  - 04/10/2008 Recompiled and tested with PB 9.00.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' SED_PBWIN

#COMPILE EXE "Circles.exe"
#DIM ALL

#INCLUDE "Win32Api.inc"
#INCLUDE "CommCtrl.inc"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%ID_RESET     = 1010
%ID_START     = 1020
%ID_CANCEL    = 1030
%ID_GRAPHIC   = 1040
%ID_TOP       = 1050
%ID_BOT       = 1060
%ID_NDISKS    = 1070
%ID_MAXRAD    = 1080
%ID_STEPF     = 1090
%ID_SAVE      = 1100
%ID_ENUM      = 1110
%ID_FIXRAD    = 1120
%ID_PREC1     = 1130
%ID_PREC2     = 1140
%ID_PREC3     = 1150
%ID_CONSOLE   = 1160
%ID_CLOG      = 1170
%ID_DEBUG     = 1180

%MINRADIUS    = 15                  'minimum radius for variable circles
%MAXRADIUS    = 45                  'maximum radius for variable circles
%DEFRADIUS    = 25                  'default radius for fixed circles
%INITCIRCLE   = 90                  'default size for circle to be insert
%NUMCIRCLES   = 20                  'number of circles as default
%STEPFACTOR   = 2                   'step value to be used on first main loop

%CANVAS       = &hEEFAFA???         'RGB(250,250,238)
%LTLINES      = &hEAEAEA???         'RGB(234,234,234)
$TITLE = "Best fit circle - 1a   (framework)"   'title on caption
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
MACRO Form0(D,L) = RSET$(FORMAT$(D,"#,"),L)
MACRO Form2(D,L) = RSET$(FORMAT$(D,"#0.00"),L)
MACRO Form6(D,L) = RSET$(FORMAT$(D,"#0.000000"),L)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DECLARE FUNCTION MakeFontEx(BYVAL FontName AS STRING, BYVAL PointSize AS LONG, BYVAL fBold AS LONG, _
                            BYVAL fItalic AS LONG, BYVAL fUnderline AS LONG) AS DWORD
DECLARE FUNCTION EnumCharSet(elf AS ENUMLOGFONT, ntm AS NEWTEXTMETRIC, BYVAL FontType AS LONG, CharSet AS LONG) AS LONG
DECLARE FUNCTION CirclesDoNotIntersect(BYVAL diskX1 AS SINGLE, BYVAL diskY1 AS SINGLE, BYVAL diskR AS SINGLE) AS LONG
DECLARE FUNCTION WorkingAll(BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION CurrentTimeInSeconds() AS DOUBLE
DECLARE SUB OutString(txtMsg AS STRING, OPTIONAL BYVAL forceRedraw AS LONG)
DECLARE SUB SetToolTipText(hTool AS DWORD, ID AS LONG, BYVAL txt AS STRING)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
TYPE TCIRCLE
   X     AS SINGLE      'X position
   Y     AS SINGLE      'Y position
   R     AS SINGLE      'radius
END TYPE

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GLOBAL hDlg, hThread         AS DWORD      'dialog and console handlers
GLOBAL hFont1, hFont2        AS DWORD      'handlers for fonts used here
GLOBAL rWs, rHs              AS SINGLE     'size of main canvas, needed of calculations as Single
GLOBAL Circ()                AS tCircle    'main program array
GLOBAL bestX, bestY, bestR   AS SINGLE     'red disk values obtained
GLOBAL initCircle            AS SINGLE     'red disk initial radius
GLOBAL stepFactor            AS SINGLE     'step value for pass 1
GLOBAL precision             AS SINGLE     'accuracy on search
GLOBAL numCircles            AS LONG       'number of circles defined
GLOBAL eNum, fixRad          AS LONG
GLOBAL emergencyStop         AS LONG
GLOBAL aToolTipText          AS ASCIIZ * 256
GLOBAL hToolTip              AS DWORD

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION PBMAIN () AS LONG
   LOCAL signature AS ASCIIZ * 120
   LOCAL rW, rH AS LONG

   '--- only one instance of this program is allowed ---
   signature = $TITLE + $TITLE + $TITLE
   IF CreateMutex(BYVAL 0, 1, signature) THEN
      IF GetLastError = %ERROR_ALREADY_EXISTS THEN EXIT FUNCTION
   END IF

   '--- create dialog window ---
   DIALOG NEW PIXELS, 0, $TITLE, , , 784, 460, %WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg

   CONTROL ADD GRAPHIC, hDlg, %ID_GRAPHIC,"", 3, 3, 502, 402, %WS_BORDER OR %SS_NOTIFY
   CONTROL GET CLIENT hDlg, %ID_GRAPHIC TO rW, rH     'get client (canvas) size
   GRAPHIC SCALE (0, 0) - (rW, rH)                    'scale to pixel coordinate system
   'convert canvas size to single values to avoid extra conversions during process
   rWs = rW  :  rHs = rH

   GRAPHIC ATTACH hDlg, %ID_GRAPHIC, REDRAW
   GRAPHIC FONT "Arial", 7, 0
   GRAPHIC COLOR %BLACK, %CANVAS                       'canvas colors
   GRAPHIC CLEAR

   CONTROL ADD BUTTON,  hDlg, %ID_RESET,   "Reset",                    490, 418,  60, 32
   CONTROL ADD BUTTON,  hDlg, %ID_START,   "Start",                    552, 418,  60, 32
   CONTROL ADD BUTTON,  hDlg, %ID_CANCEL,  "Cancel",                   614, 418,  60, 32
   CONTROL ADD BUTTON,  hDlg, %ID_TOP,     "top",                      698, 412,  40, 22
   CONTROL ADD BUTTON,  hDlg, %ID_BOT,     "bot",                      698, 434,  40, 22
   CONTROL ADD BUTTON,  hDlg, %ID_SAVE,    "save",                     740, 412,  40, 22
   CONTROL ADD BUTTON,  hDlg, %ID_CLOG,    "clear",                    740, 434,  40, 22
   CONTROL ADD CHECKBOX,hDlg, %ID_ENUM,    "enumerate circles",        280, 408, 102, 16
   CONTROL ADD CHECKBOX,hDlg, %ID_FIXRAD,  "fixed circle size",        280, 424, 102, 16
   CONTROL ADD CHECKBOX,hDlg, %ID_DEBUG,   "debug mode",               280, 440, 102, 16

   CONTROL ADD LABEL,   hDlg, -1,          "accuracy",                 416, 405,  60, 14
   CONTROL ADD OPTION,  hDlg, %ID_PREC1,   "0.5",                      420, 419,  40, 14, %WS_GROUP
   CONTROL ADD OPTION,  hDlg, %ID_PREC2,   "0.2",                      420, 432,  40, 14
   CONTROL ADD OPTION,  hDlg, %ID_PREC3,   "0.1",                      420, 445,  40, 14
   CONTROL SET OPTION   hDlg, %ID_PREC1, %ID_PREC1, %ID_PREC3

   CONTROL ADD LABEL,   hDlg, -2,          "# circles (10-50)",          1, 412, 100, 14
   CONTROL ADD TEXTBOX, hDlg, %ID_NDISKS,  "20",                        80, 410,  30, 18, _
           %ES_NUMBER OR %ES_CENTER, %WS_EX_CLIENTEDGE

   CONTROL ADD LABEL,   hDlg, -3,          "step factor (1-5)",          1, 434, 100, 14
   CONTROL ADD TEXTBOX, hDlg, %ID_STEPF,   "2",                         80, 432,  30, 18, _
           %ES_NUMBER OR %ES_CENTER, %WS_EX_CLIENTEDGE

   CONTROL ADD LABEL,   hDlg, -4,          "initial radius of circle", 126, 410, 108, 14
   CONTROL ADD LABEL,   hDlg, -5,          "to be fit on this space",  126, 422, 108, 14
   CONTROL ADD LABEL,   hDlg, -6,          "(from 180 to 60 pixels)",  126, 434, 108, 14
   CONTROL ADD TEXTBOX, hDlg, %ID_MAXRAD,  "90",                       230, 420,  30, 18, _
           %ES_NUMBER OR %ES_CENTER, %WS_EX_CLIENTEDGE

   CONTROL ADD TEXTBOX, hDlg, %ID_CONSOLE, "",                         510,  3, 270, 402, _
           %ES_READONLY OR %ES_WANTRETURN OR %ES_MULTILINE OR %ES_NOHIDESEL OR %WS_VSCROLL, %WS_EX_STATICEDGE

   '--- fonts not standard ---
   hFont1 = MakeFontEx("Lucida Console",  9, %FW_NORMAL, %FALSE, %FALSE)     'small size fixed pitch
   CONTROL SEND hDlg, %ID_CONSOLE, %WM_SETFONT, hFont1, 0
   hFont2 = MakeFontEx("MS Sans Serif",  9, %FW_BOLD, %FALSE, %FALSE)        'standard font in bold
   CONTROL SEND hDlg, %ID_START,  %WM_SETFONT, hFont2, 0
   CONTROL SEND hDlg, %ID_RESET,  %WM_SETFONT, hFont2, 0
   CONTROL SEND hDlg, %ID_CANCEL, %WM_SETFONT, hFont2, 0

   '--- tooltips support ---
   hToolTip = CreateWindowEx(BYVAL 0, "tooltips_class32", "", %TTS_ALWAYSTIP, _     ' Or %TTS_BALLOON, _
              0, 0, 0, 0, BYVAL hDlg, BYVAL 0, GetModuleHandle(BYVAL %NULL), BYVAL 0)
   DIALOG SEND hToolTip, %TTM_SETMAXTIPWIDTH, 0, 200                                '200 seems appropriate
   DIALOG SEND hToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000                     '3000 = 3 seconds

   '--- tooltips text ---
   SetToolTipText hToolTip, %ID_TOP,     "Go to top of Log board"
   SetToolTipText hToolTip, %ID_BOT,     "Go to bottom of Log board"
   SetToolTipText hToolTip, %ID_SAVE,    "Save on file with a unique name the entire contents of Log board"
   SetToolTipText hToolTip, %ID_CLOG,    "Erase all contents of Log board"
   SetToolTipText hToolTip, %ID_CANCEL,  "Cancel current calculation and return to wait an action operator"
   SetToolTipText hToolTip, %ID_START,   "Starts calculations trying to search the best fit big circle"
   SetToolTipText hToolTip, %ID_RESET,   "Creates at random a new set of circles based on defined parameters"
   SetToolTipText hToolTip, %ID_PREC1,   "Set the precision to fit in 0.5 pixel, used on search pass 2. It's fast"
   SetToolTipText hToolTip, %ID_PREC2,   "Set the precision to fit in 0.2 pixels, used on search pass 2. Takes some time"
   SetToolTipText hToolTip, %ID_PREC3,   "Set the precision to fit in 0.1 pixels, used on search pass 2. It's slow"
   SetToolTipText hToolTip, %ID_NDISKS,  "Number of circles to be created on 2D space. Needs a Reset"
   SetToolTipText hToolTip, %ID_STEPF,   "Step value used on main loop of search in pass 1"
   SetToolTipText hToolTip, %ID_ENUM,    "Enumerate all circles"
   SetToolTipText hToolTip, %ID_FIXRAD,  "Use same radius for all circles. Needs a Reset"
   SetToolTipText hToolTip, %ID_MAXRAD,  "Initial radius of circle to be fit on this space without intersecting " + _
                                         "other circles or outside the boundary of this 2D space."
   SetToolTipText hToolTip, %ID_CONSOLE, "Log board. All relevant data related or obtained during program " + _
                                         "process is written here. This information can be saved on a file or " + _
                                         "selected and set on clipboard."
   SetToolTipText hToolTip, %ID_GRAPHIC, "2D graphic space"

   DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CALLBACK FUNCTION DlgProc() AS LONG
   LOCAL buffer AS STRING
   LOCAL iLb AS LOGBRUSH
   STATIC lineCount, result, iBrushBlue AS LONG

   SELECT CASE AS LONG CBMSG
      CASE %WM_INITDIALOG
         CONTROL DISABLE CBHNDL, %ID_CANCEL
         iLb.lbStyle  = %WHITE_BRUSH
         iLb.lbColor  = %WHITE
         iBrushBlue   = CreateBrushIndirect(iLb)
         emergencyStop = %TRUE
         numCircles = %NUMCIRCLES
         stepFactor = %STEPFACTOR
         initCircle = %INITCIRCLE
         precision  = 0.5
         CALL CanvasCleaner(%TRUE, %TRUE)
         CALL InitialData                          'only if needed
         CALL DrawCircles(%FALSE)
      CASE %WM_CTLCOLORSTATIC
         SELECT CASE GetDlgCtrlID(CBLPARAM)
            CASE %ID_CONSOLE
               SetBkMode CBWPARAM, %OPAQUE
               SetTextColor CBWPARAM, RGB(0,0,120)
               FUNCTION = iBrushBlue  :  EXIT FUNCTION
         END SELECT
      CASE %WM_COMMAND
         SELECT CASE CBCTL
            CASE %ID_PREC1  :  precision = 0.5
            CASE %ID_PREC2  :  precision = 0.2
            CASE %ID_PREC3  :  precision = 0.1
            CASE %ID_ENUM   :  CONTROL GET CHECK CBHNDL, %ID_ENUM TO eNum  :  CALL DrawCircles(%TRUE)
            CASE %ID_FIXRAD :  CONTROL GET CHECK CBHNDL, %ID_FIXRAD TO fixRad
            CASE %ID_MAXRAD
               CONTROL GET TEXT CBHNDL, %ID_MAXRAD TO buffer
               initCircle = VAL(buffer)
            CASE %ID_STEPF
               CONTROL GET TEXT CBHNDL, %ID_STEPF TO buffer
               stepFactor = VAL(buffer)
            CASE %ID_TOP
               CONTROL SEND hDlg, %ID_CONSOLE, %EM_GETLINECOUNT, 0, 0 TO lineCount
               CONTROL SEND hDlg, %ID_CONSOLE, %EM_LINESCROLL, 0, -lineCount
            CASE %ID_BOT
               CONTROL SEND hDlg, %ID_CONSOLE, %EM_GETLINECOUNT, 0, 0 TO lineCount
               CONTROL SEND hDlg, %ID_CONSOLE, %EM_LINESCROLL, 0, lineCount
            CASE %ID_NDISKS
               CONTROL GET TEXT CBHNDL, %ID_NDISKS TO buffer
               numCircles = VAL(buffer)
            CASE %ID_CANCEL
               IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                  emergencyStop = %TRUE
                  OutString $CRLF + "= = = = = =  Cancelled  = = = = = =" + $CRLF, %TRUE
                  CONTROL ENABLE CBHNDL, %ID_START
                  CONTROL ENABLE CBHNDL, %ID_RESET
                  CONTROL DISABLE CBHNDL, %ID_CANCEL
               END IF
            CASE %ID_START
               IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                  CONTROL ENABLE CBHNDL, %ID_CANCEL
                  CONTROL DISABLE CBHNDL, %ID_START
                  CONTROL DISABLE CBHNDL, %ID_RESET
                  IF UBOUND(Circ) < 5 THEN EXIT FUNCTION
                  IF (stepFactor > 5) OR (stepFactor < 1) THEN            'check limits stepfactor
                     stepFactor = %STEPFACTOR
                     CONTROL SET TEXT CBHNDL, %ID_STEPF, LTRIM$(STR$(%STEPFACTOR))
                     CONTROL REDRAW CBHNDL, %ID_STEPF
                  END IF
                  CONTROL SET TEXT CBHNDL, %ID_NDISKS, LTRIM$(STR$(UBOUND(Circ)))
                  IF (initCircle > 180) OR (initCircle < 60) THEN         'check limits red circle
                     initCircle = %INITCIRCLE
                     CONTROL SET TEXT CBHNDL, %ID_MAXRAD, LTRIM$(STR$(%INITCIRCLE))
                     CONTROL REDRAW CBHNDL, %ID_MAXRAD
                  END IF
                  emergencyStop = %FALSE
                  CALL CanvasCleaner(%FALSE, %FALSE)
                  CALL DrawCircles(%FALSE)
                  THREAD CREATE WorkingAll(hDlg) TO hThread
                  THREAD CLOSE hThread TO result
               END IF
            CASE %ID_RESET
               IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                  CONTROL GET TEXT CBHNDL, %ID_NDISKS TO buffer
                  numCircles = VAL(buffer)
                  IF (numCircles > 50) OR (numCircles < 10) THEN         'check limits num circles
                     numCircles = %NUMCIRCLES
                     CONTROL SET TEXT CBHNDL, %ID_NDISKS, LTRIM$(STR$(%NUMCIRCLES))
                  END IF
                  CONTROL GET TEXT CBHNDL, %ID_MAXRAD TO buffer
                  initCircle = VAL(buffer)
                  IF (initCircle > 160) OR (initCircle < 60) THEN         'check limits red circle
                     initCircle = %INITCIRCLE
                     CONTROL SET TEXT CBHNDL, %ID_MAXRAD, LTRIM$(STR$(%INITCIRCLE))
                  END IF
                  CALL CanvasCleaner(%TRUE, %TRUE)
                  CALL GenerateCircles
                  CALL DrawCircles(%FALSE)
               END IF
            CASE %ID_CLOG
               IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                  CONTROL SET TEXT hDlg, %ID_CONSOLE, ""
                  CONTROL REDRAW hDlg, %ID_CONSOLE
               END IF
            CASE %ID_SAVE  :  CALL SaveLog
         END SELECT
      CASE %WM_NCACTIVATE
         STATIC hWndSaveFocus AS DWORD
         IF ISFALSE CBWPARAM THEN
            hWndSaveFocus = GetFocus()
         ELSEIF hWndSaveFocus THEN
            SetFocus(hWndSaveFocus)
            hWndSaveFocus = 0
         END IF
      CASE %WM_DESTROY
         IF hFont1 THEN DeleteObject hFont1
         IF hFont2 THEN DeleteObject hFont2
   END SELECT
END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB DrawCircles(drawbestfit AS LONG)
   REGISTER j AS LONG
   LOCAL sx, sy AS LONG
   LOCAL txt AS STRING

   FOR j = 1 TO numCircles
      GRAPHIC ELLIPSE (Circ(j).X-Circ(j).R,Circ(j).Y-Circ(j).R) - (Circ(j).X+Circ(j).R,Circ(j).Y+Circ(j).R), -1, %WHITE
      IF eNum THEN                           'enumerate disks ?
         txt = LTRIM$(STR$(j))
         GRAPHIC TEXT SIZE txt TO sx, sy
         GRAPHIC SET POS (Circ(j).X-sx/2, Circ(j).Y-sy/2)
         GRAPHIC PRINT txt
      END IF
   NEXT j

   IF drawbestfit THEN
      GRAPHIC ELLIPSE (bestX-bestR,bestY-bestR) - (bestX+bestR,bestY+bestR), %RED, %LTLINES, 5
      txt = "r=" + Form2(bestR, 5)
      GRAPHIC TEXT SIZE txt TO sx, sy
      GRAPHIC SET POS (bestX-sx/2, bestY-sy/2)
      GRAPHIC PRINT txt
   END IF
   GRAPHIC REDRAW
END SUB

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB GenerateCircles()
   'Generate random non-interseding circles.
   'Save the circles center and radius on array.
   'Check that a given circle does not intersect or exists inside another circle.
   REGISTER j AS LONG
   LOCAL radius, middleX, middleY AS SINGLE

   REDIM Circ(1 TO numCircles) AS TCIRCLE
   RANDOMIZE TIMER

   FOR j = 1 TO numCircles
      DO
         radius  = IIF(fixrad, %DEFRADIUS, RND(%MINRADIUS, %MAXRADIUS))  'if fixed 25, variable see values
         middleX = RND(radius, rWs-radius)                               'coordinates inside our 2D space
         middleY = RND(radius, rHs-radius)                               '     "         "    "   "   "
      LOOP UNTIL CirclesDoNotIntersect(middleX, middleY, radius) = %TRUE
      Circ(j).X = middleX
      Circ(j).Y = middleY
      Circ(j).R = radius
   NEXT j
END SUB

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION CirclesDoNotIntersect(BYVAL bX1 AS SINGLE, BYVAL bY1 AS SINGLE, BYVAL bR AS SINGLE) AS LONG
   'Calculate if two circles intersect. Returns TRUE (no intersection) or FALSE (circles intersect)
   'Method: distance between two centerpoints must be bigger or equal to the sum of their radius
   REGISTER j AS LONG
   LOCAL distance AS SINGLE

   FUNCTION = %TRUE
   FOR j = 1 TO UBOUND(Circ())
      IF NOT (Circ(j).X = 0 AND Circ(j).Y = 0 AND Circ(j).R = 0) THEN
         distance = SQR(((bX1-Circ(j).X) ^2) + ((bY1-Circ(j).Y) ^2))
         IF distance >= (bR + Circ(j).R) THEN
            'no intersection, to next circle
         ELSE
            FUNCTION = %FALSE
            EXIT FOR
         END IF
      END IF
   NEXT j
END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB CanvasCleaner(wantRedim AS LONG, wantRedraw AS LONG)
   REGISTER j AS LONG

   GRAPHIC CLEAR
   IF wantRedim THEN REDIM Circ(0) AS tCircle
   FOR j = 0 TO 24
      GRAPHIC LINE (j*20, 00) - (j*20, 500), %LTLINES
      GRAPHIC LINE (00, j*20) - (500, j*20), %LTLINES
   NEXT
   IF wantRedraw THEN GRAPHIC REDRAW
END SUB

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION WorkingAll(BYVAL hWnd AS DWORD) AS LONG
   REGISTER j AS LONG
   LOCAL fits, conta1, conta2, conta3, conta4, cdebug AS LONG
   LOCAL i1s, j1s, i2s, j2s, stpF, stepFactor2 AS SINGLE
   LOCAL wmin, wmax, hmin, hmax, radius1, radius2 AS SINGLE
   LOCAL T1, T2, T3 AS DOUBLE
   LOCAL txt AS STRING
   STATIC ntest AS LONG

   INCR ntest
   CONTROL GET CHECK hDlg, %ID_DEBUG TO cdebug
   stpF  = StepFactor
   stepFactor2 = stepFactor * 2              'to avoid repetitive operations on loops

   OutString "= = = Starting test number:" + STR$(ntest) + " = = ="
   OutString "Map:" + $CRLF + "Circle   X     Y     R"
   FOR j = 1 TO UBOUND(Circ)
      txt = txt + Form0(j,4) + Form0(Circ(j).X,7) + Form0(Circ(j).Y,6) + Form0(Circ(j).R,5) + $CRLF
   NEXT j
   txt = txt + "= = = = = = = = = = = = = = = = = =" + $CRLF + $CRLF
   txt = txt + "--- Start measurement ---" + $CRLF + "step 1 ..."
   OutString txt, %TRUE

   'starts a new internal thread for graphics inside this working thread
   'seems unnecessary but needed to make long time loops interrumpibles
   'with possibility to display on graphics window during process
   GRAPHIC ATTACH hDlg, %ID_GRAPHIC, REDRAW                        'starts new trhread
   SLEEP 1

   'after some tests I decided divide the search in two stages
   ' - first with force brute brute to find aproximation
   ' - second is also brute but with some refinemets to find exact the value expected
   'in the two steps the outer loop starts with maximum value with a step negative

   '===== Step 1 =====                                                           '''''
   'uses brute force by excess search method                                         '
   T1 = CurrentTimeInSeconds                                                         '
   radius1 = initCircle                                                              '
   DO WHILE radius1 > 10.0                                                           '
      wmin = radius1  :  wmax = rHs - radius1                                        '
      hmin = radius1  :  hmax = rWs - radius1                                        '
      FOR j1s = wmin TO wmax       'wmin to wmax                                     '
         INCR conta1                                                                 '
         IF emergencyStop THEN GOTO DoExit             'cancel ???                   '
         FOR i1s = hmin TO hmax    'hmin to hmax                                     '
            INCR conta2                                                              '
            IF CirclesDoNotIntersect(i1s, j1s, radius1) = %FALSE THEN ITERATE FOR    '
            IF stpF > 1 THEN                                                         '
               radius1 = radius1 + stpF                                              '
               stpF = 1                                                              '
               EXIT, EXIT                                                            '
            END IF                                                                   '
            bestX = i1s  :  bestY = j1s  :  bestR = radius1                          '
            CALL CanvasCleaner(%FALSE, %FALSE)                                       '
            CALL DrawCircles(%TRUE)                                                  '
            SLEEP 1                                                                  '
            fits = %TRUE                                                             '
            EXIT, EXIT, EXIT                                                         '
         NEXT j1s                                                                    '
      NEXT i1s                                                                       '
      radius1 = radius1 - stpF                                                       '
   LOOP                                                                          '''''

   IF emergencyStop THEN GOTO DoExit                     'cancel ???
   OutString "step 2 ...", %TRUE

   IF fits THEN
      T2 = CurrentTimeInSeconds
      IF bestR >= initCircle THEN
         txt =       "===       BEST FIT FALSE        ===" + $CRLF
         txt = txt + "=== initial circle is too small ===" + $CRLF
         txt = txt + "=== = = = = End of test = = = = ===" + $CRLF
         OutString txt, %TRUE
      ELSE
         '===== Step 2 =====                                                       '''''
         'proof by exhaustion is the method used (brute force refined)                 '
         fits = %FALSE                                                                 '
         'recovers stepfactor used on previous step and apply precision                '
         FOR radius2 = radius1+1 TO radius1 STEP -Precision                            '
            wmin = radius2  :  wmax = rHs - radius2                                    '
            hmin = radius2  :  hmax = rWs - radius2                                    '
            FOR j2s = wmin TO wmax STEP precision       'wmin to wmax                  '
               INCR conta3                                                             '
               IF emergencyStop THEN GOTO DoExit        'cancel ???                    '
               IF j2s > j1s + stepfactor2+1 THEN EXIT   'stop, unneeded search on wide '
               FOR i2s = hmin TO hmax STEP precision    'hmin To hmax                  '
                  INCR conta4                                                          '
                  IF i2s > i1s + stepfactor2+1 THEN EXIT 'stop, undeeded search on high'
                  IF CirclesDoNotIntersect(i2s, j2s, radius2) = %FALSE THEN ITERATE FOR
                  bestX = i2s  :  bestY = j2s  :  bestR = radius2                      '
                  CALL CanvasCleaner(%FALSE, %FALSE)                                   '
                  CALL DrawCircles(%TRUE)                                              '
                  fits = %TRUE                                                         '
                  SLEEP 1          'to visual effect                                   '
                  IF fits THEN EXIT, EXIT, EXIT                                        '
               NEXT j2s                                                                '
            NEXT i2s                                                                   '
         NEXT radius2                                                              '''''

         T3 = CurrentTimeInSeconds
         OutString "--- End measurement ---"  + $CRLF

         IF bestR >= initCircle THEN
            txt =       "===       BEST FIT FALSE        ===" + $CRLF
            txt = txt + "=== something is bad, try again ===" + $CRLF
            txt = txt + "=== = = = = End of test = = = = ===" + $CRLF
            OutString txt, %TRUE
         ELSE
            txt =       "--- Statistics about test:" + STR$(nTest) + " ---" + $CRLF
            txt = txt + "Number of circles drawn     :" + STR$(UBOUND(Circ)) + $CRLF
            txt = txt + "Pixels precision requested  : " + Form2(precision, 3) + $CRLF
            txt = txt + "Step factor used on Step1   :" + STR$(stepFactor) + $CRLF
            txt = txt + "Max radius of circle to fit :" + STR$(initCircle) + $CRLF + $CRLF
            txt = txt + "  Best fit circle:" + $CRLF
            txt = txt + "    X     " + Form2(bestX, 7) + $CRLF
            txt = txt + "    Y     " + Form2(bestY, 7) + $CRLF
            txt = txt + "    Radius" + Form2(bestR, 7) + $CRLF + $CRLF
            txt = txt + "Iterations j1s    : " + Form0(conta1, 10) + $CRLF
            txt = txt + "Iterations i1s    : " + Form0(conta2, 10) + $CRLF
            txt = txt + "Iterations j2s    : " + Form0(conta3, 10) + $CRLF
            txt = txt + "Iterations i2s    : " + Form0(conta4, 10) + $CRLF
            txt = txt + "Iterations total  : " + Form0(conta2+conta4, 10) + $CRLF + $CRLF
            txt = txt + "Time spent pass 1 : " + Form6(T2 - T1, 9) + " secs" + $CRLF
            txt = txt + "Time spent pass 2 : " + Form6(T3 - T2, 9) + " secs" + $CRLF
            txt = txt + "Time spent total  : " + Form6(T3 - T1, 9) + " secs" + $CRLF + $CRLF
            IF cdebug THEN
               txt = txt + "radius1 : " + Form2(radius1,6) + "   radius2 : " + Form2(radius2,6) + $CRLF
               txt = txt + "I1S     : " + Form2(i1s,6)     + "   I2S     : " + Form2(i2s,6) + $CRLF
               txt = txt + "J1S     : " + Form2(j1s,6)     + "   J2S     : " + Form2(j2s,6) + $CRLF + $CRLF
            END IF
            txt = txt + "=== = = = = = End of test = = = ===" + $CRLF
            OutString txt, %TRUE
         END IF
      END IF
   ELSE
      txt =       "===    IT SHOULD NOT HAPPEN     ===" + $CRLF
      txt = txt + "=== something is bad, try again ===" + $CRLF
      txt = txt + "=== = = = = End of test = = = = ===" + $CRLF
      OutString txt, %TRUE
   END IF

DoExit:
   emergencyStop = %TRUE
   CONTROL ENABLE hDlg, %ID_RESET
   CONTROL ENABLE hDlg, %ID_START
   CONTROL DISABLE hDlg, %ID_CANCEL
   BEEP
END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB OutString(txtMsg AS STRING, OPTIONAL BYVAL forceRedraw AS LONG)
   'based on code of Eros Olmi
   LOCAL redrawCntl, lineCount AS LONG
   LOCAL tmpStr AS STRING

   RedrawCntl = %FALSE
   IF UCASE$(LEFT$(txtMsg, 8)) = "[MSGBOX]" THEN
      MSGBOX RIGHT$(txtMsg, LEN(txtMsg) - 8)
   ELSE
      'if single char passed, repeat it for 80, ie lines/separators
      IF LEN(txtMsg) = 1 THEN
         txtMsg = REPEAT$(35, txtMsg)    'adjusted to actual window
         redrawCntl = %TRUE
      END IF
      'if no string passed, than blank the text area
      IF LEN(txtMsg) > 0 THEN CONTROL GET TEXT hDlg, %ID_CONSOLE TO tmpStr
      tmpStr = tmpStr + txtMsg
      IF LEN(txtMsg) > 0 THEN tmpStr = tmpStr + $CRLF
      CONTROL SET TEXT hDlg, %ID_CONSOLE, tmpStr
   END IF
   IF redrawCntl = %TRUE OR forceRedraw = %TRUE THEN
      CONTROL REDRAW hDlg, %ID_CONSOLE
      CONTROL SEND hDlg, %ID_CONSOLE, %EM_GETLINECOUNT, 0, 0 TO lineCount
      CONTROL SEND hDlg, %ID_CONSOLE, %EM_LINESCROLL, 0, lineCount
   END IF
END SUB

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION EnumCharSet(elf AS ENUMLOGFONT, ntm AS NEWTEXTMETRIC, BYVAL FontType AS LONG, CharSet AS LONG) AS LONG
   'Get type of character set - ansi, symbol.. a must for some fonts.
   CharSet = elf.elfLogFont.lfCharSet
END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION MakeFontEx(BYVAL FontName AS STRING, BYVAL PointSize AS LONG, BYVAL fBold AS LONG, _
                    BYVAL fItalic AS LONG, BYVAL fUnderline AS LONG) AS DWORD
   'Create a desirable font and return its handle. Original code by Dave Navarro
   'Note: any font created with MakeFontEx should also be destroyed with DeleteObject
   LOCAL hfDC AS DWORD
   LOCAL CharSet, CyPixels AS LONG

   hfDC = GetDC(%HWND_DESKTOP)
   CyPixels  = GetDeviceCaps(hfDC, %LOGPIXELSY)
   EnumFontFamilies hfDC, BYVAL STRPTR(FontName), CODEPTR(EnumCharSet), BYVAL VARPTR(CharSet)
   ReleaseDC %HWND_DESKTOP, hfDC
   PointSize = 0 - (PointSize * CyPixels) \ 72
   FUNCTION = CreateFont(PointSize, 0, _  'height, width(default=0)
              0, 0, _                     'escapement(angle), orientation
              fBold, _                    'weight (%FW_DONTCARE = 0, %FW_NORMAL = 400, %FW_BOLD = 700)
              fItalic, _                  'Italic
              fUnderline, _               'Underline
              %FALSE, _                   'StrikeThru
              CharSet, %OUT_TT_PRECIS, _
              %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
              %FF_DONTCARE, BYCOPY FontName)
END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION CurrentTimeInSeconds() AS DOUBLE
   'This function returns the number of seconds since midnight as a Double-precision
   'floating-point value. Original code by Erik Christensen.
   'Can be simplified for modern PCs only.
   STATIC PerfFreq AS QUAD, Res AS LONG, Prec AS LONG, First AS LONG, TimeCorrection AS DOUBLE
   LOCAL t1 AS QUAD, ta AS DOUBLE

   IF ISFALSE First THEN
      'Get, in counts per second, the current performance-counter frequency
      'if supported by your hardware.
      Res = QueryPerformanceFrequency(PerfFreq)
      'determine precision
      IF Res THEN
         Prec = CEIL(LOG10(PerfFreq))
         QueryPerformanceCounter t1
         ta = ROUND(CDBL(t1) / CDBL(PerfFreq), Prec)
         'find time correction to obtain number of seconds past midnight.
         TimeCorrection = TIMER - ta
         FUNCTION = ta + TimeCorrection
         First = %TRUE : EXIT FUNCTION
      END IF
      First = %TRUE
   END IF
   'measure current time
   IF Res THEN          'if possible use this:
      QueryPerformanceCounter t1
      FUNCTION = ROUND(CDBL(t1) / CDBL(PerfFreq), Prec) + TimeCorrection
   END IF
END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB SetToolTipText(hToolTip AS DWORD, ID AS LONG, BYVAL txt AS STRING)
   LOCAL hLocalDlg AS DWORD
   LOCAL ti AS TOOLINFO

   aToolTipText = txt
   hLocalDlg    = GetParent(hToolTip)
   ti.cbSize    = LEN(ti)
   ti.uFlags    = %TTF_SUBCLASS OR %TTF_IDISHWND
   ti.hWnd      = hLocalDlg
   ti.uId       = GetDlgItem(hLocalDlg, ID)
   ti.lpszText  = VARPTR(aToolTipText)
   SendMessage hToolTip, %TTM_ADDTOOL, 0, VARPTR(ti)
END SUB

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB SaveLog()
   'Save entire Log to file with a unique name in current directory
   LOCAL f      AS INTEGER
   LOCAL fname, buffer  AS STRING

   'create an unique filename
   fname = "B" + MID$(DATE$,3,4) + TIME$ + ".txt"
   fname = REMOVE$(fname, ANY ":")

   CONTROL GET TEXT hDlg, %ID_CONSOLE TO buffer
   IF LEN(buffer) < 200 THEN EXIT SUB      'if less than 200 chars, nothing to do
   f = FREEFILE
   OPEN fname FOR OUTPUT AS f
      PRINT# f, "*** Created on " + DATE$ + " at " + TIME$ + " ***" + $CRLF
      PRINT# f, buffer
   CLOSE f
END SUB

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB InitialData()
   REGISTER j AS LONG
   LOCAL i AS LONG

   numCircles = VAL(READ$(1))
   REDIM Circ(1 TO numCircles) AS tCircle

   FOR j = 1 TO DATACOUNT-1 STEP 3
      INCR i
      Circ(i).X = VAL(READ$(j+1))
      Circ(i).Y = VAL(READ$(j+2))
      Circ(i).R = VAL(READ$(j+3))
   NEXT j

   'Is user responsability to maintain coherent data if is modified
   'First line is the numCircles and indicates the amount of next DATA lines
   'Rest of lines has the format X,Y and Radius in entire pixel values

   'This data is appropriate to experiment with specific input data
   'More input data can be collected from previous saved Log

   'To remember: NO write comments on DATA lines

'   Data  20
'   Data 418, 288, 41
'   Data 133, 155, 36
'   Data 119,  64, 35
'   Data 396,  93, 21
'   Data 332, 122, 23
'   Data 268, 269, 30
'   Data 452, 199, 44
'   Data  75, 297, 33
'   Data 364,  30, 18
'   Data  27, 112, 21
'   Data 207, 108, 22
'   Data  98, 212, 19
'   Data 144, 272, 32
'   Data 392, 355, 30
'   Data 446,  16, 16
'   Data 230, 324, 23
'   Data  39,  41, 15
'   Data 345, 319, 22
'   Data 372, 231, 16
'   Data 344, 274, 17

'   Data  20
'   Data 275, 215, 42
'   Data 352, 369, 17
'   Data  35, 195, 25
'   Data  28, 247, 26
'   Data 310, 131, 22
'   Data 401, 205, 25
'   Data 431, 358, 25
'   Data 186, 329, 30
'   Data 192, 105, 36
'   Data 395, 267, 36
'   Data 291,  64, 15
'   Data 346,  37, 33
'   Data 188, 229, 19
'   Data 280, 101, 17
'   Data 138, 301, 24
'   Data 447, 142, 20
'   Data 478, 261, 15
'   Data  50, 111, 27
'   Data 293, 337, 32
'   Data 474, 312, 18

   DATA  20
   DATA 189, 315, 19
   DATA 182, 187, 15
   DATA 322, 277, 20
   DATA 131, 347, 22
   DATA 107,  65, 37
   DATA  65, 239, 18
   DATA 332, 100, 34
   DATA 360, 218, 26
   DATA  36, 108, 28
   DATA 255,  42, 31
   DATA 391, 274, 36
   DATA  28, 367, 23
   DATA 120, 214, 37
   DATA  82, 319, 28
   DATA  87, 146, 18
   DATA 421, 191, 31
   DATA 463, 300, 19
   DATA 391, 341, 25
   DATA 225, 119, 44
   DATA 466,  38, 32

END SUB

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'eof