BBC BASIC for Windows
Programming >> Graphics and Games >> Pac-Man
http://bb4w.conforums.com/index.cgi?board=graphics&action=display&num=1407921918
Pac-Man
Post by rtr 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
Richard
Re: Pac-Man
Post by David Williams 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.
--
Re: Pac-Man
Post by Richey on Aug 13th, 2014, 10:26pm

Quote:
The program needs the pacmaze.bmp file that you can get from here:

http://alycesrestaurant.com/zips/pacman2.zip


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?
Re: Pac-Man
Post by rtr 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.
Re: Pac-Man
Post by rtr 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.
Re: Pac-Man
Post by rtr 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.
Re: Pac-Man
Post by Richey 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
:)