Classic Breakout Game

[B+]

DE stands for DOS Emulation ie a single screen that does colored graphics like old QB
'DE6 Breakout.txt started 2016-12-23
'new a number of graphic subs pset, line, circ, fcirc, ellips, fellipse
'wait4key$ (revised to return the key), at ,cp, seyes

global xmax, ymax  'these two you can easily reset to your needs
'set these to screen width = xmax, screen height = ymax, that you want

xmax = 700 : ymax = 560  '<<<<<< set this as you need or from plug-in notes

global cellW, cellH
'do not mess with cellW and cellH globals for printing
cellW = 10 '10 pixels wide for characters
cellH = 20 '20 pixels high for characters
global maxRow, maxCol
'and then these are calclated from above globals
maxCol = int(xmax / cellW)  'these control printing characters
maxRow = int(ymax / cellH)
global lastC, lastR 'for loc8 (locate), pl (print a line), lp (locate and print)
lastC = 1 : lastR = 1

'mouse and key events update globals with latest info
global inkee$
global mouseX, mouseY
global lbdX, lbdY, lbmX, lbmY, lbuX, lbuY  'using -99 for inactive positions
global rbdX, rbdY, rbmX, rbmY, rbuX, rbuY  'using -99 for inactive positions

dim qb$(15) 'thanks Andy Amaya for use with his sub qColor fore, back
qb$( 0) = "  0   0   0" 'black
qb$( 1) = "  0   0 128" 'blue
qb$( 2) = "  8 128   8" 'green
qb$( 3) = "  0 128 128" 'cyan
qb$( 4) = "128   0   0" 'red
qb$( 5) = "128   0 128" 'magenta
qb$( 6) = "128  64  32" 'brown
qb$( 7) = "168 168 168" 'white
qb$( 8) = "128 128 128" 'grey
qb$( 9) = " 84  84 252" 'light blue
qb$(10) = " 42 252  42" 'light green
qb$(11) = "  0 220 220" 'light cyan
qb$(12) = "255   0   0" 'light red
qb$(13) = "255  84 255" 'light magenta
qb$(14) = "255 255   0" 'yellow
qb$(15) = "255 255 255" 'bright white

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (DisplayWidth-WindowWidth) / 2
UpperLeftY = (DisplayHeight-WindowHeight) / 2

'graphicbox #gr, 2, 2, xmax-2, ymax-2
open "DE6 Breakout" for graphics_nsb_nf as #gr '<, == change for plug in modules
#gr "trapclose quit"

'fonts that don't work arial, tahoma, verdana
'fonts that work
'#gr "font courier_new 10 20"
'#gr "font consolas 10 20"
#gr "font dejavu_sans_mono 10 20"

#gr "home"                  '< check drawing area
#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

#gr "setfocus"
#gr "when mouseMove mMove"
#gr "when leftButtonDown leftDown"
#gr "when leftButtonMove leftMove"
#gr "when leftButtonUp leftUp"
#gr "when rightButtonDown rightDown"
#gr "when rightButtonMove rightMove"
#gr "when rightButtonUp rightUp"
#gr "when characterInput charIn"
#gr "down"
'========================================================== plug-in main modules here
'plug-in notes: xmax = 700 : ymax = 560 title: Breakout
'               >>> remove flush from pause

' wall is 50 pixels X 14 columns wide = 700 make screen width
' wall is 20 pixels X 8  rows = 160 = 1/3 screen height = 480 + 20 width
' under paddle track score and lifes on one line padded by blank lines 540 = 27
' so total height 480 to paddle 500 + 60 for 3 lines = 560

global br, bx, by, dx, dy, px, py, pw, plf, prt, bkw, bkh, score, life, hits, obk, rbk, speedups
br = 10  'ball radius, paddle and goals use this number also
bkw = 50 'brick width
bkh = 20 'brick height
py = 480 ' paddle surface
pw = 50  ' 100 wide to start half that at certain point
life = 5  ' only 3 allowed according to wiki
dim wc$(13, 7), wp(13, 7) 'for brick tracking wc wall colors, wp wall points
call initwall 'load arrays with data
call initball 'set dx, dy, bx, by ball position and change
call clear 0, 0, 0 'set background to black
call drawtable
call updatescore
px = xmax/2
while life
   scan
   call drawpaddle
   call drawball
   call updatescore
   if hits = 112 and scrn = 0 then 'setup new
       scrn = 1
       speedups = 0 : obk = 0 : rbk = 0 : pw = 50
       call initwall
       call drawtable
       call initball
   else
       if hits = 224 then
           call qColor 15, 0
           call cp 14, "Congratulations on a perfect score!!!"
           call pause 2500
           call cp 14, space$(40)
           exit while
       end if
   end if
   call pause 20 '< adjust as needed for speed of your system
wend
call qColor 15, 0
call cp 14, "Game Over!"

wait

sub initwall
   for r = 0 to 7
       select case r
       case 0,1 : cr$ = "225 0 0"    : p = 7
       case 2,3 : cr$ = "255 100 0"  : p = 5
       case 4,5 : cr$ = "0 128 0"    : p = 3
       case 6,7 : cr$ = "255 255 0"  : p = 1
       end select
       for c = 0 to 13
           wc$(c, r) = cr$ : wp(c, r) = p
           totp = totp + p
       next
   next
   notice "Total Points available for this screen is ";totp
end sub

sub initball  'set ball in play with location and dx, dy
 bx = rand(br, 700 - br)
 by = rand(py - 100, py - 10)
 dx = rand(3, 7)
 if rand(0, 1) then dx = -1 * dx
 dy = -3 - speedups
end sub

sub drawtable  ' in JB don't want to redraw this every loop
   for r = 0 to 7
       for c = 0 to 13
           if wp(c, r) then
               call cstr "255 255 255"
               call bstr wc$(c, r)
               call fbox c * bkw, r * bkh, c * bkw + bkw, r * bkh + bkh
           end if
       next
   next
end sub

sub drawpaddle ' update paddle to mouseY, paddle top and bottom are global
   'erase last paddle, it is aligned with Blue Computer Goal Line
   call qColor 0, 0 'return to computer goal color
   call fbox plf, py, prt, py + 20

   px = mouseX 'update paddle location
   plf = px - pw
   prt = px + pw
   call qColor 7, 7
   call fbox plf, py, prt, py + 20
end sub

