Atom Breakout

[badidea]

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
	'private:
	dim as double tNow
	dim as double tPrev
	dim as double dt
	dim as double dtAvg
	public:
	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

'-------------------------------------------------------------------------------

#DEFINE MOUSE_IDLE 0
#DEFINE MOUSE_POS_CHANGED 1
#DEFINE MOUSE_LB_PRESSED 2
#DEFINE MOUSE_LB_RELEASED 3
#DEFINE MOUSE_RB_PRESSED 4
#DEFINE MOUSE_RB_RELEASED 5
#DEFINE MOUSE_MB_PRESSED 6
#DEFINE MOUSE_MB_RELEASED 7
#DEFINE MOUSE_WHEEL_UP 8
#DEFINE MOUSE_WHEEL_DOWN 9

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
		mouse.lb = 0
		mouse.rb = 0
		mouse.mb = 0
		mouse.posChange.x = 0
		mouse.posChange.y = 0
	else
		mouse.lb = (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 (previous.lb = 0 and mouse.lb = 1) then change = MOUSE_LB_PRESSED
			if (previous.lb = 1 and mouse.lb = 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 (b1.active = 1) and (b2.active = 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
	next
next

loopTimer.init()
while quit = 0
	key = inkey
	select case key
		case KEY_ESC : quit = 1
	end select

	handleMouse(mouse)
	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))
			next
		next
		'paddle / bat
		paddle.boundColl()
		paddle.setTarget(toSgl(lastValidMousePos))
		paddle.update(dtStep)
		'ball / bullet
		ball.boundColl()
		ball.setTarget(paddle.p)
		ball.update(dtStep)
		'update bricks
		for yi = 0 to BRICK_Y_NUM - 1
			for xi = 0 to BRICK_X_NUM - 1
				brick(xi, yi).update(dtStep)
			next
		next
	next
	if ball.p.y > SCRN_H then quit = 1

	screenlock
	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_()
		next
	next
	paddle.draw_()
	ball.draw_()
	locate 1, 1 : print "Use mouse, <esc> to exit";
	screenunlock

	sleep 15
	loopTimer.update()
wend

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.

[badidea]

Because of the overwhelming number of positive replies, I decided to make a GitHub version: https://github.com/verybadidea/Atom-Breakout
Which allows me to get familiar with GitHub as well.

[h4tt3n]

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.

Cheers,
Mike

[badidea]

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.

[dodicat]

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)
        Line(L(n).x1,L(n).y1)-(L(n).x2,L(n).y2),L(n).col
    Next
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
        this.z(1)=Type<Line>(x,y,x+dx,y,this.col)
        this.z(2)=Type<Line>(x+dx,y,x+dx,y+dy,this.col)
        this.z(3)=Type<Line>(x+dx,y+dy,x,y+dy,this.col)
        this.z(4)=Type<Line>(x,y+dy,x,y,this.col)
        this.ctr=Type<Point>(x+dx/2,y+dy/2)
    Else
        this.z(1)=Type<Line>(x-20,y+50,x,y,this.col):p(1)=Type<Point>(x-20,y+50)
        this.z(2)=Type<Line>(x,y,x+dx\2,y+dy\2,this.col):p(2)=Type<Point>(x,y)
        this.z(3)=Type<Line>(x+dx\2,y+dy\2,x+dx,y,this.col):p(3)=Type<Point>(x+dx\2,y+dy\2)
        this.z(4)=Type<Line>(x+dx,y,x+dx+20,y+dy,this.col):p(4)=Type<Point>(x+dx,y)
        p(5)=Type<Point>(x+dx+20,y+dy)
        this.ctr=Type<Point>(x+dx/2,y+dy/2+5)
    End If
End Sub

Sub box.show(b() As box)
    For n As Long=1 To Ubound(b)
        drawline(b(n).z()) 
        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)
    ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    #endmacro
    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 
        Else
            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
    M1=-1/M2
    C1=p.y-M1*p.x
    C2=(l.y1*l.x2-l.x1*l.y2)/B
    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
    Ox=(C2-C1)/M
    Oy=(M1*C2-M2*C1)/M
    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
                points(n1).x=points(n2).x+(points(n1).radius*2)*impulsex
                points(n1).y=points(n2).y+(points(n1).radius*2)*impulsey
                Var impactx=points(n1).dx-points(n2).dx
                Var impacty=points(n1).dy-points(n2).dy
                Var dot=impactx*impulsex+impacty*impulsey
                points(n1).dx-=dot*impulsex
                points(n1).dy-=dot*impulsey
                points(n2).dx+=dot*impulsex
                points(n2).dy+=dot*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
                ball(z).x=closepoint.x-ball(z).radius*impulsex
                ball(z).y=closepoint.y-ball(z).radius*impulsey
                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
    frames+=1
    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
    lastsleeptime=sleeptime
    timervalue=Timer
    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)
            Line(p(n).x,p(n).y)-(p(n).x+d*Cos(a),p(n).y+d*Sin(a))
            Circle(p(n).x,p(n).y),p(n).radius,Rgb(200,0,0),,,,f
        Else
            Circle(p(n).x,p(n).y),p(n).radius,rgb(100,100,100),,,,f
        End If
    Next n
End Sub

Sub show(bxs() As box,p() As Point,fps As Long)
    Screenlock
    Cls
    box.show(bxs())
    drawpoints(p())
    Screenunlock
    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
            ctr+=1
            bxs(ctr).x=map(1,5,x,100,600)
            bxs(ctr).y=map(1,5,y,50,200)
            bxs(ctr).dx=50
            bxs(ctr).dy=20
            bxs(ctr).col=Rgb(Rnd*255,Rnd*255,Rnd*255)
            bxs(ctr).setlines(0,polygon())
            copy(ctr)=bxs(ctr)
        Next y
    Next x
    
    Redim Preserve bxs(1 To 27)
    bxs(26)=Type<box>(0,0,xres,yres)
    bxs(26).setlines(0,polygon())
    
    bxs(27)=Type<box>(10,550,150,50,Rgb(0,200,0))
    bxs(27).setlines(1,polygon())
    p(1).x=100
    p(1).y=500
    p(1).dx=5
    p(1).dy=5
    p(1).radius=15
    p(2)=p(1)
    p(2).dx=-1
    
    Dim As Long mx,my,fps
    Setmouse 0,0,1,1
    Do
        Getmouse mx,my
        If inpolygon(polygon(),Type<Point>(mx,my)) Then 
            bxs(27).x=mx-bxs(27).dx/2
        Else
            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
        bxs(27).setlines(1,polygon())
        
        For n As Long=Lbound(p) To Ubound(p)
            p(n).x+=p(n).dx
            p(n).y+=p(n).dy
            If inpolygon(polygon(),p(n)) Then p(n).y=polygon(2).y
        Next
        For n As Long=1 To Ubound(bxs)
            check_line_collisions(bxs(n).z(),p(),bxs(),n)
        Next n
        Check_PointCollisions(p())
        
        show(bxs(),p(),fps)
        
        If p(1).y>yres-17 Then 
            For n As Long=1 To 25
                bxs(n)=copy(n)
            Next n
        End If
       
    Loop Until Len(Inkey)
    Return 0
End Function


End play
Sleep



  

[badidea]

The best I can do is annoying pong.

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