Few weeks ago I promised to try find and eventually convert something - B3D/Bmax, not there yet. Time issues.
But cleaning the drive tonight I found this. It uses the very same base. Without the mode7 which goes on top. I hope I find the time to make that aswell soon. I do hope so.
But this, alone, might be useful for some ppl It's the most important half of the mode7 aswell. It has added boulder mechanichs though just as fun little test. I could assist in some comments later if you need to understand the code, maybe some nice ppl will help clean it up aswell if you find it useful enough.
You need a png of some tiles before running it, I uploaded mine, look in the few top lines.
; 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
|