Арканоид

Очень красивая, самодостаточная игра. Проще всего добавить свои уровни, а в игре их по умолчанию 5. 
Платформы: Windows , Linux.
Автор: Deleter 2007

Арканоид

#IFDEF __FB_WIN32__

Setenviron("fbgfx=gdi")
#ENDIF

Screenres 640,480,32,2


Sub flipscr()
    Static As Integer pg
    Screenset pg,1-pg
    pg=1-pg
End Sub


Const blockW=50

Const blockH=20


Dim As Integer speedMod
Do

    Input "Difficulty?(1=baby,3=avg,6=gettin dirty,7-10 hardcore)", speedMod
Loop Until (speedMod > 0 And speedMod < 11)

Do

    Sleep 5,1

Loop While Multikey(28)

Type block
    As Integer x,y
    As Integer alive
    As Integer colB,colM,colD
    As Integer pts
End Type


Setmouse 320,470,0

Dim As Integer x,y,b
Dim As Integer lives=5

Dim As Integer level=1

Dim As Integer pX
Dim As Single bX,bY,bR=4,bVx,bVy
'is ball attached to paddle
Dim As Integer attached=0

Dim As Integer pWidth=80

Dim As Double tm=Timer

Dim As Single flash=0


Dim As block grid(640/blockW,240/blockH)

Dim As Integer combo=0

Dim As Integer pts,tmppts
For tmpy As Integer = 2 To 240/blockH
    For tmpx As Integer=1 To 640/blockW-2

        With grid(tmpx,tmpy)
            .x=tmpx*blockW
            .y=tmpy*blockH
            Read .alive
            .alive*=-1

            .pts=(240/blockH-tmpy+1)*10*speedMod
            .colB= Rgb((1-tmpx/(640/blockW-1))*255,tmpy/(240/blockH)*255,(tmpx/(640/blockW-1))*255)
            .colM= Rgb((1-tmpx/(640/blockW-1))*128,tmpy/(240/blockH)*128,(tmpx/(640/blockW-1))*128)
            .colD= Rgb((1-tmpx/(640/blockW-1))*64,tmpy/(240/blockH)*64,(tmpx/(640/blockW-1))*64)
        End With

    Next

Next


Dim As Any Ptr img = Imagecreate(640,240+blockH,0)
Dim As Double fpstm=Timer+1

Dim As Integer tfps,fps

Dim As Any Ptr ballimg=ImageCreate(bR,bR,255 Shl 16)

