Author |
Topic: Pac-Man (Read 1823 times) |
|
rtr
Guest
|
 |
Pac-Man
« Thread started on: Aug 13th, 2014, 09:25am » |
|
As discussed in another thread, here is a Pac-Man game which will run in the demo version of BB4W. It's entirely native BBC BASIC code - there are no libraries, no SYS calls and no assembler.
The program needs the pacmaze.bmp file that you can get from here:
http://alycesrestaurant.com/zips/pacman2.zip
There may well be bugs!
Code: REM Original Liberty BASIC version by Tom Watson (c) 1998 All Rights Reserved
REM Adapted and simplified for BBC BASIC for Windows by Richard Russell, 2014
LEFT = 1
UP = 2
RIGHT = 3
DOWN = 4
DIM gx(3),gy(3),gd(3),ga(3)
lives = 3
dead = 0
done = 0
bonus = 0
ghostflash = 0
ghostblue = 0
fruit = 0
dotcount = 0
pacspeed = 5
ghostspeed = 5
slowghost = 1
frame = 0
dir = 1
try = 0
cx = 210
cy = 240
INPUT "Enter level (1-8): " level
VDU 23,22,482;400;8,16,16,0
VDU 24,0;-240;1918;798;
VDU 28,0,1,59,0,5
COLOUR 1,247,222,115
*TEMPO 1
PROCload
PROCdrawlives
REPEAT
WAIT 10
CASE INKEY(0) OF
WHEN 136: newdir = 1 : try = TRUE
WHEN 139: newdir = 2 : try = TRUE
WHEN 137: newdir = 3 : try = TRUE
WHEN 138: newdir = 4 : try = TRUE
ENDCASE
PROCdot
PROCmovePacman
PROCbackground
PROCghost(0)
PROCghost(1)
PROCghost(2)
PROCghost(3)
PROCdetectGhost
PROCdrawPacman
IF dotcount = 254 THEN dotcount = 0 : PROCwin
IF dead = 1 THEN dead = 0 : PROCdie
IF done = 1 THEN PROCgameover
UNTIL FALSE
DEF PROCdrawlives
LOCAL i
GCOL 0 : RECTANGLE FILL 0,0,300,60
IF lives<=1 ENDPROC
FOR i = 1 TO lives-1
RECTANGLE 960,6,56,56 TO i*60-60,10
NEXT i
ENDPROC
DEF PROCdootFruit
LOCAL sc$
IF fruit = 1 IF cy = 180 IF cx > 220 IF cx < 230 THEN
fruit = 0
start = TIME
CASE level OF
WHEN 1: sc$ = "100"
WHEN 2: sc$ = "200"
WHEN 3: sc$ = "500"
WHEN 4: sc$ = "700"
WHEN 5: sc$ = "1000"
WHEN 6: sc$ = "2000"
WHEN 7: sc$ = "3000"
OTHERWISE: sc$ = "5000"
ENDCASE
score += VAL(sc$)
GCOL 15 : MOVE 500,362 : PRINT ;sc$;
ENVELOPE 1,1,0,0,0,0,0,0,126,-1,0,-8,126,0
SOUND 0,1,4,50
WAIT 50
PROCprintScore
ENDIF
ENDPROC
DEF PROCmovePacman
LOCAL i
IF (ghostblue > 0) AND (TIME > ghostblue + (100 * (20 - (level * 2)))) THEN
ghostblue = 0
ghostflash = 0
FOR i = 0 TO 3
gx(i) -= gx(i) MOD 30 : gy(i) -= gy(i) MOD 30 : ga(i) = 1
NEXT
ENDIF
IF TIME > ghostblue + 100 * (16 - (level * 2)) THEN ghostflash = NOT ghostflash
PROCdootFruit
IF try IF (cx MOD 15) = 0 IF (cy MOD 15) = 0 THEN
CASE newdir OF
WHEN 1: IF TINT(2*cx, 702-2*cy)<>blue dir = newdir : try = 0
WHEN 4: IF TINT(2*cx+32,672-2*cy)<>blue dir = newdir : try = 0
WHEN 3: IF TINT(2*cx+58,702-2*cy)<>blue dir = newdir : try = 0
WHEN 2: IF TINT(2*cx+32,730-2*cy)<>blue dir = newdir : try = 0
ENDCASE
ENDIF
CASE dir OF
WHEN 1: IF TINT(2*cx, 702-2*cy)<>blue cx -= pacspeed ELSE cx = 30 * INT(cx/30 + 0.5) : frame = 2
WHEN 4: IF TINT(2*cx+32,672-2*cy)<>blue cy += pacspeed ELSE cy = 30 * INT(cy/30 + 0.5) : frame = 2
WHEN 3: IF TINT(2*cx+58,702-2*cy)<>blue cx += pacspeed ELSE cx = 30 * INT(cx/30 + 0.5) : frame = 2
WHEN 2: IF TINT(2*cx+32,730-2*cy)<>blue cy -= pacspeed ELSE cy = 30 * INT(cy/30 + 0.5) : frame = 2
ENDCASE
IF cx<30 cx += 480
IF cx>=460 cx -= 480
ENDPROC
DEF PROCdetectGhost
LOCAL p,x,y,active,text$
FOR p = 0 TO 3
x = gx(p) : y = gy(p) : active = ga(p)
IF ABS(cx-x) < 16 IF ABS(cy-y) < 16 THEN
IF active = 0 THEN
active = 1
ghostcount += 1
y += 25
CASE ghostcount OF
WHEN 1: text$ = "200"
WHEN 2: text$ = "400"
WHEN 3: text$ = "800"
WHEN 4: text$ = "1600"
ENDCASE
score += VAL(text$)
PROCprintScore
GCOL 15 : MOVE x*2+32,712-y*2 : PRINT text$;
ENVELOPE 1,1,0,0,0,0,0,0,126,-1,0,-8,126,0
SOUND 0,1,4,50
WAIT 50
x = 225
y = 150
ELSE
dead = 1
ENDPROC
ENDIF
ENDIF
ga(p) = active : gx(p) = x : gy(p) = y
NEXT p
ENDPROC
DEF PROCbackground
RECTANGLE 960,70,960,660 TO 0,70
IF (TIME > start + 800) AND (TIME < start + 800 + (1000 - (50 * level))) THEN PROCdrawFruit : fruit = 1
IF TIME >= start + 800 + (1000 - (50 * level)) THEN fruit = 0 : start = TIME
ENDPROC
DEF PROCdot
IF (cx MOD 15) = 0 IF (cy MOD 15) = 0 THEN
CASE TINT(992+2*cx,702-2*cy) OF
WHEN yellow: PROCchomp : GCOL 0 : RECTANGLE FILL 976+2*cx,686-2*cy,32,32
WHEN pink: PROCpill : GCOL 0 : RECTANGLE FILL 976+2*cx,686-2*cy,32,32
ENDCASE
ENDIF
ENDPROC
DEF PROCdrawFruit
CASE level OF
WHEN 1: RECTANGLE 1324,-52,48,48 TO 450,318
WHEN 2: RECTANGLE 1384,-52,48,48 TO 450,318
WHEN 3: RECTANGLE 1444,-52,48,48 TO 450,318
WHEN 4: RECTANGLE 1204,-112,48,48 TO 450,318
WHEN 5: RECTANGLE 1264,-112,48,48 TO 450,318
WHEN 6: RECTANGLE 1324,-112,48,48 TO 450,318
WHEN 7: RECTANGLE 1384,-112,48,48 TO 450,318
WHEN 8: RECTANGLE 1444,-112,48,48 TO 450,318
ENDCASE
ENDPROC
DEF PROCghost(i)
LOCAL gx,gy,op,change
op = TIME MOD 10
IF gx(i) MOD 30 = 0 IF gy(i) MOD 30 = 0 IF op < 4 THEN gd(i) = op + 1
IF ga(i) speed = ghostspeed ELSE speed = slowghost
REPEAT
change = FALSE
CASE gd(i) OF
WHEN 1: IF TINT(2*gx(i), 702-2*gy(i))=blue change = TRUE
WHEN 4: IF TINT(2*gx(i)+32,672-2*gy(i))=blue change = TRUE
WHEN 3: IF TINT(2*gx(i)+58,702-2*gy(i))=blue change = TRUE
WHEN 2: IF TINT(2*gx(i)+32,730-2*gy(i))=blue change = TRUE
ENDCASE
IF change gd(i) = RND(4) : gx(i) = 30 * INT(gx(i)/30 + 0.5) : gy(i) = 30 * INT(gy(i)/30 + 0.5)
UNTIL NOT change
CASE gd(i) OF
WHEN 1: gx(i) -= speed
WHEN 4: gy(i) += speed
WHEN 3: gx(i) += speed
WHEN 2: gy(i) -= speed
ENDCASE
IF gx(i) < 0 THEN gx(i) = 450
IF gx(i) > 450 THEN gx(i) = 0
gy = 60*i
CASE gd(i) OF
WHEN LEFT: gx = 0
WHEN DOWN: gx = 30
WHEN RIGHT: gx = 60
WHEN UP: gx = 90
ENDCASE
IF ga(i) = 0 AND ghostflash = 0 THEN gx = 120 : gy = 0
IF ga(i) = 0 AND ghostflash <> 0 THEN gx = 150 : gy = 0
RECTANGLE gx*2+968,-50-gy,40,40 TO gx(i)*2+10,680-gy(i)*2
ENDPROC
DEF PROCdrawPacman
LOCAL pacx
frame = (frame + 1) MOD 3
pacx = frame * 60 + 6
CASE dir OF
WHEN 4: pacx += 120
WHEN 3: pacx += 240
WHEN 2: pacx += 360
ENDCASE
IF frame = 2 pacx = 486
RECTANGLE pacx+960,10,36,36 TO cx*2+8,680-cy*2
ENDPROC
DEF PROCload
IF level > 8 THEN level = 8
ga() = 1
gx() = 240,240,180,270
gy() = 120,150,150,150
gd() = 1,2,3,1
IF level < 6 THEN pacspeed = 5 : ghostspeed = 5 : slowghost = 1
IF level > 5 THEN pacspeed = 15 : ghostspeed = 15 : slowghost = 5
*DISPLAY pacmaze 960,-238
blue = TINT(962,728)
yellow = TINT(990,700)
pink = TINT(990,640)
RECTANGLE 1320,-56,56,56 TO 900,8
IF level > 1 RECTANGLE 1380,-56,56,56 TO 840,8
IF level > 2 RECTANGLE 1440,-56,56,56 TO 780,8
IF level > 3 RECTANGLE 1200,-116,56,56 TO 720,8
IF level > 4 RECTANGLE 1260,-116,56,56 TO 660,8
IF level > 5 RECTANGLE 1320,-116,56,56 TO 600,8
IF level > 6 RECTANGLE 1380,-116,56,56 TO 540,8
IF level > 7 RECTANGLE 1440,-116,56,56 TO 480,8
start = TIME
ENDPROC
DEF PROCchomp
SOUND 1,-10,124,2
score += 10
dotcount += 1
PROCprintScore
ENDPROC
DEF PROCpill
ENVELOPE 1,1,1,-1,0,20,20,0,8,0,0,-6,126,0
SOUND 1,1,20,40
ghostcount = 0
ga() = 0
ghostblue = TIME
ghostflash = 0
score += 50
dotcount += 1
PROCprintScore
ENDPROC
DEF PROCprintScore
MOVE 40,780 : GCOL 1 : CLS : PRINT "SCORE: "; score
WHILE score >= (bonus+1) * 10000 AND (lives <= 6)
lives += 1 : bonus += 1
ENDWHILE
PROCdrawlives
ENDPROC
DEF PROCwin
LOCAL p
fruit = 0
level += 1
dotcount = 0
frame = 0
dir = LEFT
cx = 210
cy = 240
ENVELOPE 1,1,0,0,0,0,0,0,100,-4,0,-2,126,0
SOUND 2,0,0,6
FOR p = 24 TO 42
SOUND (p MOD 2) + 1,1,p*4,12
SOUND 3,1,216,6
NEXT
REPEAT WAIT 1 : UNTIL ADVAL(-6)=16
PROCload
PROCprintScore
ENDPROC
DEF PROCdie
LOCAL p
lives -= 1
IF lives = 0 THEN done = 1
PROCdrawlives
ga() = 1
gx() = 240,240,180,270
gy() = 120,150,150,150
gd() = LEFT,UP,RIGHT,LEFT
ghostflash = 0
ghostblue = 0
fruit = 0
frame = 0
dir = 1
RECTANGLE 1506,10,36,36 TO cx*2+8,680-cy*2
cx = 210
cy = 240
ENVELOPE 1,1,0,0,0,0,0,0,100,-4,0,-100,126,0
SOUND 2,0,0,12
SOUND 3,0,0,6
FOR p = 51 TO 24 STEP -1
SOUND (p MOD 3) + 1,1,p*4,18
NEXT
REPEAT WAIT 1 : UNTIL ADVAL(-6)=16
ENDPROC
DEF PROCgameover
*FONT Arial,80
GCOL 15 : MOVE 0,600 : PRINT " GAME"'" OVER";
REPEAT WAIT 1 : UNTIL FALSE
|
|
 Logged
