Packman

Отличный пример знаменитой игры.
Платформы: Windows , Linux.
Автор: Anselme Dewavrin 2006 dewavrin@yahoo.com

PackMan

'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))And Abs(a.iy*m+a.dy - (pacman.iy*m+pacman.dy))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