sub drawball
   'erase last ball, blend into table color
   call qColor 0, 0
   call fcirc bx, by, br

   'update
   bx = bx + dx
   if bx < br then dx = dx * -1 : bx = br + 1
   if bx > xmax - br then dx = dx * -1 : bx = xmax - br - 1

   by = by + dy
   if by + br > py then 'ball past paddle line
       by = py - br 'don't let ball go into paddle or goal
       if bx + br < plf or bx - br > prt then 'paddle miss
           life = life - 1
           ' if life = 0 then end game
           call updatescore
           call qColor 7, 7
           call fcirc bx, by, br
           call pause 2500 'reflect on position of ball and loss of life
           call qColor 0, 0 'black out
           call fcirc bx, by, br
           call initball 'get ball rolling again
       else 'paddle hit
           dy = dy * -1
           dx = dx + rand(-2, 2)
           if dx > 7 then dx = 7
           if dx < -7 then dx = -7
       end if
   else
       if by - br < 0 then 'ball hits back border, reverse direction
           by = br : dy = dy * -1
       else
           if by - br < 160 then 'in wall area, what row and column?
               starthits = hits
               'maybe should check all 4 corners or smaller ball
               row = int((by - br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by - br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               if hits <> starthits then dy = dy * -1 'reverse ball direction
           end if
       end if
   end if

   call qColor 9, 9
   call fcirc bx, by, br
end sub

sub handleBall row, col
   if 0 <= row and row <= 7 and 0 <= col and col <= 13 then
       if wp(col, row) then 'brick just hit, lot's to do before update ball
           hits = hits + 1
           if hits = 4 or hits = 8 or hits = 116 or hits = 120 then
               speedups = speedups + 1
               if dy < 0 then dy = dy - 1 else dy = dy + 1
           end if
           val = wp(col, row)
           if val = 5 then 'first orange brick
               if obk = 0 then 'flag first orange speed increase
                   obk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
               end if
           end if
           if val = 7 then 'flag first red, speed increase paddle decrease!
               if rbk = 0 then
                   rbk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
                   pw = pw/2
               end if
           end if
           score = score + wp(col, row) 'update score with point value
           wp(col, row) = 0            'no points here now
           call qColor 0, 0             'black out box
           call fbox col * bkw, row * bkh, col * bkw + bkw, row * bkh + bkh
       end if
   end if
end sub

sub updatescore
   call qColor 7, 0
   dy$ = right$("  ";str$(dy), 2)
   dx$ = right$("  ";str$(dx), 2)
   score$ = right$("   ";str$(score), 3)
   call cp 27, "dy: ";dy$;"   dx: ";dx$;"           Lives: ";life;"    Score: ";score$
end sub

wait ' ======= DE procedures color, drawing, events very useful subs or functions

sub mMove hdl$, mx, my
   mouseX = mx : mouseY = my
end sub

' dont want to use Boolean 0 for non active button so am using -99
sub leftDown hdl$, mx, my  'must have handle and mouse x,y
   lbdX = mx : lbdY = my
   lbuX = -99 : lbuY = -99
   lbmX = -99 : lbmY = -99
end sub

sub leftMove hdl$, mx, my  'must have handle and mouse x,y
   lbmX = mx : lbmY = my
end sub

sub leftUp hdl$, mx, my  'must have handle and mouse x,y
   lbuX = mx : lbuY = my
   lbdX = -99 : lbdY = -99
   lbmX = -99 : lbmY = -99
end sub

sub rightDown hdl$, mx, my  'must have handle and mouse x,y
   rbdX = mx : rbdY = my
   rbuX = -99 : rbuY = -99
   rbmX = -99 : rbmY = -99
end sub

sub rightMove hdl$, mx, my  'must have handle and mouse x,y
   rbmX = mx : rbmY = my
end sub

sub rightUp hdl$, mx, my  'must have handle and mouse x,y
   rbuX = mx : rbuY = my
   rbdX = -99 : rbdY = -99
   rbmX = -99 : rbmY = -99
end sub

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub

sub clear r, g, b 'clear screen to new RGB color and set backcolor
' and set up so pl (print line) will start at line 1, cell column 1)
   #gr "fill ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
   lastC = 1 : lastR = 1
end sub

sub fore r, g, b 'set fore color lines pixels text
   #gr "color ";r;" ";g;" ";b
end sub

sub back r, g, b 'set background color for fills
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub hue r, g, b 'fore and back RGB color system
'hue sets both fore and backcolor for filled graphics commands fbox, fcirc, fellipse
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub cstr rgb$
   #gr "color ";rgb$
end sub

sub bstr rgb$
   #gr "backcolor ";rgb$
end sub

Sub qColor foreColor, backColor 'thanks Andy Amaya old QB color system
   #gr "Color ";qb$(foreColor);";BackColor ";qb$(backColor)
End Sub

sub seyes thickness  'pixel, line, border size for box, fbox, circ, fcirc...
   #gr "size ";thickness
end sub

sub pset x, y 'set pixel at x, y (at whatever the current fore color is)
   #gr "set ";x;" ";y
end sub

sub aline x0, y0, x1, y1 'somethimes you might want to spec a pixel longer on end x1, y1
   #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point
end sub

sub box x0, y0, x1, y1  'box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "box ";x1;" ";y1
end sub

sub fbox x0, y0, x1, y1   'fill box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "boxfilled ";x1;" ";y1
end sub

sub circ x, y, radius ' just circle border at center x,y
   #gr "place ";x;" ";y;"; circle ";radius
end sub

sub fcirc x, y, radius ' fill circle x,y center
   #gr "place ";x;" ";y;"; circlefilled ";radius
end sub

sub ellips x, y, w, h  '< no e on end! just ellipse border
   #gr "place ";x;" ";y;"; ellipse ";w;" ";h
end sub

sub fellipse x, y, w, h  ' fill ellipse
   #gr "place ";x;" ";y;"; ellipsefilled ";w;" ";h
end sub

sub loc8 x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub pl mess$ 'print line (feed)
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
       if lastR > maxRow then lastR = maxRow 'yuck!
   end if
end sub

sub cp y,cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol-len(cpText$))/2+1.5),y,cpText$
end sub

sub inp prmpt$, byref var$   'input
'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   do
       scan
       if instr(OK$, inkee$) then
           if inkee$ = Chr$(8) then
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           else
               if inkee$=Chr$(13) or inkee$=Chr$(27) then
                   'new D5, I was expecting nothing in return for my esc
                   if inkee$ = chr$(27) then t$ = ""
                   exit do
               else
                   t$=t$;inkee$
               end if
           end if
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

function wait4key$() 'updated for DE6 from sub to function like input$(1)
'This function stops program flow for keypress, and returns keypress
   inkee$ = ""
   while len(inkee$) = 0 : scan : k$ = inkee$ : wend
   wait4key$ = k$
end function

sub pause mil
'================== Warning !!! =======================
'      MARK (or anyone who uses this handy) remember to
' timer 0
'      before close window and end program
'======================================================
   '#gr "flush"
   timer mil, [timesup]
   wait
[timesup]
   timer 0
end sub

function sMult$(s$, mult) 'xerox a copy of a string mult times
   for i = 1 to mult
       rtn$ = rtn$ + s$
   next
   sMult$ = rtn$
end function

function rand(n1, n2)  'very handy for screen saver like eye candy
   if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function


I pulled this out of my files because I am thinking of radical simplification for base to new mod Game.

Think I would enjoy a minimized version maybe tsh73 or Rod would be interested too?

[tsh73]

dx = dx + rand(-2, 2)

*bangs head about keyboard*

'flag first red, speed increase paddle decrease!

*PANIC MODE ON*

[B+]

Aug 13, 2021 17:44:16 GMT tsh73 said:

dx = dx + rand(-2, 2)

*bangs head about keyboard*

'flag first red, speed increase paddle decrease!

*PANIC MODE ON*

dx = dx + rand(-2, 2)
If there is a question why that's there, it is to break up repeated patterns so that ball has a chance to get at all the bricks, otherwise it could get stuck in an infinite unchanging sequence.


'flag first red, speed increase paddle decrease!
" *PANIC MODE ON* "
LOL, did you get lulled to sleep with giant paddle and slow speed?

[tsh73]

Speed increase for me got un-noticed because of +rand(-2,2) thing.
|dX| changed from 0 to 7!
So slow steady dY change went unnoticed.
But paddle shrinking is really hard not to notice - and really unexpected, and suddenly very easy to miss!

Breaking the pattern is good, but being so unpredictable (really random in fact) is, IMHO, bad.
Way I have seen it is that reflection angle depends on paddle hit position, like it is rounded (ellipse?)
So if you want ordinary reflection you catch with center of a paddle, while working near edges allow to change angle.
(another idea is to transfer som horisontal speed from moving paddle).

[B+]

Yeah, I agree, my SdlBasic version that came next switched to an elliptical paddle so more skill may be employed for return.

Update: shoot! I did not change the way the the ball returned. Well now I have something to work on.

[B+]

