10-30-2022, 03:10 PM
This is a modification and expansion of the original programs level generation, really just a test so I'm including it here in this thread.
The fungus can be harvested with "h" and eaten with "e".
The monsters are just for show currently and don't do much beyond jumping into lava.
The file "DTDtiles.bi" in this thread is required to be in the folder to compile.
The fungus can be harvested with "h" and eaten with "e".
The monsters are just for show currently and don't do much beyond jumping into lava.
The file "DTDtiles.bi" in this thread is required to be in the folder to compile.
Code: (Select All)
'ruingen
'By James D. Jarvis
'testing combination indoor/outdoor roguelike level generation.
'need to have the file 'DTDtiles.bi' in the same folder to compile
'$dynamic
Screen _NewImage(800, 500, 32)
_Title "ruinedcity v0.0"
_Define K As _UNSIGNED LONG
Dim Shared dmap As _Unsigned Long
Dim Shared ms As _Unsigned Long
Dim Shared Kblack, Kwhite, Kdgrey, Klgrey, kredm, kwater, kslime, klava, krubble, kcrystal, kexit, kfungus, kwaste
Dim Shared kfloor2, kfloor3, kfloor4, cornerrubblechance, kgrass, ktree1, ktree2, ktree3, ktree4, kcactus1, kcactus2
Dim Shared mp(1000, 1000) As Integer
Dim Shared tiles&
Dim Shared rect_count As Integer
Type rect_type
xx As Integer
yy As Integer
ww As Integer
hh As Integer
lk As _Unsigned Long
fk As _Unsigned Long
notes As String
End Type
Type monster_type
tile As Integer
mx As Integer
my As Integer
End Type
Dim Shared monst(300) As monster_type
Dim Shared tilespot(0 To 528, 2) As Integer
Dim Shared rect(0) As rect_type
Dim Shared min_rectd
Dim Shared fillcell, openwallchance, pillarchance, puddleno, slimechance, lavachance, cactuschance, funcguschance
Dim Shared phealth, pstamina, pwounds, ptemp, ppx, ppy, lastx, lasty, prads, rwid, rht, pshrooms
Randomize Timer
Kblack = _RGB32(0, 0, 0) 'this is visible black as 0,0,0 will be "nothing is here" eventually
Kwhite = _RGB32(250, 250, 250) 'this is cooled paper white
kwaste = _RGB32(240, 200, 100)
kcactus1 = _RGB32(240, 201, 101): kcactus2 = _RGB32(240, 201, 102)
Kdgrey = _RGB32(40, 40, 40)
Klgrey = _RGB32(150, 150, 150)
kgrass = _RGB32(170, 200, 50): ktree1 = _RGB32(170, 201, 50): ktree2 = _RGB32(170, 202, 50): ktree3 = _RGB32(170, 203, 50): ktree4 = _RGB32(170, 204, 50)
kfloor2 = _RGB32(151, 151, 151): kfloor3 = _RGB32(152, 152, 152): kfloor4 = _RGB32(153, 153, 153)
kred = _RGB32(250, 0, 0)
kwater = _RGB32(10, 30, 240): kslime = _RGB32(20, 240, 100): klava = _RGB32(200, 5, 5)
krubble = _RGB32(120, 120, 120): kcrystal = _RGB32(250, 250, 0): kexit = _RGB32(255, 0, 255)
kfungus = _RGB32(200, 50, 150)
dmap = _NewImage(1000, 1000, 32)
ms = _NewImage(800, 500, 32)
tiles& = Loadtileset1& 'loads the tileset in the file DTDtiles.bi
Const tilemaxx = 48
Const tilemaxy = 11
t = 0
For y = 0 To tilemaxy - 1
For x = 0 To tilemaxx - 1
tilespot(t, 1) = x * 16
tilespot(t, 2) = y * 16
t = t + 1
Next x
Next y
maxtiles = t - 1
fh = _FontHeight
fw = _FontWidth
restartdungeon:
walltile = getwalltile
Screen dmap
_Dest dmap
_Source dmap
_PrintMode _KeepBackground
Color Kdgrey, Kdgrey
rwid = 980
rht = 980
Do
ReDim rect(0) As rect_type
makemonsters
rect_count = 0
Cls
newrect 10, 10, rwid, rht, Kdgrey, kwaste
min_rectd = 40
'If min_rectd < 4 Then min_rectd = 4
fillcell = 85
cornerrubblechance = Int(10 + Rnd * 35)
puddleno = Int(Rnd * 30)
slimechance = Int(2 + Rnd * 28)
lavachance = Int(Rnd * 25)
funguschance = Int(Rnd * 15)
cactuschance = Int(10 + Rnd * 30)
drawrect 1
bisectrect 1
n = 0
min_rectd = Int(1 + Rnd * 30)
If min_rectd < 10 Then min_rectd = 10
Do
'Cls
For r = 1 To rect_count
bisectrect r
Next r
For r = 1 To rect_count
drawrect r
Next r
_Limit 5
kk$ = InKey$
n = n + Int(1 + Rnd * 8)
Loop Until kk$ <> "" Or n > 90
kk$ = Chr$(27)
Loop Until kk$ = Chr$(27)
For r = 1 To rect_count
If Int(1 + Rnd * 100) < fillcell Then
rect(r).fk = kwaste
rect(r).lk = kwaste
Else
rect(r).fk = Klgrey
End If
drawrect r
Next r
For treps = 2 To 4
current_rect = rect_count
For r = 1 To current_rect
min_rectd = 10
If rect(r).fk = Klgrey Then bisectrect r
Next r
Next treps
For r = 1 To rect_count 'if there's an open space across a wall open a space in the wall
If rect(r).fk <> Kdgrey Then
mx = rect(r).xx + Int(rect(r).ww / 2)
my = rect(r).yy + Int(rect(r).hh / 2)
If Point(mx, my + Int(rect(r).hh / 2) + 2) = Klgrey Then
Line (mx, my)-(mx, my + Int(rect(r).hh / 2) + 2), Klgrey
End If
If Point(mx, my - Int(rect(r).hh / 2) - 2) = Klgrey Then
Line (mx, my)-(mx, my - Int(rect(r).hh / 2) - 2), Klgrey
End If
If Point(mx - Int(rect(r).ww / 2) - 2, my) = Klgrey Then
Line (mx - Int(rect(r).ww / 2) - 2, my)-(mx, my), Klgrey
End If
If Point(mx + Int(rect(r).ww / 2) + 2, my) = Klgrey Then
Line (mx + Int(rect(r).ww / 2) + 2, my)-(mx, my), Klgrey
End If
End If
Next r
For y = 11 To rht - 1
For x = 11 To rwid - 2
If Point(x, y) = Klgrey And Point(x + 1, y) = Kdgrey And Point(x + 2, y) = Klgrey Then
PSet (x + 1, y), kred
End If
If Point(x, y) = Klgrey And Point(x + 1, y) = kred And Point(x + 2, y) = Kdgrey And Point(x + 3, y) = Klgrey Then
PSet (x + 2, y), kred
End If
If Point(x, y) = kdrgey And Point(x + 1, y) = Klgrey And Point(x + 2, y) = Kdgrey And Point(x + 3, y) = Kdgrey And Point(x + 4, y) = Klgrey And Point(x + 5, y) = Kdgrey Then
PSet (x + 2, y), Klgrey
PSet (x + 3, y), Klgrey
End If
Next x
Next y
For x = 11 To rwid - 2
For y = 11 To rht - 2
If Point(x, y) = Klgrey And Point(x, y + 1) = Kdgrey And Point(x, y + 2) = Klgrey Then
PSet (x, y + 1), kred
End If
If Point(x, y) = Klgrey And Point(x, y + 1) = kred And Point(x, y + 2) = Kdgrey And Point(x, y + 3) = Klgrey Then
PSet (x, y + 2), kred
End If
If Point(x, y) = kdrgey And Point(x, y + 1) = Klgrey And Point(x, y + 2) = Kdgrey And Point(x, y + 3) = Kdgrey And Point(x, y + 4) = Klgrey And Point(x, y + 5) = Kdgrey Then
PSet (x, y + 2), Klgrey
PSet (x, y + 3), Klgrey
End If
Next
Next
aa$ = Input$(1)
For y = 10 To rht
For x = 10 To rwid
If Point(x, y) = kred Then PSet (x, y), Klgrey
Next
Next
Color Kblack, Kwhite
'check to open walls
For r = 1 To rect_count
If rect(r).fk <> Kdgrey And Int(1 + Rnd * 100) <= openwallchance Then
Select Case Int(1 + Rnd * 4)
Case 1
rect(r).xx = rect(r).xx - 2
rect(r).ww = rect(r).ww + 2
Case 2
rect(r).xx = rect(r).xx + 2
rect(r).ww = rect(r).ww + 2
Case 3
rect(r).yy = rect(r).yy - 2
rect(r).hh = rect(r).hh + 2
Case 4
rect(r).yy = rect(r).yy + 2
rect(r).hh = rect(r).hh + 2
End Select
Line (rect(r).xx, rect(r).yy)-(rect(r).xx + rect(r).ww, rect(r).yy + rect(r).hh), Klgrey, BF
End If
Next r
'straysspaces
sp = Int(Rnd * 12)
For ss = 1 To sp
sx = Int(10 + Rnd * rwid - 30)
sy = Int(10 + Rnd * rht - 30)
sw = 10 + Int(Rnd * 20)
sh = 10 + Int(Rnd * 20)
Line (sx, sy)-(sx + sw, sy + sh), Klgrey, BF
Next
'add wanderingpaths
nwt = Int(Rnd * (12 + fillcell))
For ww = 1 To nwt
wsx = Int(20 + Rnd * rwid - 50)
wsy = Int(20 + Rnd * rht - 50)
wtx = Int(20 + Rnd * rwid - 50)
wty = Int(20 + Rnd * rht - 50)
If wsx < wtx Then xtrend = 1
If wsx > wtx Then xtrend = -1
If wsy < wty Then ytrend = 1
If wsy > wty Then ytrend = -1
sx = wsx
sy = wsy
rl = 0
Do
nx = sx + Int(xtrend + Rnd * 2 - Rnd * 2)
ny = sy + Int(ytrend + Rnd * 2 - Rnd * 2)
If nx < 11 Then
nx = 11
xtrend = xtrend * -1
End If
If ny < 11 Then
ny = 11
ytrend = ytrend * -1
End If
If nx > rwid Then
nx = rwid
xtrend = xtrend * -1
End If
If ny > rht Then
ny = rht
ytrend = ytrend * -1
End If
dx = Abs(nx - wtx)
dy = Abs(ny - wty)
Line (sx, sy)-(nx, ny), Klgrey
sx = nx
sy = ny
rl = rl + 1
Loop Until dx < 5 And dy < 5 Or rl > rwid + 40
Line (sx, sy)-(wtx, wty), Klgrey
Next ww
For r = 1 To rect_count 'add pillars
pillarspread = 2 + Int(Rnd * 7)
If rect(r).fk <> Kdgrey And Int(1 + Rnd * 100) <= pillarchance Then
For y = rect(r).yy + pillarspread To rect(r).yy + rect(r).hh - pillarspread Step pillarspread
For x = rect(r).xx + pillarspread To rect(r).xx + rect(r).ww - pillarspread Step pillarspread
PSet (x, y), Kdgrey
Next
Next
End If
Next
For pr = 1 To rect_count
If Int(1 + Rnd * 100) < 35 Then addgrass pr, Int(rect(pr).xx + 1 + Rnd * (rect(pr).ww - 2)), Int(rect(pr).yy + 1 + Rnd * (rect(pr).hh - 2)), Int(1 + Rnd * 3)
If rect(pr).fk <> Kdgrey And Int(1 + Rnd * 100) <= cornerrubblechance Then
addcornerrubble pr
End If
If rect(pr).fk <> Kdgrey And Int(1 + Rnd * 100) <= puddleno Then
addwater pr, Int(rect(pr).xx + 1 + Rnd * (rect(pr).ww - 2)), Int(rect(pr).yy + 1 + Rnd * (rect(pr).hh - 2)), Int(1 + Rnd * 3)
End If
If rect(pr).fk <> Kdgrey And Int(1 + Rnd * 100) <= slimechance Then
addslime pr, Int(rect(pr).xx + 1 + Rnd * (rect(pr).ww - 2)), Int(rect(pr).yy + 1 + Rnd * (rect(pr).hh - 2)), Int(1 + Rnd * 3)
End If
If rect(pr).fk <> Kdgrey And Int(1 + Rnd * 100) <= lavachance Then
addlava pr, Int(rect(pr).xx + 1 + Rnd * (rect(pr).ww - 2)), Int(rect(pr).yy + 1 + Rnd * (rect(pr).hh - 2)), Int(1 + Rnd * 3)
End If
If rect(pr).fk <> Kdgrey And Int(1 + Rnd * 100) <= funguschance Then
addfungus pr, Int(rect(pr).xx + 1 + Rnd * (rect(pr).ww - 2)), Int(rect(pr).yy + 1 + Rnd * (rect(pr).hh - 2)), Int(1 + Rnd * 3)
End If
If Int(1 + Rnd * 100) < 65 Then addtrees pr, Int(rect(pr).xx + 1 + Rnd * (rect(pr).ww - 2)), Int(rect(pr).yy + 1 + Rnd * (rect(pr).hh - 2)), Int(1 + Rnd * 3)
If Int(1 + Rnd * 100) < cactuschance Then addcactus pr, Int(rect(pr).xx + 1 + Rnd * (rect(pr).ww - 2)), Int(rect(pr).yy + 1 + Rnd * (rect(pr).hh - 2)), Int(1 + Rnd * 3)
Next pr
'dress floor to make it more interesting
For y = 1 To rht
For x = 1 To rwid
kpp = Point(x, y)
If kpp = kgrass Then
Select Case Int(1 + Rnd * 100)
Case 1, 2
PSet (x, y), _RGB32(171, 200, 50)
Case 3, 4
PSet (x, y), _RGB32(172, 200, 50)
Case 5
PSet (x, y), _RGB32(173, 200, 50)
End Select
End If
If kpp = Klgrey Then
Select Case Int(1 + Rnd * 100)
Case 1, 2
PSet (x, y), kfloor2
Case 3
PSet (x, y), kfloor3
Case 4
PSet (x, y), kfloor4
End Select
End If
If kpp = Kdgrey Then 'convert some wall near lava inot rubble
If Point(x - 1, y) = klava And Int(1 + Rnd * 100) < 30 Then PSet (x, y), krubble
If Point(x + 1, y) = klava And Int(1 + Rnd * 100) < 30 Then PSet (x, y), krubble
If Point(x, y + 1) = klava And Int(1 + Rnd * 100) < 30 Then PSet (x, y), krubble
If Point(x, y - 1) = klava And Int(1 + Rnd * 100) < 30 Then PSet (x, y), krubble
If Point(x - 2, y) = klava And Int(1 + Rnd * 100) < 10 Then PSet (x, y), krubble
If Point(x + 2, y) = klava And Int(1 + Rnd * 100) < 10 Then PSet (x, y), krubble
If Point(x, y + 2) = klava And Int(1 + Rnd * 100) < 10 Then PSet (x, y), krubble
If Point(x, y - 2) = klava And Int(1 + Rnd * 100) < 10 Then PSet (x, y), krubble
End If
If kpp = kwaste Then
whl = Int(1 + Rnd * 10)
Select Case whl
Case 1
PSet (x, y), _RGB32(250, 200, 100)
Case 2
PSet (x, y), _RGB32(245, 205, 100)
Case 3
PSet (x, y), _RGB32(245, 200, 105)
Case 4
PSet (x, y), _RGB32(240, 205, 105)
End Select
End If
Next
Next
For e = 0 To 9 'clean edge
Line (e, e)-(_Width - e, e), Kdgrey: Line (e, e)-(e, _Height - e), Kdgrey: Line (_Width - e, e)-(_Width - e, _Height - e), Kdgrey
Next e
Screen ms
_Source dmap
pick = 0
Do
pick = pick + 1
ppx = rect(pick).xx + Int(rect(pick).ww / 2): ppy = rect(pick).yy + Int(rect(pick).hh / 2)
kk = Point(ppx, ppy)
Loop Until kk <> Kdgrey
lightradius = 10: pstamina = 100: phealth = 100: pwounds = 0: ptemp = 98: prads = 0: pshrooms = 0
turn = 0
Do
If rec_count > 12 Then
exitspot = Int(6 + Rnd * (rect_count - 7))
Else
exitspot = Int(1 + Rnd * rect_count)
End If
exitX = rect(exitspot).xx + Int(rect(exitspot).ww / 2)
exitY = rect(exitspot).yy + Int(rect(exitspot).hh / 2)
startX = Abs(exitX - ppx)
startY = Abs(exitY - ppy)
start_dx = Sqr(startX * startX + startY * startY)
Loop Until Point(exitX, exitY) <> Kdgrey And exitspot <> pick
_Dest dmap
PSet (exitX, exitY), kexit
_Dest ms
_PrintMode _KeepBackground
View Print 25 To 30
Cls
Do
'draw location
rsqrd = (lightradius + .4) * (lightradius + .4)
y = -lightradius
While y <= lightradius
x = Int(Sqr(rsqrd - y * y))
For x2 = ppx - x To ppx + x
vx = x2 - ppx + 12
kk = Point(x2, ppy + y)
Line (vx * 16, (y + 12) * 16)-(vx * 16 + 15, (y + 12) * 16 + 15), kk, BF
If kk = ktree1 Then
coltileat 48, _RGB32(10, 100, 10), vx * 16, (y + 12) * 16
End If
If kk = ktree2 Then
coltileat 49, _RGB32(10, 105, 10), vx * 16, (y + 12) * 16
End If
If kk = ktree3 Then
coltileat 50, _RGB32(15, 105, 10), vx * 16, (y + 12) * 16
End If
If kk = ktree4 Then
coltileat 51, _RGB32(20, 110, 10), vx * 16, (y + 12) * 16
End If
If kk = _RGB32(171, 200, 50) Then
coltileat 5, _RGB32(100, 80, 80), vx * 16, (y + 12) * 16
End If
If kk = _RGB32(172, 200, 50) Then
coltileat 5, _RGB32(90, 110, 80), vx * 16, (y + 12) * 16
End If
If kk = _RGB32(173, 200, 50) Then
coltileat 6, _RGB32(200, 0, 150), vx * 16, (y + 12) * 16
End If
If kk = _RGB32(250, 200, 100) Then
coltileat 2, _RGB32(200, 180, 80), vx * 16, (y + 12) * 16
End If
If kk = _RGB32(245, 205, 100) Then
coltileat 5, _RGB32(140, 150, 10), vx * 16, (y + 12) * 16
End If
If kk = _RGB32(245, 200, 105) Then
coltileat 7, _RGB32(120, 150, 80), vx * 16, (y + 12) * 16
End If
If kk = _RGB32(240, 205, 105) Then
coltileat 3, _RGB32(180, 180, 180), vx * 16, (y + 12) * 16
End If
If kk = kcactus1 Then
coltileat 54, _RGB32(15, 105, 10), vx * 16, (y + 12) * 16
End If
If kk = kcactus2 Then
coltileat 55, _RGB32(15, 105, 10), vx * 16, (y + 12) * 16
End If
If kk = Kdgrey Then
coltileat walltile, _RGB32(100, 100, 100), vx * 16, (y + 12) * 16
End If
If kk = kfloor2 Then
coltileat 2, _RGB32(160, 160, 160), vx * 16, (y + 12) * 16
End If
If kk = kfloor3 Then
coltileat 3, _RGB32(165, 165, 170), vx * 16, (y + 12) * 16
End If
If kk = kfloor4 Then
coltileat 4, _RGB32(175, 165, 165), vx * 16, (y + 12) * 16
End If
If kk = kexit Then
coltileat 24, _RGB32(40, 40, 40), vx * 16, (y + 12) * 16
End If
If kk = kfungus Then
Color _RGB32(250, 100, 200)
' _PrintString (vx * 16, (y + 12) * 16), Chr$(234)
coltileat 57, _RGB32(250, 100, 200), vx * 16, (y + 12) * 16
Color _RGB32(255, 255, 255)
End If
If kk = kcrystal Then
'_PrintString (vx * 16, (y + 12) * 16), Chr$(127)
coltileat 433, _RGB32(10, 0, 10), vx * 16, (y + 12) * 16
End If
If kk = krubble Then
Color _RGB32(150, 150, 150)
'_PrintString (vx * 16, (y + 12) * 16), Chr$(177)
'61
coltileat 119, _RGB32(220, 200, 180), vx * 16, (y + 12) * 16
Color _RGB32(255, 255, 255)
End If
If kk = kslime Then
Color _RGB32(250, 250, 150)
sb = Int(Rnd * 4)
'If sb = 1 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(247)
If sb = 1 Then coltileat 61, _RGB32(250, 250, 150), vx * 16, (y + 12) * 16
' If sb = 2 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(126)
If sb = 2 Then coltileat 61, _RGB32(150, 250, 150), vx * 16, (y + 12) * 16
Color _RGB32(255, 255, 255)
End If
If kk = klava Then
Color _RGB32(250, 250, 150)
lb = Int(Rnd * 7)
'If lb = 1 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(249)
If lb = 1 Then coltileat 61, _RGB32(250, 250, 150), vx * 16, (y + 12) * 16
'If lb = 2 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(9)
If lb = 2 Then coltileat 468, _RGB32(250, 250, 150), vx * 16, (y + 12) * 16
'If lb = 3 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(176)
If lb = 3 Then coltileat 461, _RGB32(250, 250, 150), vx * 16, (y + 12) * 16
'If lb = 4 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(248)
If lb = 4 Then coltileat 61, _RGB32(250, 0, 0), vx * 16, (y + 12) * 16
'If lb = 5 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(46)
If lb = 5 Then coltileat 468, _RGB32(250, 100, 0), vx * 16, (y + 12) * 16
Color _RGB32(255, 255, 255)
End If
If kk = kwater Then
Color _RGB32(40, 120, 250)
wb = Int(Rnd * 6)
'If wb = 1 Then _PrintString (vx * 16, (y + 12) * 16), Chr$(45)
If wb = 1 Then coltileat 136, _RGB32(40, 120, 250), vx * 16, (y + 12) * 16
If wb = 2 Then coltileat 136, _RGB32(40, 120, 250), vx * 16, (y + 12) * 16
If wb = 3 Then _PrintString (vx * 16 + 4, (y + 12) * 16), Chr$(240)
Color _RGB32(255, 255, 255)
End If
If mp(x2, ppy + y) >= 1 Then
coltileat monst(mp(x2, ppy + y)).tile, _RGB32(10, 10, 10), (vx) * 16, (y + 12) * 16
End If
Next
y = y + 1
Wend
Line (598, 18)-(795, 144), Kdgrey, BF
'_PrintString ((12) * 8, (12) * 16), "@"
If ptemp > 199 Then coltileat 470, _RGB32(40, 0, 0), (12) * 16, (12) * 16
coltileat 304, _RGB32(250, 250, 250), (12) * 16, (12) * 16
o$ = "Stamina " + Str$(pstamina)
_PrintString (600, 20), o$
o$ = "Health " + Str$(phealth)
_PrintString (600, 40), o$
o$ = "Wounds " + Str$(pwounds)
_PrintString (600, 60), o$
dptemp = 0.1 * (Int(ptemp * 10))
o$ = "Temperature " + Str$(dptemp)
_PrintString (600, 80), o$
o$ = "Radiation " + Str$(prads)
_PrintString (600, 100), o$
edd = Int(Sqr((ppx - exitX) * (ppx - exitX) + (ppy - exitY) * (ppy - exitY)))
o$ = "Distance to Exit " + Str$(edd)
_PrintString (600, 120), o$
Print "Turn", turn
handlemonsters
minimap
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
turn = turn + 1
lastx = ppx
lasty = ppy
Select Case kk$
Case "e", "E"
eatshrooms
Case "h", "H"
pshrooms = pshrooms + harvestfungus
Case "w", "8"
If pstamina > 0 And Point(ppx, ppy - 1) <> Kdgrey Then ppy = ppy - 1
Case "s", "2"
If pstamina > 0 And Point(ppx, ppy + 1) <> Kdgrey Then ppy = ppy + 1
Case "a", "4"
If pstamina > 0 And Point(ppx - 1, ppy) <> Kdgrey Then ppx = ppx - 1
Case "d", "6"
If pstamina > 0 And Point(ppx + 1, ppy) <> Kdgrey Then ppx = ppx + 1
Case "7"
If pstamina > 0 And Point(ppx - 1, ppy - 1) <> Kdgrey Then
ppy = ppy - 1
ppx = ppx - 1
End If
Case "9"
If pstamina > 0 And Point(ppx + 1, ppy - 1) <> Kdgrey Then
ppy = ppy - 1
ppx = ppx + 1
End If
Case "1"
If pstamina > 0 And Point(ppx - 1, ppy + 1) <> Kdgrey Then
ppy = ppy + 1
ppx = ppx - 1
End If
Case "3"
If pstamina > 0 And Point(ppx + 1, ppy + 1) <> Kdgrey Then
ppy = ppy + 1
ppx = ppx + 1
End If
Case "5", "."
If Int(1 + Rnd * 50) < phealth And pstamina < 100 Then pstamina = pstamina + Int(1.5 + Rnd * (phealth / 25))
End Select
If Point(ppx, ppy) = krubble Then pwounds = pwounds + checkrubble(ppx, ppy)
If Point(ppx, ppy) = kcrystal Then pwounds = pwounds + checkcrystal(ppx, ppy)
If Point(ppx, ppy) = ktree1 Then
ppx = lastx: ppy = lasty
End If
If Point(ppx, ppy) = ktree2 Then
ppx = lastx: ppy = lasty
End If
If Point(ppx, ppy) = ktree3 Then
ppx = lastx: ppy = lasty
End If
If Point(ppx, ppy) = ktree4 Then
ppx = lastx: ppy = lasty
End If
If Point(ppx, ppy) = kcactus1 Or Point(ppx, ppy) = kcactus2 Then
Print "Ouch... that hurts.."
dmg = Int(Rnd * 5) - 2: If dmg < 0 Then dmg = 0
If dmg > 1 Then Print "You got poked for "; dmg; " pt(s) of damage"
pwounds = pwounds + dmg
ppx = lastx: ppy = lasty
End If
If Point(ppx, ppy) = kwaste And Int(1 + Rnd * 102) > phealth Then
tinc = (Int(1 + Rnd * 5) - 2) / 20: If tinc < .05 Then tinc = 0
ptemp = ptemp + tinc
End If
If Int(1 + Rnd * 80 + pwounds) > phealth Then pstamina = pstamina - 1
If Point(ppx, ppy) = kslime Then
Print "The slime is nauseating...";
If Int(Rnd * 120) > phealth Then phealth = phealth - Int(Rnd * 4)
If Int(Rnd * 120) > phealth Then
Select Case Int(1 + Rnd * 6)
Case 1, 2, 3
Print " it's making you itch."
Case 4, 5, 6
Print " it's feel's like it is burning you."
wounds = wounds + Abs(Int(Rnd * 2 - Rnd * 2))
pexpo = Int(Rnd * 5) - 2: If pexpo < 1 Then pexpo = 0
prads = prads + pexpo
If pexpo > 0 Then phealth = phealth - 1
End Select
End If
End If
If Point(ppx, ppy) = kwater Then ptemp = ptemp - Int(Abs(Rnd * 2 - Rnd * 2))
If Point(ppx, ppy) = klava Then
ptemp = ptemp + 100
dmg = 10 + Int(Rnd * 20)
pwounds = pwounds + dmg
Print "YOU ARE STANDING IN LAVA !!!"
Print "....suffering "; dmg; " points of damage !"
End If
If ptemp < 0 Then
Print "You are dangerously COLD .... brrrrr"
pstamina = pstamina - Int(Rnd * 2)
If Int(1 + Rnd * (50 + Abs(ptemp))) > pstamina Then
pwounds = pwounds + Int(1 + Rnd * 2)
phealth = phealth - Int(Rnd * 2)
End If
End If
tcheck = ptemp + Rnd * 10
If tcheck > 108 Then
pstamina = pstamina - 1
Print "You are dangerously warm!"
If Int(1 + Rnd * ptemp) > pstamina Then
pwounds = pwounds + 1
phealth = phealth - Int(Rnd * 2)
End If
End If
If ptemp < 98 Then ptemp = ptemp + 1
If ptemp > 107 Then ptemp = Int((ptemp + 107) / 2)
If Point(ppx, ppy) = Klgrey Then
If ptemp > 98 Then ptemp = ptemp - 0.1
End If
If Int(1 + Rnd * (100 + prads)) > phealth * 1.5 Then
phealth = phealth - 1
pstamina = pstamina - 1
dmg = Int(Rnd * 5) - 2: If dmg < 1 Then dmg = 0
If Int(1 + Rnd * 100) > phealth Then pwounds = pwounds + dmg
End If
If pstamina < 20 Then
Print "You are ";
If pstamina < 1 Then
Print "exhausted."
Else
Print "fatigued."
End If
End If
If wounds > phealth Then
Print "You are in intense pain !"
pstamina = pstamina - Int(Rnd * 2)
End If
If pstamina < 1 Then pstamina = 0
If Point(ppx, ppy) = kexit Then
Print
Print "YOU HAVE FOUND THE EXIT"
Print
Print "it took you "; turn; " turns after starting "; start_dx; " spaces away from the exit."
Print
kk$ = Chr$(27)
End If
If phealth < 1 Or pwounds > 99 Then
Print "YOU HAVE PERISHED DUE TO YOUR POOR CONDITION."
Print
Print "(press any key to continue)"
any$ = Input$(1)
kk$ = Chr$(27)
End If
Loop Until kk$ = Chr$(27)
Print "GAME OVER"
Print "play again?"
Print "Y or N?"
Do
ask$ = Input$(1)
ask$ = UCase$(ask$)
Loop Until ask$ = "Y" Or ask$ = "N"
If ask$ = "Y" Then
Screen cmap
GoTo restartdungeon
End If
System
'SUBS======================================================================
'$INCLUDE: 'DTDtiles.bi'
'==========================================================================
Sub bisectrect (r)
If r > 0 Or r < rect_count + 1 Then
Select Case Int(1 + Rnd * 6)
Case 1, 2, 3 'vertical split
tries = 0
Do
tries = tries + 1
vpercent = (Int(1 + Rnd * 4) + Int(1 + Rnd * 4)) * .1
Loop Until vpercent * rect(r).ww >= min_rectd And vpercent * rect(r).hh >= min_rectd Or tries > 7
If tries < 8 Then
oldWW = Int(rect(r).ww * vpercent)
newX = rect(r).xx + oldWW
newWW = rect(r).ww - oldWW
If oldWW >= min_rectd And newWW >= min_rectd Then
rect(r).ww = oldWW
newrect newX, rect(r).yy, newWW, rect(r).hh, rect(r).lk, rect(r).fk
End If
End If
Case 4, 5, 6 'horizontal split
tries = 0
Do
tries = tries + 1
vpercent = (Int(1 + Rnd * 4) + Int(1 + Rnd * 4)) * .1
Loop Until vpercent * rect(r).ww >= min_rectd And vpercent * rect(r).hh >= min_rectd Or tries > 7
If tries < 8 Then
oldHH = Int(rect(r).hh * vpercent)
newYY = (rect(r).yy + oldHH)
newHH = rect(r).hh - oldHH
If oldHH >= min_rectd And newHH >= min_rectd Then
rect(r).hh = oldHH
newrect rect(r).xx, newYY, rect(r).ww, newHH, rect(r).lk, rect(r).fk
End If
End If
End Select
End If
End Sub
Sub wrect (rx, ry, ww, hh, line_klr As _Unsigned Long, fill_klr As _Unsigned Long)
If fill_klr > 0 Then Line (rx, ry)-(rx + ww - 1, ry + hh - 1), fill_klr, BF
If line_klr > 0 Then Line (rx, ry)-(rx + ww - 1, ry + hh - 1), line_klr, B
End Sub
Sub drawrect (r)
wrect rect(r).xx, rect(r).yy, rect(r).ww, rect(r).hh, rect(r).lk, rect(r).fk
End Sub
Sub newrect (XX, YY, WW, HH, klk, kfl)
rect_count = rect_count + 1
ReDim _Preserve rect(rect_count) As rect_type
rect(rect_count).xx = XX
rect(rect_count).yy = YY
rect(rect_count).ww = WW
rect(rect_count).hh = HH
rect(rect_count).lk = klk
rect(rect_count).fk = kfl
rect(rect_count).notes = "newrect"
End Sub
Sub addwater (rno, pcx, pcy, scale)
prr = Int(6 + Rnd * (12 * scale))
preps = (3 + Int(Rnd * prr))
For wr = 1 To preps
pcxx = pcx + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
pcyy = pcy + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = pcxx - x To pcxx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If pcyy + y >= rect(rno).yy And pcyy + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, pcyy + y)
If kk = kwaste Or kk = kgrass Or kk = Klgrey Then
PSet (x2, pcyy + y), kwater
End If
End If
End If
Next
y = y + 1
Wend
prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
Next
End Sub
Sub addgrass (rno, pcx, pcy, scale)
prr = Int(6 + Rnd * (12 * scale))
preps = (3 + Int(Rnd * prr))
For wr = 1 To preps
pcxx = pcx + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
pcyy = pcy + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = pcxx - x To pcxx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If pcyy + y >= rect(rno).yy And pcyy + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, pcyy + y)
If kk = kwaste Then
PSet (x2, pcyy + y), kgrass
End If
End If
End If
Next
y = y + 1
Wend
prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
Next
End Sub
Sub addtrees (rno, pcx, pcy, scale)
prr = Int(6 + Rnd * (12 * scale))
preps = (3 + Int(Rnd * prr))
For wr = 1 To preps
pcxx = pcx + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
pcyy = pcy + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = pcxx - x To pcxx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If pcyy + y >= rect(rno).yy And pcyy + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, pcyy + y)
If kk = kgrass Then
If Int(1 + Rnd * 100) < 20 Then
tc = Int(1 + Rnd * 4)
Select Case tc
Case 1
PSet (x2, pcyy + y), ktree1
Case 2
PSet (x2, pcyy + y), ktree2
Case 3
PSet (x2, pcyy + y), ktree3
Case 4
PSet (x2, pcyy + y), ktree4
End Select
End If
End If
End If
End If
Next
y = y + 1
Wend
prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
Next
End Sub
Sub addcactus (rno, pcx, pcy, scale)
prr = Int(6 + Rnd * (12 * scale))
preps = (3 + Int(Rnd * prr))
For wr = 1 To preps
pcxx = pcx + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
pcyy = pcy + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = pcxx - x To pcxx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If pcyy + y >= rect(rno).yy And pcyy + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, pcyy + y)
If kk = kwaste Then
If Int(1 + Rnd * 100) < 15 Then
tc = Int(1 + Rnd * 2)
Select Case tc
Case 1
PSet (x2, pcyy + y), kcactus1
Case 2
PSet (x2, pcyy + y), kcactus2
End Select
End If
End If
End If
End If
Next
y = y + 1
Wend
prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
Next
End Sub
Sub addslime (rno, pcx, pcy, scale)
prr = Int(5 + Rnd * (10 * scale))
preps = (3 + Int(Rnd * prr))
For wr = 1 To preps
pcxx = pcx + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
pcyy = pcy + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = pcxx - x To pcxx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If pcyy + y >= rect(rno).yy And pcyy + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, pcyy + y)
If kk = Klgrey Or kk = kwater Or kk = kgrass Then
PSet (x2, pcyy + y), kslime
End If
If kk = kwaste And Int(Rnd * 100) < 75 Then
PSet (x2, pcyy + y), kslime
End If
End If
End If
Next
y = y + 1
Wend
prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
Next
End Sub
Sub addlava (rno, pcx, pcy, scale)
prr = Int(5 + Rnd * (10 * scale))
preps = (3 + Int(Rnd * prr))
For wr = 1 To preps
pcxx = pcx + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
pcyy = pcy + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = pcxx - x To pcxx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If pcyy + y >= rect(rno).yy And pcyy + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, pcyy + y)
If kk = Klgrey Or kk = kwater Or kk = kslime Or kk = kgrass Or kk = kwaste Then
If kk = kwater Then
If Abs(y) < prr / 2 Then
PSet (x2, pcyy + y), klava
Else
Select Case Int(1 + Rnd * 12)
Case 1, 2, 3, 4, 5
PSet (x2, pcyy + y), klava
Case 6, 7, 8
PSet (x2, pcyy + y), krubble
Case 9, 10
PSet (x2, pcyy + y), Klgrey
Case 11
PSet (x2, pcyy + y), Kdgrey
Case 12
PSet (x2, pcyy + y), kcrystal
End Select
End If
Else
PSet (x2, pcyy + y), klava
End If
End If
End If
End If
Next
y = y + 1
Wend
prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
Next
End Sub
Sub addfungus (rno, pcx, pcy, scale)
prr = Int(2 + Rnd * (2 * scale))
preps = (3 + Int(Rnd * prr))
For wr = 1 To preps
pcxx = pcx + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
pcyy = pcy + Int(Rnd * (prr / 2)) - Int(Rnd * (prr / 2))
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = pcxx - x To pcxx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If pcyy + y >= rect(rno).yy And pcyy + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, pcyy + y)
If kk = Klgrey Or kk = kwater Then
If Int(1 + Rnd * 100) <= 30 Then PSet (x2, pcyy + y), kfungus
End If
If kk = kgrass Then
If Int(1 + Rnd * 100) <= 65 Then PSet (x2, pcyy + y), kfungus
End If
If kk = kwaste Then
If Int(1 + Rnd * 100) <= 15 Then PSet (x2, pcyy + y), kfungus
End If
End If
End If
Next
y = y + 1
Wend
prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
Next
End Sub
Function checkrubble (xx, yy)
stumblecheck = Int(1 + Rnd * 120)
dmg = 0
If stumblecheck > health Then
Print "whooops.... you stumbled on the rubble...";
Select Case Int(1 + Rnd * 20)
Case 1
If Point(ppx - 1, ppy - 1) <> Kdgrey Then
ppx = ppx - 1: ppy = ppy - 1
End If
Case 2
If Point(ppx, ppy - 1) <> Kdgrey Then
ppy = ppy - 1
End If
Case 3
If Point(ppx + 1, ppy + 1) <> Kdgrey Then
ppx = ppx + 1: ppy = ppy + 1
End If
Case 4
If Point(ppx - 1, ppy) <> Kdgrey Then
ppx = ppx - 1
End If
Case 6
If Point(ppx + 1, ppy) <> Kdgrey Then
ppx = ppx + 1
End If
Case 7
If Point(ppx - 1, ppy + 1) <> Kdgrey Then
ppx = ppx - 1: ppy = ppy + 1
End If
Case 8
If Point(ppx, ppy + 1) <> Kdgrey Then
ppy = ppy + 1
End If
Case 9
If Point(ppx + 1, ppy + 1) <> Kdgrey Then
ppy = ppy + 1: ppx = ppx + 1
End If
Case 10, 11, 12, 13, 14
Print " knocking the wind out of you... ";
pstamina = Int(pstamina / 4)
Case 15, 16, 17, 18, 19, 20
ppx = lastx: ppy = lasty
Print "you tumble back...";
End Select
dmg = Abs(Int((Rnd * 3) - (Rnd * 3)))
If dmg > 0 Then
Print "you suffer "; dmg; " points of damage!"
Else
Print "."
End If
End If
checkrubble = dmg
End Function
Sub addcornerrubble (rno)
numcorn = Int(1 + Rnd * 4)
For crr = 1 To numcorn
Select Case Int(Rnd * 5)
Case 1
crx = rect(rno).xx + 1
cry = rect(rno).yy + 1
Case 2
crx = rect(rno).xx + 1
cry = rect(rno).yy + rect(rno).hh - 2
Case 3
crx = rect(rno).xx + rect(rno).ww - 2
cry = rect(rno).yy + 1
Case 4
crx = rect(rno).xx + rect(rno).ww - 2
cry = rect(rno).yy + rect(rno).hh - 2
End Select
prr = Int((rect(rno).hh + rect(rno).ww) / 12)
rsqrd = prr * prr
y = -prr
While y <= prr
x = Int(Sqr(rsqrd - y * y))
For x2 = crx - x To crx + x
If x2 >= rect(rno).xx And x2 <= rect(rno).xx + rect(rno).ww Then
If cry + y >= rect(rno).yy And cry + y <= rect(rno).yy + rect(rno).hh Then
kk = Point(x2, cry + y)
If kk = kwaste And Int(1 + Rnd * 100) < (cornerrubblechance * 2.5) Then
PSet (x2, cry + y), krubble
End If
End If
End If
Next
y = y + 1
Wend
Next crr
End Sub
Function checkcrystal (xx, yy)
climbcheck = Int(1 + Rnd * 100)
If climbcheck > phealth Then
Print "You just can't gain any purchase to climb the crystal."
Else
stumblecheck = Int(1 + Rnd * 120)
dmg = 0
If stumblecheck > health Then
Print ".... you fell from the crytsal...";
Select Case Int(1 + Rnd * 9)
Case 1
If Point(ppx - 1, ppy - 1) <> Kdgrey Then
ppx = ppx - 1: ppy = ppy - 1
End If
Case 2
If Point(ppx, ppy - 1) <> Kdgrey Then
ppy = ppy - 1
End If
Case 3
If Point(ppx + 1, ppy + 1) <> Kdgrey Then
ppx = ppx + 1: ppy = ppy + 1
End If
Case 4
If Point(ppx - 1, ppy) <> Kdgrey Then
ppx = ppx - 1
End If
Case 5
ppx = lastx: ppy = lasty
Case 6
If Point(ppx + 1, ppy) <> Kdgrey Then
ppx = ppx + 1
End If
Case 7
If Point(ppx - 1, ppy + 1) <> Kdgrey Then
ppx = ppx - 1: ppy = ppy + 1
End If
Case 8
If Point(ppx, ppy + 1) <> Kdgrey Then
ppy = ppy + 1
End If
Case 9
If Point(ppx + 1, ppy + 1) <> Kdgrey Then
ppy = ppy + 1: ppx = ppx + 1
End If
End Select
dmg = Abs(Int((Rnd * 4) - (Rnd * 4)))
If dmg > 0 Then
Print "you suffer "; dmg; " points of damage!"
Else
Print "."
End If
End If
End If
checkcrystal = dmg
End Function
Sub coltileat (tn, ktc, xx, yy)
Dim kc As _Unsigned Long
_Source tiles&
_Dest ms
tx = tilespot(tn, 1): ty = tilespot(tn, 2)
For px = 0 To 16
For py = 0 To 15
kc = Point(tx + px, ty + py)
If kc <> Kblack Then
PSet (xx + px, yy + py), ktc
End If
Next py
Next px
_Source dmap
End Sub
Function getwalltile
wt = Int(1 + Rnd * 8)
Select Case wt
Case 1, 2, 3
wt = 8
Case 4, 5
wt = 15
Case 6
wt = 14
Case 7
wt = 11
Case 8
wt = 12
End Select
getwalltile = wt
End Function
Sub makemonsters
ReDim mp(1000, 1000) As Integer
For m = 1 To 300
monst(m).tile = 144 + Int(Rnd * 239)
monst(m).mx = Int(11 + Rnd * 980)
monst(m).my = Int(11 + Rnd * 980)
mp(monst(m).mx, monst(m).my) = m
Next m
End Sub
Sub handlemonsters
ReDim mp(1000, 1000)
For m = 1 To 300
If monst(m).my <> 0 Then
If Int(Rnd * 100) < 30 Then
If ppx < monst(m).mx Then monst(m).mx = monst(m).mx - 1
If ppx > monst(m).mx Then monst(m).mx = monst(m).mx + 1
If ppy < monst(m).my Then monst(m).my = monst(m).my - 1
If ppy > monst(m).my Then monst(m).my = monst(m).my + 1
mk = Point(monst(m).mx, monst(m).my)
If mk = klava Then
Print "Monster Falls in lava! ";
monst(m).my = 0
monst(m).mx = 0
End If
End If
End If
mp(monst(m).mx, monst(m).my) = m
Next m
End Sub
Function harvestfungus
If Point(ppx, ppy) = kfungus And pstamina > 0 Then
nf = Int(Rnd * 3)
Print "You root among the fungus and harvest "; nf; " decent mushrooms";
_Dest cmap
PSet (ppx, ppy), kfloor
_Dest ms
pstamina = pstamina - Int(Rnd * 3)
If Int(1 + Rnd * 100) > phealth Then
Print " getting a face full of toxic spores."
phealth = phealth - Int(Rnd * 4)
Else
Print "."
End If
If Int(Rnd * 100) < 67 Then
_Dest dmap
Select Case Int(Rnd * 3)
Case 0
PSet (ppx, ppy), kfloor2
Case 1
PSet (ppx, ppy), kfloor3
Case 2
PSet (ppx, ppy), kfloor4
_Dest ms
End Select
End If
harvestfungus = nf
Else
Print "No mushrooms to pick here."
End If
End Function
Sub eatshrooms
If pshrooms < 1 Then Print "You don't have any mushrooms."
If pshrooms > 0 Then
pshrooms = pshrooms - 1
eat = Int(1 + Rnd * 100)
If eat > phealth Then
Select Case eat
Case 1 To 50
Print "Oh.... that was horrible, it makes you terribly ill."
phealth = Int(phealth * .7)
pstamina = Int(pstamina / 2)
pwounds = pwounds + Int(1 + Rnd * 3)
Case 51 To 75
Print "Oh..That was awful, it tasted like dirt."
pstamina = Int(pstamina * .9)
phealth = Int(phealth * .9)
Case 76 To 100
Print "That didn't go down right."
pstamina = Int(pstamina * .9)
End Select
Else
Select Case eat
Case 1 To 25
Print "You've eatem worse."
phealth = phealth + Int(Rnd * 2)
pstamina = pstamina + 2
Case 26 To 75
Print "That tasted great!"
pwounds = pwounds - Int(Rnd * 2)
phealth = phealth + Int(1 + Rnd * 6)
pstamina = pstamina + 3
Case 76 To 100
pwounds = pwounds - Int(Rnd * 3)
Print "Munch, munch... well that hit the spot."
pstamina = pstamina + 4
End Select
End If
If pstamina < 1 Then pstamina = 0
If phealth < 1 Then phealth = 0
If phealth > 100 Then phealth = 100
If pwounds < 1 Then pwounds = 0
If pstamina > 100 Then pstamina = pstamina - 1
End If
End Sub
Sub minimap
minx = ppx - 50
maxx = ppx + 50
miny = ppy - 50
maxy = ppy + 50
mvx = 51
mvy = 51
If minx < 10 Then
minx = 10
maxx = 111
End If
If miny < 10 Then
miny = 10
maxy = 111
End If
If maxx > 990 Then
maxx = 990
minx = 879
End If
If maxy > 990 Then
maxy = 990
miny = 879
End If
miniy = 0
For ly = miny To maxy
miniy = miniy + 1
minix = 0
For lx = minx To maxx
minix = minix + 1
km = Point(lx, ly)
PSet (minix + 400, miniy + 200), km
Next
Next
End Sub