Boulders

; You could to get the font.png here
; 

; if you need to reconstruct font.png
; font.png is - a 800x600 png with 16 x 8 tiles (any tiles) of of size 8x8, in the upper left corner. It uses ASCII style so tile number 32 is space / air for instance.

; How to use
; Draw tiles using the mouse, and press 1, 2 or 3 to get different tiles.
; move around inside the world using cursor keys

Graphics 640,400,32,2 : SetBuffer BackBuffer() : Dim buffer(1024,600) : tiles=LoadImage("font.png") : SetBuffer ImageBuffer(tiles) : LockBuffer()
For y=0 To 599 : For x=0 To 1023 : buffer(x,y)=ReadPixelFast(x,y) : Next : Next : UnlockBuffer() : FreeImage(tiles) : SetBuffer BackBuffer()
Dim map(476,317) : For y=0 To 316 : For x=0 To 475: map(x,y)=32 : Next : Next : For temp=0 To 255 : map(temp,0)=temp : Next
Dim cmap(476,317) : For y=0 To 316 : For x=0 To 475: cmap(x,y)=7 : Next : Next : For temp=0 To 15 : cmap(temp,0)=temp : Next
Global worldx,worldy,currentx,c : c=-459528 : c=buffer(0,0) : Dim cols(16) : For temp=0 To 15 : Read cols(temp) : Next
Data $000000, $FFFFFF, $68372B, $70A4B2, $6F3D86, $588D43, $352879, $B8C76F, $6F4F25, $433900, $9A6759, $444444, $6C6C6C, $9AD284, $6C5EB5, $959595
writetomap("                                         ",0,0) : writetomap("    **** COMMODORE 64 BASIC V2 ****     ",0,1)
writetomap("                                        ",0,2) : writetomap(" 64K RAM SYSTEM  38911 BASIC BYTES FREE ",0,3)
writetomap("                                        ",0,4) : writetomap("READY.                                  ",0,5)
writetomap("                                        ",0,4)
writetomap("----------------------------------- ",0,20)
Global current=79, current2=7

; For y=0 To 316 : For x=0 To 475: map(x,y)=Rnd(127) : Next : Next 

Repeat : readinputs()

alive()

ddd=Ddd+1 : If ddd = 4 Then boulders() : ddd=0
If KeyDown(2) Then current=79 : current2=7
If KeyDown(3) Then current=17 : current2=8
If KeyDown(4) Then current=32 : current2=7
display(worldx,worldy)

; Show a moving sprite inside wthe world coordinatesystem
drawsprite 31,spritex,spritey,worldx,worldy ,0,0,16*80,16*50
; spritex = spritex + 1 : spritey = spritey + 1

Flip : Until MouseDown(2) 

Function readinputs() : mx=MouseX()*6 : my=MouseY()*6 : scrollspeed=4
worldx=worldx-scrollspeed*KeyDown(203)+scrollspeed*KeyDown(205) : worldy=worldy-scrollspeed*KeyDown(200)+scrollspeed*KeyDown(208)
If worldx<0 Then worldx=0
If worldy<0 Then worldy=0
If worldx>10000 Then worldx=10000
If worldy>10000 Then worldy=10000
mx=mx/6 : my=my/6 : xxx=(worldx+mx) Sar 4 : yyy=(worldy+my) Sar 4 :  If MouseDown(1) Then If map(xxx,yyy)<>79 And map(xxx,yyy)<>111 And map(xxx,yyy)<>112 Then map(xxx,yyy)=current:cmap(xxx,yyy)=current2
End Function

Function alive() : For temp=1 To 16: buffer(Rnd(15),Rnd(15))=c*Int(Rnd(1)):Next : currentx=(currentx+1) Mod 640
For tempy=0 To 15 : For temp=0 To 15+32 : buffer(16+temp,0+tempy)=buffer(0+temp+currentx,16+tempy) : Next : Next
For temp=1 To 16: cmap(Rnd(40),Rnd(25))=Rnd(16):Next : End Function

