Atom Breakout

Game development specific discussions.
Posts: 1779
Joined: May 24, 2007 22:10
Location: The Netherlands

Atom Breakout

Postby badidea » Jun 15, 2019 23:43

Start of a small game. Initially I planned to use Cairo, but no real use for it.
If things gone wrong, try changing MIN_DT (physics loop time).

Code: Select all

'=== Atom breakout ===

const SCRN_W = 800, SCRN_H = 600
const as double MIN_DT = 2.0 / 1000 's

const as string KEY_ESC = chr(27)


type int2d
   as integer x, y
   declare operator cast () as string
end type

operator =(a as int2d, b as int2d) as boolean
   if a.x <> b.x then return false
   if a.y <> b.y then return false
   return true
end operator

operator <>(a as int2d, b as int2d) as boolean
   if a.x = b.x and a.y = b.y then return false
   return true
end operator

' a - b
operator - (a as int2d, b as int2d) as int2d
   return type(a.x - b.x, a.y - b.y)
end operator

' -a
operator - (a as int2d) as int2d
   return type(-a.x, -a.y)
end operator


type sgl2d
   as single x, y
   declare operator cast () as string
end type

' a + b
operator + (a as sgl2d, b as sgl2d) as sgl2d
   return type(a.x + b.x, a.y + b.y)
end operator

' a - b
operator - (a as sgl2d, b as sgl2d) as sgl2d
   return type(a.x - b.x, a.y - b.y)
end operator

' a * mul
operator * (a as sgl2d, mul as single) as sgl2d
   return type(a.x * mul, a.y * mul)
end operator

' a / div
operator / (a as sgl2d, div as single) as sgl2d
   return type(a.x / div, a.y / div)
end operator

' distance / lenth
operator len (a as sgl2d) as single
   return sqr(a.x * a.x + a.y * a.y)
end operator


type loop_timer_type
   dim as double tNow
   dim as double tPrev
   dim as double dt
   dim as double dtAvg
   declare sub init()
   declare sub update()
end type

sub loop_timer_type.init()
   tNow = timer
   tPrev = tNow
   dt = 0.0
   dtAvg = 0.0
end sub

sub loop_timer_type.update()
   tPrev = tNow
   tNow = timer
   dt = tNow - tPrev
   dtAvg = 0.95 * dtAvg + 0.05 * dt
end sub



type mouseType
   pos as int2d
   posChange as int2d
   wheel as integer
   buttons as integer
   lb as integer 'left button
   rb as integer 'right button
   mb as integer 'middle button
end type

function handleMouse(byref mouse as mouseType) as integer
   static previous as mouseType
   dim as integer change = MOUSE_IDLE
   getmouse mouse.pos.x, mouse.pos.y, mouse.wheel, mouse.buttons
   if (mouse.buttons = -1) then = 0
      mouse.rb = 0
      mouse.mb = 0
      mouse.posChange.x = 0
      mouse.posChange.y = 0
   else = (mouse.buttons and 1)
      mouse.rb = (mouse.buttons shr 1) and 1
      mouse.mb = (mouse.buttons shr 2) and 1
      'if (previous.pos.x <> mouse.pos.x or previous.pos.y <> mouse.pos.y) then
      if previous.pos <> mouse.pos then
         change = MOUSE_POS_CHANGED
      end if
      'mouse.posChange.x = mouse.pos.x - previous.pos.x
      'mouse.posChange.y = mouse.pos.y - previous.pos.y
      mouse.posChange = mouse.pos - previous.pos
      if (previous.buttons <> mouse.buttons) then
         if ( = 0 and = 1) then change = MOUSE_LB_PRESSED
         if ( = 1 and = 0) then change = MOUSE_LB_RELEASED
         if (previous.rb = 0 and mouse.rb = 1) then change = MOUSE_RB_PRESSED
         if (previous.rb = 1 and mouse.rb = 0) then change = MOUSE_RB_RELEASED
         if (previous.mb = 0 and mouse.mb = 1) then change = MOUSE_MB_PRESSED
         if (previous.mb = 1 and mouse.mb = 0) then change = MOUSE_MB_RELEASED
      end if
      if (mouse.wheel > previous.wheel) then change = MOUSE_WHEEl_UP
      if (mouse.wheel < previous.wheel) then change = MOUSE_WHEEl_DOWN
      previous = mouse
   end if
   return change