This might be more satisfactory ball control:

'DE6 Breakout.txt started 2016-12-23
'new a number of graphic subs pset, line, circ, fcirc, ellips, fellipse
'wait4key$ (revised to return the key), at ,cp, seyes

global xmax, ymax  'these two you can easily reset to your needs
'set these to screen width = xmax, screen height = ymax, that you want

xmax = 700 : ymax = 560  '<<<<<< set this as you need or from plug-in notes

global cellW, cellH
'do not mess with cellW and cellH globals for printing
cellW = 10 '10 pixels wide for characters
cellH = 20 '20 pixels high for characters
global maxRow, maxCol
'and then these are calclated from above globals
maxCol = int(xmax / cellW)  'these control printing characters
maxRow = int(ymax / cellH)
global lastC, lastR 'for loc8 (locate), pl (print a line), lp (locate and print)
lastC = 1 : lastR = 1

'mouse and key events update globals with latest info
global inkee$
global mouseX, mouseY
global lbdX, lbdY, lbmX, lbmY, lbuX, lbuY  'using -99 for inactive positions
global rbdX, rbdY, rbmX, rbmY, rbuX, rbuY  'using -99 for inactive positions

dim qb$(15) 'thanks Andy Amaya for use with his sub qColor fore, back
qb$( 0) = "  0   0   0" 'black
qb$( 1) = "  0   0 128" 'blue
qb$( 2) = "  8 128   8" 'green
qb$( 3) = "  0 128 128" 'cyan
qb$( 4) = "128   0   0" 'red
qb$( 5) = "128   0 128" 'magenta
qb$( 6) = "128  64  32" 'brown
qb$( 7) = "168 168 168" 'white
qb$( 8) = "128 128 128" 'grey
qb$( 9) = " 84  84 252" 'light blue
qb$(10) = " 42 252  42" 'light green
qb$(11) = "  0 220 220" 'light cyan
qb$(12) = "255   0   0" 'light red
qb$(13) = "255  84 255" 'light magenta
qb$(14) = "255 255   0" 'yellow
qb$(15) = "255 255 255" 'bright white

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (DisplayWidth-WindowWidth) / 2
UpperLeftY = (DisplayHeight-WindowHeight) / 2

'graphicbox #gr, 2, 2, xmax-2, ymax-2
open "DE6 Breakout" for graphics_nsb_nf as #gr '<, == change for plug in modules
#gr "trapclose quit"

'fonts that don't work arial, tahoma, verdana
'fonts that work
'#gr "font courier_new 10 20"
'#gr "font consolas 10 20"
#gr "font dejavu_sans_mono 10 20"

#gr "home"                  '< check drawing area
#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

#gr "setfocus"
#gr "when mouseMove mMove"
#gr "when leftButtonDown leftDown"
#gr "when leftButtonMove leftMove"
#gr "when leftButtonUp leftUp"
#gr "when rightButtonDown rightDown"
#gr "when rightButtonMove rightMove"
#gr "when rightButtonUp rightUp"
#gr "when characterInput charIn"
#gr "down"
'========================================================== plug-in main modules here
'plug-in notes: xmax = 700 : ymax = 560 title: Breakout
'               >>> remove flush from pause

' wall is 50 pixels X 14 columns wide = 700 make screen width
' wall is 20 pixels X 8  rows = 160 = 1/3 screen height = 480 + 20 width
' under paddle track score and lifes on one line padded by blank lines 540 = 27
' so total height 480 to paddle 500 + 60 for 3 lines = 560

global br, bx, by, dx, dy, px, py, pw, plf, prt, bkw, bkh, score, life, hits, obk, rbk, speedups
br = 10  'ball radius, paddle and goals use this number also
bkw = 50 'brick width
bkh = 20 'brick height
py = 480 ' paddle surface
pw = 50  ' 100 wide to start half that at certain point
life = 5  ' only 3 allowed according to wiki
dim wc$(13, 7), wp(13, 7) 'for brick tracking wc wall colors, wp wall points
call initwall 'load arrays with data
call initball 'set dx, dy, bx, by ball position and change
call clear 0, 0, 0 'set background to black
call drawtable
call updatescore
px = xmax/2
while life
   scan
   call drawpaddle
   call drawball
   call updatescore
   if hits = 112 and scrn = 0 then 'setup new
       scrn = 1
       speedups = 0 : obk = 0 : rbk = 0 : pw = 50
       call initwall
       call drawtable
       call initball
   else
       if hits = 224 then
           call qColor 15, 0
           call cp 14, "Congratulations on a perfect score!!!"
           call pause 2500
           call cp 14, space$(40)
           exit while
       end if
   end if
   call pause 20 '< adjust as needed for speed of your system
wend
call qColor 15, 0
call cp 14, "Game Over!"

wait

sub initwall
   for r = 0 to 7
       select case r
       case 0,1 : cr$ = "225 0 0"    : p = 7
       case 2,3 : cr$ = "255 100 0"  : p = 5
       case 4,5 : cr$ = "0 128 0"    : p = 3
       case 6,7 : cr$ = "255 255 0"  : p = 1
       end select
       for c = 0 to 13
           wc$(c, r) = cr$ : wp(c, r) = p
           totp = totp + p
       next
   next
   notice "Total Points available for this screen is ";totp
end sub

sub initball  'set ball in play with location and dx, dy
 bx = rand(br, 700 - br)
 by = rand(py - 100, py - 10)
 dx = rand(3, 7)
 if rand(0, 1) then dx = -1 * dx
 dy = -3 - speedups
end sub

sub drawtable  ' in JB don't want to redraw this every loop
   for r = 0 to 7
       for c = 0 to 13
           if wp(c, r) then
               call cstr "255 255 255"
               call bstr wc$(c, r)
               call fbox c * bkw, r * bkh, c * bkw + bkw, r * bkh + bkh
           end if
       next
   next
end sub

sub drawpaddle ' update paddle to mouseY, paddle top and bottom are global
   'erase last paddle, it is aligned with Blue Computer Goal Line
   call qColor 0, 0 'return to computer goal color
   call fbox plf, py, prt, py + 20

   px = mouseX 'update paddle location
   plf = px - pw
   prt = px + pw
   call qColor 7, 7
   call fbox plf, py, prt, py + 20
end sub

