Packman
Отличный пример знаменитой игры.
Платформы: Windows , Linux.
Автор:
Anselme Dewavrin 2006 dewavrin@yahoo.com
'Pacman simple, Anselme Dewavrin 2006 - dewavrin@yahoo.com 'Feel free to use it, provided you mention my name. 'Option Explicit Const m = 10 'magnifier Const w = 19 'labyrinth width Const h = 22 'labyrinth height Const Pi = 3.1415926, Pi2 = Pi*2, Pid2 = Pi/2 Dim Shared As Integer t(-1 To w, -1 To h) 'terrain : 0 = gum, 1 = wall, 2 = clear Dim Shared As Integer uncaught, pacgumcountdown, readycountdown Type actor direc As Integer Move As Integer ix As Integer 'position in the terrain iy As Integer dx As Integer 'fine position 0..m-1 dy As Integer block As Integer waits As Integer slow As Integer col As Integer Angle As Single chomp As Single Animate As Single End Type 'start positions Dim Shared pacman As actor, sue As actor, clyde As actor, inky As actor 'place actor Sub Start(a As actor, ix As Integer, iy As Integer, slow As Integer, col As Integer) a.ix = ix : a.iy = iy : a.dx = 0 : a.dy = 0 : a.move = 0 : a.direc = 0 : a.block = 0 : a.waits = 0: a.slow = slow : a.col = col End Sub Sub DrawGhost(a As actor) Dim As Integer col = a.col If pacgumcountdown > 100 Or (pacgumcountdown>0 And a.waits = 0) Then col = &hFF00FF Circle(a.ix*m + m/2 + a.dx, a.iy*m + m/2 + a.dy), m/2-1, col , , , ,F Line (a.ix*m + a.dx, a.iy*m + m/2 + a.dy)-(a.ix*m + a.dx +m -1, a.iy*m + m-2 + a.dy), col , BF Pset (a.ix*m + a.dx, a.iy*m + a.dy + m -1), col Pset (a.ix*m + a.dx +m -1, a.iy*m + a.dy + m -1), col End Sub Sub Move(a As actor) 'when on a crossroad, tries to follow player's wish or ghosts' hunting strategy If (a.direc = 0 And a.dy = 0 And (a.dx <> 0 Or t(a.ix-1, a.iy) <> 1)) Or _ (a.direc = 1 And a.dy = 0 And (a.dx <> 0 Or t(a.ix+1, a.iy) <> 1)) Or _ (a.direc = 2 And a.dx = 0 And (a.dy <> 0 Or t(a.ix, a.iy-1) <> 1)) Or _ (a.direc = 3 And a.dx = 0 And (a.dy <> 0 Or t(a.ix, a.iy+1) <> 1)) Then a.move = a.direc 'continue until wall a.block = 1 If a.move = 0 And (a.dx <> 0 Or t(a.ix-1, a.iy) <> 1) Then a.block = 0 : a.dx -= 1 : If a.dx = -1 Then a.dx = m - 1 : a.ix -= 1 If a.move = 1 And (a.dx <> 0 Or t(a.ix+1, a.iy) <> 1) Then a.block = 0 : a.dx += 1 : If a.dx = m Then a.dx = 0 : a.ix += 1 If a.move = 2 And (a.dy <> 0 Or t(a.ix, a.iy-1) <> 1) Then a.block = 0 : a.dy -= 1 : If a.dy = -1 Then a.dy = m - 1 : a.iy -= 1 If a.move = 3 And (a.dy <> 0 Or t(a.ix, a.iy+1) <> 1) Then a.block = 0 : a.dy += 1 : If a.dy = m Then a.dy = 0 : a.iy += 1 End Sub 'ghosts must determine best direction to catch pacman Sub Hunt(a As actor) If (a.block=0 And Abs(a.ix - pacman.ix) >= Abs(a.iy - pacman.iy)) Or (a.block=1 And Abs(a.ix - pacman.ix) <= Abs(a.iy - pacman.iy)) Then If a.ix > pacman.ix Xor pacgumcountdown <> 0 Then a.direc = 0 Else a.direc = 1 Else If a.iy > pacman.iy Xor pacgumcountdown <> 0 Then a.direc = 2 Else a.direc = 3 Endif 'caught pacman ? If Abs(a.ix*m+a.dx - (pacman.ix*m+pacman.dx)) < m/2 And Abs(a.iy*m+a.dy - (pacman.iy*m+pacman.dy)) < m/2 Then If pacgumcountdown = 0 Then uncaught = 0 Else a.dx = 0 : a.dy = 0 : a.ix = 9 : a.iy = 10 Endif 'move actor a.waits = a.waits Xor 1 : If a.slow = 0 Or a.waits = 0 Then Move a End Sub 'START !!! Screenres 320,240,24,2 Dim As Integer gums = 0, score = 0, slow, lives = 3 'gums 'count gums Dim As Integer i,j,s For j = 0 To h-1 : For i = 0 To w-1 : Read t(i,j) : gums = gums - (t(i,j) = 0) : Next i : Next j For j = 0 To h-1 For i = 0 To w-1 If t(i,j) = 1 Then Line (i*m, j*m)-(i*m+m-1, j*m+m-1), 60, bf If i=0 Or t(i-1,j)<>1 Then Line (i*m, j*m)-(i*m, j*m+m-1), 255, b If i=w-1 Or t(i+1,j)<>1 Then Line (i*m+m-1, j*m)-(i*m+m-1, j*m+m-1), 255, b If j=0 Or t(i,j-1)<>1 Then Line (i*m, j*m)-(i*m+m-1, j*m), 255, b If j=h-1 Or t(i,j+1)<>1 Then Line (i*m, j*m+m-1)-(i*m+m-1, j*m+m-1), 255, b Endif Next i Next j Do '3 lives loop Start(pacman, 10, 16, 0, &hFFFF00) 'position, slow, color Start(sue, 9, 10, 0, &hFFA0A0) Start(clyde, 10, 12, 1, &hFF0000) Start(inky, 9, 10, 1, &h00FFFF) uncaught = 1 : pacgumcountdown = 0 : readycountdown = 150 Do 'draw terrain Screensync For j = 0 To h-1 For i = 0 To w-1 If t(i,j) <> 1 Then Line (i*m, j*m)-(i*m+m-1, j*m+m-1), 0, bf If t(i,j) = 0 Then Circle(i*m + m/2, j*m + m/2), 1, &hFFFFFF , , , 'draw gum If t(i,j) = 3 Then Circle(i*m + m/2, j*m + m/2), 3, &hFFFFFF , , , 'draw pacgum Next i Next j If readycountdown > 0 Then readycountdown -= 1 Locate 16,11 : Print "READY" Else 'player moves If Multikey(&h4B) Then pacman.direc = 0 'left pacman.angle = -pi End If If Multikey(&h4D) Then pacman.direc = 1 'right pacman.angle = 0 End If If Multikey(&h48) Then pacman.direc = 2 'up pacman.angle = -pi2-pid2 End If If Multikey(&h50) Then pacman.direc = 3 'down pacman.angle = -pi2+pid2 End If Move pacman 'follow hero Hunt sue Hunt clyde Hunt inky 'eat gum/pacgum ? If pacman.dx = 0 And pacman.dy = 0 Then If t(pacman.ix,pacman.iy) = 0 Then t(pacman.ix,pacman.iy) = 2 : score = score + 1 If t(pacman.ix,pacman.iy) = 3 Then t(pacman.ix,pacman.iy) = 2 : pacgumcountdown = 500 Endif If pacgumcountdown <> 0 Then pacgumcountdown -= 1 'print info Locate 1,1 :Print "1UP SCORE " ;score Line (0, 230)-(2*m-1, 230+m-1), 0, b For i = 1 To lives-1 : Circle ((i-1)*m + m/2, 230 - m/2), m/2-1, pacman.col , , , ,F : Next i 'lives 'tunnel ? If pacman.ix = -1 Then pacman.ix = w-1 If pacman.ix = w Then pacman.ix = 0 Endif pacman.animate+=.75 If Pacman.animate>Pi2 Then pacman.animate = 0 pacman.chomp=.45+.45*Sin(pacman.animate) Dim As Single cStart = pacman.angle-pacman.chomp Dim As Single cEnd = pacman.angle+pacman.chomp If cEnd>0 Then cEnd-=Pi2 'draw actors Circle(pacman.ix*m + m/2 + pacman.dx, pacman.iy*m + m/2 + pacman.dy), m/2-1, &hFFFF00, cStart, cEnd Paint( (pacman.ix*m + m/2 + pacman.dx) - 2 * Cos(pacman.angle), (pacman.iy*m + m/2 + pacman.dy) - 2 * Sin(pacman.angle) ),&hFFFF00, &hFFFF00 DrawGhost(sue) DrawGhost(clyde) DrawGhost(inky) Loop While Not Multikey(&h01) And gums <> score And uncaught While InKey$ <> "": Wend If gums = score Then Locate 16,10 : Print "YEAH !":Sleep : End Else If uncaught = 1 Then End 'must be esc key then lives -= 1 : If lives = 0 Then Locate 11,9 : Print "GAME OVER":Sleep : End Sleep Endif Loop While 1 Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 Data 1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1 Data 1,0,1,1,0,1,1,1,0,1,0,1,1,1,0,1,1,0,1 Data 1,3,1,1,0,1,1,1,0,1,0,1,1,1,0,1,1,3,1 Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,1,1,0,1 Data 1,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,1 Data 1,1,1,1,0,1,1,1,2,1,2,1,1,1,0,1,1,1,1 Data 1,1,1,1,0,1,2,2,2,2,2,2,2,1,0,1,1,1,1 Data 1,1,1,1,0,1,2,1,1,2,1,1,2,1,0,1,1,1,1 Data 2,2,2,2,0,2,2,1,2,2,2,1,2,2,0,2,2,2,2 Data 1,1,1,1,0,1,2,1,1,1,1,1,2,1,0,1,1,1,1 Data 1,1,1,1,0,1,2,2,2,2,2,2,2,1,0,1,1,1,1 Data 1,1,1,1,0,1,2,1,1,1,1,1,2,1,0,1,1,1,1 Data 1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1 Data 1,0,1,1,0,1,1,1,0,1,0,1,1,1,0,1,1,0,1 Data 1,3,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,3,1 Data 1,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1 Data 1,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,1 Data 1,0,1,1,1,1,1,1,0,1,0,1,1,1,1,1,1,0,1 Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