end function


sub setScreen(w as integer, h as integer)
   screenres w, h, 32
   width w \ 8, h \ 16
end sub

sub clearScreen(c as ulong)
   line(0, 0)-(SCRN_W - 1, SCRN_H - 1), c, bf
end sub

function toInt(p as sgl2d) as int2d
   return type<int2d>(p.x, p.y)
end function

function toSgl(p as int2d) as sgl2d
   return type<sgl2d>(p.x, p.y)
end function

function SgnSqr(a as single) as single
   return sgn(a) * a * a
end function


type ball_type
   dim as sgl2d p 'position
   dim as sgl2d v 'velocity
   dim as sgl2d F 'force [N]
   dim as single r = 15 'raduis [px]
   dim as single kc = 1000 'compression spring constant [N/px]
   dim as single ka = 1 'attraction spring constant [N/px]
   dim as single m = 1.0 'mass [kg]
   dim as single b = 0.5 'Linear drag coexficient [N/(px/s)]
   dim as single intF, intFmax = -1
   dim as single xMin = 0, xMax = SCRN_W-1
   dim as single yMin = 0, yMax = SCRN_H-1
   dim as ulong colour
   dim as ulong active = 1
   dim as sgl2d pt 'target pos
   declare sub init(p as sgl2d, r as single, kc as  single, ka as  single, m as single, b as single, c as ulong)
   declare sub boundColl() 'wall / boundary collisions
   declare sub setTarget(targetPos as sgl2d)
   declare sub update(dt as double)
   declare sub draw_()
end type

sub ball_type.init(p as sgl2d, r as single, kc as  single, ka as  single, m as single, b as single, c as ulong)
   this.p = p
   this.r = r
   this.kc = kc
   this.ka = ka
   this.m = m
   this.b = b
   this.colour = c
end sub

sub ball_type.boundColl()
   dim as single edgeDist
   edgeDist = (p.x - r) - xMin
   if (edgeDist < 0) then F.x -= kc * edgeDist
   edgeDist = (p.y - r) - yMin
   if (edgeDist < 0) then F.y -= kc * edgeDist
   edgeDist = xMax - (p.x + r)
   if (edgeDist < 0) then F.x += kc * edgeDist
   edgeDist = yMax - (p.y + r)
   if (edgeDist < 0) then F.y += kc * edgeDist
end sub

sub ball_type.setTarget(targetPos as sgl2d)
   pt = targetPos
end sub

sub ball_type.update(dt as double)
   dim as sgl2d a 'acceleration
   dim as sgl2d dp = pt - p 'delta position
   F += dp * ka 'F = k * x
   if intFmax > 0 then
      intF += len(F) * dt
      if intF > intFmax then active = 0
   end if
   F -= v * b 'drag
   a = F / m 'F = m * a -> a = F  / m
   v += a * dt
   'if len(v) > vMax then v *= (vMax / len(v))
   p += v * dt
   F = type(0, 0) 'reset for next run
end sub

sub ball_type.draw_()
   if active = 1 then
      circle (p.x, p.y), r, colour,,,,f
      if intFmax > 0 then
         dim as integer damage = 9 - int(10 * (intF / intFmax))
         draw string (p.x - 3, p.y - 7), str(damage), rgb(255, 255, 0)
      end if
   end if
end sub