sub drawball
   'erase last ball, blend into table color
   call qColor 0, 0
   call fcirc bx, by, br

   'update
   bx = bx + dx
   if bx < br then dx = dx * -1 : bx = br + 1
   if bx > xmax - br then dx = dx * -1 : bx = xmax - br - 1

   by = by + dy
   if by + br > py then 'ball past paddle line
       by = py - br 'don't let ball go into paddle or goal
       if bx + br < plf or bx - br > prt then 'paddle miss
           life = life - 1
           ' if life = 0 then end game
           call updatescore
           call qColor 7, 7
           call fcirc bx, by, br
           call pause 2500 'reflect on position of ball and loss of life
           call qColor 0, 0 'black out
           call fcirc bx, by, br
           call initball 'get ball rolling again
       else 'paddle hit
           dy = dy * -1
           'dx = dx + rand(-2, 2)
           If bx < px Then
               per = .5 * (px - bx) / pw
               dx = dx - 6 * per
           Else
               per = .5 * (bx - px) / pw
               dx = dx + 6 * per
           End If
           if dx > 7 then dx = 7
           if dx < -7 then dx = -7
       end if
   else
       if by - br < 0 then 'ball hits back border, reverse direction
           by = br : dy = dy * -1
       else
           if by - br < 160 then 'in wall area, what row and column?
               starthits = hits
               'maybe should check all 4 corners or smaller ball
               row = int((by - br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by - br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               if hits <> starthits then dy = dy * -1 'reverse ball direction
           end if
       end if
   end if

   call qColor 9, 9
   call fcirc bx, by, br
end sub

sub handleBall row, col
   if 0 <= row and row <= 7 and 0 <= col and col <= 13 then
       if wp(col, row) then 'brick just hit, lot's to do before update ball
           hits = hits + 1
           if hits = 4 or hits = 8 or hits = 116 or hits = 120 then
               speedups = speedups + 1
               if dy < 0 then dy = dy - 1 else dy = dy + 1
           end if
           val = wp(col, row)
           if val = 5 then 'first orange brick
               if obk = 0 then 'flag first orange speed increase
                   obk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
               end if
           end if
           if val = 7 then 'flag first red, speed increase paddle decrease!
               if rbk = 0 then
                   rbk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
                   pw = .75 * pw
               end if
           end if
           score = score + wp(col, row) 'update score with point value
           wp(col, row) = 0            'no points here now
           call qColor 0, 0             'black out box
           call fbox col * bkw, row * bkh, col * bkw + bkw, row * bkh + bkh
       end if
   end if
end sub

sub updatescore
   call qColor 7, 0
   dy$ = right$("  ";str$(dy), 2)
   dx$ = right$("  ";str$(dx), 2)
   score$ = right$("   ";str$(score), 3)
   call cp 27, "dy: ";dy$;"   dx: ";dx$;"           Lives: ";life;"    Score: ";score$
end sub

wait ' ======= DE procedures color, drawing, events very useful subs or functions

sub mMove hdl$, mx, my
   mouseX = mx : mouseY = my
end sub

' dont want to use Boolean 0 for non active button so am using -99
sub leftDown hdl$, mx, my  'must have handle and mouse x,y
   lbdX = mx : lbdY = my
   lbuX = -99 : lbuY = -99
   lbmX = -99 : lbmY = -99
end sub

sub leftMove hdl$, mx, my  'must have handle and mouse x,y
   lbmX = mx : lbmY = my
end sub

sub leftUp hdl$, mx, my  'must have handle and mouse x,y
   lbuX = mx : lbuY = my
   lbdX = -99 : lbdY = -99
   lbmX = -99 : lbmY = -99
end sub

sub rightDown hdl$, mx, my  'must have handle and mouse x,y
   rbdX = mx : rbdY = my
   rbuX = -99 : rbuY = -99
   rbmX = -99 : rbmY = -99
end sub

sub rightMove hdl$, mx, my  'must have handle and mouse x,y
   rbmX = mx : rbmY = my
end sub

sub rightUp hdl$, mx, my  'must have handle and mouse x,y
   rbuX = mx : rbuY = my
   rbdX = -99 : rbdY = -99
   rbmX = -99 : rbmY = -99
end sub

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub

sub clear r, g, b 'clear screen to new RGB color and set backcolor
' and set up so pl (print line) will start at line 1, cell column 1)
   #gr "fill ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
   lastC = 1 : lastR = 1
end sub

sub fore r, g, b 'set fore color lines pixels text
   #gr "color ";r;" ";g;" ";b
end sub

sub back r, g, b 'set background color for fills
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub hue r, g, b 'fore and back RGB color system
'hue sets both fore and backcolor for filled graphics commands fbox, fcirc, fellipse
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub cstr rgb$
   #gr "color ";rgb$
end sub

sub bstr rgb$
   #gr "backcolor ";rgb$
end sub

Sub qColor foreColor, backColor 'thanks Andy Amaya old QB color system
   #gr "Color ";qb$(foreColor);";BackColor ";qb$(backColor)
End Sub

sub seyes thickness  'pixel, line, border size for box, fbox, circ, fcirc...
   #gr "size ";thickness
end sub

sub pset x, y 'set pixel at x, y (at whatever the current fore color is)
   #gr "set ";x;" ";y
end sub

sub aline x0, y0, x1, y1 'somethimes you might want to spec a pixel longer on end x1, y1
   #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point
end sub

sub box x0, y0, x1, y1  'box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "box ";x1;" ";y1
end sub

sub fbox x0, y0, x1, y1   'fill box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "boxfilled ";x1;" ";y1
end sub

sub circ x, y, radius ' just circle border at center x,y
   #gr "place ";x;" ";y;"; circle ";radius
end sub

sub fcirc x, y, radius ' fill circle x,y center
   #gr "place ";x;" ";y;"; circlefilled ";radius
end sub

sub ellips x, y, w, h  '< no e on end! just ellipse border
   #gr "place ";x;" ";y;"; ellipse ";w;" ";h
end sub

sub fellipse x, y, w, h  ' fill ellipse
   #gr "place ";x;" ";y;"; ellipsefilled ";w;" ";h
end sub

sub loc8 x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub pl mess$ 'print line (feed)
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
       if lastR > maxRow then lastR = maxRow 'yuck!
   end if
end sub

sub cp y,cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol-len(cpText$))/2+1.5),y,cpText$
end sub

sub inp prmpt$, byref var$   'input
'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   do
       scan
       if instr(OK$, inkee$) then
           if inkee$ = Chr$(8) then
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           else
               if inkee$=Chr$(13) or inkee$=Chr$(27) then
                   'new D5, I was expecting nothing in return for my esc
                   if inkee$ = chr$(27) then t$ = ""
                   exit do
               else
                   t$=t$;inkee$
               end if
           end if
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

function wait4key$() 'updated for DE6 from sub to function like input$(1)
'This function stops program flow for keypress, and returns keypress
   inkee$ = ""
   while len(inkee$) = 0 : scan : k$ = inkee$ : wend
   wait4key$ = k$
end function

sub pause mil
'================== Warning !!! =======================
'      MARK (or anyone who uses this handy) remember to
' timer 0
'      before close window and end program
'======================================================
   '#gr "flush"
   timer mil, [timesup]
   wait
[timesup]
   timer 0
end sub

function sMult$(s$, mult) 'xerox a copy of a string mult times
   for i = 1 to mult
       rtn$ = rtn$ + s$
   next
   sMult$ = rtn$
end function

function rand(n1, n2)  'very handy for screen saver like eye candy
   if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function



EDIT: reduced the paddle decrease to .75 * pw

[honky]

Reduced paddle + increased speed = scam !! Repay me!

[tsh73]

I play tested on my kid (age 11), then again on myself.

Takeaway from kid's testing:

Version 1
1) reducing paddle 1/2 *feels* unfair
2) dx = dx + rand(-2, 2) not felt at all (I'm surprised)
3) but some dependence from hit point on paddle or paddle speed IS expected. I see her try.
4) Since it is visible that you cannot control ball at all, it *feels* that you will chase last brick FOREVER -> desperation -> refused to replay
5) hence request for special ability - like shooting
(I remember I think DX-Ball - then you got last piece and fiddle around it long enough, lightning struck and destroys the pesky brick)

Version 2
1) somehow I was told that program tell ball is lost then it could be saved.
"it lose ball too fast, it still above paddle, I could move it there really fast"
(I dunno, I did not felt that way)
2) ball control by hitting different part of the paddle works. Game is much more playable
3) reducing paddle to 3/4 is much better then to 1/2
4) Then ball is lost, it would be beneficial to put new ball on paddle and release it on mouse up (so player could aim first)

And from me - I see dx shows something different this time (often 2-digit number)
Interesting.

[B+]

Tsh73 thanks for specific feedbacks

dy speed bumped up 1 notch, ball now always starts from center just above paddle y and dx, dy of score update fixed:

'DE6 Breakout.txt started 2016-12-23
'new a number of graphic subs pset, line, circ, fcirc, ellips, fellipse
'wait4key$ (revised to return the key), at ,cp, seyes

