Арканоид
Очень красивая, самодостаточная игра. Проще всего добавить свои уровни, а в
игре их по умолчанию 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