sub ballColl(byref b1 as ball_type, byref b2 as ball_type)
   if ( = 1) and ( = 1) then
      dim as single dx = b1.p.x - b2.p.x
      dim as single dy = b1.p.y - b2.p.y
      dim as single cntrDist = sqr(dx * dx + dy * dy)
      dim as single edgeDist = cntrDist - (b1.r + b2.r)
      if(edgeDist < 0) then
         dim as single factor = edgeDist / cntrDist
         dim as single F1 = b1.kc * factor
         b1.F.x -= F1 * dx
         b1.F.y -= F1 * dy
         dim as single F2 = b2.kc * factor
         b2.F.x += F2 * dx
         b2.F.y += F2 * dy
      end if
   end if
end sub


const BRICK_X_NUM = 12, BRICK_Y_NUM = 6

dim as string key
dim as integer quit
dim as mouseType mouse
dim as ball_type paddle
dim as ball_type ball
dim as ball_type brick(BRICK_X_NUM - 1, BRICK_Y_NUM - 1)
dim as loop_timer_type loopTimer
dim as int2d lastValidMousePos = type(SCRN_W \ 2, 0.9 * SCRN_H)
dim as integer yMinMouse = 0.8 * SCRN_H
dim as integer xi, yi, x, y
dim as integer numSteps, iStep
dim as double dtStep 's

setScreen(SCRN_W, SCRN_H)

paddle.init(type(0.5 * SCRN_W, 0.9 * SCRN_H), 30, 2000, 1000, 0.1, 10.0, rgb(127, 0, 0))
ball.init(type(0.5 * SCRN_W, 0.6 * SCRN_H), 10, 1000, 0.5, 1, 0.25, rgb(0, 127, 0))
ball.yMax = SCRN_H * 2

for yi = 0 to BRICK_Y_NUM - 1
   y = 0.05 * SCRN_H + 0.5 * SCRN_H * ((0.5 + yi) / BRICK_Y_NUM)
   for xi = 0 to BRICK_X_NUM - 1
      x = 0.1 * SCRN_W + 0.8 * SCRN_W * ((0.5 + xi) / BRICK_X_NUM)
      brick(xi, yi).init(type(x, y), 15, 1000, 1000, 0.2, 5.0, rgb(127, 127, 0))
      brick(xi, yi).setTarget(type(x, y))
      brick(xi, yi).intFmax = 1e3

while quit = 0
   key = inkey
   select case key
      case KEY_ESC : quit = 1
   end select

   if mouse.buttons <> -1 then
      lastValidMousePos = mouse.pos
      if lastValidMousePos.y < yMinMouse then lastValidMousePos.y = yMinMouse
   end if

   'take smaller time steps for updates
   numSteps = int(loopTimer.dt / MIN_DT) + 1 'ceiling, at least 1 step
   dtStep = loopTimer.dt / numSteps
   for iStep = 0 to numSteps - 1
      'check inter-collisions
      ballColl(ball, paddle)
      for yi = 0 to BRICK_Y_NUM - 1
         for xi = 0 to BRICK_X_NUM - 1
            ballColl(ball, brick(xi, yi))
      'paddle / bat
      'ball / bullet
      'update bricks
      for yi = 0 to BRICK_Y_NUM - 1
         for xi = 0 to BRICK_X_NUM - 1
            brick(xi, yi).update(dtStep)
   if ball.p.y > SCRN_H then quit = 1

   line(0, 0)-(SCRN_W - 1, 0.8 * SCRN_H - 1), &h000000, bf
   line(0, 0.8 * SCRN_H)-(SCRN_W - 1, SCRN_H - 1), &h202020, bf
   for yi = 0 to BRICK_Y_NUM - 1
      for xi = 0 to BRICK_X_NUM - 1
         brick(xi, yi).draw_()
   locate 1, 1 : print "Use mouse, <esc> to exit";

   sleep 15

draw string (0.5 * SCRN_W - 36, 0.65 * SCRN_H), "GAME OVER", &he0e0e0
while inkey = "" : wend

'Todo: Add spin

Edit: Code updated, now possible to 'break' things.
Posts: 1779
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Atom Breakout

Postby badidea » Jun 17, 2019 18:55