global xmax, ymax  'these two you can easily reset to your needs
'set these to screen width = xmax, screen height = ymax, that you want

xmax = 700 : ymax = 560  '<<<<<< set this as you need or from plug-in notes

global cellW, cellH
'do not mess with cellW and cellH globals for printing
cellW = 10 '10 pixels wide for characters
cellH = 20 '20 pixels high for characters
global maxRow, maxCol
'and then these are calclated from above globals
maxCol = int(xmax / cellW)  'these control printing characters
maxRow = int(ymax / cellH)
global lastC, lastR 'for loc8 (locate), pl (print a line), lp (locate and print)
lastC = 1 : lastR = 1

'mouse and key events update globals with latest info
global inkee$
global mouseX, mouseY
global lbdX, lbdY, lbmX, lbmY, lbuX, lbuY  'using -99 for inactive positions
global rbdX, rbdY, rbmX, rbmY, rbuX, rbuY  'using -99 for inactive positions

dim qb$(15) 'thanks Andy Amaya for use with his sub qColor fore, back
qb$( 0) = "  0   0   0" 'black
qb$( 1) = "  0   0 128" 'blue
qb$( 2) = "  8 128   8" 'green
qb$( 3) = "  0 128 128" 'cyan
qb$( 4) = "128   0   0" 'red
qb$( 5) = "128   0 128" 'magenta
qb$( 6) = "128  64  32" 'brown
qb$( 7) = "168 168 168" 'white
qb$( 8) = "128 128 128" 'grey
qb$( 9) = " 84  84 252" 'light blue
qb$(10) = " 42 252  42" 'light green
qb$(11) = "  0 220 220" 'light cyan
qb$(12) = "255   0   0" 'light red
qb$(13) = "255  84 255" 'light magenta
qb$(14) = "255 255   0" 'yellow
qb$(15) = "255 255 255" 'bright white

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (DisplayWidth-WindowWidth) / 2
UpperLeftY = (DisplayHeight-WindowHeight) / 2

'graphicbox #gr, 2, 2, xmax-2, ymax-2
open "DE6 Breakout" for graphics_nsb_nf as #gr '<, == change for plug in modules
#gr "trapclose quit"

'fonts that don't work arial, tahoma, verdana
'fonts that work
'#gr "font courier_new 10 20"
'#gr "font consolas 10 20"
#gr "font dejavu_sans_mono 10 20"

#gr "home"                  '< check drawing area
#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

#gr "setfocus"
#gr "when mouseMove mMove"
#gr "when leftButtonDown leftDown"
#gr "when leftButtonMove leftMove"
#gr "when leftButtonUp leftUp"
#gr "when rightButtonDown rightDown"
#gr "when rightButtonMove rightMove"
#gr "when rightButtonUp rightUp"
#gr "when characterInput charIn"
#gr "down"
'========================================================== plug-in main modules here
'plug-in notes: xmax = 700 : ymax = 560 title: Breakout
'               >>> remove flush from pause

' wall is 50 pixels X 14 columns wide = 700 make screen width
' wall is 20 pixels X 8  rows = 160 = 1/3 screen height = 480 + 20 width
' under paddle track score and lifes on one line padded by blank lines 540 = 27
' so total height 480 to paddle 500 + 60 for 3 lines = 560

global br, bx, by, dx, dy, px, py, pw, plf, prt, bkw, bkh, score, life, hits, obk, rbk, speedups
br = 10  'ball radius, paddle and goals use this number also
bkw = 50 'brick width
bkh = 20 'brick height
py = 480 ' paddle surface
pw = 50  ' 100 wide to start half that at certain point
life = 5  ' only 3 allowed according to wiki
dim wc$(13, 7), wp(13, 7) 'for brick tracking wc wall colors, wp wall points
call initwall 'load arrays with data
call initball 'set dx, dy, bx, by ball position and change
call clear 0, 0, 0 'set background to black
call drawtable
call updatescore
px = xmax/2
while life
   scan
   call drawpaddle
   call drawball
   call updatescore
   if hits = 112 and scrn = 0 then 'setup new
       scrn = 1
       speedups = 0 : obk = 0 : rbk = 0 : pw = 50
       call initwall
       call drawtable
       call initball
   else
       if hits = 224 then
           call qColor 15, 0
           call cp 14, "Congratulations on a perfect score!!!"
           call pause 2500
           call cp 14, space$(40)
           exit while
       end if
   end if
   call pause 20 '< adjust as needed for speed of your system
wend
call qColor 15, 0
call cp 14, "Game Over!"

wait

sub initwall
   for r = 0 to 7
       select case r
       case 0,1 : cr$ = "225 0 0"    : p = 7
       case 2,3 : cr$ = "255 100 0"  : p = 5
       case 4,5 : cr$ = "0 128 0"    : p = 3
       case 6,7 : cr$ = "255 255 0"  : p = 1
       end select
       for c = 0 to 13
           wc$(c, r) = cr$ : wp(c, r) = p
           totp = totp + p
       next
   next
   notice "Total Points available for this screen is ";totp
end sub

sub initball  'set ball in play with location and dx, dy
 bx = 350
 by = py -20
 dx = rand(3, 7)
 if rand(0, 1) then dx = -1 * dx
 dy = -4 - speedups
end sub

sub drawtable  ' in JB don't want to redraw this every loop
   for r = 0 to 7
       for c = 0 to 13
           if wp(c, r) then
               call cstr "255 255 255"
               call bstr wc$(c, r)
               call fbox c * bkw, r * bkh, c * bkw + bkw, r * bkh + bkh
           end if
       next
   next
end sub

sub drawpaddle ' update paddle to mouseY, paddle top and bottom are global
   'erase last paddle, it is aligned with Blue Computer Goal Line
   call qColor 0, 0 'return to computer goal color
   call fbox plf, py, prt, py + 20

   px = mouseX 'update paddle location
   plf = px - pw
   prt = px + pw
   call qColor 7, 7
   call fbox plf, py, prt, py + 20
end sub