Function display(worldx,worldy,ofx=0,ofy=0,sx=640,sy=400)
Cls : LockBuffer() : scrx=worldx And 15 : scry=worldy And 15 : mapx=worldx Shr 4 : mapy=worldy Shr 4
cnty = 0 : For y=mapy To mapy+((sy Shr 4)+1)
cntx = 0 : For x=mapx To mapx+((sx Shr 4)+1)
tilex=map(x,y) And 15 : tiley=map(x,y) Shr 4 : colour=cols(cmap(x,y)) : xx=cntx - scrx + ofx : yy=cnty - scry + ofy
For ty=0 To 7 : For tx=0 To 7
If ((xx+tx+tx)=>ofx) And ((yy+ty+ty)=>ofy) And ((xx+tx+tx)<(ofx+sx)) And ((yy+ty+ty)<(ofy+sy))
If buffer(tilex Shl 3 + tx,tiley Shl 3 + ty) <> c Then WritePixelFast xx+tx+tx,yy+ty+ty,colour : WritePixelFast xx+tx+tx+1,yy+ty+ty,colour
EndIf
Next : Next : cntx=cntx+16 : Next : cnty=cnty+16 : Next : UnlockBuffer() : End Function

Function drawsprite(sprite,xx,yy,worldx,worldy,ofx=0,ofy=0,sx=640,sy=400)
	xx=xx-worldx : yy=yy-worldy ; xx,yy is now screen coordinates
	LockBuffer()
	tilex=sprite And 15 : tiley=sprite Shr 4 : colour=cols(1)
	For ty=0 To 7 : For tx=0 To 7
			If ((xx+tx+tx)=>ofx) And ((yy+ty+ty)=>ofy) And ((xx+tx+tx)<(ofx+sx)) And ((yy+ty+ty)<(ofy+sy))
				If buffer(tilex Shl 3 + tx,tiley Shl 3 + ty) <> c Then WritePixelFast xx+tx+tx,yy+ty+ty,buffer(tilex Shl 3 + tx,tiley Shl 3  + ty) : WritePixelFast xx+tx+tx+1,yy+ty+ty,buffer(tilex Shl 3 + tx,tiley Shl 3  + ty)
			EndIf
	Next : Next
	UnlockBuffer()
End Function

Function writetomap(t$,x,y) : For tempx=x To Len(t$)-1 : temp=Asc(Mid$(t$,1+tempx,1)) : map(tempx,y)=temp : cmap(tempx,y)=14 : Next : End Function

Function boulders()
For y=100 To 0 Step -1 : For x=0 To 100

If map(x,y)=79 ; BOULDER
     If map(x,y+1) = 32
        map(x,y) = 111
     ElseIf map(x,y+1) = 79 And map(x-1,y) = 32 And map(x-1,y+1) = 32
        map(x,y) = 32 : map(x-1,y) = 111
     ElseIf map(x,y+1) = 79 And map(x+1,y) = 32 And map(x+1,y+1) = 32
        map(x,y) = 32 : map(x+1,y) = 112 ; 111
    EndIf
EndIf

If map(x,y)=111 ; FALLINGBOULDER
     If map(x,y+1) = 32
        map(x,y)=32 : map(x,y+1) = 111
     ElseIf map(x,y+1)=79 And map(x-1,y) = 32 And map(x-1,y+1) = 32
        map(x,y) = 32 : map(x-1,y+0) = 111
     ElseIf map(x,y+1)=79 And map(x+1,y) = 32 And map(x+1,y+1) = 32
        map(x,y) = 32 : map(x+1,y+0) = 112 ; 111
     Else
        map(x,y)=79
    EndIf
EndIf

If map(x,y)=112 Then map(x,y)=111 ; added

Next : Next
End Function

Replace( Replace("_H_T_T_P_//s29\postimg\org/flls07ap3/font\png", "_H_T_T_P_", "http:"), "\",".")