topbanner_forum
  *

avatar image

Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
  • Friday April 19, 2024, 7:35 pm
  • Proudly celebrating 15+ years online.
  • Donate now to become a lifetime supporting member of the site and get a non-expiring license key for all of our programs.
  • donate

Author Topic: FBSL - Bouncing balls  (Read 4438 times)

Gerome

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 154
    • View Profile
    • Get my Freestyle Basic Script Language + compiler!
    • Donate to Member
FBSL - Bouncing balls
« on: March 18, 2006, 06:13 AM »
Hello,

Wanna see bouncing balls ?
You can compile the following script there : http://gedd123.free..../studio/fbsl2exe.php

#Option Explicit
$DllDeclare user32("BeginPaint","EndPaint","GetSystemMetrics","SetWindowPos","GetDC","ReleaseDC",_
"SystemParametersInfoA","ShowCursor","GetClientRect","SetRect","FillRect")
$DllDeclare gdi32("CreateSolidBrush","CreatePen","Ellipse")

Dim %width,%height,$RECT
Dim %hDCgame,%color_pen,%color_brush,%black_pen,%black_brush
Dim %i
Dim %x,%y
Dim %xball = ScNew(),%yball = ScNew()   ,%xspeed = ScNew(),%yspeed = ScNew()
FillString( xball, 40, 0 ): FillString( yball, 40, 0 ): FillString( xspeed, 40, 0 ): FillString( yspeed, 40, 0 )

Dim $PS
FillString(PS,64,0)
Dim %hDWDC,%hMemDC,%hBitmap,%hOldBitmap

Begin Const
   SM_CXSCREEN = 0 'X Size of screen
   SM_CYSCREEN = 1 'Y Size of Screen
   SPI_SETSCREENSAVEACTIVE = 17
   HWND_TOPMOST = -1
   SWP_NOMOVE = 2
   OEM_CHARSET = 255
End Const

Begin Const
   GAME_SPEED = 33 'speed of game (increase to go slower)
   PS_SOLID = 0
   SRCCOPY = &HCC0020
End Const

Sub Main()
   GameInit()
   Begin Events
      Select Case CBMsg
         Case WM_TIMER
            Paint()
         Case WM_LBUTTONDOWN
            GameQuit()
         Case WM_ERASEBKGND
            ' Say we handled it
            Return 1
         Case WM_PAINT
            BeginPaint(Me,PS)
            EndPaint(Me,PS)
            Paint()
      End Select
   End Events
End Sub

Sub Paint()
   GetClientRect(Me,RECT)
   hDCgame = GetDC(Me) 'get the DC
   ' Our hidden buffer to hide the drawing process
  hMemDC = CreateCompatibleDC(hdcgame)
  ' Create a bitmap for that offscreen buffer
  hBitmap = CreateCompatibleBitmap(hdcgame,width,height)
  hOldBitmap = SelectObject(hMemDC,hBitmap)
   'Erase the background
  black_brush = CreateSolidBrush(RGB(0,255,0))
  FillRect(hMemDC,Rect,black_brush)
  DeleteObject(black_brush)
  'Draw the stuff onto the memdc backbuffer
  hDWDC=hMemDC : GameLoop()
  '..and when you are done, blit the final result onto the actual screen buffer
  BitBlt(hdcgame,0,0,width,height,hMemDC,0,0,SRCCOPY)
  SelectObject(hMemDC,hOldBitmap) 'select the old bitmap into hMemDC
  DeleteDC(hMemDC)
  Deleteobject(hBitmap)
  ReleaseDC(me,hdcgame)
End Sub

Sub GameLoop()
   For i = 0 To 36 Step 4
      ' save the x and y position of current ball
            x = GetMem(xball,i,4): y = GetMem(yball,i,4)
            ' then move them
            x = x + GetMem(xspeed,i,4)
            y = y + GetMem(yspeed,i,4)
            ' check if out of range on x axis
            If (x < 0 OR x > width - 32) Then
               ' if so bounce and push back
               SetMem( xspeed, - GetMem(xspeed,i,4), i )
                  x = x + GetMem(xspeed,i,4)
            End If
            ' check if out of range on y axis
            If (y < 0 OR y > HEIGHT - 32) Then
               ' if so bounce and push back
               SetMem( yspeed, - GetMem(yspeed,i,4), i )
                  y = y + GetMem(yspeed,i,4)
            End If
            ' after move redraw them in new position
            SelectObject(hDWDC, color_pen)
            SelectObject(hDWDC, color_brush)
            Ellipse(hDWDC, x, y, x + 32, y + 32)
            ' store the new x and y position
            SetMem( xball, x, i ) : SetMem( yball, y, i )
   Next