sub drawball
   'erase last ball, blend into table color
   call qColor 0, 0
   call fcirc bx, by, br

   'update
   bx = bx + dx
   if bx < br then dx = dx * -1 : bx = br + 1
   if bx > xmax - br then dx = dx * -1 : bx = xmax - br - 1

   by = by + dy
   if by + br > py then 'ball past paddle line
       by = py - br 'don't let ball go into paddle or goal
       if bx + br < plf or bx - br > prt then 'paddle miss
           life = life - 1
           ' if life = 0 then end game
           call updatescore
           call qColor 7, 7
           call fcirc bx, by, br
           call pause 2500 'reflect on position of ball and loss of life
           call qColor 0, 0 'black out
           call fcirc bx, by, br
           call initball 'get ball rolling again
       else 'paddle hit
           dy = dy * -1
           'dx = dx + rand(-2, 2)
           If bx < px Then
               per = .5 * (px - bx) / pw
               dx = dx - 6 * per
           Else
               per = .5 * (bx - px) / pw
               dx = dx + 6 * per
           End If
           if dx > 7 then dx = 7
           if dx < -7 then dx = -7
       end if
   else
       if by - br < 0 then 'ball hits back border, reverse direction
           by = br : dy = dy * -1
       else
           if by - br < 160 then 'in wall area, what row and column?
               starthits = hits
               'maybe should check all 4 corners or smaller ball
               row = int((by - br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by - br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               if hits <> starthits then dy = dy * -1 'reverse ball direction
           end if
       end if
   end if

   call qColor 9, 9
   call fcirc bx, by, br
end sub

sub handleBall row, col
   if 0 <= row and row <= 7 and 0 <= col and col <= 13 then
       if wp(col, row) then 'brick just hit, lot's to do before update ball
           hits = hits + 1
           if hits = 4 or hits = 8 or hits = 116 or hits = 120 then
               speedups = speedups + 1
               if dy < 0 then dy = dy - 1 else dy = dy + 1
           end if
           val = wp(col, row)
           if val = 5 then 'first orange brick
               if obk = 0 then 'flag first orange speed increase
                   obk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
               end if
           end if
           if val = 7 then 'flag first red, speed increase paddle decrease!
               if rbk = 0 then
                   rbk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
                   pw = .75*pw
               end if
           end if
           score = score + wp(col, row) 'update score with point value
           wp(col, row) = 0            'no points here now
           call qColor 0, 0             'black out box
           call fbox col * bkw, row * bkh, col * bkw + bkw, row * bkh + bkh
       end if
   end if
end sub

sub updatescore
   'call qColor 0, 0
   'call fbox 0, 26 * cellH, xmax, 27 * cellH  'too much blinking!
   call qColor 7, 0
   call cp 27, right$( space$(70) + "Ball dx, dy: ";int(dx);", ";int(dy);"   Lives: ";life;"   Score: ";score, 70)
end sub

wait ' ======= DE procedures color, drawing, events very useful subs or functions

sub mMove hdl$, mx, my
   mouseX = mx : mouseY = my
end sub

' dont want to use Boolean 0 for non active button so am using -99
sub leftDown hdl$, mx, my  'must have handle and mouse x,y
   lbdX = mx : lbdY = my
   lbuX = -99 : lbuY = -99
   lbmX = -99 : lbmY = -99
end sub

sub leftMove hdl$, mx, my  'must have handle and mouse x,y
   lbmX = mx : lbmY = my
end sub

sub leftUp hdl$, mx, my  'must have handle and mouse x,y
   lbuX = mx : lbuY = my
   lbdX = -99 : lbdY = -99
   lbmX = -99 : lbmY = -99
end sub

sub rightDown hdl$, mx, my  'must have handle and mouse x,y
   rbdX = mx : rbdY = my
   rbuX = -99 : rbuY = -99
   rbmX = -99 : rbmY = -99
end sub

sub rightMove hdl$, mx, my  'must have handle and mouse x,y
   rbmX = mx : rbmY = my
end sub

sub rightUp hdl$, mx, my  'must have handle and mouse x,y
   rbuX = mx : rbuY = my
   rbdX = -99 : rbdY = -99
   rbmX = -99 : rbmY = -99
end sub

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub

sub clear r, g, b 'clear screen to new RGB color and set backcolor
' and set up so pl (print line) will start at line 1, cell column 1)
   #gr "fill ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
   lastC = 1 : lastR = 1
end sub

sub fore r, g, b 'set fore color lines pixels text
   #gr "color ";r;" ";g;" ";b
end sub

sub back r, g, b 'set background color for fills
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub hue r, g, b 'fore and back RGB color system
'hue sets both fore and backcolor for filled graphics commands fbox, fcirc, fellipse
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub cstr rgb$
   #gr "color ";rgb$
end sub

sub bstr rgb$
   #gr "backcolor ";rgb$
end sub

Sub qColor foreColor, backColor 'thanks Andy Amaya old QB color system
   #gr "Color ";qb$(foreColor);";BackColor ";qb$(backColor)
End Sub

sub seyes thickness  'pixel, line, border size for box, fbox, circ, fcirc...
   #gr "size ";thickness
end sub

sub pset x, y 'set pixel at x, y (at whatever the current fore color is)
   #gr "set ";x;" ";y
end sub

sub aline x0, y0, x1, y1 'somethimes you might want to spec a pixel longer on end x1, y1
   #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point
end sub

sub box x0, y0, x1, y1  'box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "box ";x1;" ";y1
end sub

sub fbox x0, y0, x1, y1   'fill box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "boxfilled ";x1;" ";y1
end sub

sub circ x, y, radius ' just circle border at center x,y
   #gr "place ";x;" ";y;"; circle ";radius
end sub

sub fcirc x, y, radius ' fill circle x,y center
   #gr "place ";x;" ";y;"; circlefilled ";radius
end sub

sub ellips x, y, w, h  '< no e on end! just ellipse border
   #gr "place ";x;" ";y;"; ellipse ";w;" ";h
end sub

sub fellipse x, y, w, h  ' fill ellipse
   #gr "place ";x;" ";y;"; ellipsefilled ";w;" ";h
end sub

sub loc8 x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub pl mess$ 'print line (feed)
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
       if lastR > maxRow then lastR = maxRow 'yuck!
   end if
end sub

sub cp y,cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol-len(cpText$))/2+1.5),y,cpText$
end sub

sub inp prmpt$, byref var$   'input
'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   do
       scan
       if instr(OK$, inkee$) then
           if inkee$ = Chr$(8) then
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           else
               if inkee$=Chr$(13) or inkee$=Chr$(27) then
                   'new D5, I was expecting nothing in return for my esc
                   if inkee$ = chr$(27) then t$ = ""
                   exit do
               else
                   t$=t$;inkee$
               end if
           end if
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

function wait4key$() 'updated for DE6 from sub to function like input$(1)
'This function stops program flow for keypress, and returns keypress
   inkee$ = ""
   while len(inkee$) = 0 : scan : k$ = inkee$ : wend
   wait4key$ = k$
end function

sub pause mil
'================== Warning !!! =======================
'      MARK (or anyone who uses this handy) remember to
' timer 0
'      before close window and end program
'======================================================
   '#gr "flush"
   timer mil, [timesup]
   wait
[timesup]
   timer 0
end sub

function sMult$(s$, mult) 'xerox a copy of a string mult times
   for i = 1 to mult
       rtn$ = rtn$ + s$
   next
   sMult$ = rtn$
end function

function rand(n1, n2)  'very handy for screen saver like eye candy
   if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function



I have a pesky problem of paddle getting stuck when mouse drifts out of range of screen.

Version 2
1) somehow I was told that program tell ball is lost then it could be saved.

tsh73 Not sure what you want here?

[tsh73]

>> >> Version 2
>> >>1) somehow I was told that program tell ball is lost then it could be saved.

>> tsh73 Not sure what you want here?

Me? I mean to say I haven't seen this behavior
Probably need to watch more, lose some more balls.

[tsh73]

sub UpdateScore flickers a lot
Change to
   call cp 27, right$( space$(70) + "Ball dx, dy: ";using("##", dx);", ";using("##", dy);"   Lives: ";life;"   Score: ";score, 70)



[B+]

Aug 14, 2021 19:40:05 GMT tsh73 said:

sub UpdateScore flickers a lot
Change to
   call cp 27, right$( space$(70) + "Ball dx, dy: ";using("##", dx);", ";using("##", dy);"   Lives: ";life;"   Score: ";score, 70)



For my system that fixed flickering I was getting, my paddle flickers more specially when not moved.

[tsh73]

It was not exactly flicker - just text "Ball dx, dy:" was constatnly jumping because of appearing/disappearing "-" at dx, dy

[B+]

Ahhhh much better!!! Solved the sticking problem and sped up game.
' Breakout revisit.txt 2021-08 b+
'DE6 Breakout.txt started 2016-12-23
'new a number of graphic subs pset, line, circ, fcirc, ellips, fellipse
'wait4key$ (revised to return the key), at ,cp, seyes

global xmax, ymax  'these two you can easily reset to your needs
'set these to screen width = xmax, screen height = ymax, that you want

xmax = 700 : ymax = 560  '<<<<<< set this as you need or from plug-in notes