Because of the overwhelming number of positive replies, I decided to make a GitHub version:
Which allows me to get familiar with GitHub as well.
Posts: 691
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: Atom Breakout

Postby h4tt3n » Jun 17, 2019 19:44

Nice take on a very classic game :-)

I noticed that you wanted to add spin. I've got some physics examples lying around that deals with rotation and friction, if you need inspiration.

Posts: 1779
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Atom Breakout

Postby badidea » Jun 17, 2019 20:47

I had read that some of the later classic breakout games used spin, so I put this on my to-do list. I have not given it much thought yet (until now).

Static fraction can probably be ignored. The kinetic friction I expect to depend on normal force, contact area and some friction constant. This results in a force on the 2 balls (in opposite directions) perpendicular to the normal. And via the rotational inertia to rotation changes.

In text it always sounds easy, coding the stuff properly is something else. I'll start with some pencil and paper...

And I should adjust the graphics for spin visualization. Maybe a reason to use Cairo after all.
Posts: 6155
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Atom Breakout

Postby dodicat » Jun 17, 2019 21:44

Thanks verybadidea, got your game.
Looks very cool with the impact reverberations.
If you use cairo then I reckon about ten forum members will be able to run it on windows.
If you use spin then it is quantum pong breakout.
If then you use static and dynamic friction with rotational inertia it will be full Monty pong breakout, which would be interesting.

The best I can do is annoying pong.

Code: Select all

Type Point
    As Single x,y,dx,dy
    As Integer radius
    As Long Kill
End Type

Type Line
    As Single x1,y1,x2,y2
    As Ulong col
End Type

Sub drawline(L() As Line)
    For n As Long=Lbound(L) To Ubound(L)
End Sub

Type box
    As Long x,y,dx,dy
    As Ulong col
    As Point ctr
    As Line z(1 To 4)
    Declare Sub setlines(f As Long=0,p() As Point)
    Declare Static Sub show(() As box)
End Type

Sub box.setlines(f As Long,p() As Point)
    If f=0 Then
    End If
End Sub

Sub As box)
    For n As Long=1 To Ubound(b)
        If b(n).z(1).x1 Then Paint (b(n).ctr.x,b(n).ctr.y),b(n).col,b(n).col
    Next n
End Sub

Function inpolygon(p1() As Point,Byval p2 As Point) As Integer
    #macro Winder(L1,L2,p)
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
            If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

Function segment_distance(l As Line, _
    p As Point,_
    Byref ox As Single=0,_
    Byref oy As Single=0) As Single
    Dim As Single M1,M2,C1,C2,B
    B=(l.x2-l.x1):If B=0 Then B=1e-20
    M2=(l.y2-l.y1)/B:If M2=0 Then M2=1e-20
    Var L1=((p.x-l.x1)*(p.x-l.x1)+(p.y-l.y1)*(p.y-l.y1)),L2=((p.x-l.x2)*(p.x-l.x2)+(p.y-l.y2)*(p.y-l.y2))
    Var a=((l.x1-l.x2)*(l.x1-l.x2) + (l.y1-l.y2)*(l.y1-l.y2))
    Var a1=a+L1
    Var a2=a+L2
    Var f1=a1>L2,f2=a2>L1
    If f1 Xor f2 Then
        Var d1=((p.x-l.x1)*(p.x-l.x1)+(p.y-l.y1)*(p.y-l.y1))
        Var d2=((p.x-l.x2)*(p.x-l.x2)+(p.y-l.y2)*(p.y-l.y2))
        If d1<d2 Then Ox=l.x1:Oy=l.y1 : Return Sqr(d1) Else  Ox=l.x2:Oy=l.y2:Return Sqr(d2)
    End If
    Var M=M1-M2:If M=0 Then M=1e-20:If m>1e20 Then M=1e20
    Return Sqr((p.x-Ox)*(p.x-Ox)+(p.y-Oy)*(p.y-Oy))