Windowtitle "Deleter's Breakout Clone"
Do

    Screenset 1,1

    Cls

    Locate 30,37

    ? "Level ";Str(level)

    Do

        Getmouse x,y,,b

        If b > 0 Then Exit Do

        For tmp As Integer=0 To 128

            If Multikey(tmp) Then Exit Do

        Next

        Sleep 5,1

    Loop


    Do

        Getmouse x,y,,b

        If b = 0 Then
            For tmp As Integer=0 To 128

                If Multikey(tmp) Then Exit For

                If tmp=128 Then Exit Do

            Next

        End If

        Sleep 5,1

    Loop


    Do

        Locate 1,1

        ? "Score:";pts+tmppts*combo;"   "
        Locate 1,71

        ? " Lives:";lives;" "
        '? "FPS:"; fps

        Getmouse x,y,,b

        tm=(Timer-tm)
        flash-=tm
        If x > -1 Then
            If y < 300 Or y > 410 Then Setmouse x,350

            If x < pWidth/2 Then Setmouse pWidth/2,350

            If x > 640-pWidth/2 Then Setmouse 640-pWidth/2,350

            Dim As Integer opX=pX
            pX+=(x-pX)*tm*16

            If pX > x And opX < x Then pX=x
            If pX < x And opX > x Then pX=x
            'pset(x,y),255
            If pX-pWidth/2 < 0 Then pX=pWidth/2

            If pX+pWidth/2 > 640 Then pX=640-pWidth/2


        End If


        If attached<>0 Then


            'update position
            tm=tm/10

            For tmstep As Double = tm To tm*10 Step tm

                bX+=bVx*tm
                bY+=bVy*tm
                If bX < 0 Then

                    bX=0

                    bVx*=-1

                End If

                If bX+bR > 640 Then

                    bX=640-bR
                    bVx*=-1

                End If


                If bY < 0 Then

                    bY=0

                    bVy*=-1

                End If

                If bY+bR > 480 Then

                    combo=0

                    tmppts=0

                    lives-=1

                    attached=0

                    Exit For

                End If


                'check ball collision with paddle
                If bY+bR >= 460 Then

                    If bX+bR >= pX-pWidth/2 Then

                        If bX < pX+pWidth/2 Then

                            pts+=tmppts*combo
                            tmppts=0

                            combo=0

                            bVy*=-1

                            bVx+=(bX-pX)*speedMod

                            bY=460-bR
                            flash=.15

                        End If

                    End If

                End If


                'check block collision with ball
                For tmpx As Integer=0 To 640/blockW-1

                    For tmpy As Integer = 0 To 240/blockH
                        With grid(tmpx,tmpy)
                            If .alive=-1 Then


                                If bY+bR >= .y Then

                                    If bY <= .y+blockH Then

                                        If bX+bR >= .x Then

                                            If bX <= .x+blockW Then

                                                .alive=0

                                                combo+=1

                                                tmppts+=.pts*level
                                                'reflect y
                                                If bY-bVy*tm+bR < .y Then

                                                    bY=.y-bR
                                                Elseif bY-bVy*tm > .y+blockH Then

                                                    by=.y+blockH+1

                                                Else

                                                    bVy*=-1

                                                End If


                                                'reflect x
                                                If bX-bVx*tm+bR < .x Then

                                                    bX=.x-bR
                                                Elseif bX-bVx*tm > .x+blockW Then

                                                    bX=.x+blockW+1

                                                Else

                                                    bVx*=-1

                                                End If


                                                bVx*=-1

                                                bVy*=-1

                                            End If

                                        End If

                                    End If

                                End If

                            End If

                        End With

                    Next

                Next

            Next
        Else

            If (b > -1) And (b And 1) Then

                bVy=-100*(speedMod)-10*level
                attached=-1

            End If


            bX=pX-bR/2

            bY=450

            bVx=0

        End If


        tm=Timer


        Dim As Integer tmpcount
        'display grid
        For tmpx As Integer=0 To 640/blockW-1

            For tmpy As Integer = 0 To 240/blockH
                With grid(tmpx,tmpy)
                    If .alive=-1 Then

                        tmpcount+=1

                        Line (.x,.y)-(.x+blockW-1,.y+blockH-1),.colM,bf
                        Line (.x,.y)-(.x+blockW-1,.y+blockH-1),.colB,b

                        Line (.x,.y+blockH-1)-(.x+blockW-1,.y+blockH-1),.colD,bf
                        Line (.x+blockW-1,.y)-(.x+blockW-1,.y+blockH-1),.colD,bf
                    End If

                End With

            Next

        Next


        Get(1,1)-(639,239+blockH),img

        'display paddle
        If flash > 0 Then

            Line (pX-pWidth/2,460)-(pX+pWidth/2,475),128+1280/1.5*flash,bf
        Else

            Line (pX-pWidth/2,460)-(pX+pWidth/2,475),128,bf
        End If

        Line (pX-pWidth/2,460)-(pX+pWidth/2,475),255,b
        Line (pX-pWidth/2,475)-(pX+pWidth/2,475),64,b
        Line (pX+pWidth/2,460)-(pX+pWidth/2,475),64,b

        If combo > 1 Then

            Locate 40,37

            ? combo;"x combo"
            Line (36*8,39*8-1)-(36*8+8*10,39*8-1),0

        End If

        If tmpcount < 1 Then Exit Do

        If lives < 0 Then Exit Do


        'display ball
        'line (bX,bY)-(bX+bR,bY+bR),255 shl 16 , bf
        Put(Int(bX),Int(bY)),ballimg,Alpha,100

        Put(Int(bX),Int(bY+1.5)),ballimg,Alpha,100

        Put(Int(bX+1.5),Int(bY)),ballimg,Alpha,100

        Put(Int(bX+1.5),Int(bY+1.5)),ballimg,Alpha,100


        If Multikey(25) Then

            Locate 45,39

            ? "Paused"
            flipscr
            tm=Timer-tm
            fpstm=Timer-fpstm
            While Multikey(25):Sleep 5,1:Wend 'let the user let go