global cellW, cellH
'do not mess with cellW and cellH globals for printing
cellW = 10 '10 pixels wide for characters
cellH = 20 '20 pixels high for characters
global maxRow, maxCol
'and then these are calclated from above globals
maxCol = int(xmax / cellW)  'these control printing characters
maxRow = int(ymax / cellH)
global lastC, lastR 'for loc8 (locate), pl (print a line), lp (locate and print)
lastC = 1 : lastR = 1

'mouse and key events update globals with latest info
global inkee$
global mouseX, mouseY
global lbdX, lbdY, lbmX, lbmY, lbuX, lbuY  'using -99 for inactive positions
global rbdX, rbdY, rbmX, rbmY, rbuX, rbuY  'using -99 for inactive positions

dim qb$(15) 'thanks Andy Amaya for use with his sub qColor fore, back
qb$( 0) = "  0   0   0" 'black
qb$( 1) = "  0   0 128" 'blue
qb$( 2) = "  8 128   8" 'green
qb$( 3) = "  0 128 128" 'cyan
qb$( 4) = "128   0   0" 'red
qb$( 5) = "128   0 128" 'magenta
qb$( 6) = "128  64  32" 'brown
qb$( 7) = "168 168 168" 'white
qb$( 8) = "128 128 128" 'grey
qb$( 9) = " 84  84 252" 'light blue
qb$(10) = " 42 252  42" 'light green
qb$(11) = "  0 220 220" 'light cyan
qb$(12) = "255   0   0" 'light red
qb$(13) = "255  84 255" 'light magenta
qb$(14) = "255 255   0" 'yellow
qb$(15) = "255 255 255" 'bright white

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (DisplayWidth-WindowWidth) / 2
UpperLeftY = (DisplayHeight-WindowHeight) / 2

'graphicbox #gr, 2, 2, xmax-2, ymax-2
open "DE6 Breakout" for graphics_nsb_nf as #gr '<, == change for plug in modules
#gr "trapclose quit"

'fonts that don't work arial, tahoma, verdana
'fonts that work
'#gr "font courier_new 10 20"
'#gr "font consolas 10 20"
#gr "font dejavu_sans_mono 10 20"

#gr "home"                  '< check drawing area
#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

#gr "setfocus"
#gr "when mouseMove mMove"
#gr "when leftButtonDown leftDown"
#gr "when leftButtonMove leftMove"
#gr "when leftButtonUp leftUp"
#gr "when rightButtonDown rightDown"
#gr "when rightButtonMove rightMove"
#gr "when rightButtonUp rightUp"
#gr "when characterInput charIn"
#gr "down"
'========================================================== plug-in main modules here
'plug-in notes: xmax = 700 : ymax = 560 title: Breakout
'               >>> remove flush from pause

' wall is 50 pixels X 14 columns wide = 700 make screen width
' wall is 20 pixels X 8  rows = 160 = 1/3 screen height = 480 + 20 width
' under paddle track score and lifes on one line padded by blank lines 540 = 27
' so total height 480 to paddle 500 + 60 for 3 lines = 560

global br, bx, by, dx, dy, px, py, pw, plf, prt, bkw, bkh, score, life, hits, obk, rbk, speedups
br = 10  'ball radius, paddle and goals use this number also
bkw = 50 'brick width
bkh = 20 'brick height
py = 480 ' paddle surface
pw = 50  ' 100 wide to start half that at certain point
life = 5  ' only 3 allowed according to wiki
dim wc$(13, 7), wp(13, 7) 'for brick tracking wc wall colors, wp wall points
call initwall 'load arrays with data
call initball 'set dx, dy, bx, by ball position and change
call clear 0, 0, 0 'set background to black
call drawtable
call updatescore
px = xmax/2
while life
   scan
   call drawpaddle
   call drawball
   call updatescore
   if hits = 112 and scrn = 0 then 'setup new
       scrn = 1
       speedups = 0 : obk = 0 : rbk = 0 : pw = 50
       call initwall
       call drawtable
       call initball
   else
       if hits = 224 then
           call qColor 15, 0
           call cp 14, "Congratulations on a perfect score!!!"
           call pause 2500
           call cp 14, space$(40)
           exit while
       end if
   end if
   call pause 20 '< adjust as needed for speed of your system
wend
call qColor 15, 0
call cp 14, "Game Over!"

wait

sub initwall
   for r = 0 to 7
       select case r
       case 0,1 : cr$ = "225 0 0"    : p = 7
       case 2,3 : cr$ = "255 100 0"  : p = 5
       case 4,5 : cr$ = "0 128 0"    : p = 3
       case 6,7 : cr$ = "255 255 0"  : p = 1
       end select
       for c = 0 to 13
           wc$(c, r) = cr$ : wp(c, r) = p
           totp = totp + p
       next
   next
   notice "Total Points available for this screen is ";totp
end sub

sub initball  'set ball in play with location and dx, dy
 bx = 350
 by = 280
 dx = rand(3, 7)
 if rand(0, 1) then dx = -1 * dx
 dy = -6 - speedups
end sub

sub drawtable  ' in JB don't want to redraw this every loop
   for r = 0 to 7
       for c = 0 to 13
           if wp(c, r) then
               call cstr "255 255 255"
               call bstr wc$(c, r)
               call fbox c * bkw, r * bkh, c * bkw + bkw, r * bkh + bkh
           end if
       next
   next
end sub

sub drawpaddle ' update paddle to mouseY, paddle top and bottom are global
   'erase last paddle, it is aligned with Blue Computer Goal Line
   call qColor 0, 0 'return to computer goal color
   call fbox plf, py, prt, py + 20

   px = mouseX 'update paddle location
   if mouseY > 300 then py = mouseY
   plf = px - pw
   prt = px + pw
   call qColor 7, 7
   call fbox plf, py, prt, py + 20
end sub

sub drawball
   'erase last ball, blend into table color
   call qColor 0, 0
   call fcirc bx, by, br

   'update
   bx = bx + dx
   if bx < br then dx = dx * -1 : bx = br + 1
   if bx > xmax - br then dx = dx * -1 : bx = xmax - br - 1

   by = by + dy
   if by + br > py then 'ball past paddle line
       by = py - br 'don't let ball go into paddle or goal
       if bx + br < plf or bx - br > prt then 'paddle miss
           life = life - 1
           ' if life = 0 then end game
           call updatescore
           call qColor 7, 7
           call fcirc bx, by, br
           call pause 2500 'reflect on position of ball and loss of life
           call qColor 0, 0 'black out
           call fcirc bx, by, br
           call initball 'get ball rolling again
       else 'paddle hit
           dy = dy * -1
           'dx = dx + rand(-2, 2)
           If bx < px Then
               per = .5 * (px - bx) / pw
               dx = dx - 6 * per
           Else
               per = .5 * (bx - px) / pw
               dx = dx + 6 * per
           End If
           if dx > 7 then dx = 7
           if dx < -7 then dx = -7
       end if
   else
       if by - br < 0 then 'ball hits back border, reverse direction
           by = br : dy = dy * -1
       else
           if by - br < 160 then 'in wall area, what row and column?
               starthits = hits
               'maybe should check all 4 corners or smaller ball
               row = int((by - br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by - br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx - br) / bkw)
               call handleBall row, col
               row = int((by + br) / bkh) : col = int((bx + br) / bkw)
               call handleBall row, col
               if hits <> starthits then dy = dy * -1 'reverse ball direction
           end if
       end if
   end if

   call qColor 9, 9
   call fcirc bx, by, br
end sub

