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

  • Jordi Vallès
    replied
    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

    Leave a comment:


  • Petr Schreiber jr
    replied
    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.

    Leave a comment:


  • Jordi Vallès
    replied
    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.

    Leave a comment:


  • Jordi Vallès
    started a topic A graphical entertainment

    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
Working...
X