12-28-2024, 06:55 PM
(This post was last modified: 12-28-2024, 06:55 PM by James D Jarvis.)
I was messing about with different ways to encode graphics inside the source code so it could be manually edited by the programmer or the program itself and still be comprehensible. I adapted an older ascii game I programmed to make use of graphics and here you go: Grave DAYZ Blockgraphics V0.2
There are undoubtedly ways to speed up rendering using putimage after the graphics are read and drawn the first time but on a modern machine this code is speedy enough as is.
There are undoubtedly ways to speed up rendering using putimage after the graphics are read and drawn the first time but on a modern machine this code is speedy enough as is.
Code: (Select All)
'Grave DAYZ BlockGrpahics v0.2
' by James D. Jarvis
'Dec 2024
'uses graphics from or modified from those at : kenney.nl
'
'use WASD to navigate. Grab the key to unlock the door and the shovel to dig holes and bash the undead
' press H to dig a hole (and direction to dig that hole)
'
'I was experimenting with different ways to encode graphics and decided to adapt an ascii game I made a while back
_Title ("GRAVE DAYZ BlockGraphics V0.2")
Screen _NewImage(800, 520, 256)
_PrintMode _KeepBackground
Randomize Timer
Dim Shared sp$(1 To 20)
Dim Shared gmap(1 To 20, 1 To 15) 'ground map
Dim Shared mmap(1 To 20, 1 To 15) 'mobile map
Dim Shared level
Dim Shared shovelflag, keyflag, lockflag$
Dim Shared tspot, pop
Dim Shared dgo(4, 2)
Dim Shared hurt$(6)
Type gspot_type
x As Integer 'x coordiante
y As Integer 'y coordinate
s As Integer 'state
End Type
Type player_type
x As Integer
y As Integer
sta As Integer
score As Long
End Type
Type monster_type
x As Integer
y As Integer
s As Integer
look As Integer
End Type
Dim Shared gspot(8) As gspot_type
Dim Shared player As player_type
Dim Shared mon(100) As monster_type
Dim Shared KK$
For n = 1 To 20
Read sp$(n)
' Sblock 2, n * 4, 4, 4, sp$(n)
Next
For m = 1 To 100
mon(m).x = 1
mon(m).y = 1
mon(m).s = 0
mon(m).look = 0
Next m
dgo(1, 1) = 0: dgo(1, 2) = -1
dgo(2, 1) = 1: dgo(2, 2) = 0
dgo(3, 1) = 0: dgo(3, 2) = 1
dgo(4, 1) = -1: dgo(4, 2) = 0
hurt$(1) = "Ow!": hurt$(2) = "Ouch!": hurt$(3) = "Hey!": hurt$(4) = "Argh!": hurt$(5) = "Eeek!": hurt$(6) = "No!"
startgame:
level = 1
player.score = 0
player.sta = 1000
shovelflag = 0
keyflag = 0
Do
Cls
buildgraveyard
lockflag$ = "Locked"
Do
Cls
drawground
drawmobiles
Locate 1, 83: Print "LEVEL "; level
Locate 2, 83: Print "SCORE"
Locate 3, 83: Print player.score
If keyflag > 1 Then Sblock 8, 83, 4, 4, sp$(17)
If lockflag$ = "UNLOCKED" Then Sblock 8, 89, 4, 4, sp$(6)
If shovelflag > 1 Then
Sblock 11, 83, 4, 4, sp$(19)
Locate 12, 87: Print shovelflag
End If
If gmap(player.x, player.y) = 20 Then
player.sta = player.sta - 50
Color 14
msg player.x, player.y - 1, "Oof!"
End If
If player.x > 1 And player.x < 20 And player.y > 1 And player.y < 15 Then
If mmap(player.x, player.y - 1) > 0 Then
player.sta = player.sta - (1 + Rnd * mmap(player.x, player.y - 1))
Color 12
msg player.x, player.y - Rnd * 2 + Rnd * 2, hurt$(Int(1 + Rnd * 6))
End If
If mmap(player.x, player.y + 1) > 0 Then
player.sta = player.sta - (1 + Rnd * mmap(player.x, player.y + 1))
Color 12
msg player.x, player.y - Rnd * 2 + Rnd * 2, hurt$(Int(1 + Rnd * 6))
End If
If mmap(player.x + 1, player.y) > 0 Then
player.sta = player.sta - (1 + Rnd * mmap(player.x + 1, player.y))
Color 12
msg player.x - Rnd * 2 + Rnd * 2, player.y, hurt$(Int(1 + Rnd * 6))
End If
If mmap(player.x - 1, player.y) > 0 Then
player.sta = player.sta - (1 + Rnd * mmap(player.x - 1, player.y))
Color 12
msg player.x - Rnd * 2 + Rnd * 2, player.y, hurt$(Int(1 + Rnd * 6))
End If
Color 15
End If
Locate 5, 83: Print "STAMINA"
Locate 6, 83: Print player.sta
_Display
If player.x = gspot(tspot).x And player.y = gspot(tspot).y Then
KK$ = "NEXTLEVEL"
Else
Sleep
KK$ = InKey$
End If
If player.sta < 1 Then KK$ = "GAMEOVER"
nx = player.x: ny = player.y
Select Case KK$
Case "W", "w"
ny = player.y - 1
wf = dowalk(nx, ny)
Case "S", "s"
ny = player.y + 1
wf = dowalk(nx, ny)
Case "D", "d"
nx = player.x + 1
wf = dowalk(nx, ny)
Case "A", "a"
nx = player.x - 1
wf = dowalk(nx, ny)
Case Chr$(32)
Case "H", "h"
_KeyClear
If shovelflag > 0 Then
Do
Sleep
tk$ = InKey$
Loop Until InStr("WwAaSsDd", tk$) > 0
player.sta = player.sta - 3
Select Case tk$
Case "W", "w"
If gmap(player.x, player.y - 1) = 0 Or gmap(player.x, player.y - 1) = 16 Then gmap(player.x, player.y - 1) = 20
Case "A", "a"
If gmap(player.x - 1, player.y) = 0 Or gmap(player.x - 1, player.y) = 16 Then gmap(player.x - 1, player.y) = 20
Case "S", "s"
If gmap(player.x, player.y + 1) = 0 Or gmap(player.x, player.y + 1) = 16 Then gmap(player.x, player.y + 1) = 20
Case "D", "d"
If gmap(player.x + 1, player.y) = 0 Or gmap(player.x + 1, player.y) = 16 Then gmap(player.x + 1, player.y) = 20
End Select
_KeyClear
shovelflag = shovelflag - 1
drawground
End If
Case Chr$(27)
KK$ = "GAMEOVER"
End Select
_KeyClear
If wf = 1 Then player.sta = player.sta - 1
wf = 0
movemonsters
Loop Until KK$ = "NEXTLEVEL" Or KK$ = "GAMEOVER"
level = level + 1
player.sta = player.sta + 333: If player.sta > 1000 Then player.sta = 1000
keyflag = 0
Loop Until KK$ = "GAMEOVER"
_AutoDisplay
Cls
_KeyClear
Print
Print "G A M E O V E R"
Print
Print "Reached Level : "; level
Print
Print "Final Score :"; player.score
Print
Print "Press P to play again or Q to quit"
Do
Sleep
ask$ = UCase$(InKey$)
Loop Until ask$ = "P" Or ask$ = "Q"
If ask$ = "P" Then GoTo startgame
System
'monochrome block sprites
'peggy sue 1
Data 080E00000000008CC400072CC1B0006ED90000833400067DEB9000CCCC0000200100
'rock wall1 2
Data 08074CC484402332111169FFFF6908848CC82222133169FFFF694CC4844023321111
'rockwall2 3
Data 08074C0CC0402303301145516FF94C0CC0C8230330316FF92AA8440CC0C801033031
'rockwall3 4
Data 08074C888CC86F9A8CC844C48FF9223214086F6F9119442313114569FF6901213321
'closed tomb 5
Data 080F000CC0004C6699C8231B7231231332310F6FF9F00F6FB9F0036FD93023233131
'open tomb 6
Data 080F000CC0004C6699C8231B7231231332310F6339F00F6009F00360093023200131
'skeleton 7
Data 080F000CC0000067B900002B7100008334000A37B3500967B96000700B0000300300
'zombie 8
Data 080B000CC0000F6FF9F0066ED990068B7490007FFB00006FF9000060090000200100
'ghoul- 9
Data 080D000CC000276FF9B1076ED9B006896490007FFB000063390000E00D0002300310
'skullbat 10
Data 080D000480000467B9804FFEDFF8639DE63900000000000000000000000000000000
'grave1- 11
Data 08070000000004B33780066B79900660099006696990066FF990426FF91800000000
'grave2 12
Data 0807000000000A7BB7800959959009999F900B3BB3900FFFFF904333335000000000
'grave 3 13
Data 08070000000000008000000CD8000000900000009000004775000055551000000000
'fencegate 14
Data 0808008408006DDECDE969840869699B3969489D4948699739692333333121120121
'fence 15
Data 0808040840804ECDECD8040840800609609006096090060960902333333102012010
'bones 16
Data 080F0080000004300000290CC800002F3F0000C7CF4000FF35A10004A10000001000
'key 17
Data 080E0000000000C000000E09000060FFFFF907090CC0003001200000000000000000
'lock 18
Data 080E0CCCCCC064CCCC8966FB7F9966F00F9966F96F9966FDEF996233331903333330
' shovel 19
Data 080C00000CC00000EFF90002F5F900008FB0000A02000AA0000028A0000002000000
'Hole 20
Data 0804000000000000000000000000000000000A33335009500A6005ECCDA000000000
Sub buildgraveyard
'builds a level for the game
Dim place(8) As gspot_type
Dim postx(4), posty(4), postv(4)
gspot(1).x = 3: gspot(1).y = 1: gspot(1).s = 0
gspot(2).x = 18: gspot(2).y = 1: gspot(2).s = 0
gspot(3).x = 20: gspot(3).y = 3: gspot(3).s = 0
gspot(4).x = 20: gspot(4).y = 13: gspot(4).s = 0
gspot(5).x = 18: gspot(5).y = 15: gspot(5).s = 0
gspot(6).x = 3: gspot(6).y = 15: gspot(6).s = 0
gspot(7).x = 1: gspot(7).y = 13: gspot(8).s = 0
gspot(8).x = 1: gspot(8).y = 3: gspot(8).s = 0
place(1).x = 3: place(1).y = 2: place(1).s = 0
place(2).x = 18: place(2).y = 2: place(2).s = 0
place(3).x = 19: place(3).y = 3: place(3).s = 0
place(4).x = 19: place(4).y = 13: place(4).s = 0
place(5).x = 18: place(5).y = 14: place(5).s = 0
place(6).x = 3: place(6).y = 14: place(6).s = 0
place(7).x = 2: place(7).y = 13: place(8).s = 0
place(8).x = 2: place(8).y = 3: place(8).s = 0
postx(1) = 5: posty(1) = 5
postx(2) = 15: posty(2) = 5
postx(3) = 15: posty(3) = 10
postx(4) = 5: posty(4) = 10
For p = 1 To 4 'place posts for fences
postv(p) = Int(1 + Rnd * 6)
If postv(p) > 3 Then postv(p) = 0
Next p
For x = 1 To 20: For y = 1 To 15: gmap(x, y) = 0: mmap(x, y) = 0: Next: Next
tspot = Int(1 + Rnd * 8)
gspot(tspot).s = 5
Do
lockspot = Int(1 + Rnd * 8)
Loop Until lockspot <> tspot
gspot(lockspot).s = 18
Do
keyspot = Int(1 + Rnd * 8)
Loop Until lockspot <> keyspot
place(keyspot).s = 17
Do
shovelspot = Int(1 + Rnd * 8)
Loop Until shovelspot <> keyspot
place(shovelspot).s = 19
Do
playerspot = Int(1 + Rnd * 8)
Loop Until (playerspot <> keyspot) And (playerspot <> shovelspot)
place(playerspot).s = 1
player.x = place(playerspot).x
player.y = place(playerspot).y
mmap(player.x, player.y) = 1
gmap(1, 1) = 4: gmap(20, 1) = 4
gmap(1, 15) = 4: gmap(20, 15) = 4
For x = 2 To 19: gmap(x, 1) = 3:: gmap(x, 15) = 3: Next
For y = 2 To 14: gmap(1, y) = 2:: gmap(20, y) = 2: Next
gmap(gspot(tspot).x, gspot(tspot).y) = gspot(tspot).s
gmap(gspot(lockspot).x, gspot(lockspot).y) = gspot(lockspot).s
gmap(place(keyspot).x, place(keyspot).y) = place(keyspot).s
gmap(place(shovelspot).x, place(shovelspot).y) = place(shovelspot).s
For p = 1 To 4
If postv(p) <> 0 Then
gmap(postx(p), posty(p)) = 4
Select Case postv(p)
Case 1 'horizontal fence
y = posty(p)
Select Case p
Case 1, 4
For fx = 2 To postx(p) - 1: gmap(fx, y) = 15: Next
Case 2, 3
For fx = postx(p) + 1 To 19: gmap(fx, y) = 15: Next
End Select
Case 2 'vertical fence
x = postx(p)
Select Case p
Case 1, 2
For fy = 2 To posty(p) - 1: gmap(x, fy) = 15: Next
Case 3, 4
For fy = posty(p) + 1 To 14: gmap(x, fy) = 15: Next
End Select
End Select
End If
Next p
For x = 5 To 15 Step 2
For y = 2 To 14 Step 2
If Int(1 + Rnd * 6) < 3 Then
If gmap(x, y) = 0 Then gmap(x, y) = 11 + Int(Rnd * 3) 'place a gravestone
End If
Next
Next
For x = 2 To 19 Step 2
For y = 4 To 12 Step 2
If Int(1 + Rnd * 6) < 3 Then
If gmap(x, y) = 0 Then gmap(x, y) = 11 + Int(Rnd * 3) 'place a gravestone
End If
Next
Next
pop = Int(3 + Sqr(level * 2)): If pop > 100 Then pop = 100
For m = 1 To pop 'place the monsters
Do
Do
x = Int(Rnd * 18) + 2
y = Int(Rnd * 13) + 2
dx = Abs(player.x - x)
dy = Abs(player.y - y)
Loop Until dx + dy > 3
Loop Until (gmap(x, y)) = 0 And (mmap(x, y) = 0)
mon(m).x = x: mon(m).y = y
mon(m).s = 1
mmap(x, y) = 7: mon(m).look = 7
slimit = 100 - (level * 15): If slimit < Sqr(level) Then slimit = 10
If Int(Rnd * 100) > slimit Then
mmap(x, y) = 8
mon(m).look = 8
If Int(Rnd * 40) < level Then
mmap(x, y) = 9
mon(m).look = 9
If Int(Rnd * 60) < level Then
mmap(x, y) = 10
mon(m).look = 10
End If
End If
End If
Next m
End Sub
Sub drawground
For y = 1 To 15
For x = 1 To 20
If gmap(x, y) <> 0 Then Sblock (y * 2) - 1, (x * 4) - 3, 4, 4, sp$(gmap(x, y))
Next
Next
End Sub
Sub drawmobiles
For y = 2 To 14: For x = 2 To 19: mmap(x, y) = 0: Next: Next
For m = 1 To pop
If mon(m).s > 0 Then Sblock (mon(m).y * 2) - 1, (mon(m).x * 4) - 3, 4, 4, sp$(mon(m).look)
mmap(mon(m).x, mon(m).y) = mon(m).look
Next m
mmap(player.x, player.y) = 1
Sblock (player.y * 2) - 1, (player.x * 4) - 3, 4, 4, sp$(1)
_Display
End Sub
Sub movemonsters
For m = 1 To pop
If mon(m).s > 0 Then
WanderChance = 50 - (level * 5 + (mon(m).look * 3))
If WanderChance < 10 Then wnaderchance = 10 - Int(mon(m).look \ 3)
If Int(Rnd * 100) <= WanderChance Then
mwalk m, Int(1 + Rnd * 4)
Else
seekP = Int(1 + Rnd * 2)
Select Case seekP
Case 1 'seek X
If player.x < mon(m).x Then DD = 4 Else DD = 2
Case 2 'seek Y
If player.y < mon(m).y Then DD = 1 Else DD = 3
End Select
mwalk m, DD
End If
End If
Next m
End Sub
Sub mwalk (m, DDR)
ox = mon(m).x: oy = mon(m).y
Select Case DDR
Case 1
cx = ox: cy = oy - 1
Case 2
cx = ox + 1: cy = oy
Case 3
cx = ox: cy = oy + 1
Case 4
cx = ox - 1: cy = oy
End Select
If mmap(cx, cy) = 0 Then
Select Case mon(m).look
Case 7
Select Case gmap(cx, cy)
Case 0, 16, 17, 18, 19
mmap(ox, oy) = 0
mon(m).x = cx
mon(m).y = cy
mmap(cx, cy) = mon(m).look
Case 20
mmap(ox, oy) = 0
mon(m).x = 1
mon(m).y = 1
mon(m).s = 0
player.score = player.score + (mon(m).look * level) \ 2
End Select
Case 8
Select Case gmap(cx, cy)
Case 0, 16, 17, 18, 19
mmap(ox, oy) = 0
mon(m).x = cx
mon(m).y = cy
mmap(cx, cy) = mon(m).look
Case 20
If Int(1 + Rnd * 100) < 50 Then
mmap(ox, oy) = 0
mon(m).x = 1
mon(m).y = 1
mon(m).s = 0
player.score = player.score + (mon(m).look * level) \ 2
End If
End Select
Case 9
Select Case gmap(cx, cy)
Case 0, 16, 17, 18, 19
mmap(ox, oy) = 0
mon(m).x = cx
mon(m).y = cy
mmap(cx, cy) = mon(m).look
Case 14, 15
If Int(1 + Rnd * 100) < 50 Then
mmap(ox, oy) = 0
mon(m).x = cx
mon(m).y = cy
mmap(cx, cy) = mon(m).look
If Int(1 + Rnd * 100) < 25 Then
gmap(cx, cy) = 0
End If
End If
Case 20
If Int(1 + Rnd * 100) < 50 Then
mmap(ox, oy) = 0
mon(m).x = 1
mon(m).y = 1
mon(m).s = 0
player.score = player.score + (mon(m).look * level) \ 2
End If
End Select
Case 10
Select Case gmap(cx, cy)
Case 0, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20
mmap(ox, oy) = 0
mon(m).x = cx
mon(m).y = cy
mmap(cx, cy) = mon(m).look
End Select
End Select
End If
End Sub
Function dowalk (xx, yy)
wscore = gmap(xx, yy)
Select Case wscore
Case 0, 16
cc = 1
Case 6
cc = 1
player.score = player.score + player.sta + level * 50
Case 17
keyflag = 100
gmap(xx, yy) = 0
msg player.x, player.y - .25, "Yoink!"
_Delay 0.2
cc = 1
player.score = player.score + level * 50
Case 18
If keyflag > 0 Then
lockflag$ = "UNLOCKED"
msg player.x - .5, player.y - 1, "Click!"
_Delay 0.2
cc = 0
gmap(gspot(tspot).x, gspot(tspot).y) = 6
If keyflag = 100 Then
player.score = player.score + level * 50
keyflag = keyflag - 1
End If
End If
Case 19
If shovleflag > 0 Then shovelflag = shovelflag + 50 Else shovelflag = 100
gmap(xx, yy) = 0
cc = 1
player.score = player.score + level * 50
msg player.x, player.y - .25, "Yoink!"
_Delay 0.2
Case 20
cc = 1
player.sta = player.sta - 10
Case Else
cc = 0
End Select
If mmap(xx, yy) > 1 Then
cc = 0
If shovelflag > 0 Then
msg xx, yy - .25, "Bonk!"
_Delay 0.2
Select Case KK$
Case "W", "w": md = 1
Case "D", "d": md = 2
Case "S", "s": md = 3
Case "A", "a": md = 4
End Select
Select Case mmap(xx, yy)
Case 7, 8, 9, 10
shovelflag = shovelflag - 2
m = 0
Do
m = m + 1
Loop Until mon(m).x = xx And mon(m).y = yy
If mon(m).s <> 0 And gmap(mon(m).x + dgo(md, 1), mon(m).y + dgo(md, 2)) <> 0 Then
If gmap(mon(m).x + dgo(md, 1), mon(m).y + dgo(md, 2)) <> 16 Then
mon(m).s = 0
gmap(xx, yy) = 16
player.score = player.score + mon(m).look * 5
csblock (mon(m).y * 2) - 1, (mon(m).x * 4) - 3, 4, 4, 12, sp$(mon(m).look)
_Display
_Delay 0.1
mon(m).x = 1: mon(m).y = 1
Else
csblock (mon(m).y * 2) - 1, (mon(m).x * 4) - 3, 4, 4, 12, sp$(mon(m).look)
_Delay 0.1
_Display
mwalk m, md
End If
Else
mwalk m, md
drawmobiles
_Display
End If
End Select
End If
End If
If cc = 1 Then
mmap(player.x, player.y) = 0
player.x = xx
player.y = yy
mmap(player.x, player.y) = 1
End If
dowalk = cc
End Function
Sub msg (px, py, tmsg$)
'show a message on the play screen
tx = (px * 4) - 3: ty = (py * 2) - 1
If tx < 2 Then tx = 2: If tx > 80 Then tx = 80
If ty < 2 Then tx = 2: If ty > 80 Then tx = 50
Locate ty, tx
Print tmsg$
_Display
End Sub
Sub csblock (sy, sx, xs, ys, newklr, spb$)
'the color is temporarily rewritten and the graphic is sent to sblock
tsp$ = spb$
hk$ = Hex$(newklr)
If Len(hk$) = 1 Then hk$ = "0" + hk$
Mid$(tsp$, 3, 2) = hk$
Sblock sy, sx, xs, ys, tsp$
End Sub
Sub Sblock (sy, sx, scaleX, scaleY, spb$)
'wblock draws a block graphic described in the string spb$
'1st 2 charcters is width, allowing a grahpic up to 255 characters wide
'2nd 2 charcters are the color of the graphicfrom 0 to 255
'remainig characters fr om 5 onward define the block drawn
'each block is defined by active blocks from top left at 1 goign clockwise by power of 2
' 1 2
' 8 4
'scalex and scaleY are size in pixels for each block segment
sw = Val("&H" + Left$(spb$, 2))
klr = Val("&H" + Mid$(spb$, 3, 2))
r = 0
xe = scaleX - 1: xm = xe \ 2
ye = scaleY - 1: ym = ye \ 2
px = (sx - 1) * 8: py = (sy - 1) * 16
For c = 5 To Len(spb$)
r = r + 1
v = Val("&H" + Mid$(spb$, c, 1))
Select EveryCase v
Case 1, 3, 5, 7, 9, 11, 13
Line (px, py)-(px + xm, py + ym), klr, BF
Case 2, 3, 6, 7, 10, 11, 14
Line (px + xm + 1, py)-(px + xe, py + ym), klr, BF
Case 4, 5, 6, 7, 12, 13, 14
Line (px + xm + 1, py + ym + 1)-(px + xe, py + ye), klr, BF
Case 8, 9, 10, 11, 12, 13, 14
Line (px, py + ym + 1)-(px + xm, py + ye), klr, BF
Case 15
Line (px, py)-(px + xe, py + ye), klr, BF
End Select
If r = sw Then
py = py + (ye + 1): px = (sx - 1) * 8
r = 0
Else
px = px + xe + 1
End If
Next c
End Sub