End Function
'optimize detection to save cpu.
Function DetectPointCollisions(Byref _that As Point,_this As Point) As Single
    Dim As Single xdiff = _this.x-_that.x
    Dim As Single ydiff = _this.y-_that.y
    If Abs(xdiff) > _this.radius*2 Then Return 0
    If Abs(ydiff) > _this.radius*2 Then Return 0
    Var L=Sqr(xdiff*xdiff+ydiff*ydiff)
    If L<=(_this.radius+_that.radius) Then Function=L
End Function

Sub Check_PointCollisions(points() As Point)
    For n1 As Long =Lbound(points) To Ubound(points)-1
        For n2 As Long =n1+1 To Ubound(points)
            Var L=DetectPointCollisions(points(n1),points(n2))
            If L Then
                Var impulsex=(points(n1).x-points(n2).x)/L
                Var impulsey=(points(n1).y-points(n2).y)/L
                'In case of overlap circles, reset to non overlap positions
                Var impactx=points(n1).dx-points(n2).dx
                Var impacty=points(n1).dy-points(n2).dy
                Var dot=impactx*impulsex+impacty*impulsey
            End If
        Next n2
    Next n1
End Sub

Sub check_line_collisions(LN() As Line, ball() As Point,b() As box,n As Long)
    For z As Integer=Lbound(ball) To Ubound(ball)
        For z2 As Integer=Lbound(Ln) To Ubound(Ln)
            Dim As Point closepoint
            Var seperation=segment_distance(Ln(z2),ball(z),closepoint.x,closepoint.y)
            If seperation<=ball(z).radius Then
                Var impactx=-ball(z).dx
                Var impacty=-ball(z).dy
                Var impulsex=(closepoint.x-ball(z).x)/seperation
                Var impulsey=(closepoint.y-ball(z).y)/seperation
                Var dv=impactx*impulsex+impacty*impulsey
                ball(z).dx+= 2*dv*impulsex
                ball(z).dy+= 2*dv*impulsey
                If n=Ubound(b) Then ball(z).kill=1
                If ball(z).kill Then
                    If n <Ubound(b)-1 Then Erase b(n).z:ball(z).kill=0
                End If
            End If
        Next z2
    Next z
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    Return sleeptime
End Function

Sub drawpoints(p() As Point)
    Dim As Long d=20
    For n As Long=1 To Ubound(p)
        If p(n).kill Then
            Var a=Atan2(p(n).dy,p(n).dx)
        End If
    Next n
End Sub

Sub show(bxs() As box,p() As Point,fps As Long)
    Sleep regulate(60,fps),1
End Sub

Function play As Long
    Screen 19,32
    screencontrol 100,100,100
    Dim As Integer xres,yres
    Screeninfo xres,yres
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    Redim As box bxs(1 To 25),copy(1 To 25)
    Dim As Point p(1 To 2),polygon(1 To 5)
    Dim As Long ctr
    For x As Long=1 To 5
        For y As Long=1 To 5
        Next y
    Next x
    Redim Preserve bxs(1 To 27)
    Dim As Long mx,my,fps
    Setmouse 0,0,1,1
        Getmouse mx,my
        If inpolygon(polygon(),Type<Point>(mx,my)) Then
            If my>590 Then bxs(27).x=mx
        End If
        If bxs(27).x<0 Then  bxs(27).x=0
        If bxs(27).x>650 Then  bxs(27).x=650
        For n As Long=Lbound(p) To Ubound(p)
            If inpolygon(polygon(),p(n)) Then p(n).y=polygon(2).y
        For n As Long=1 To Ubound(bxs)
        Next n
        If p(1).y>yres-17 Then
            For n As Long=1 To 25
            Next n
        End If
    Loop Until Len(Inkey)
    Return 0
End Function

End play

Posts: 1779
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Atom Breakout

Postby badidea » Jun 17, 2019 21:58

dodicat wrote:The best I can do is annoying pong.

Especially with mouse-pad, it is quite annoying :-)

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 7 guests