sub handleBall row, col
   if 0 <= row and row <= 7 and 0 <= col and col <= 13 then
       if wp(col, row) then 'brick just hit, lot's to do before update ball
           hits = hits + 1
           if hits = 4 or hits = 8 or hits = 116 or hits = 120 then
               speedups = speedups + 1
               if dy < 0 then dy = dy - 1 else dy = dy + 1
           end if
           val = wp(col, row)
           if val = 5 then 'first orange brick
               if obk = 0 then 'flag first orange speed increase
                   obk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
               end if
           end if
           if val = 7 then 'flag first red, speed increase paddle decrease!
               if rbk = 0 then
                   rbk = 1
                   speedups = speedups + 1
                   if dy < 0 then dy = dy - 1 else dy = dy + 1
                   pw = .75*pw
               end if
           end if
           score = score + wp(col, row) 'update score with point value
           wp(col, row) = 0            'no points here now
           call qColor 0, 0             'black out box
           call fbox col * bkw, row * bkh, col * bkw + bkw, row * bkh + bkh
       end if
   end if
end sub

sub updatescore
   call qColor 0, 0
   call fbox 0, 26 * cellH, xmax, 27 * cellH  'too much blinking, too bad leaving artifacts of last score
   dxs$ = Right$("   " + Str$(Int(dx)), 3)
   dys$ = Right$("   " + Str$(Int(dy)), 3)
   scores$ = Right$("   " + Str$(score), 3)
   call qColor 7, 0
   call cp 27, right$( space$(70) + "Ball dx,dy: ";dxs$;", ";dys$;"   Lives: ";life;"   Score: ";scores$, 70)
end sub

wait ' ======= DE procedures color, drawing, events very useful subs or functions

sub mMove hdl$, mx, my
   mouseX = mx : mouseY = my
end sub

' dont want to use Boolean 0 for non active button so am using -99
sub leftDown hdl$, mx, my  'must have handle and mouse x,y
   lbdX = mx : lbdY = my
   lbuX = -99 : lbuY = -99
   lbmX = -99 : lbmY = -99
end sub

sub leftMove hdl$, mx, my  'must have handle and mouse x,y
   lbmX = mx : lbmY = my
end sub

sub leftUp hdl$, mx, my  'must have handle and mouse x,y
   lbuX = mx : lbuY = my
   lbdX = -99 : lbdY = -99
   lbmX = -99 : lbmY = -99
end sub

sub rightDown hdl$, mx, my  'must have handle and mouse x,y
   rbdX = mx : rbdY = my
   rbuX = -99 : rbuY = -99
   rbmX = -99 : rbmY = -99
end sub

sub rightMove hdl$, mx, my  'must have handle and mouse x,y
   rbmX = mx : rbmY = my
end sub

sub rightUp hdl$, mx, my  'must have handle and mouse x,y
   rbuX = mx : rbuY = my
   rbdX = -99 : rbdY = -99
   rbmX = -99 : rbmY = -99
end sub

sub charIn hdl$, c$
   inkee$ = c$
end sub

sub quit hdl$
   timer 0
   close #gr
   end
end sub

sub clear r, g, b 'clear screen to new RGB color and set backcolor
' and set up so pl (print line) will start at line 1, cell column 1)
   #gr "fill ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
   lastC = 1 : lastR = 1
end sub

sub fore r, g, b 'set fore color lines pixels text
   #gr "color ";r;" ";g;" ";b
end sub

sub back r, g, b 'set background color for fills
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub hue r, g, b 'fore and back RGB color system
'hue sets both fore and backcolor for filled graphics commands fbox, fcirc, fellipse
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub cstr rgb$
   #gr "color ";rgb$
end sub

sub bstr rgb$
   #gr "backcolor ";rgb$
end sub

Sub qColor foreColor, backColor 'thanks Andy Amaya old QB color system
   #gr "Color ";qb$(foreColor);";BackColor ";qb$(backColor)
End Sub

sub seyes thickness  'pixel, line, border size for box, fbox, circ, fcirc...
   #gr "size ";thickness
end sub

sub pset x, y 'set pixel at x, y (at whatever the current fore color is)
   #gr "set ";x;" ";y
end sub

sub aline x0, y0, x1, y1 'somethimes you might want to spec a pixel longer on end x1, y1
   #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point
end sub

sub box x0, y0, x1, y1  'box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "box ";x1;" ";y1
end sub

sub fbox x0, y0, x1, y1   'fill box two corners x0, y0 and x1, y1
   #gr "place ";x0;" ";y0
   #gr "boxfilled ";x1;" ";y1
end sub

sub circ x, y, radius ' just circle border at center x,y
   #gr "place ";x;" ";y;"; circle ";radius
end sub

sub fcirc x, y, radius ' fill circle x,y center
   #gr "place ";x;" ";y;"; circlefilled ";radius
end sub

sub ellips x, y, w, h  '< no e on end! just ellipse border
   #gr "place ";x;" ";y;"; ellipse ";w;" ";h
end sub

sub fellipse x, y, w, h  ' fill ellipse
   #gr "place ";x;" ";y;"; ellipsefilled ";w;" ";h
end sub

sub loc8 x, y   'locate xColumnCell, yRowCell for printing
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       lastC = x
       lastR = y
   end if
end sub

sub pl mess$ 'print line (feed)
   startR = lastR
   for i = 1 to len(mess$)
       scan
       call lp lastC, lastR, mid$(mess$, i, 1)
       if lastR <> startR then exit for
   next
   lastC = 1
   lastR = startR + 1
   if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
   'if locate = x col and y row then and top left corner locates as 1, 1
   c = x - 1: r = y
   if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
       #gr "place ";c * cellW;" ";r * cellH - 4
       #gr "|";mess$
       lastC = x + len(mess$)
       if lastC > maxCol then lastC = 1 : lastR = lastR + 1
       if lastR > maxRow then lastR = maxRow 'yuck!
   end if
end sub

sub cp y,cpText$ 'cp Center Print on line y the cpText$
   call lp int((maxCol-len(cpText$))/2+1.5),y,cpText$
end sub

sub inp prmpt$, byref var$   'input
'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

   inkee$ = "" 'clear last key (new fix for DE5)
   call lp lastC, lastR, prmpt$;"{"
   'this will update lastR and lastC to the starting point of input variable
   pRow = lastR : pCol = lastC 'save these for redrawing var
   call lp pCol, pRow, "}"
   OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
   OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
   do
       scan
       if instr(OK$, inkee$) then
           if inkee$ = Chr$(8) then
               if t$ <> "" then
                   if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
               end if
           else
               if inkee$=Chr$(13) or inkee$=Chr$(27) then
                   'new D5, I was expecting nothing in return for my esc
                   if inkee$ = chr$(27) then t$ = ""
                   exit do
               else
                   t$=t$;inkee$
               end if
           end if
           call lp pCol, pRow, t$;"} "
           inkee$ = ""
       end if
   loop until done
   var$ = t$
   lastC = 1 : lastR = pRow + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
   #gr "place ";xPix;" ";yPix
   #gr "|";char$
end sub

function wait4key$() 'updated for DE6 from sub to function like input$(1)
'This function stops program flow for keypress, and returns keypress
   inkee$ = ""
   while len(inkee$) = 0 : scan : k$ = inkee$ : wend
   wait4key$ = k$
end function

sub pause mil
'================== Warning !!! =======================
'      MARK (or anyone who uses this handy) remember to
' timer 0
'      before close window and end program
'======================================================
   '#gr "flush"
   timer mil, [timesup]
   wait
[timesup]
   timer 0
end sub

function sMult$(s$, mult) 'xerox a copy of a string mult times
   for i = 1 to mult
       rtn$ = rtn$ + s$
   next
   sMult$ = rtn$
end function

function rand(n1, n2)  'very handy for screen saver like eye candy
   if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function



EDIT: Need to clear area where score goes because of expanding and shrinking text even though it's supposed to be all same length in chars!