|
|
|
|
David Williams
Developer
member is offline
meh
Gender: 
Posts: 452
|
|
Re: Pac-Man
« Reply #1 on: Aug 13th, 2014, 9:05pm » |
|
It works at this end, and I'm pleased to say that the flickering didn't induce an epileptic seizure with me.
Nice use of native graphics commands.
David.
--
|
|
Logged
|
|
|
|
Richey
New Member
member is offline
Gender:
Posts: 35
|
|
Re: Pac-Man
« Reply #2 on: Aug 13th, 2014, 10:26pm » |
|
Quote:
Thanks Richard...very useful to be able to review and modify the source code in order to aid learning. One dumb question first though - I have the pacmaze.bmp but how do I get it to link to the program?
|
|
Logged
|
|
|
|
rtr
Guest
|
|
Re: Pac-Man
« Reply #3 on: Aug 14th, 2014, 08:30am » |
|
on Aug 13th, 2014, 9:05pm, David Williams wrote:| It works at this end, and I'm pleased to say that the flickering didn't induce an epileptic seizure with me. |
|
There's no flickering on the (two) machines I've tried it on, but in the absence of *REFRESH (which I had originally, but removed as it seemed to be unnecessary) it relies on a prompt response to the internal InvalidateRect calls. Windows gives no guarantees about that, and it depends very much on what else is going on.
Richard.
|
|
Logged
|
|
|
|
rtr
Guest
|
|
Re: Pac-Man
« Reply #4 on: Aug 14th, 2014, 08:39am » |
|
on Aug 13th, 2014, 10:26pm, Richey wrote:| I have the pacmaze.bmp but how do I get it to link to the program? |
|
Save it to the same folder as the program. That will usually work, but it does depend on the 'current directory' being the same as the 'program directory'. In the unlikely event of that not being the case (for example if you compile the program and run it from a shortcut) change the *DISPLAY line to:
Code: OSCLI "DISPLAY """ + @dir$ + "pacmaze"" 960,-238"
Richard.
|
|
Logged
|
|
|
|
rtr
Guest
|
|
Re: Pac-Man
« Reply #5 on: Aug 14th, 2014, 11:33am » |
|
on Aug 14th, 2014, 08:30am, Richard Russell wrote:| *REFRESH (which I had originally, but removed as it seemed to be unnecessary) |
|
If you find that flickering is an issue you should be able to eliminate it by restoring the *REFRESH:
Code: REPEAT
WAIT 10
CASE INKEY(0) OF
WHEN 136: newdir = 1 : try = TRUE
WHEN 139: newdir = 2 : try = TRUE
WHEN 137: newdir = 3 : try = TRUE
WHEN 138: newdir = 4 : try = TRUE
ENDCASE
PROCdot
PROCmovePacman
*REFRESH OFF
PROCbackground
PROCghost(0)
PROCghost(1)
PROCghost(2)
PROCghost(3)
PROCdrawPacman
*REFRESH ON
*REFRESH
PROCdetectGhost
IF dotcount = 254 THEN dotcount = 0 : PROCwin
IF dead = 1 THEN dead = 0 : PROCdie
IF done = 1 THEN PROCgameover
UNTIL FALSE
Richard.
|
|
Logged
|
|
|
|
Richey
New Member
member is offline
Gender:
Posts: 35
|
|
Re: Pac-Man
« Reply #6 on: Aug 14th, 2014, 8:53pm » |
|
on Aug 14th, 2014, 08:39am, Richard Russell wrote:Save it to the same folder as the program. That will usually work, but it does depend on the 'current directory' being the same as the 'program directory'. In the unlikely event of that not being the case (for example if you compile the program and run it from a shortcut) change the *DISPLAY line to:
Code: OSCLI "DISPLAY """ + @dir$ + "pacmaze"" 960,-238"
Richard.
|
|
Thanks Richard - it worked saving it to the same folder - and no flicker for me
:)
|
|
Logged
|
|
|
|
|