End Sub

Sub GameQuit()
    DeleteObject(color_pen)
    DeleteObject(color_brush)
    DeleteObject(black_pen)
    DeleteObject(black_brush)
   ReleaseDC(me, hDCgame)
   ScFinalize(xball):ScFinalize(yball)
   ShowCursor(1)
   ExitProgram(0)
End Sub

Sub GameInit()
   FillString(RECT,20,0)
   Center(Me)
   width  = GetSystemMetrics(SM_CXSCREEN) + 15
   height = GetSystemMetrics(SM_CYSCREEN)
   Resize( Me, 0, 0, width,height )
   SetWindowLong(Me,GWL_STYLE,WS_CHILD+WS_VISIBLE)
   SetWindowPos(Me,HWND_TOPMOST,0,0,width,height,SWP_NOMOVE)
   'ShowCursor(0)
   color_pen = CreatePen(PS_SOLID, 1, RGB(0,0,0))
   color_brush = CreateSolidBrush(RGB(255,0,0))
   'black_pen = CreatePen(PS_SOLID, 1, RGB(0,0,0))
   black_brush = CreateSolidBrush(RGB(0,0,0))
   'set initial position and speed of balls
   Randomize
   For i = 0 To 36 Step 4
      SetMem( xball, randint(0,width), i )
      SetMem( yball, randint(0,height), i )
      SetMem( xspeed, randint(5,30), i )
      SetMem( yspeed, randint(5,30), i )
   Next
   Show(me)
   SetTimer(Me,null,GAME_SPEED)
End Sub
Yours,
(¯`·._.·[Gerome GUILLEMIN]·._.·´¯)
http://www.fbsl.net [FBSL Author]
http://gedd123.free.fr/FBSLv3.zip [FBSL Help file]
(¯`·._.·[If you need help... just ask]·._.·´¯)

brotherS

  • Master of Good Ideas
  • Honorary Member
  • Joined in 2005
  • **
  • Posts: 2,260
    • View Profile
    • Donate to Member
Re: FBSL - Bouncing balls
« Reply #1 on: March 18, 2006, 06:24 AM »
Impressive!

PS: Now I'm blind. ;D

Cpilot

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 293
    • View Profile
    • Bite Notes
    • Read more about this member.
    • Donate to Member
Re: FBSL - Bouncing balls
« Reply #2 on: March 18, 2006, 07:17 AM »
PS: Now I'm blind.
Yeah the green is pretty extreme ain't it? I got the script last night from the FBSL Forum and ran it while I was in the dark.  :o



Gerome

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 154
    • View Profile
    • Get my Freestyle Basic Script Language + compiler!
    • Donate to Member
Re: FBSL - Bouncing balls
« Reply #3 on: March 18, 2006, 07:23 AM »
Hi Rick,

PS: Now I'm blind.
Yeah the green is pretty extreme ain't it? I got the script last night from the FBSL Forum and ran it while I was in the dark.  :o

Yeah :)
I love extreme samples like that one :)

Yours,
(¯`·._.·[Gerome GUILLEMIN]·._.·´¯)
http://www.fbsl.net [FBSL Author]
http://gedd123.free.fr/FBSLv3.zip [FBSL Help file]
(¯`·._.·[If you need help... just ask]·._.·´¯)

Cpilot

  • Charter Honorary Member
  • Joined in 2006
  • ***
  • Posts: 293
    • View Profile
    • Bite Notes
    • Read more about this member.
    • Donate to Member
Re: FBSL - Bouncing balls
« Reply #4 on: March 18, 2006, 07:32 AM »
Yeah
I love extreme samples like that one

I understand, but like brotherS there it took a little time for my vision to clear. And I got an LCD display. Those of you with CRT's be warned.  ;D