Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

A graphical entertainment

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • A graphical entertainment

    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' PackBalloons.bas              by Jordi Vallès       version 1b      27/06/2008
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' A graphical entertainment.
    '
    ' Searching information about dynamic graphs for networks I found this algorithm 
    ' from Scott Buckley and after some small modifications and an implementation 
    ' inside a PB DDT suit this is the result.
    ' Don't know if is useful for something but is curious.
    ' Sincerely, I understood this routine, but not allways the results obtained.
    '
    ' - Press mouse left button on free area to add balloons to pool.
    ' - Observe the behaviour after the 37th (approx) balloon when starts the dance
    '   due to collisions caused by unstability between center distances.
    ' - With Explode button a balloon is removed at random.
    ' - Balloons can be numbered using the checkbox "enumerate"
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' - Program developed and tested with PowerBASIC for Windows (PB/Win 8.04) on a
    '   PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium.
    ' - Only PB Graphic package is used to display information generated by program.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' SED_PBWIN
    
    #Compile Exe "PackBalloons.exe"
    #Dim All
    
    #Include "Win32Api.inc"
    #Include "CommCtrl.inc"
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    %IDM_RESET    = 1110
    %IDM_REMOVE   = 1120
    %IDM_EXIT     = 1130
    %IDM_GRAPHIC  = 1140
    %IDM_INFO1    = 1150
    %IDM_ENUM     = 1160
    %IDM_TIMER    = 1210
    %IDM_STEP     = 1310
    %IDM_NSTEPS   = 1320
    %CANVAS       = &hEEFAFA???  'RGB(250,250,238)
    %LTLINES      = &hEAEAEA???  'RGB(234,234,234)
    $TITLE = "Packing Balloons - 1b"   'title on caption
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Macro Pi        = 3.141592653589793#
    Macro NearZero  = 0.000000000000001# 'to avoid problems in some divisions
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Declare Function Atn2(X As Double, Y As Double) As Double
    Declare Function BalloonsOverlap(ByVal bX1 As Long, ByVal bY1 As Long) As Long
    Declare Function DistancePoints(pX1 As Double, pY1 As Double, pX2 As Double, pY2 As Double) As Double
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Global OldGraphicProc       As Dword      'old process, used in subclass
    Global hTimer, hGraphic     As Dword
    Global swidth, sheight      As Long       'size of main canvas
    Global maxColors, enum      As Long
    Global apX(), apY()         As Double
    Global apC(), Colors()      As Long
    Global Radius, Radius4      As Double
    Global atime, nBalloons     As Long
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function PBMain () As Long
       Local hDlg As Dword
       Local signature As Asciiz * 90
    
       '~~~ 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
    
       Dialog New Pixels, 0, $TITLE, , , 309, 552, %WS_CAPTION Or %WS_SYSMENU, 0 To hDlg
       Control Add Graphic, hDlg, %IDM_GRAPHIC,"", 3, 3, 302, 502, %WS_BORDER Or %SS_NOTIFY
    
       Control Get Client hDlg, %IDM_GRAPHIC To swidth, sheight    'get client (canvas) size
       Graphic Scale (0, 0) - (swidth, sheight)                     'scale to pixel coordinate system
       Graphic Attach hDlg, %IDM_GRAPHIC, Redraw
       Graphic Font "Arial", 7, 0
       Graphic Color %BLACK, %CANVAS                      'canvas colors
    
       Control Add Button,  hDlg, %IDM_REMOVE,  "Explode 1",         120, 530,  60, 20
       Control Add Button,  hDlg, %IDM_RESET,   "Reset",             182, 530,  60, 20
       Control Add Button,  hDlg, %IDM_EXIT,    "Quit",              244, 530,  60, 20
       Control Add Label,   hDlg, %IDM_INFO1,   "balloons :  0",     120, 510,  80, 14
       Control Add CheckBox,hDlg, %IDM_enum,   "enumerate",         234, 510,  70, 16
    
       Control Add "msctls_trackbar32", hDlg, %IDM_STEP, "",           2, 510, 110, 20, _
               %WS_CHILD Or %TBS_HORZ Or %WS_VISIBLE Or %TBS_BOTTOM Or %WS_TABSTOP Or %TBS_NOTICKS
       Control Send         hDlg, %IDM_STEP, %TBM_SETRANGE, %TRUE, MakLng(10,100)
       Control Send         hDlg, %IDM_STEP, %TBM_SETPOS, %TRUE, 30
       Control Add Textbox, hDlg, %IDM_NSTEPS,  "30",                 34, 530,  28, 20, _
               %ES_READONLY Or %ES_CENTER, %WS_EX_CLIENTEDGE
       Control Add Label,   hDlg, -1,           "mSecs.",             60, 532,  50, 18
    
       Dialog Show Modal hDlg Call DlgProc
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    CallBack Function DlgProc() As Long
       Local i As Long
    
       Select Case As Long CbMsg
          Case %WM_INITDIALOG
             Control Handle CbHndl, %IDM_GRAPHIC To hGraphic
             OldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CodePtr(GraphicProc))
             Call Initialize(CbHndl)
             atime = 30
          Case %WM_TIMER
             KillTimer CbHndl, hTimer
             Call TimerBalloons(CbHndl)
             hTimer = SetTimer(CbHndl, %IDM_TIMER, atime, ByVal %NULL)
          Case %WM_HSCROLL
             Select Case CbLParam
                Case GetDlgItem(CbHndl, %IDM_STEP)
                   Control Send CbHndl, %IDM_STEP, %TBM_GETPOS, 0, 0 To atime
                   Control Set Text CbHndl, %IDM_NSTEPS, Format$(atime)
             End Select
             Function = %TRUE
          Case %WM_COMMAND
             Select Case CbCtl
                Case %IDM_RESET  :  If CbCtlMsg = %BN_CLICKED Then Call Initialize(CbHndl)
                Case %IDM_EXIT   :  If CbCtlMsg = %BN_CLICKED Then Dialog End CbHndl
                Case %IDM_enum  :  Control Get Check CbHndl, %IDM_enum To enum
                Case %IDM_REMOVE
                   If CbCtlMsg = %BN_CLICKED Then         'to explode balloons at random
                      KillTimer CbHndl, hTimer
                      If nBalloons > 5 Then
                         i = Rnd(2,nballoons)
                         Array Delete apX(i)  :  Array Delete apY(i)  :  Array Delete apC(i)
                         Decr nBalloons
                         Control Set Text CbHndl, %IDM_INFO1, "balloons : " + Str$(nBalloons)
                      End If
                      hTimer = SetTimer(CbHndl, %IDM_TIMER, atime, ByVal %NULL)
                   End If
             End Select
          Case %WM_DESTROY
             If hTimer Then KillTimer CbHndl, hTimer
             If OldGraphicProc Then SetWindowLong hGraphic, %GWL_WNDPROC, OldGraphicProc
       End Select
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function GraphicProc(Byval hWnd As Dword, Byval wMsg As Dword, Byval wParam As Dword, Byval lParam As Long) As Long
       Select Case wMsg
          Case %WM_LBUTTONUP  :  Call LeftButtonUp(hWnd, wParam, lParam)
       End Select
       Function = CallWindowProc(OldGraphicProc, hWnd, wMsg, wParam, lParam)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub LeftButtonUp(Byval hWnd As Dword, Byval wParam As Dword, Byval lParam As Long)
       Local pt As POINTAPI
    
       KillTimer hWnd, hTimer
       Randomize Timer * nBalloons
       GetCursorPos pt
       ScreenToClient hWnd, pt
       If BalloonsOverlap(pt.X, pt.Y) Then
          Incr nBalloons
          apX(nBalloons) = pt.X
          apY(nBalloons) = pt.Y
          apC(nBalloons) = Colors(Rnd(1,maxColors))
       End If
       Control Set Text GetParent(hWnd), %IDM_INFO1, "balloons : " + Str$(nBalloons)
       hTimer = SetTimer(hWnd, %IDM_TIMER, atime, ByVal %NULL)
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub TimerBalloons(hWnd As Dword)
       'based from an idea of Scott Buckley
       Local i, j, x, y  As Long
       Local txt As String
       Local Angle, cX, cY As Double
    
       If nBalloons <= 1 Then Exit Sub            'skip the first ball at initial
       For j = 1 To nBalloons                                                       ''''
          apY(j) = apY(j) + 5.3  'motion: 5.3 pixels on timestep (non-divisible value) '
          If apY(j) < Radius Then apY(j) = Radius                                      '
          If apY(j) > sheight - Radius Then apY(j) = sheight - Radius                  '
          If apX(j) < Radius Then apX(j) = Radius                                      '
          If apX(j) > swidth - Radius Then apX(j) = swidth - Radius                    '
          For i = 1 To nBalloons                                                ''''   '
             If i <> j Then                           'avoid war against itself    '   '
                If DistancePoints(apX(j),apY(j), apX(i),apY(i)) < Radius4 Then     '   '
                   Angle = Atn2(apX(j) - apX(i), apY(j) - apY(i))                  '   '
                   cX = (apX(j) + apX(i)) / 2                                      '   '
                   cY = (apY(j) + apY(i)) / 2                                      '   '
                   apX(j) = cX + (Radius * Cos(Angle))                             '   '
                   apY(j) = cY - (Radius * Sin(Angle))                             '   '
                   apX(i) = cX - (Radius * Cos(Angle))                             '   '
                   apY(i) = cY + (Radius * Sin(Angle))                             '   '
                End If                                                             '   '
             End If                                                                '   '
          Next i                                                                ''''   '
          'this a copy of first part, but necessary for balloons in the inner loop     '
          If apY(j) < Radius Then apY(j) = Radius                                      '
          If apY(j) > sheight - Radius Then apY(j) = sheight - Radius                  '
          If apX(j) < Radius Then apX(j) = Radius                                      '
          If apX(j) > swidth - Radius Then apX(j) = swidth - Radius                    '
       Next j                                                                       ''''
    
       Call CanvasCleaner(%FALSE)
       For j = 1 to nBalloons
          Graphic Ellipse (apX(j)-Radius,apY(j)-Radius) - (apX(j)+Radius,apY(j)+Radius), -1, apC(j)
          If enum Then
             txt = Ltrim$(Str$(j))
             Graphic Text Size txt To x, y
             Graphic Set Pos (apX(j)-x/2, apY(j)-y/2)
             Graphic Print txt
          End If
       Next j
       Graphic Redraw
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub CanvasCleaner(wantRedraw As Long)
       Local j As Long
       Graphic Clear
       For j = 0 To 24
          Graphic Line (j*20, 00) - (j*20, 500), %LTLINES
          Graphic Line (00, j*20) - (300, j*20), %LTLINES
       Next
       'suggested by Petr Schreiber
       If wantRedraw Then Graphic Redraw
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub Initialize(hWnd As Dword)
       ReDim apX(250), apY(250), apC(250)   'max 250 balloons
       Call CanvasCleaner(%TRUE)
       Call PrepareColors
       Radius    = 25                       'balloon Radius 25 pixels
       Radius4   = (Radius*2)^2             'to save time on process
       nBalloons = 1                        'first balloon
       apX(1) = swidth/2                    '  "      "
       apY(1) = sheight-Radius              '  "      "
       apC(1) = Colors(Rnd(1, maxColors))   '  "      "
       Control Set Text hWnd, %IDM_INFO1, "balloons : " + Str$(nBalloons)
       hTimer = SetTimer(hWnd, %IDM_TIMER, atime, ByVal %NULL)
       Graphic Set Pos (44,44)
       Graphic Print "Use left button mouse on free area to add balloons."
       Graphic Ellipse (apX(1)-Radius,apY(1)-Radius) - (apX(1)+Radius,apY(1)+Radius), -1, apC(1)
       Graphic Redraw
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub PrepareColors()
       Local i, j As Long
       'array with 96 soft colors to mapping balloons
       ReDim Colors(1 To DataCount) As Long
       maxColors = UBound(Colors)
       For j = 1 To DataCount
          Colors(j) = Val(Read$(j))
       Next j
       'shuffle colors array (by John Gleason)
       For j = LBound(Colors) To UBound(Colors)
          i = Rnd(j, UBound(Colors))
          Swap Colors(j), Colors(i)
       Next
       'from soft colors chart found on Internet some time ago
       Data 16777215, 16777164, 16777113, 16777062, 16764159, 16764108, 16764057, 16764006
       Data 16751103, 16751052, 16751001, 16750950, 16711935, 16711884, 16711833, 16711782
       Data 13434879, 13434828, 13434777, 13434726, 13421823, 13421772, 13421721, 13421670
       Data 13408767, 13408716, 13408665, 13408614, 13395711, 13395660, 13395609, 13395558
       Data 10092543, 10092492, 10092441, 10092390, 10079487, 10079436, 10079385, 10079334
       Data 10066431, 10066380, 10066329, 10066278, 10053375, 10053324, 10053273, 10053222
       Data  6750207,  6750156,  6750105,  6750054,  6737151,  6737100,  6737049,  6736998
       Data  6724095,  6724044,  6723993,  6723942,  6711039,  6710988,  6710937,  6710886
       Data  3407871,  3407820,  3407769,  3407718,  3394815,  3394764,  3394713,  3394662
       Data  3381759,  3381708,  3381657,  3381606,  3368703,  3368652,  3368601,  3368550
       Data    65535,    65484,    65433,    65382,    52479,    52428,    52377,    52326
       Data    39423,    39372,    39321,    39270,    26367,    26316,    26265,    26214
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function Atn2(X As Double, Y As Double) As Double
       'Atn2 optimized version. Simple but sufficient for this purpose.
       'Range of the result is 0 to 2Pi radians.
       If Y = 0 Then Y = NearZero
       Function = (Atn(Abs(X)/Abs(Y)) * Sgn(X) - Pi/2) * Sgn(Y)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function DistancePoints(pX1 As Double, pY1 As Double, pX2 As Double, pY2 As Double) As Double
       Function = (pX1-pX2)*(pX1-pX2) + (pY1-pY2)*(pY1-pY2)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function BalloonsOverlap(ByVal bX1 As Long, ByVal bY1 As Long) As Long
       'Calculate if two balloons overlaps when is inserted on pool.
       'Returns true (no overlap) or false (balloons overlap)
       Local j, distance  As Long
       Function = %TRUE
       For j = 1 To nBalloons   'loop over existing balls
          If Not (apX(j) = 0 And apY(j) = 0) Then
             distance = Sqr(((bX1-apX(j)) ^2) + ((bY1-apY(j)) ^2))
             If distance >= Radius*2 Then
                'not overlap, to next ball
             Else
                Function = %FALSE
                Exit For
             End If
          End If
       Next j
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    'eof

  • #2
    After receive the next message from Petr Schreiber jr.
    I just modified the pixels factor in timestep from 5.3 to 2.1, to be able to watch the interesting "ball" turbulence at lower speed and intensity. Sometimes it even finds new stable position.
    I decided to add a new trackbar in order to modify the pixel motion dynamically. Read the comments inside code.
    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' PackBalloons.bas              by Jordi Vallès       version 1c      27/06/2008
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' A graphical entertainment.
    '
    ' Searching information about dynamic graphs for networks I found this simple
    ' algorithm from Scott Buckley and after some small modifications and an 
    ' implementation inside a PB DDT suit this is the result.
    ' Don't know if is useful for something but is curious.
    ' Sincerely, I understood this routine, but not allways the results obtained.
    '
    ' - Press mouse left button on free area to add balloons to pool.
    ' - Observe the behaviour after the 35th (approx) balloon when starts the 
    '   "dance" due to collisions caused by unstability between center distances.
    ' - With Explode button a balloon is removed at random.
    ' - Balloons can be numbered using the checkbox "enumerate"
    ' - Use trackbars to modify: 
    '           motion in pixels by timestep 
    '           interval timestep
    '   modifying the motion pixel factor on a specific timestamp is possible to 
    '   watch the interesting "ball" turbulence at lower speed and intensity. 
    '   Sometimes it even finds new stable position. Is recommended to use small 
    '   non-divisible values for motion. These two values can be changed during
    '   the normal program process.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' - Program developed and tested with PowerBASIC for Windows (PB/Win 8.04) on a
    '   PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium.
    ' - Only PB Graphic package is used to display information generated by program.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' 27/06/2008-1c- Due a suggestion of Petr Schreiber added a trackbar to modify 
    ' the motion in pixels by timestep dinamically.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' SED_PBWIN
    
    #Compile Exe "PackBalloons.exe"
    #Dim All
    
    #Include "Win32Api.inc"
    #Include "CommCtrl.inc"
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    %IDM_RESET    = 1110
    %IDM_REMOVE   = 1120
    %IDM_EXIT     = 1130
    %IDM_GRAPHIC  = 1140
    %IDM_INFO1    = 1150
    %IDM_ENUM     = 1160
    %IDM_MOTION   = 1170
    %IDM_TIMER    = 1210
    %IDM_STEP     = 1310
    %IDM_NSTEPS   = 1320
    %IDM_PIXELS   = 1330
    %CANVAS       = &hEEFAFA???  'RGB(250,250,238)
    %LTLINES      = &hEAEAEA???  'RGB(234,234,234)
    $TITLE = "Packing Balloons - 1c"   'title on caption
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Macro Pi        = 3.141592653589793# 'a comment?
    Macro NearZero  = 0.000000000000001# 'to avoid problems in some divisions
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Declare Function Atn2(X As Double, Y As Double) As Double
    Declare Function BalloonsOverlap(ByVal bX1 As Long, ByVal bY1 As Long) As Long
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Global OldGraphicProc       As Dword      'old process, used in subclass
    Global hTimer, hGraphic     As Dword
    Global swidth, sheight      As Long       'size of main canvas
    Global maxColors, enum      As Long
    Global apX(), apY()         As Double
    Global apC(), Colors()      As Long
    Global Radius, Radius4      As Double
    Global nBalloons            As Long
    Global atime, amotion       As Long
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function PBMain () As Long
       Local hDlg As Dword
       Local signature As Asciiz * 90
    
       '~~~ 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
    
       Dialog New Pixels, 0, $TITLE, , , 309, 592, %WS_CAPTION Or %WS_SYSMENU, 0 To hDlg
       Control Add Graphic, hDlg, %IDM_GRAPHIC,"", 3, 3, 302, 502, %WS_BORDER Or %SS_NOTIFY
    
       Control Get Client hDlg, %IDM_GRAPHIC To swidth, sheight    'get client (canvas) size
       Graphic Scale (0, 0) - (swidth, sheight)                    'scale to pixel coordinate system
       Graphic Attach hDlg, %IDM_GRAPHIC, Redraw
       Graphic Font "Arial", 7, 0
       Graphic Color %BLACK, %CANVAS                      'canvas colors
    
       Control Add Button,  hDlg, %IDM_REMOVE,  "Explode 1",         120, 568,  60, 20
       Control Add Button,  hDlg, %IDM_RESET,   "Reset",             182, 568,  60, 20
       Control Add Button,  hDlg, %IDM_EXIT,    "Quit",              244, 568,  60, 20
       Control Add Label,   hDlg, %IDM_INFO1,   "balloons :  0",      10, 576,  80, 14
       Control Add CheckBox,hDlg, %IDM_ENUM,    "enumerate",          10, 556,  70, 16
    
       Control Add "msctls_trackbar32", hDlg, %IDM_STEP, "",          10, 510, 110, 20, _
               %WS_CHILD Or %TBS_HORZ Or %WS_VISIBLE Or %TBS_BOTTOM Or %WS_TABSTOP Or %TBS_NOTICKS
       Control Send         hDlg, %IDM_STEP, %TBM_SETRANGE, %TRUE, MakLng(10,100)
       Control Send         hDlg, %IDM_STEP, %TBM_SETPOS, %TRUE, 30
       Control Add Label,   hDlg, -1,           "timerstep:",         10, 532,  44, 18
       Control Add Label,   hDlg, -2,           "mSecs.",             88, 532,  40, 18
       Control Add Textbox, hDlg, %IDM_NSTEPS,  "30",                 58, 530,  28, 20, _
               %ES_READONLY Or %ES_CENTER, %WS_EX_CLIENTEDGE
       
          Control Add "msctls_trackbar32", hDlg, %IDM_MOTION, "",    190, 510, 110, 20, _
               %WS_CHILD Or %TBS_HORZ Or %WS_VISIBLE Or %TBS_BOTTOM Or %WS_TABSTOP Or %TBS_NOTICKS
       Control Send         hDlg, %IDM_MOTION, %TBM_SETRANGE, %TRUE, MakLng(11,99)
       Control Send         hDlg, %IDM_MOTION, %TBM_SETPOS, %TRUE, 53
       Control Add Label,   hDlg, -3,           "motion:",           194, 532,  44, 18
       Control Add Label,   hDlg, -4,           "pixels",            272, 532,  40, 18
       Control Add Textbox, hDlg, %IDM_PIXELS,  "5.3",               234, 530,  34, 20, _
               %ES_READONLY Or %ES_CENTER, %WS_EX_CLIENTEDGE
           
       Dialog Show Modal hDlg Call DlgProc
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    CallBack Function DlgProc() As Long
       Local i As Long
    
       Select Case As Long CbMsg
          Case %WM_INITDIALOG
             Control Handle CbHndl, %IDM_GRAPHIC To hGraphic
             OldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CodePtr(GraphicProc))
             Call Initialize(CbHndl)
             atime = 30
             amotion = 53
          Case %WM_TIMER
             KillTimer CbHndl, hTimer
             Call TimerBalloons(CbHndl)
             hTimer = SetTimer(CbHndl, %IDM_TIMER, atime, ByVal %NULL)
          Case %WM_HSCROLL
             Select Case CbLParam
                Case GetDlgItem(CbHndl, %IDM_STEP)
                   Control Send CbHndl, %IDM_STEP, %TBM_GETPOS, 0, 0 To atime
                   Control Set Text CbHndl, %IDM_NSTEPS, Format$(atime)
                Case GetDlgItem(CbHndl, %IDM_MOTION)
                   Control Send CbHndl, %IDM_MOTION, %TBM_GETPOS, 0, 0 To amotion
                   Control Set Text CbHndl, %IDM_PIXELS, Format$(amotion/10, "##.#")   
             End Select
             Function = %TRUE
          Case %WM_COMMAND
             Select Case CbCtl
                Case %IDM_RESET  :  If CbCtlMsg = %BN_CLICKED Then Call Initialize(CbHndl)
                Case %IDM_EXIT   :  If CbCtlMsg = %BN_CLICKED Then Dialog End CbHndl
                Case %IDM_enum  :  Control Get Check CbHndl, %IDM_enum To enum
                Case %IDM_REMOVE
                   If CbCtlMsg = %BN_CLICKED Then         'to explode balloons at random
                      KillTimer CbHndl, hTimer
                      If nBalloons > 5 Then
                         i = Rnd(2,nballoons)
                         Array Delete apX(i)  :  Array Delete apY(i)  :  Array Delete apC(i)
                         Decr nBalloons
                         Control Set Text CbHndl, %IDM_INFO1, "balloons : " + Str$(nBalloons)
                      End If
                      hTimer = SetTimer(CbHndl, %IDM_TIMER, atime, ByVal %NULL)
                   End If
             End Select
          Case %WM_DESTROY
             If hTimer Then KillTimer CbHndl, hTimer
             If OldGraphicProc Then SetWindowLong hGraphic, %GWL_WNDPROC, OldGraphicProc
       End Select
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function GraphicProc(Byval hWnd As Dword, Byval wMsg As Dword, Byval wParam As Dword, Byval lParam As Long) As Long
       Select Case wMsg
          Case %WM_LBUTTONUP  :  Call LeftButtonUp(hWnd, wParam, lParam)
       End Select
       Function = CallWindowProc(OldGraphicProc, hWnd, wMsg, wParam, lParam)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub LeftButtonUp(Byval hWnd As Dword, Byval wParam As Dword, Byval lParam As Long)
       Local pt As POINTAPI
    
       KillTimer hWnd, hTimer
       Randomize Timer * nBalloons
       GetCursorPos pt
       ScreenToClient hWnd, pt
       If BalloonsOverlap(pt.X, pt.Y) Then
          Incr nBalloons
          apX(nBalloons) = pt.X
          apY(nBalloons) = pt.Y
          apC(nBalloons) = Colors(Rnd(1,maxColors))
       End If
       Control Set Text GetParent(hWnd), %IDM_INFO1, "balloons : " + Str$(nBalloons)
       hTimer = SetTimer(hWnd, %IDM_TIMER, atime, ByVal %NULL)
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub TimerBalloons(hWnd As Dword)
       'based from an idea of Scott Buckley
       Local i, j, x, y  As Long
       Local txt As String
       Local Angle, dmotion, cX, cY As Double
    
       If nBalloons <= 1 Then Exit Sub            'skip the first ball at initial
       dmotion = amotion/10
    
       For j = 1 To nBalloons                                                       ''''
          apY(j) = apY(j) + dmotion         'motion: on timestep (non-divisible value) '
          If apY(j) < Radius Then apY(j) = Radius                                      '
          If apY(j) > sheight - Radius Then apY(j) = sheight - Radius                  '
          If apX(j) < Radius Then apX(j) = Radius                                      '
          If apX(j) > swidth - Radius Then apX(j) = swidth - Radius                    '
          For i = 1 To nBalloons                                                ''''   '
             If i <> j Then                           'avoid war against itself    '   '
                If ((apX(j)-apX(i))^2 + (apY(j)-apY(i))^2) < Radius4 Then          '   '
                   Angle = Atn2(apX(j) - apX(i), apY(j) - apY(i))                  '   '
                   cX = (apX(j) + apX(i)) / 2                                      '   '
                   cY = (apY(j) + apY(i)) / 2                                      '   '
                   apX(j) = cX + (Radius * Cos(Angle))                             '   '
                   apY(j) = cY - (Radius * Sin(Angle))                             '   '
                   apX(i) = cX - (Radius * Cos(Angle))                             '   '
                   apY(i) = cY + (Radius * Sin(Angle))                             '   '
                End If                                                             '   '
             End If                                                                '   '
          Next i                                                                ''''   '
          'is a copy of first part, but necessary here for balloons in the inner loop  '
          If apY(j) < Radius Then apY(j) = Radius                                      '
          If apY(j) > sheight - Radius Then apY(j) = sheight - Radius                  '
          If apX(j) < Radius Then apX(j) = Radius                                      '
          If apX(j) > swidth - Radius Then apX(j) = swidth - Radius                    '
       Next j                                                                       ''''
    
       Call CanvasCleaner(%FALSE)
       For j = 1 to nBalloons
          Graphic Ellipse (apX(j)-Radius,apY(j)-Radius) - (apX(j)+Radius,apY(j)+Radius), -1, apC(j)
          If enum Then                     'enumerate balloons ?
             txt = Ltrim$(Str$(j))
             Graphic Text Size txt To x, y
             Graphic Set Pos (apX(j)-x/2, apY(j)-y/2)
             Graphic Print txt
          End If
       Next j
       Graphic Redraw
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub CanvasCleaner(wantRedraw As Long)
       Local j As Long
       Graphic Clear
       For j = 0 To 24
          Graphic Line (j*20, 00) - (j*20, 500), %LTLINES
          Graphic Line (00, j*20) - (300, j*20), %LTLINES
       Next
       'suggestion by Petr Schreiber
       If wantRedraw Then Graphic Redraw
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub Initialize(hWnd As Dword)
       ReDim apX(250), apY(250), apC(250)   'max 250 balloons
       Call CanvasCleaner(%TRUE)
       Call PrepareColors
       Radius    = 25                       'balloon Radius 25 pixels
       Radius4   = (Radius*2)^2             'to save time on process
       nBalloons = 1                        'first balloon
       apX(1) = swidth/2                    '  "      "
       apY(1) = sheight-Radius              '  "      "
       apC(1) = Colors(Rnd(1, maxColors))   '  "      "
       Control Set Text hWnd, %IDM_INFO1, "balloons : " + Str$(nBalloons)
       hTimer = SetTimer(hWnd, %IDM_TIMER, atime, ByVal %NULL)
       Graphic Set Pos (44,44)
       Graphic Print "Use left button mouse on free area to add balloons."
       Graphic Ellipse (apX(1)-Radius,apY(1)-Radius) - (apX(1)+Radius,apY(1)+Radius), -1, apC(1)
       Graphic Redraw
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub PrepareColors()
       Local i, j As Long
       'array with 96 soft colors to mapping balloons
       ReDim Colors(1 To DataCount) As Long
       maxColors = UBound(Colors)
       For j = 1 To DataCount
          Colors(j) = Val(Read$(j))
       Next j
       'shuffle colors array (by John Gleason)
       For j = LBound(Colors) To UBound(Colors)
          i = Rnd(j, UBound(Colors))
          Swap Colors(j), Colors(i)
       Next
       'from soft colors chart found on Internet some time ago
       Data 16777215, 16777164, 16777113, 16777062, 16764159, 16764108, 16764057, 16764006
       Data 16751103, 16751052, 16751001, 16750950, 16711935, 16711884, 16711833, 16711782
       Data 13434879, 13434828, 13434777, 13434726, 13421823, 13421772, 13421721, 13421670
       Data 13408767, 13408716, 13408665, 13408614, 13395711, 13395660, 13395609, 13395558
       Data 10092543, 10092492, 10092441, 10092390, 10079487, 10079436, 10079385, 10079334
       Data 10066431, 10066380, 10066329, 10066278, 10053375, 10053324, 10053273, 10053222
       Data  6750207,  6750156,  6750105,  6750054,  6737151,  6737100,  6737049,  6736998
       Data  6724095,  6724044,  6723993,  6723942,  6711039,  6710988,  6710937,  6710886
       Data  3407871,  3407820,  3407769,  3407718,  3394815,  3394764,  3394713,  3394662
       Data  3381759,  3381708,  3381657,  3381606,  3368703,  3368652,  3368601,  3368550
       Data    65535,    65484,    65433,    65382,    52479,    52428,    52377,    52326
       Data    39423,    39372,    39321,    39270,    26367,    26316,    26265,    26214
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function Atn2(X As Double, Y As Double) As Double
       'Atn2 optimized version. Simple but sufficient for this purpose.
       'Range of the result is 0 to 2Pi radians.
       If Y = 0 Then Y = NearZero
       Function = (Atn(Abs(X)/Abs(Y)) * Sgn(X) - Pi/2) * Sgn(Y)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function BalloonsOverlap(ByVal bX1 As Long, ByVal bY1 As Long) As Long
       'Calculate if two balloons overlaps when is inserted on pool.
       'Returns true (no overlap) or false (balloons overlap)
       Local j, distance  As Long
       Function = %TRUE
       For j = 1 To nBalloons   'loop over existing balls
          If Not (apX(j) = 0 And apY(j) = 0) Then
             distance = Sqr(((bX1-apX(j)) ^2) + ((bY1-apY(j)) ^2))
             If distance >= Radius*2 Then
                'not overlap, to next ball
             Else
                Function = %FALSE
                Exit For
             End If
          End If
       Next j
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    'eof
    Last edited by Jordi Vallès; 27 Jun 2008, 05:51 PM.

    Comment


    • #3
      Here is little modification, which allows different radiuses and infinite number of ballons. All costs something, so it is possible performance of this version is lower than in the Jordi's originals.

      Code:
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      ' PackBalloons.bas              by Jordi Valle`s       version 1d      28/06/2008
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ' A graphical entertainment.
      '
      ' Searching information about dynamic graphs for networks I found this simple
      ' algorithm from Scott Buckley and after some small modifications and an
      ' implementation inside a PB DDT suit this is the result.
      ' Don't know if is useful for something but is curious.
      ' Sincerely, I understood this routine, but not allways the results obtained.
      '
      ' - Press mouse left button on free area to add balloons to pool.
      ' - Observe the behaviour after the 35th (approx) balloon when starts the
      '   "dance" due to collisions caused by unstability between center distances.
      ' - With Explode button a balloon is removed at random.
      ' - Balloons can be numbered using the checkbox "enumerate"
      ' - Use trackbars to modify:
      '           motion in pixels by timestep
      '           interval timestep
      '   modifying the motion pixel factor on a specific timestamp is possible to
      '   watch the interesting "ball" turbulence at lower speed and intensity.
      '   Sometimes it even finds new stable position. Is recommended to use small
      '   non-divisible values for motion. These two values can be changed during
      '   the normal program process.
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ' - Program developed and tested with PowerBASIC for Windows (PB/Win 8.04) on a
      '   PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium.
      ' - Only PB Graphic package is used to display information generated by program.
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      ' 27/06/2008-1c- Due a suggestion of Petr Schreiber added a trackbar to modify
      ' the motion in pixels by timestep dinamically.
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      ' 28/06/2008-1d- Support for different radiuses and infinite number of ballons
      ' added by Petr Schreiber
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      
      ' SED_PBWIN
      
      #COMPILE EXE "PackBalloons.exe"
      #DIM ALL
      
      #INCLUDE "Win32Api.inc"
      #INCLUDE "CommCtrl.inc"
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      %IDM_RESET    = 1110
      %IDM_REMOVE   = 1120
      %IDM_EXIT     = 1130
      %IDM_GRAPHIC  = 1140
      %IDM_INFO1    = 1150
      %IDM_ENUM     = 1160
      %IDM_MOTION   = 1170
      %IDM_TIMER    = 1210
      %IDM_STEP     = 1310
      %IDM_NSTEPS   = 1320
      %IDM_PIXELS   = 1330
      %CANVAS       = &hEEFAFA???  'RGB(250,250,238)
      %LTLINES      = &hEAEAEA???  'RGB(234,234,234)
      $TITLE = "Packing Balloons - 1d"   'title on caption
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      MACRO Pi        = 3.141592653589793# 'a comment?
      MACRO NearZero  = 0.000000000000001# 'to avoid problems in some divisions
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      DECLARE FUNCTION Atn2(X AS DOUBLE, Y AS DOUBLE) AS DOUBLE
      DECLARE FUNCTION BalloonsOverlball(BYVAL bX1 AS LONG, BYVAL bY1 AS LONG) AS LONG
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      GLOBAL OldGraphicProc       AS DWORD      'old process, used in subclass
      GLOBAL hTimer, hGraphic     AS DWORD
      GLOBAL swidth, sheight      AS LONG       'size of main canvas
      GLOBAL maxColors, enum      AS LONG
      
      TYPE tBall
        x   AS DOUBLE     ' X position
        y   AS DOUBLE     ' Y position
        c   AS LONG       ' Color
        r   AS DOUBLE     ' Radius
      END TYPE
      
      GLOBAL Ball() AS tBall
      GLOBAL Colors()      AS LONG
      
      GLOBAL nBalloons            AS LONG
      GLOBAL atime, amotion       AS LONG
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      FUNCTION PBMAIN () AS LONG
         LOCAL hDlg AS DWORD
         LOCAL signature AS ASCIIZ * 90
      
         '~~~ 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
      
         DIALOG NEW PIXELS, 0, $TITLE, , , 309, 592, %WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg
         CONTROL ADD GRAPHIC, hDlg, %IDM_GRAPHIC,"", 3, 3, 302, 502, %WS_BORDER OR %SS_NOTIFY
      
         CONTROL GET CLIENT hDlg, %IDM_GRAPHIC TO swidth, sheight    'get client (canvas) size
         GRAPHIC SCALE (0, 0) - (swidth, sheight)                    'scale to pixel coordinate system
         GRAPHIC ATTACH hDlg, %IDM_GRAPHIC, REDRAW
         GRAPHIC FONT "Arial", 7, 0
         GRAPHIC COLOR %BLACK, %CANVAS                      'canvas colors
      
         CONTROL ADD BUTTON,  hDlg, %IDM_REMOVE,  "Explode 1",         120, 568,  60, 20
         CONTROL ADD BUTTON,  hDlg, %IDM_RESET,   "Reset",             182, 568,  60, 20
         CONTROL ADD BUTTON,  hDlg, %IDM_EXIT,    "Quit",              244, 568,  60, 20
         CONTROL ADD LABEL,   hDlg, %IDM_INFO1,   "balloons :  0",      10, 576,  80, 14
         CONTROL ADD CHECKBOX,hDlg, %IDM_ENUM,    "enumerate",          10, 556,  70, 16
      
         CONTROL ADD "msctls_trackbar32", hDlg, %IDM_STEP, "",          10, 510, 110, 20, _
                 %WS_CHILD OR %TBS_HORZ OR %WS_VISIBLE OR %TBS_BOTTOM OR %WS_TABSTOP OR %TBS_NOTICKS
         CONTROL SEND         hDlg, %IDM_STEP, %TBM_SETRANGE, %TRUE, MAKLNG(10,100)
         CONTROL SEND         hDlg, %IDM_STEP, %TBM_SETPOS, %TRUE, 30
         CONTROL ADD LABEL,   hDlg, -1,           "timerstep:",         10, 532,  44, 18
         CONTROL ADD LABEL,   hDlg, -2,           "mSecs.",             88, 532,  40, 18
         CONTROL ADD TEXTBOX, hDlg, %IDM_NSTEPS,  "30",                 58, 530,  28, 20, _
                 %ES_READONLY OR %ES_CENTER, %WS_EX_CLIENTEDGE
      
            CONTROL ADD "msctls_trackbar32", hDlg, %IDM_MOTION, "",    190, 510, 110, 20, _
                 %WS_CHILD OR %TBS_HORZ OR %WS_VISIBLE OR %TBS_BOTTOM OR %WS_TABSTOP OR %TBS_NOTICKS
         CONTROL SEND         hDlg, %IDM_MOTION, %TBM_SETRANGE, %TRUE, MAKLNG(11,99)
         CONTROL SEND         hDlg, %IDM_MOTION, %TBM_SETPOS, %TRUE, 53
         CONTROL ADD LABEL,   hDlg, -3,           "motion:",           194, 532,  44, 18
         CONTROL ADD LABEL,   hDlg, -4,           "pixels",            272, 532,  40, 18
         CONTROL ADD TEXTBOX, hDlg, %IDM_PIXELS,  "5.3",               234, 530,  34, 20, _
                 %ES_READONLY OR %ES_CENTER, %WS_EX_CLIENTEDGE
      
         DIALOG SHOW MODAL hDlg CALL DlgProc
      END FUNCTION
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      CALLBACK FUNCTION DlgProc() AS LONG
         LOCAL i AS LONG
      
         SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
               CONTROL HANDLE CBHNDL, %IDM_GRAPHIC TO hGraphic
               OldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CODEPTR(GraphicProc))
               CALL Initialize(CBHNDL)
               atime = 30
               amotion = 53
            CASE %WM_TIMER
               KillTimer CBHNDL, hTimer
               CALL TimerBalloons(CBHNDL)
               hTimer = SetTimer(CBHNDL, %IDM_TIMER, atime, BYVAL %NULL)
            CASE %WM_HSCROLL
               SELECT CASE CBLPARAM
                  CASE GetDlgItem(CBHNDL, %IDM_STEP)
                     CONTROL SEND CBHNDL, %IDM_STEP, %TBM_GETPOS, 0, 0 TO atime
                     CONTROL SET TEXT CBHNDL, %IDM_NSTEPS, FORMAT$(atime)
                  CASE GetDlgItem(CBHNDL, %IDM_MOTION)
                     CONTROL SEND CBHNDL, %IDM_MOTION, %TBM_GETPOS, 0, 0 TO amotion
                     CONTROL SET TEXT CBHNDL, %IDM_PIXELS, FORMAT$(amotion/10, "##.#")
               END SELECT
               FUNCTION = %TRUE
            CASE %WM_COMMAND
               SELECT CASE CBCTL
                  CASE %IDM_RESET  :  IF CBCTLMSG = %BN_CLICKED THEN CALL Initialize(CBHNDL)
                  CASE %IDM_EXIT   :  IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL
                  CASE %IDM_enum  :  CONTROL GET CHECK CBHNDL, %IDM_enum TO enum
                  CASE %IDM_REMOVE
                     IF CBCTLMSG = %BN_CLICKED THEN         'to explode balloons at random
                        KillTimer CBHNDL, hTimer
                        IF nBalloons > 5 THEN
                           i = RND(6,nballoons)
                           ARRAY DELETE ball(i)
                           DECR nBalloons
                           CONTROL SET TEXT CBHNDL, %IDM_INFO1, "balloons : " + STR$(nBalloons)
                        END IF
                        hTimer = SetTimer(CBHNDL, %IDM_TIMER, atime, BYVAL %NULL)
                     END IF
               END SELECT
            CASE %WM_DESTROY
               IF hTimer THEN KillTimer CBHNDL, hTimer
               IF OldGraphicProc THEN SetWindowLong hGraphic, %GWL_WNDPROC, OldGraphicProc
         END SELECT
      END FUNCTION
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      FUNCTION GraphicProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
         SELECT CASE wMsg
            CASE %WM_LBUTTONUP  :  CALL LeftButtonUp(hWnd, wParam, lParam)
         END SELECT
         FUNCTION = CallWindowProc(OldGraphicProc, hWnd, wMsg, wParam, lParam)
      END FUNCTION
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      SUB LeftButtonUp(BYVAL hWnd AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
         LOCAL pt AS POINTAPI
      
         KillTimer hWnd, hTimer
         RANDOMIZE TIMER * nBalloons
         GetCursorPos pt
         ScreenToClient hWnd, pt
         IF BalloonsOverlball(pt.X, pt.Y) THEN
            INCR nBalloons
            IF nBalloons > UBOUND(Ball) THEN REDIM PRESERVE Ball(nBalloons+8)     ' +8 means some extra buffer to not redim for each ballon then
            Ball(nBalloons).x = pt.X
            Ball(nBalloons).y = pt.Y
            Ball(nBalloons).c = Colors(RND(1, maxColors))   '  "      "
            Ball(nBalloons).r = RND(15,30)                  '  "      "
         END IF
         CONTROL SET TEXT GetParent(hWnd), %IDM_INFO1, "balloons : " + STR$(nBalloons)
         hTimer = SetTimer(hWnd, %IDM_TIMER, atime, BYVAL %NULL)
      END SUB
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      SUB TimerBalloons(hWnd AS DWORD)
         REGISTER i AS LONG, j AS LONG
         'based from an idea of Scott Buckley
         'based from an idea of Scott Buckley
         LOCAL x, y  AS LONG
         LOCAL txt AS STRING
         LOCAL Angle, dmotion, cX, cY AS DOUBLE
      
         LOCAL factor AS DOUBLE
      
      
         IF nBalloons <= 1 THEN EXIT SUB            'skip the first ball at initial
         dmotion = amotion/10
      
         ' -- Collision between balls
         FOR j = 1 TO nBalloons                                                       ''''
            Ball(j).y = Ball(j).y + dmotion         'motion: on timestep (non-divisible value) '
            ' -- Collision against the walls
            IF Ball(j).y < Ball(j).r THEN Ball(j).y = Ball(j).r                                      '
            IF Ball(j).y > sheight - Ball(j).r THEN Ball(j).y = sheight - Ball(j).r                  '
            IF Ball(j).x < Ball(j).r THEN Ball(j).x = Ball(j).r                                      '
            IF Ball(j).x > swidth - Ball(j).r THEN Ball(j).x = swidth - Ball(j).r                    '
            FOR i = 1 TO nBalloons                                                ''''   '
               IF i <> j THEN                           'avoid war against itself    '   '
                  IF ((Ball(j).x-Ball(i).x)^2 + (Ball(j).y-Ball(i).y)^2) < (Ball(j).r+Ball(i).r)^2 THEN          '   '
                     Angle = Atn2(Ball(j).x - Ball(i).x, Ball(j).y - Ball(i).y)                  '   '
                     cX = (Ball(j).x + Ball(i).x) / 2                                      '   '
                     cY = (Ball(j).y + Ball(i).y) / 2                                      '   '
                     factor = (Ball(i).r+Ball(j).r)/2
                     Ball(j).x = cX + (factor * COS(Angle))                             '   '
                     Ball(j).y = cY - (factor * SIN(Angle))                             '   '
                     Ball(i).x = cX - (factor * COS(Angle))                             '   '
                     Ball(i).y = cY + (factor * SIN(Angle))                             '   '
                  END IF                                                             '   '
               END IF                                                                '   '
            NEXT i                                                                ''''   '
            'is a copy of first part, but necessary here for balloons in the inner loop  '
      
            ' -- Collision against the walls
            IF Ball(j).y < Ball(j).r THEN Ball(j).y = Ball(j).r                                      '
            IF Ball(j).y > sheight - Ball(j).r THEN Ball(j).y = sheight - Ball(j).r                  '
            IF Ball(j).x < Ball(j).r THEN Ball(j).x = Ball(j).r                                      '
            IF Ball(j).x > swidth - Ball(j).r THEN Ball(j).x = swidth - Ball(j).r                    '
         NEXT j                                                                       ''''
      
         CALL CanvasCleaner(%FALSE)
         FOR j = 1 TO nBalloons
            GRAPHIC ELLIPSE (Ball(j).x-Ball(j).r,Ball(j).y-Ball(j).r) - (Ball(j).x+Ball(j).r,Ball(j).y+Ball(j).r), -1, Ball(j).c
            IF enum THEN                     'enumerate balloons ?
               txt = LTRIM$(STR$(j))
               GRAPHIC TEXT SIZE txt TO x, y
               GRAPHIC SET POS (Ball(j).x-x/2, Ball(j).y-y/2)
               GRAPHIC PRINT txt
            END IF
         NEXT j
         GRAPHIC REDRAW
      
      
      END SUB
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      SUB CanvasCleaner(wantRedraw AS LONG)
         LOCAL j AS LONG
         GRAPHIC CLEAR
         FOR j = 0 TO 24
            GRAPHIC LINE (j*20, 00) - (j*20, 500), %LTLINES
            GRAPHIC LINE (00, j*20) - (300, j*20), %LTLINES
         NEXT
         'suggestion by Petr Schreiber
         IF wantRedraw THEN GRAPHIC REDRAW
      END SUB
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      SUB Initialize(hWnd AS DWORD)
         REDIM Ball(250) 'max 250 balloons
         CALL CanvasCleaner(%TRUE)
         CALL PrepareColors
         nBalloons = 1                        'first balloon
         Ball(1).r = 25                  '  "      "
         Ball(1).x = swidth/2                    '  "      "
         Ball(1).y = sheight-Ball(1).r           '  "      "
         Ball(1).c = Colors(RND(1, maxColors))   '  "      "
         CONTROL SET TEXT hWnd, %IDM_INFO1, "balloons : " + STR$(nBalloons)
         hTimer = SetTimer(hWnd, %IDM_TIMER, atime, BYVAL %NULL)
         GRAPHIC SET POS (44,44)
         GRAPHIC PRINT "Use left button mouse on free area to add balloons."
         GRAPHIC ELLIPSE (Ball(1).x-Ball(1).r,Ball(1).y-Ball(1).r) - (Ball(1).x+Ball(1).r,Ball(1).y+Ball(1).r), -1, ball(1).c
         GRAPHIC REDRAW
      END SUB
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      SUB PrepareColors()
         LOCAL i, j AS LONG
         'array with 96 soft colors to mapping balloons
         REDIM Colors(1 TO DATACOUNT) AS LONG
         maxColors = UBOUND(Colors)
         FOR j = 1 TO DATACOUNT
            Colors(j) = VAL(READ$(j))
         NEXT j
         'shuffle colors array (by John Gleason)
         FOR j = LBOUND(Colors) TO UBOUND(Colors)
            i = RND(j, UBOUND(Colors))
            SWAP Colors(j), Colors(i)
         NEXT
         'from soft colors chart found on Internet some time ago
         DATA 16777215, 16777164, 16777113, 16777062, 16764159, 16764108, 16764057, 16764006
         DATA 16751103, 16751052, 16751001, 16750950, 16711935, 16711884, 16711833, 16711782
         DATA 13434879, 13434828, 13434777, 13434726, 13421823, 13421772, 13421721, 13421670
         DATA 13408767, 13408716, 13408665, 13408614, 13395711, 13395660, 13395609, 13395558
         DATA 10092543, 10092492, 10092441, 10092390, 10079487, 10079436, 10079385, 10079334
         DATA 10066431, 10066380, 10066329, 10066278, 10053375, 10053324, 10053273, 10053222
         DATA  6750207,  6750156,  6750105,  6750054,  6737151,  6737100,  6737049,  6736998
         DATA  6724095,  6724044,  6723993,  6723942,  6711039,  6710988,  6710937,  6710886
         DATA  3407871,  3407820,  3407769,  3407718,  3394815,  3394764,  3394713,  3394662
         DATA  3381759,  3381708,  3381657,  3381606,  3368703,  3368652,  3368601,  3368550
         DATA    65535,    65484,    65433,    65382,    52479,    52428,    52377,    52326
         DATA    39423,    39372,    39321,    39270,    26367,    26316,    26265,    26214
      END SUB
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      FUNCTION Atn2(X AS DOUBLE, Y AS DOUBLE) AS DOUBLE
         'Atn2 optimized version. Simple but sufficient for this purpose.
         'Range of the result is 0 to 2Pi radians.
         IF Y = 0 THEN Y = NearZero
         FUNCTION = (ATN(ABS(X)/ABS(Y)) * SGN(X) - Pi/2) * SGN(Y)
      END FUNCTION
      
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      FUNCTION BalloonsOverlball(BYVAL bX1 AS LONG, BYVAL bY1 AS LONG) AS LONG
         'Calculate if two balloons overlaps when is inserted on pool.
         'Returns true (no overlap) or false (balloons overlap)
         LOCAL j, distance  AS LONG
         FUNCTION = %TRUE
         FOR j = 1 TO nBalloons   'loop over existing balls
            IF NOT (ball(j).x = 0 AND ball(j).y = 0) THEN
               distance = SQR(((bX1-ball(j).x) ^2) + ((bY1-ball(j).y) ^2))
               IF distance >= ball(j).r*2 THEN
                  'not overlap, to next ball
               ELSE
                  FUNCTION = %FALSE
                  EXIT FOR
               END IF
            END IF
         NEXT j
      END FUNCTION
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      'eof
      Last edited by Petr Schreiber jr; 28 Jun 2008, 05:51 AM.
      [email protected]

      Comment


      • #4
        This is the last modification, I hope. A checkbox has been added to allow choose if fixed or variable balloons size, if fixed the radius is set to 25 pixels, variable from 18 to 30. Variable is the default. Also an small error is corrected and some cosmetic improvements has been introduced.

        Code:
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        ' PackBalloons.bas              by Jordi Vallès        version 1e     29/06/2008
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ' A graphical entertainment.
        ' 
        ' Searching information about dynamic graphs for networks I found this simple
        ' algorithm from Scott Buckley and after some small modifications and an
        ' implementation inside a PB DDT suit this is the result.
        ' Don't know if is useful for something but is curious.
        ' Sincerely, I understood this routine, but not allways the results obtained.
        '
        ' - Press mouse left button on free area to add balloons to pool.
        ' - Observe the behaviour after the 35th (approx) balloon when starts the
        '   "dance" due to collisions caused by unstability between center distances.
        ' - With Explode button a balloon is removed at random.
        ' - Balloons can be numbered using the checkbox "enumerate"
        ' - Use trackbars to modify:
        '           motion in pixels by timestep
        '           interval timestep
        '   modifying the motion pixel factor on a specific timestamp is possible to
        '   watch the interesting "ball" turbulence at lower speed and intensity.
        '   Sometimes it even finds new stable position. Is recommended to use small
        '   non-divisible values for motion. These two values can be changed during
        '   the normal program process.
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ' - Program developed and tested with PowerBASIC for Windows (PB/Win 8.04) on a
        '   PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium.
        ' - Only PB Graphic package is used to display information generated by program.
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        ' 27/06/2008-1c- Due a suggestion of Petr Schreiber added a trackbar to modify
        ' the motion in pixels by timestep dinamically
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ' 28/06/2008-1d- Support for different radiuses and infinite number of ballons
        ' added by Petr Schreiber.
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        ' 29/06/2008-1e- Checkbox added to allow choose if fixed or variable balloons
        ' size, if fixed the radius is set to 25, variable from  18 to 30. Variable is
        ' the default. Also an small error corrected and some cosmetic improvements.
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        ' SED_PBWIN
        
        #Compile Exe "PackBalloons.exe"
        #Dim All
        
        #Include "Win32Api.inc"
        #Include "CommCtrl.inc"
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        %IDM_RESET    = 1110
        %IDM_REMOVE   = 1120
        %IDM_EXIT     = 1130
        %IDM_GRAPHIC  = 1140
        %IDM_NBALLS   = 1150
        %IDM_ENUM     = 1160
        %IDM_MOTION   = 1170
        %IDM_FIXRAD   = 1180
        %IDM_TIMER    = 1210
        %IDM_STEP     = 1310
        %IDM_NSTEPS   = 1320
        %IDM_PIXELS   = 1330
        %CANVAS       = &hEEFAFA???  'RGB(250,250,238)
        %LTLINES      = &hEAEAEA???  'RGB(234,234,234)
        $TITLE = "Packing Balloons - 1e"   'title on caption
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        Macro Pi        = 3.141592653589793# 'a comment?
        Macro NearZero  = 0.000000000000001# 'to avoid problems in some divisions
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        Declare Function Atn2(X As Double, Y As Double) As Double
        Declare Function BalloonsOverlap(ByVal bX1 As Long, ByVal bY1 As Long) As Long
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        Type tBall
           x     As Double     'X position
           y     As Double     'Y position
           c     As Long       'Color
           r     As Double     'Radius
        End Type
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        Global OldGraphicProc       As Dword      'old process, used in subclass
        Global hTimer, hGraphic     As Dword
        Global swidth, sheight      As Long       'size of main canvas
        Global maxColors, enum      As Long
        Global Ball()               As tBall
        Global Colors()             As Long
        Global nBalls, fixrad       As Long
        Global atime, amotion       As Long
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Function PBMain () As Long
           Local hDlg As Dword
           Local signature As Asciiz * 90
        
           '~~~ 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
        
           Dialog New Pixels, 0, $TITLE, , , 309, 586, %WS_CAPTION Or %WS_SYSMENU, 0 To hDlg
           Control Add Graphic, hDlg, %IDM_GRAPHIC,"", 3, 3, 302, 502, %WS_BORDER Or %SS_NOTIFY
        
           Control Get Client hDlg, %IDM_GRAPHIC To swidth, sheight    'get client (canvas) size
           Graphic Scale (0, 0) - (swidth, sheight)                    'scale to pixel coordinate system
           Graphic Attach hDlg, %IDM_GRAPHIC, ReDraw                   'REDRAW will be needed to refresh canvas
           Graphic Font "Arial", 7, 0                                  'font used in graphics
           Graphic Color %Black, %CANVAS                               'canvas colors
        
           Control Add Button,  hDlg, %IDM_REMOVE,  "Explode 1",         120, 560,  60, 22
           Control Add Button,  hDlg, %IDM_RESET,   "Reset",             182, 560,  60, 22
           Control Add Button,  hDlg, %IDM_EXIT,    "Quit",              244, 560,  60, 22
           Control Add Label,   hDlg, -1,           "balloons",          138, 510,  40, 14
           Control Add CheckBox,hDlg, %IDM_ENUM,    "enumerate balloons",  4, 552, 110, 16
           Control Add CheckBox,hDlg, %IDM_FIXRAD,  "fixed balloon size",  4, 568, 110, 16
           Control Add TextBox, hDlg, %IDM_NBALLS,  "0",                 144, 526,  30, 20, _
                   %ES_READONLY Or %ES_CENTER, %WS_EX_CLIENTEDGE
        
           Control Add "msctls_trackbar32", hDlg, %IDM_STEP, "",           4, 506, 110, 20, _
                   %WS_CHILD Or %TBS_HORZ Or %WS_VISIBLE Or %TBS_BOTTOM Or %WS_TABSTOP Or %TBS_NOTICKS
           Control Send         hDlg, %IDM_STEP, %TBM_SETRANGE, %TRUE, MakLng(10,100)
           Control Send         hDlg, %IDM_STEP, %TBM_SETPOS, %TRUE, 30
           Control Add Label,   hDlg, -2,           "timerstep:",          4, 528,  44, 18
           Control Add Label,   hDlg, -3,           "mSecs.",             82, 528,  40, 18
           Control Add TextBox, hDlg, %IDM_NSTEPS,  "30",                 52, 526,  28, 20, _
                   %ES_READONLY Or %ES_CENTER, %WS_EX_CLIENTEDGE
        
           Control Add "msctls_trackbar32", hDlg, %IDM_MOTION, "",       196, 506, 110, 20, _
                   %WS_CHILD Or %TBS_HORZ Or %WS_VISIBLE Or %TBS_BOTTOM Or %WS_TABSTOP Or %TBS_NOTICKS
           Control Send         hDlg, %IDM_MOTION, %TBM_SETRANGE, %TRUE, MakLng(11,99)
           Control Send         hDlg, %IDM_MOTION, %TBM_SETPOS, %TRUE, 53
           Control Add Label,   hDlg, -4,           "motion:",           200, 528,  44, 18
           Control Add Label,   hDlg, -5,           "pixels",            276, 528,  40, 18
           Control Add TextBox, hDlg, %IDM_PIXELS,  "5.3",               238, 526,  34, 20, _
                   %ES_READONLY Or %ES_CENTER, %WS_EX_CLIENTEDGE
        
           Dialog Show Modal hDlg Call DlgProc
        End Function
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        CallBack Function DlgProc() As Long
           Local i As Long
        
           Select Case As Long CbMsg
              Case %WM_INITDIALOG
                 Control Handle CbHndl, %IDM_GRAPHIC To hGraphic
                 OldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CodePtr(GraphicProc))
                 Call Initialize(CbHndl)
                 atime = 30           'initial defaults
                 amotion = 53         '   "        "
              Case %WM_TIMER
                 KillTimer CbHndl, hTimer
                 Call TimerBalloons(CbHndl)
                 hTimer = SetTimer(CbHndl, %IDM_TIMER, atime, ByVal %NULL)
              Case %WM_HSCROLL
                 Select Case CbLParam
                    Case GetDlgItem(CbHndl, %IDM_STEP)
                       Control Send CbHndl, %IDM_STEP, %TBM_GETPOS, 0, 0 To atime
                       Control Set Text CbHndl, %IDM_NSTEPS, Format$(atime)
                    Case GetDlgItem(CbHndl, %IDM_MOTION)
                       Control Send CbHndl, %IDM_MOTION, %TBM_GETPOS, 0, 0 To amotion
                       Control Set Text CbHndl, %IDM_PIXELS, Format$(amotion/10, "##.#")
                 End Select
                 Function = %TRUE
              Case %WM_COMMAND
                 Select Case CbCtl
                    Case %IDM_RESET  :  If CbCtlMsg = %BN_CLICKED Then Call Initialize(CbHndl)
                    Case %IDM_EXIT   :  If CbCtlMsg = %BN_CLICKED Then Dialog End CbHndl
                    Case %IDM_ENUM   :  Control Get Check CbHndl, %IDM_ENUM To enum
                    Case %IDM_FIXRAD :  Control Get Check CbHndl, %IDM_FIXRAD To fixrad
                    Case %IDM_REMOVE
                       If CbCtlMsg = %BN_CLICKED Then         'to explode balloons at random
                          KillTimer CbHndl, hTimer
                          If nBalls > 5 Then
                             i = Rnd(6,nBalls)
                             Array Delete Ball(i)
                             Decr nBalls
                             Control Set Text CbHndl, %IDM_NBALLS, LTrim$(Str$(nBalls))
                          End If
                          hTimer = SetTimer(CbHndl, %IDM_TIMER, atime, ByVal %NULL)
                       End If
                 End Select
              Case %WM_DESTROY
                 If hTimer Then KillTimer CbHndl, hTimer
                 If OldGraphicProc Then SetWindowLong hGraphic, %GWL_WNDPROC, OldGraphicProc
           End Select
        End Function
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Function GraphicProc(ByVal hWnd As Dword, ByVal wMsg As Dword, ByVal wParam As Dword, ByVal lParam As Long) As Long
           Select Case wMsg
              Case %WM_LBUTTONUP  :  Call LeftButtonUp(hWnd, wParam, lParam)
           End Select
           Function = CallWindowProc(OldGraphicProc, hWnd, wMsg, wParam, lParam)
        End Function
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Sub LeftButtonUp(ByVal hWnd As Dword, ByVal wParam As Dword, ByVal lParam As Long)
           Local pt As POINTAPI
        
           KillTimer hWnd, hTimer
           Randomize Timer * nBalls
           GetCursorPos pt
           ScreenToClient hWnd, pt
           If BalloonsOverlap(pt.X, pt.Y) Then
              Incr nBalls
              If nBalls > UBound(Ball) Then ReDim Preserve Ball(nBalls+8) '+8 means some extra buffer to not redim for each ballon then
              Ball(nBalls).x = pt.X
              Ball(nBalls).y = pt.Y
              Ball(nBalls).c = Colors(Rnd(1, maxColors))
              Ball(nBalls).r = IIf(fixrad, 25, Rnd(18,30))        'fixed 25, variable 18 to 30
           End If
           Control Set Text GetParent(hWnd), %IDM_NBALLS, LTrim$(Str$(nBalls))
           hTimer = SetTimer(hWnd, %IDM_TIMER, atime, ByVal %NULL)
        End Sub
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Sub TimerBalloons(hWnd As Dword)
           'based from an idea of Scott Buckley
           Register i As Long, j As Long
           Local sx, sy  As Long
           Local txt As String
           Local Angle, dmotion, factor, cX, cY As Double
        
           If nBalls <= 1 Then Exit Sub               'skip the first ball at initial
           dmotion = amotion/10
        
           ' -- Collision between balls
           For j = 1 To nBalls                                                                      ''''
              Ball(j).y = Ball(j).y + dmotion         'motion on timestep (non-divisible value)        '
              ' -- Collision against the walls                                                         '
              If Ball(j).y < Ball(j).r Then Ball(j).y = Ball(j).r                                      '
              If Ball(j).y > sheight - Ball(j).r Then Ball(j).y = sheight - Ball(j).r                  '
              If Ball(j).x < Ball(j).r Then Ball(j).x = Ball(j).r                                      '
              If Ball(j).x > swidth - Ball(j).r Then Ball(j).x = swidth - Ball(j).r                    '
              For i = 1 To nBalls                                                               ''''   '
                 If i <> j Then                           'avoid war against itself                '   '
                    If ((Ball(j).x-Ball(i).x)^2 + (Ball(j).y-Ball(i).y)^2) < (Ball(j).r+Ball(i).r)^2 Then
                       Angle = Atn2(Ball(j).x - Ball(i).x, Ball(j).y - Ball(i).y)                  '   '
                       cX = (Ball(j).x + Ball(i).x) / 2                                            '   '
                       cY = (Ball(j).y + Ball(i).y) / 2                                            '   '
                       factor = (Ball(i).r+Ball(j).r)/2                                            '   '
                       Ball(j).x = cX + (factor * Cos(Angle))                                      '   '
                       Ball(j).y = cY - (factor * Sin(Angle))                                      '   '
                       Ball(i).x = cX - (factor * Cos(Angle))                                      '   '
                       Ball(i).y = cY + (factor * Sin(Angle))                                      '   '
                    End If                                                                         '   '
                 End If                                                                            '   '
              Next i                                                                            ''''   '
              ' -- Collision against the walls                                                         '
              ' -- copy of first part, but necessary here for balloons in inner loop                   '
              If Ball(j).y < Ball(j).r Then Ball(j).y = Ball(j).r                                      '
              If Ball(j).y > sheight - Ball(j).r Then Ball(j).y = sheight - Ball(j).r                  '
              If Ball(j).x < Ball(j).r Then Ball(j).x = Ball(j).r                                      '
              If Ball(j).x > swidth - Ball(j).r Then Ball(j).x = swidth - Ball(j).r                    '
           Next j                                                                                   ''''
        
           Call CanvasCleaner(%FALSE)
           For j = 1 To nBalls
              Graphic Ellipse (Ball(j).x-Ball(j).r,Ball(j).y-Ball(j).r) - (Ball(j).x+Ball(j).r,Ball(j).y+Ball(j).r), -1, Ball(j).c
              If enum Then                           'enumerate balloons ?
                 txt = LTrim$(Str$(j))
                 Graphic Text Size txt To sx, sy
                 Graphic Set Pos (Ball(j).x-sx/2, Ball(j).y-sy/2)
                 Graphic Print txt
              End If
           Next j
           Graphic ReDraw
        End Sub
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Sub CanvasCleaner(wantRedraw As Long)
           Local j As Long
           Graphic Clear
           For j = 0 To 24
              Graphic Line (j*20, 00) - (j*20, 500), %LTLINES
              Graphic Line (00, j*20) - (300, j*20), %LTLINES
           Next
           'suggestion by Petr Schreiber
           If wantRedraw Then Graphic ReDraw
        End Sub
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Sub Initialize(hWnd As Dword)
           ReDim Ball(100)                         '100 balloons initially
           Call CanvasCleaner(%TRUE)
           Call PrepareColors
           nBalls = 1                              'first balloon
           Ball(1).r = 25                          '  "      "
           Ball(1).x = swidth/2                    '  "      "
           Ball(1).y = sheight-Ball(1).r           '  "      "
           Ball(1).c = Colors(Rnd(1, maxColors))   '  "      "
           Control Set Text hWnd, %IDM_NBALLS, LTrim$(Str$(nBalls))
           hTimer = SetTimer(hWnd, %IDM_TIMER, atime, ByVal %NULL)
           Graphic Set Pos (44,44)
           Graphic Print "Use left button mouse on free area to add balloons."
           Graphic Ellipse (Ball(1).x-Ball(1).r,Ball(1).y-Ball(1).r) - (Ball(1).x+Ball(1).r,Ball(1).y+Ball(1).r), -1, ball(1).c
           Graphic ReDraw
        End Sub
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Sub PrepareColors()
           Local i, j As Long
           'array with 96 soft colors to mapping balloons
           ReDim Colors(1 To DataCount) As Long
           maxColors = UBound(Colors)
           For j = 1 To DataCount
              Colors(j) = Val(Read$(j))
           Next j
           'shuffle colors array (by John Gleason)
           For j = LBound(Colors) To UBound(Colors)
              i = Rnd(j, UBound(Colors))
              Swap Colors(j), Colors(i)
           Next
           'from soft colors chart found on Internet some time ago
           Data 16777215, 16777164, 16777113, 16777062, 16764159, 16764108, 16764057, 16764006
           Data 16751103, 16751052, 16751001, 16750950, 16711935, 16711884, 16711833, 16711782
           Data 13434879, 13434828, 13434777, 13434726, 13421823, 13421772, 13421721, 13421670
           Data 13408767, 13408716, 13408665, 13408614, 13395711, 13395660, 13395609, 13395558
           Data 10092543, 10092492, 10092441, 10092390, 10079487, 10079436, 10079385, 10079334
           Data 10066431, 10066380, 10066329, 10066278, 10053375, 10053324, 10053273, 10053222
           Data  6750207,  6750156,  6750105,  6750054,  6737151,  6737100,  6737049,  6736998
           Data  6724095,  6724044,  6723993,  6723942,  6711039,  6710988,  6710937,  6710886
           Data  3407871,  3407820,  3407769,  3407718,  3394815,  3394764,  3394713,  3394662
           Data  3381759,  3381708,  3381657,  3381606,  3368703,  3368652,  3368601,  3368550
           Data    65535,    65484,    65433,    65382,    52479,    52428,    52377,    52326
           Data    39423,    39372,    39321,    39270,    26367,    26316,    26265,    26214
        End Sub
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Function Atn2(X As Double, Y As Double) As Double
           'Atn2 optimized version. Simple but sufficient for this purpose.
           'Range of the result is 0 to 2Pi radians.
           If Y = 0 Then Y = NearZero
           Function = (Atn(Abs(X)/Abs(Y)) * Sgn(X) - Pi/2) * Sgn(Y)
        End Function
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        Function BalloonsOverlap(ByVal bX1 As Long, ByVal bY1 As Long) As Long
           'Calculate if two balloons overlaps when is inserted on pool.
           'Returns true (no overlap) or false (balloons overlap)
           Local j, distance  As Long
           Function = %TRUE
           For j = 1 To nBalls       'loop over existing balls
              If Not (ball(j).x = 0 And ball(j).y = 0) Then
                 distance = Sqr(((bX1-ball(j).x) ^2) + ((bY1-ball(j).y) ^2))
                 If distance >= ball(j).r*2 Then
                    'not overlap, to next ball
                 Else
                    Function = %FALSE
                    Exit For
                 End If
              End If
           Next j
        End Function
        
        '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
        'eof

        Comment

        Working...
        X