Qbasicnews.com

Qbasicnews.com > General > General/Misc > Dig your floppies.
Full Version: Dig your floppies.
You're currently viewing a stripped down version of our content. View the full version with proper formatting.

E.K.Virtanen

11-24-2006, 10:06 AM
For those who dont know me, im 50% of www.ascii-world.com
Other 50% is that Canadian, known as MystikShadows. :lol:

If you have some sort of ASCII/text/console (old or new) applications/games/tutorials/articles etc. let me know. Programming language or platform is totally free for us. Even though they might feel even silly or just not worth of mentioning, they might be a real treasures for us. Your simple dice game, hangman, document creator, html file checker can be something someone has looked for he's DOS computer.
Dont let those possible treasures got lost. Smile

There is ton's of good material for us all over the internet but sadly, nicks changes, emails changes, frustrating often there is no mention of license or year when (subject) is created and those are information we want to have before we publish it on our site.

asciiworld@gmail.com

Dr_Davenstein

11-25-2006, 10:25 AM
Here's something in ASC I made a couple years ago. My coding quality has increased exponentially since those days, thanks to FB, but QB coders might still be interested in it. Wink


Code:
'$DYNAMIC
DEFINT A-Z
DECLARE FUNCTION CheckBounds% ()
DECLARE SUB MakeDungeon (IsFirstMaze%)
DECLARE SUB FixWalls ()
DECLARE SUB FixMaze ()
DECLARE SUB RandomizeMonsters ()
DECLARE SUB Waiter (Amount#)
DECLARE SUB Square (X%, Y%, Col%)
DECLARE SUB DrawMaze ()
DECLARE SUB FindPath (M%, StartX%, StartY%, TargX%, TargY%)

COMMON SHARED MazeLength, MazeHeight, TotalMonsters, TotalRooms
CONST True = -1, OpenL = 1, CloseL = -1, Null = 0
CONST GryHi = 15, BluHi = 1, RedHi = 4, GrnHi = 2

SCREEN 12
WIDTH 80, 60
RANDOMIZE TIMER

MazeLength = 50
MazeHeight = 50
TotalMonsters = 16
TotalRooms = 16

TYPE MonsterStuff
X AS INTEGER
Y AS INTEGER
Hp AS INTEGER
TargX AS INTEGER
TargY AS INTEGER
TempX AS INTEGER
TempY AS INTEGER
WalkCnt AS INTEGER
AMoves AS INTEGER
HitTarg AS INTEGER
END TYPE

TYPE MazeStuff
AssY AS INTEGER
Exposed AS INTEGER
InRad AS INTEGER
Col AS INTEGER
Typ AS INTEGER
END TYPE

TYPE RoomStuff
X AS INTEGER
Y AS INTEGER
Sx AS INTEGER
Sy AS INTEGER
Lit AS INTEGER
END TYPE

TYPE PathStuff
Cs AS INTEGER
Px AS INTEGER
Py AS INTEGER
F AS INTEGER
G AS INTEGER
H AS INTEGER
P AS INTEGER
END TYPE

TYPE WalkStuff
X AS INTEGER
Y AS INTEGER
END TYPE

DIM SHARED Rm(TotalRooms) AS RoomStuff, Sort(1 TO MazeLength, 1 TO MazeHeight) AS INTEGER
DIM SHARED Maz(1 TO MazeLength, 1 TO MazeHeight) AS MazeStuff, Mark(1 TO MazeLength, 1 TO MazeHeight) AS INTEGER
DIM SHARED Mnstr(1 TO TotalMonsters) AS MonsterStuff
DIM SHARED Path(1 TO MazeLength, 1 TO MazeHeight) AS PathStuff
DIM SHARED Walk(1 TO ((MazeLength * MazeHeight) \ 2)) AS WalkStuff, TPath(1 TO TotalMonsters, 1 TO TotalMonsters) AS WalkStuff


DO
COLOR (15)
LOCATE 58, 1
PRINT "Building maze, Please Wait.."
MakeDungeon 1
LOCATE 58, 1
PRINT STRING$(28, 32)

RandomizeMonsters
FOR M = 1 TO TotalMonsters
Fx = Mnstr(M).X
Fy = Mnstr(M).Y
Tx = Mnstr(M).TargX
Ty = Mnstr(M).TargY
FindPath M, Tx, Ty, Fx, Fy
NEXT
DrawMaze

DO
In$ = INKEY$
GoodCnt = 0
GotPath = False
StartAt = StartAt + 1
IF StartAt > TotalMonsters THEN StartAt = 1
Fx = Mnstr(StartAt).X
Fy = Mnstr(StartAt).Y
Tx = Mnstr(StartAt).TargX
Ty = Mnstr(StartAt).TargY
FindPath StartAt, Tx, Ty, Fx, Fy

FOR M = 1 TO TotalMonsters
Mnstr(M).HitTarg = False
Ox = Mnstr(M).X
Oy = Mnstr(M).Y
OWalkCnt = Mnstr(M).WalkCnt
Mnstr(M).WalkCnt = Mnstr(M).WalkCnt + 1
IF Mnstr(M).WalkCnt > Mnstr(M).AMoves THEN
Mnstr(M).WalkCnt = Mnstr(M).AMoves
END IF
Mnstr(M).TempX = TPath(M, Mnstr(M).WalkCnt).X
Mnstr(M).TempY = TPath(M, Mnstr(M).WalkCnt).Y

IF Mnstr(M).X < Mnstr(M).TempX THEN Mnstr(M).X = Mnstr(M).X + 1
IF Mnstr(M).X > Mnstr(M).TempX THEN Mnstr(M).X = Mnstr(M).X - 1
IF Mnstr(M).Y < Mnstr(M).TempY THEN Mnstr(M).Y = Mnstr(M).Y + 1
IF Mnstr(M).Y > Mnstr(M).TempY THEN Mnstr(M).Y = Mnstr(M).Y - 1

SELECT CASE Maz(Mnstr(M).X, Mnstr(M).Y).AssY
CASE 24, 25, 176, 234
'These are walkable tiles...
CASE ELSE
'These are walls...
Mnstr(M).X = Ox
Mnstr(M).Y = Oy
Mnstr(M).WalkCnt = OWalkCnt
END SELECT


IF Mnstr(M).X = Mnstr(M).TargX AND Mnstr(M).Y = Mnstr(M).TargY THEN
Mnstr(M).X = Ox
Mnstr(M).Y = Oy
Mnstr(M).HitTarg = True
END IF

FOR C = 1 TO TotalMonsters
IF C <> M THEN
IF Mnstr(C).Hp > 0 THEN
IF Mnstr(M).X = Mnstr(C).X AND Mnstr(M).Y = Mnstr(C).Y THEN
Mnstr(M).X = Ox
Mnstr(M).Y = Oy
Mnstr(M).WalkCnt = OWalkCnt
IF Mnstr(C).HitTarg THEN Mnstr(M).HitTarg = True
END IF
END IF
END IF
NEXT

COLOR (Maz(Ox, Oy).Col)
LOCATE Oy, Ox
PRINT CHR$(Maz(Ox, Oy).AssY)
MonCol = M - 1
IF MonCol = 0 THEN MonCol = 15
COLOR (MonCol)
LOCATE Mnstr(M).Y, Mnstr(M).X
PRINT CHR$(2)
Square Mnstr(M).TargX, Mnstr(M).TargY, 7
IF Mnstr(M).X = Ox AND Mnstr(M).Y = Oy THEN
IF Mnstr(M).HitTarg THEN
GoodCnt = GoodCnt + 1
END IF
END IF
NEXT

Waiter .075
IF In$ = CHR$(27) THEN GOTO Ender
Loops = Loops + 1
IF Loops >= 250 THEN EXIT DO
LOOP UNTIL GoodCnt >= TotalMonsters
Loops = 0
LOOP

Ender:
SYSTEM

REM $STATIC
FUNCTION CheckBounds%
'This function scans the entire level and returns true if it's good...

TotalDots = 0
FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
Sort(X, Y) = True
Mark(X, Y) = True
NEXT
NEXT

FOR Y = 2 TO MazeHeight - 1
FOR X = 2 TO MazeLength - 1
IF Maz(X, Y).AssY = 0 THEN
TotalDots = TotalDots + 1
Sort(X, Y) = 1
Mark(X, Y) = 0
END IF
NEXT
NEXT



Tys = MazeHeight - 1
Txs = MazeLength - 1

FOR Y = 2 TO Tys
FOR X = 2 TO Txs
IF Sort(X, Y) <> True AND NOT GotTheMark THEN
GotTheMark = True
Mark(X, Y) = True
END IF
NEXT
NEXT


FOR Y1 = 2 TO Tys
FOR X1 = 2 TO Txs
YBegin = Y1 - (Tys - (Tys - Y1))
YFinal = Y1 + (Tys - Y1)
XBegin = X1 - (Txs - (Txs - X1))
XFinal = X1 + (Txs - X1)
Cnt1 = 0: Cnt2 = 0
FakeDots = FakeDots + 1
FOR Y2 = YBegin TO YFinal
FOR X2 = XBegin TO XFinal
IF X2 >= 2 AND X2 <= Txs AND Y2 >= 2 AND Y2 <= Tys THEN
Ok1 = Sort(X2 - 1, Y2) <> True AND Mark(X2 - 1, Y2)
Ok2 = Sort(X2 + 1, Y2) <> True AND Mark(X2 + 1, Y2)
Ok3 = Sort(X2, Y2 - 1) <> True AND Mark(X2, Y2 - 1)
Ok4 = Sort(X2, Y2 + 1) <> True AND Mark(X2, Y2 + 1)
Ok = Ok1 OR Ok2 OR Ok3 OR Ok4
IF Ok AND Sort(X2, Y2) <> True THEN
Mark(X2, Y2) = True
Cnt1 = Cnt1 + 1
IF Sort(X2, Y2) = 1 THEN
Cnt2 = Cnt2 + 1
CountDots = CountDots + 1
Sort(X2, Y2) = 0
IF CountDots = TotalDots THEN GOTO Finale
END IF
END IF
END IF
NEXT
NEXT

IF Cnt1 = OCnt1 AND Cnt2 = OCnt2 THEN GOTO Finale
OCnt1 = Cnt1
OCnt2 = Cnt2
NEXT
NEXT

Finale:
IF TotalDots = CountDots THEN CheckBounds% = True


END FUNCTION

SUB DrawMaze

FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
COLOR (Maz(X, Y).Col)
LOCATE Y, X
PRINT CHR$(Maz(X, Y).AssY)
NEXT
NEXT
END SUB

SUB FindPath (M%, StartX%, StartY%, TargX%, TargY%)
IF StartX = TargX AND StartY = TargY THEN
AlreadyThere = True
GOTO Finalize
END IF
REDIM Path(1 TO MazeLength, 1 TO MazeHeight) AS PathStuff
Path(StartX, StartY).Cs = OpenL
FOR C = 1 TO TotalMonsters
IF C <> M THEN
IF Mnstr(C).Hp > 0 THEN
'This gives a penalty to the nodes that are taken by the other monsters.
'It encourages the algo to find another path.
Path(Mnstr(C).X, Mnstr(C).Y).P = 1000
END IF
END IF
NEXT
OnOpenList = 1
Walk(1).X = StartX
Walk(1).Y = StartY


DO
OCurX = CurX
OCurY = CurY
CurScore = 10000
FOR C = 1 TO OnOpenList
IF Walk(C).X > 0 AND Walk(C).Y > 0 THEN
IF Path(Walk(C).X, Walk(C).Y).Cs = OpenL THEN
IF Path(Walk(C).X, Walk(C).Y).F <= CurScore THEN
CurX = Walk(C).X
CurY = Walk(C).Y
CurScore = Path(Walk(C).X, Walk(C).Y).F
TempC = C
END IF
END IF
END IF
NEXT

Path(CurX, CurY).Cs = CloseL
Walk(TempC).X = 0
Walk(TempC).Y = 0

IF CurX = TargX AND CurY = TargY THEN EXIT DO
IF CurX = OCurX AND CurY = OCurY THEN EXIT DO
OldHole = False
FOR Y = -1 TO 1
FOR X = -1 TO 1
Tx = X + CurX
Ty = Y + CurY
IF X = 0 OR Y = 0 THEN MoveCost = 10 ELSE MoveCost = 14
IF Tx = CurX AND Ty = CurY THEN GOTO SkipNode


SELECT CASE Maz(Tx, Ty).AssY
CASE 24, 25, 176, 234

CASE ELSE
GOTO SkipNode
END SELECT


IF Path(Tx, Ty).Cs = Null THEN
Path(Tx, Ty).Cs = OpenL
Path(Tx, Ty).Px = CurX
Path(Tx, Ty).Py = CurY
Path(Tx, Ty).G = Path(CurX, CurY).G + MoveCost
Path(Tx, Ty).H = (ABS(Tx - TargX) + ABS(Ty - TargY)) * 10
Path(Tx, Ty).F = Path(Tx, Ty).G + Path(Tx, Ty).H + Path(Tx, Ty).P
IF OldHole THEN
OnOpenList = OnOpenList + 1
Walk(OnOpenList).X = Tx
Walk(OnOpenList).Y = Ty
ELSE
OldHole = True
Walk(TempC).X = Tx
Walk(TempC).Y = Ty
END IF
END IF
SkipNode:
NEXT
NEXT

LOOP

Finalize:
Mnstr(M).WalkCnt = 0
Mnstr(M).AMoves = 1
IF AlreadyThere THEN
TPath(M, 1).X = StartX
TPath(M, 1).Y = StartY
EXIT SUB
END IF
Tx = Mnstr(M).X
Ty = Mnstr(M).Y
FOR C = 1 TO TotalMonsters
TPath(M, C).X = Path(Tx, Ty).Px
TPath(M, C).Y = Path(Tx, Ty).Py
Tx2 = Path(Tx, Ty).Px
Ty2 = Path(Tx, Ty).Py
Tx = Tx2
Ty = Ty2
IF C > 1 THEN
Mnstr(M).AMoves = C - 1
END IF
IF Tx = 0 OR Ty = 0 THEN
EXIT FOR
END IF
NEXT
END SUB

SUB FixMaze

FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
Sort(X, Y) = 0
Maz(X, Y).Typ = 0
IF Maz(X, Y).AssY = True THEN
Sort(X, Y) = True
END IF
NEXT
NEXT

FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
Nw = 0
Nr = 0
Ne = 0
WS = 0
ES = 0
Sw = 0
St = 0
Se = 0

IF X > 1 AND Y > 1 THEN
Nw = Sort(X - 1, Y - 1) = True
END IF
IF Y > 1 THEN
Nr = Sort(X, Y - 1) = True
END IF
IF Y > 1 AND X < MazeLength THEN
Ne = Sort(X + 1, Y - 1) = True
END IF
IF X > 1 THEN
WS = Sort(X - 1, Y) = True
END IF
Md = Sort(X, Y) = True
IF X < MazeLength THEN
ES = Sort(X + 1, Y) = True
END IF
IF X > 1 AND Y < MazeHeight THEN
Sw = Sort(X - 1, Y + 1) = True
END IF
IF Y < MazeHeight THEN
St = Sort(X, Y + 1) = True
END IF
IF X < MazeLength AND Y < MazeHeight THEN
Se = Sort(X + 1, Y + 1) = True
END IF


TLcn = NOT Nr AND NOT WS AND St AND ES AND Md
BLcn = NOT St AND NOT WS AND Nr AND ES AND Md
TRcn = NOT Nr AND NOT ES AND St AND WS AND Md
BRcn = NOT St AND NOT ES AND Nr AND WS AND Md
Hori = NOT Nr AND NOT St AND WS AND ES AND Md
Vert = NOT WS AND NOT ES AND Nr AND St AND Md
TopT = NOT Nr AND St AND WS AND ES AND Md
BotT = NOT St AND Nr AND WS AND ES AND Md
LevT = NOT WS AND ES AND Nr AND St AND Md
RigT = NOT ES AND WS AND Nr AND St AND Md
Tend = NOT ES AND NOT WS AND NOT Nr AND St AND Md
Bend = NOT ES AND NOT WS AND NOT St AND Nr AND Md
Lend = NOT Nr AND NOT St AND NOT WS AND ES AND Md
Rend = NOT Nr AND NOT St AND NOT ES AND WS AND Md
Cros = Nr AND St AND ES AND WS AND Md
Midl = Md AND NOT Nr AND NOT St AND NOT ES AND NOT WS


IF TLcn THEN Maz(X, Y).AssY = 201: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF BLcn THEN Maz(X, Y).AssY = 200: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF TRcn THEN Maz(X, Y).AssY = 187: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF BRcn THEN Maz(X, Y).AssY = 188: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Hori THEN Maz(X, Y).AssY = 205: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Vert THEN Maz(X, Y).AssY = 186: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF TopT THEN Maz(X, Y).AssY = 203: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF BotT THEN Maz(X, Y).AssY = 202: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF LevT THEN Maz(X, Y).AssY = 204: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF RigT THEN Maz(X, Y).AssY = 185: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Tend THEN Maz(X, Y).AssY = 186: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Bend THEN Maz(X, Y).AssY = 186: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Lend THEN Maz(X, Y).AssY = 205: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Rend THEN Maz(X, Y).AssY = 205: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Cros THEN Maz(X, Y).AssY = 206: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Midl THEN Maz(X, Y).AssY = 254: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = True
IF Maz(X, Y).AssY = 0 THEN Maz(X, Y).AssY = 176: Maz(X, Y).Col = 8: Maz(X, Y).Typ = 0
NEXT
NEXT

FOR Y1 = 1 TO MazeHeight
FOR X1 = 1 TO MazeLength
IF Maz(X1, Y1).AssY < 0 THEN
Maz(X1, Y1).AssY = 177 + INT(RND * 2)
Maz(X1, Y1).Typ = True
Maz(X1, Y1).Col = 8
END IF
NEXT
NEXT

FOR R = 1 TO TotalRooms
FOR Y = Rm(R).Y - 1 TO Rm(R).Y + Rm(R).Sy + 1
FOR X = Rm(R).X - 1 TO Rm(R).X + Rm(R).Sx + 1
InXBox = X >= Rm(R).X AND X <= Rm(R).X + Rm(R).Sx
InYBox = Y >= Rm(R).Y AND Y <= Rm(R).Y + Rm(R).Sy
Corner1 = X = Rm(R).X - 1 AND Y = Rm(R).Y - 1
Corner2 = X = Rm(R).X + Rm(R).Sx + 1 AND Y = Rm(R).Y - 1
Corner3 = X = Rm(R).X - 1 AND Y = Rm(R).Y + Rm(R).Sy + 1
Corner4 = X = Rm(R).X + Rm(R).Sx + 1 AND Y = Rm(R).Y + Rm(R).Sy + 1
OnCorner = Corner1 OR Corner2 OR Corner3 OR Corner4

IF NOT InXBox OR NOT InYBox THEN
IF Maz(X, Y).AssY = 176 AND NOT OnCorner THEN
Maz(X, Y).AssY = 234
Maz(X, Y).Col = 9
Maz(X, Y).Typ = True
END IF
END IF
NEXT
NEXT
NEXT
END SUB

SUB FixWalls
FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
IF Maz(X, Y).AssY <> 0 THEN
Maz(X, Y).AssY = -3
END IF
NEXT
NEXT

FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
FOR Y2 = Y - 1 TO Y + 1
FOR X2 = X - 1 TO X + 1
IF X2 >= 1 AND Y2 >= 1 AND X2 <= MazeLength AND Y2 <= MazeHeight THEN
IF Maz(X, Y).AssY = 0 THEN
IF Maz(X2, Y2).AssY <> 0 THEN
Maz(X2, Y2).AssY = -1
END IF
END IF
END IF
NEXT
NEXT
NEXT
NEXT
END SUB

SUB MakeDungeon (IsFirstMaze%)
StartAgain:
FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
Maz(X, Y).AssY = True
Maz(X, Y).Exposed = False
NEXT
NEXT

IF IsFirstMaze% = 1 THEN
StartRooms = 1
ELSE
StartRooms = 2
IF NOT StartAgainFlag THEN
Rm(1).X = Rm(TotalRooms).X
Rm(1).Y = Rm(TotalRooms).Y
Rm(1).Sx = Rm(TotalRooms).Sx
Rm(1).Sy = Rm(TotalRooms).Sy
END IF
FOR Ry = Rm(1).Y TO Rm(1).Y + Rm(1).Sy
FOR Rx = Rm(1).X TO Rm(1).X + Rm(1).Sx
Maz(Rx, Ry).AssY = 0
NEXT
NEXT
END IF

StartAgainFlag = True

FOR Rooms = StartRooms TO TotalRooms
Rm(Rooms).X = -1000
Rm(Rooms).Y = -1000
Rm(Rooms).Sx = 1
Rm(Rooms).Sy = 1
Rm(Rooms).Lit = False
IF INT(RND * 100) >= 75 THEN Rm(Rooms).Lit = True
NEXT

Rooms = StartRooms
RandomRooms:
DO
RANDOMIZE TIMER
Rm(Rooms).X = 2 + INT(RND * (MazeLength - 2))
Rm(Rooms).Y = 2 + INT(RND * (MazeHeight - 2))
Rm(Rooms).Sx = 3 + INT(RND * 5)
Rm(Rooms).Sy = 3 + INT(RND * 5)
IF Rm(Rooms).X + Rm(Rooms).Sx > MazeLength - 1 THEN GOTO RandomRooms
IF Rm(Rooms).Y + Rm(Rooms).Sy > MazeHeight - 1 THEN GOTO RandomRooms

FOR R2 = 1 TO TotalRooms
IF R2 <> Rooms THEN
InX = Rm(R2).X + (Rm(R2).Sx + 3) >= Rm(Rooms).X AND Rm(R2).X <= Rm(Rooms).X + (Rm(Rooms).Sx + 3)
InY = Rm(R2).Y + (Rm(R2).Sy + 3) >= Rm(Rooms).Y AND Rm(R2).Y <= Rm(Rooms).Y + (Rm(Rooms).Sy + 3)
InBox = InX AND InY
IF InBox THEN GOTO RandomRooms
END IF
NEXT

FOR Ey = Rm(Rooms).Y TO Rm(Rooms).Y + Rm(Rooms).Sy
FOR Ex = Rm(Rooms).X TO Rm(Rooms).X + Rm(Rooms).Sx
IF Ex >= 2 AND Ex <= MazeLength - 1 AND Ey >= 2 AND Ey <= MazeHeight - 1 THEN
Maz(Ex, Ey).AssY = 0
END IF
NEXT
NEXT
Rooms = Rooms + 1
LOOP UNTIL Rooms >= TotalRooms + 1

AtX = Rm(1).X + (Rm(1).Sx \ 2)
AtY = Rm(1).Y + (Rm(1).Sy \ 2)

FOR Rooms = 1 TO TotalRooms
TryRoomsAgain:

FOR Fy = 1 TO MazeHeight
FOR Fx = 1 TO MazeLength
Sort(Fx, Fy) = Maz(Fx, Fy).AssY
NEXT
NEXT

AtX = Rm(Rooms).X + INT(RND * ((Rm(Rooms).Sx)))
AtY = Rm(Rooms).Y + INT(RND * ((Rm(Rooms).Sy)))
IF Rooms < TotalRooms THEN
TargX = Rm(Rooms + 1).X + INT(RND * (Rm(Rooms + 1).Sx))
TargY = Rm(Rooms + 1).Y + INT(RND * (Rm(Rooms + 1).Sy))
ELSE
TargX = Rm(1).X + INT(RND * (Rm(1).Sx))
TargY = Rm(1).Y + INT(RND * (Rm(1).Sy))
END IF

HitTarget = 0


DO
AddX = 0
AddY = 0
IF AtX < TargX THEN AddX = 1
IF AtX > TargX THEN AddX = -1
IF AtY < TargY THEN AddY = 1
IF AtY > TargY THEN AddY = -1

FOR R = 1 TO TotalRooms
InX = AtX >= Rm(R).X - 1 AND AtX <= Rm(R).X + Rm(R).Sx + 1
InY = AtY >= Rm(R).Y - 1 AND AtY <= Rm(R).Y + Rm(R).Sy + 1
OnXBorder = AtX = Rm(R).X - 1 OR AtX = Rm(R).X + Rm(R).Sx + 1
OnYBorder = AtY = Rm(R).Y - 1 OR AtY = Rm(R).Y + Rm(R).Sy + 1
OnBorder = InX AND InY
IF OnBorder THEN EXIT FOR
NEXT

IF OnBorder THEN
IF OnXBorder AND NOT OnYBorder THEN AddY = 0
IF OnYBorder AND NOT OnXBorder THEN AddX = 0
END IF

IF AddX <> 0 AND AddY <> 0 THEN
RandGo = INT(RND * 2)
IF RandGo = 0 THEN AddX = 0
IF RandGo = 1 THEN AddY = 0
END IF
IF AddX = 0 AND AddY = 0 THEN GOTO TryRoomsAgain

AtX = AtX + AddX
AtY = AtY + AddY

FOR AtY2 = AtY - 1 TO AtY + 1
FOR AtX2 = AtX - 1 TO AtX + 1
IF AtX2 >= 2 AND AtX2 <= MazeLength - 1 AND AtY2 >= 2 AND AtY2 <= MazeHeight - 1 THEN
InX = AtX2 >= Rm(Rooms).X AND AtX2 <= Rm(Rooms).X + Rm(Rooms).Sx
InY = AtY2 >= Rm(Rooms).Y AND AtY2 <= Rm(Rooms).Y + Rm(Rooms).Sy
InStartBox = InX AND InY
IF Sort(AtX2, AtY2) = 0 THEN
IF NOT InStartBox THEN
IF AtX2 = AtX OR AtY2 = AtY THEN
HitTarget = True
END IF
END IF
END IF
END IF
NEXT
NEXT

Sort(AtX, AtY) = 3

IF AtX = TargX AND AtY = TargY THEN HitTarget = True
IF NOT HitTarget THEN
FOR R = 1 TO TotalRooms
Corner1 = AtX = Rm(R).X - 1 AND AtY = Rm(R).Y - 1
Corner2 = AtX = Rm(R).X + Rm(R).Sx + 1 AND AtY = Rm(R).Y - 1
Corner3 = AtX = Rm(R).X - 1 AND AtY = Rm(R).Y + Rm(R).Sy + 1
Corner4 = AtX = Rm(R).X + Rm(R).Sx + 1 AND AtY = Rm(R).Y + Rm(R).Sy + 1
OnCorner5 = Corner1 OR Corner2 OR Corner3 OR Corner4
OnCorner = OnCorner5 AND Rooms <> R
IF OnCorner THEN
GOTO TryRoomsAgain
END IF
NEXT
END IF

LOOP UNTIL HitTarget

FOR FixY = 1 TO MazeHeight
FOR FixX = 1 TO MazeLength
IF Sort(FixX, FixY) = 3 THEN
Maz(FixX, FixY).AssY = 3
Sort(FixX, FixY) = 0
END IF
NEXT
NEXT
NEXT


FOR FixY = 1 TO MazeHeight
FOR FixX = 1 TO MazeLength
IF Maz(FixX, FixY).AssY = 3 THEN
Maz(FixX, FixY).AssY = 0
END IF
NEXT
NEXT


IF NOT CheckBounds% THEN GOTO StartAgain

FOR Y = 1 TO MazeHeight
FOR X = 1 TO MazeLength
IF Y = 1 OR Y = MazeHeight OR X = 1 OR X = MazeLength THEN
Maz(X, Y).AssY = True
END IF
NEXT
NEXT

FixWalls
FixMaze

X1 = Rm(1).X + (Rm(1).Sx \ 2)
Y1 = Rm(1).Y + (Rm(1).Sy \ 2)
X2 = Rm(TotalRooms).X + (Rm(TotalRooms).Sx \ 2)
Y2 = Rm(TotalRooms).Y + (Rm(TotalRooms).Sy \ 2)

Maz(X1, Y1).AssY = 24
Maz(X1, Y1).Col = RedHi

Maz(X2, Y2).AssY = 25
Maz(X2, Y2).Col = BluHi

END SUB

SUB RandomizeMonsters
RandomTarg:
TargX = 1 + INT(RND * MazeLength)
TargY = 1 + INT(RND * MazeHeight)
SELECT CASE Maz(TargX, TargY).AssY
CASE 24, 25, 176, 234
CASE ELSE
GOTO RandomTarg
END SELECT

FOR M = 1 TO TotalMonsters
RandomPos:
Mnstr(M).X = 1 + INT(RND * MazeLength)
Mnstr(M).Y = 1 + INT(RND * MazeHeight)
Mnstr(M).TargX = TargX
Mnstr(M).TargY = TargY
Mnstr(M).Hp = 100
Mnstr(M).HitTarg = False
SELECT CASE Maz(Mnstr(M).X, Mnstr(M).Y).AssY
CASE 24, 25, 176, 234
CASE ELSE
GOTO RandomPos
END SELECT
IF Mnstr(M).X = TargX AND Mnstr(M).Y = TargY THEN GOTO RandomPos
FOR M2 = 1 TO TotalMonsters
IF M2 <> M THEN
IF Mnstr(M).X = Mnstr(M2).X AND Mnstr(M).Y = Mnstr(M2).X THEN GOTO RandomPos
END IF
NEXT
NEXT
END SUB

SUB Square (X%, Y%, Col%)
COLOR (15)
LOCATE Y, X
PRINT "X"
END SUB

SUB Waiter (Amount#)
TTime# = TIMER + Amount#
DO: LOOP UNTIL TIMER > TTime#
END SUB
Qbasicnews.com > General > General/Misc > Dig your floppies.