Here is my attempt: A not 100% perfect clone of the famous C64 game "Boulder Dash"!
Maybe one or another in this forum was addicted to this game like me, back in the old days
This imagefile file is needed. Please save the code and the image to the same directory.
http://picload.org/image/lwggdpp/b.png
Code: Select all
;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name : BoulderDash-Clone
;* Author : Mr.L
;* Date : 20/07/14
;* Notes : My not 100% perfect remake of the famous C64 game :-)
;* Use Arrow-Keys to move, Escape-Key = restart Map
;*
;*******************************************************************************
UsePNGImageDecoder():#w=40:#h=22:Structure bm:b.i[8]:c.l:n.l:m.l:d.l;##########
EndStructure:LoadImage(0,"b.png"):NewList p.bm():OpenWindow(0,0,0,800,600,"BD")
CanvasGadget(0,0,0,800,600,#PB_Canvas_Keyboard):SetActiveGadget(0);############
AddWindowTimer(0,0,100):AddWindowTimer(0,1,50):AddWindowTimer(0,2,1000);#######
Dim b.bm(30):Macro F:EndIf:EndMacro:Macro H:Case:EndMacro:Macro G();###########
Dim w(#w,#h):ky=0:xs=0:xr=0:pl=3:ClearList(P()):StartDrawing(ImageOutput(0));##
u=lv*40:di=Point(u,406):ti=Point(u+1,406):dp=Point(u+2,406):ep=Point(u+3,406);#
For v=0 To #h-1:For u=0 To #w-1:w(u,v)=Point(u+lv*40,v+384):Select w(u,v):H 2;#
x=u:y=v:w(u,v)=18:H 99:hx=u:hy=v:w(u,v)=14:EndSelect:Next:Next:StopDrawing();##
EndMacro:Macro M(k,u,v,s):If ky=k:w=w(u,v):If w<2:w(x,y)=0:w(u,v)=s:x=u:y=v;###
ElseIf w=18:lv=(lv+1)%6:sc+ti:ti=0:de=50:w(x,y)=0:x=u:y=v:ElseIf w=7:di-1:sc+dp
If di=0:w(hx,hy)=18:bg=$FFFFFF:F:w(x,y)=0:w(u,v)=s:x=u:y=v:ElseIf w=5 And;#####
w(x+(x-u)*2,v)=0 And Random(3)=0:w(x,y)=0:w(u,v)=s:w(x+(x-u)*2,v)=5:x=u:y=v:F:F
EndMacro:Macro E(i,x,y):AddElement(p()):p()\m=x:p()\n=y:p()\d=i:p()\c=4;#######
EndMacro:Macro N(i,x,y):If c=i:If w(u+y*d,v-x*d)=0:j+y*d:k-x*d:p=1;############
ElseIf w(u+x,v+y)=0:j+x:k+y:F:F:EndMacro:Macro S(x,y):Select Abs(w(u+x,v+y));##
H 0,1:If xg And Random(120)=0:w(u+x,v+y)=15:xg=0:F:xt=0:H 9 To 12:E(0,u+x,v+y);
EndSelect:EndMacro:Macro L:Next:EndMacro:Macro I(x,y,c=8):For u=x To x+c-1;####
b(i)\b[u-x]=GrabImage(0,#PB_Any,u*32,y*32,32,32):L:b(i)\n=c:i+1:EndMacro;######
I(0,6,1):I(1,7,1):I(0,1):I(0,4):I(0,5):I(0,7,1):I(0,7,1):I(0,10):I(0,10):I(0,9)
I(0,9):I(0,9):I(0,9):I(3,6,1):I(1,6,1):I(0,8):I(1,0,3):I(4,6,4):I(4,0,4):lv=0;#
G():de=20:fi=LoadFont(0,"Verdana",16,#PB_Font_Bold):Repeat;####################
Select WaitWindowEvent():H #PB_Event_CloseWindow:End:H #PB_Event_Gadget;#######
If EventType()=#PB_EventType_KeyDown:ky=GetGadgetAttribute(0,#PB_Canvas_Key):F;
If EventType()=#PB_EventType_KeyUp:ky=0:If de<1:w(x,y)=2:F:F;##################
If ky=#PB_Shortcut_Escape:G():de=10:F:H #PB_Event_Timer:Select EventMenu():H 0;
If de<1:M(#PB_Shortcut_Up,x,y-1,3):M(#PB_Shortcut_Down,x,y+1,4);###############
M(#PB_Shortcut_Left,x-1,y,3):M(#PB_Shortcut_Right,x+1,y,4):F:xt=1:xg=1;########
For v=0 To #h-1:For u=0 To #w-1:c=w(u,v):j=u:k=v:d=Abs(w(u,v+1)):Select c:H 5,7
If d=0:c+1:ElseIf d=13 Or(d>4 And d<9):If w(u-1,v)=0 And w(u-1,v+1)=0:c+1;#####
ElseIf w(u+1,v)=0 And w(u+1,v+1)=0:c+1:F:F:H 6,8:Select d:H 2,3,4:E(0,x,y);####
H 9 To 12:E(7,u,v):H 17:If w(u,v+2)=0:k+2:If c=6:c=8:Else:c=6:F:F:EndSelect;###
If d=0:k+1:ElseIf d=13 Or(d>4 And d<9):If w(u-1,v)=0 And w(u-1,v+1)=0:j-1;#####
ElseIf w(u+1,v)=0 And w(u+1,v+1)=0:j+1:F:F:If j=u And k=v:c-1:F:H 9 To 12:d=1;#
N(9,1,0):N(10,0,1):N(11,-1,0):N(12,0,-1):If p:p=0:c-d:ElseIf(j=u And k=v);#####
c+d:F:If c=8:c=12:ElseIf c=13:c=9:F:For b=-1 To 1:For a=-1 To 1:If (a*b)=0;####
Select Abs(w(u+a,v+b)):H 2,3,4:E(0,u,v):EndSelect:F:L:L:H 15:If xs:c=7;########
ElseIf xr:c=5:Else:S(-1,0):S(1,0):S(0,-1):S(0,1):F:EndSelect:w(u,v)=0;#########
w(j,k)=-c:L:L:xs=xt:ForEach p():c=p()\c-1:d=p()\d:If c>0:d=16:F;###############
For v=p()\n-1 To p()\n+1:For u=p()\m-1 To p()\m+1:Select Abs(w(u,v)):H 2,3,4;##
de=30:E(0,u,v):H 9 To 12:E(0,u,v):H 15:xr=1:EndSelect:If Abs(w(u,v))<>14;######
w(u,v)=d:F:L:L:p()\c=c:If c<=0:DeleteElement(p()):F:L:If de:de-1:If de=20:G();#
ElseIf de=0:w(x,y)=2:F:F:H 1:c=((x*32+sx)-400):If Abs(c)>250:sx-c/20:F;########
c=((y*32+sy)-300):If Abs(c)>150:sy-c/15:F:c=((x*32)-400):For i=0 To 18;########
b(i)\c=(b(i)\c+1)%(b(i)\n):L:StartDrawing(CanvasOutput(0)):DrawingFont(fi);####
Box(0,0,800,600,0):For v=0 To #h-1:For u=0 To #w-1:b=Abs(w(u,v)):If b:w(u,v)=b;
DrawImage(ImageID(b(b)\b[b(b)\c]),u*32+sx,v*32+sy,32,32):Else;#################
Box(u*32+sx,v*32+sy,32,32,bg):F:L:L:bg=0;######################################
DrawText(0,0," D:"+Str(di)+Space(40)+Str(ti)+Space(40)+RSet(Str(sc),6,"0"));#
StopDrawing():H 2:If de<1:ti-1:If ti=0:E(0,x,y):F:F:EndSelect:EndSelect:ForEver
)