Do:Sleep 5,1: Loop Until Multikey(25)
While Multikey(25):Sleep 5,1:Wend 'let the user let go
tm=Timer-tm
fpstm=Timer-fpstm
Locate 45,39

? "      "
        Else

            flipscr()
        End If


        Sleep 5,1

        Cls

        Put(0,0),img,Alpha,240

        If fpstm < Timer Then

            fpstm=Timer+1

            fps=tfps
            tfps=0

            Windowtitle "Deleter's Breakout Clone - "+Str(fps)+" FPS"
            'getmouse x,y,,b
            'setmouse x,400
        End If


        tfps+=1

    Loop Until Multikey(1)
    If Multikey(1) Then Exit Do

    Screenset 1,1

    Cls

    level+=1

    If lives > -1 Then


    Else

        ? "You lose."
        Sleep

        Exit Do

    End If

    attached=0

    combo=0

    If level > 5 Then

        Select Case Int(Rnd*5)
            Case 0

                Restore lev1
            Case 1

                Restore lev2
            Case 2

                Restore lev3
            Case 3

                Restore lev4
            Case 4

                Restore lev5
        End Select

    End If


    For tmpy As Integer = 2 To 240/blockH
        For tmpx As Integer=1 To 640/blockW-2

            Read grid(tmpx,tmpy).alive
            grid(tmpx,tmpy).alive*=-1

        Next

    Next

Loop

Sleep 100,1

Screenset 1,1

Cls

? "Final points: ";Str(pts)
Sleep

Imagedestroy(img)
Imagedestroy(ballimg)
End


'level data
lev1:
Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1


lev2:
Data 0,0,0,0,1,1,1,0,0,0,0

Data 0,0,0,1,1,1,1,1,0,0,0

Data 0,0,1,1,1,1,1,1,1,0,0

Data 0,1,1,1,1,1,1,1,1,1,0

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 0,1,1,1,1,1,1,1,1,1,0

Data 0,0,1,1,1,1,1,1,1,0,0

Data 0,0,0,1,1,1,1,1,0,0,0

Data 0,0,0,0,1,1,1,0,0,0,0


lev3:
Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,0,0,0,1,1,0,0,0,1,1

Data 1,0,0,0,1,1,0,0,0,1,1

Data 1,0,1,1,1,1,0,1,0,0,1

Data 1,0,1,1,1,1,0,1,0,0,1

Data 1,0,0,0,1,1,0,0,0,1,1

Data 1,0,0,0,1,1,0,1,0,0,1

Data 1,0,1,1,1,1,0,1,0,0,1

Data 1,0,1,1,1,1,0,0,0,1,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1


lev4:
Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,1,1,1,1,0,1,1,1,1,1

Data 1,1,1,1,0,0,0,1,1,1,1

Data 1,1,1,0,0,1,0,0,1,1,1

Data 1,1,0,0,1,1,1,0,0,1,1

Data 1,0,0,1,1,1,1,1,0,0,1

Data 1,1,0,0,1,1,1,0,0,1,1

Data 1,1,1,0,0,1,0,0,1,1,1

Data 1,1,1,1,0,0,0,1,1,1,1

Data 1,1,1,1,1,0,1,1,1,1,1

Data 1,1,1,1,1,1,1,1,1,1,1


lev5:
Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,1,1,1,1,1,1,1,1,1,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,0,1,0,1,0,1,0,1,0,1

Data 1,1,1,1,1,1,1,1,1,1,1