Dungeon Generator

Übersicht

BlitzBasic

Allgemein

	Krischan Betreff: Dungeon Generator	Do, Jan 11, 2007 19:18 Antworten mit Zitat
Hallo zusammen, ich habe im Netz einen schönen Dungeon Generator entdeckt, habe aber echte Probleme, den alten QuickBASIC Sourcecode zu lesen geschweigen denn auf BB zu portieren. Hier mal ein Screenshot, was der kann (Dungeons mit Räumen und Türen basteln): Hat einer von Euch Lust den Code umzuschreiben? Nicht dass ich zu faul dazu bin, ich verstehe nur den QB-Code nicht mehr (auch schon wieder 15 Jahre her, dass ich mit QB was gebastelt habe). Es könnte vielleicht auch den einen oder anderen hier interessieren, so als RPG-Basis. Ich hab da jetzt auch kein konkretes Projekt im Auge, bin nur durch Zufall nach Spielen des Sword of Fargoal-Remake drauf gestossen (ein echter Klassiker ). Oh, und kennt Ihr eigentlich noch Legend of Faerghail oder oute ich mich jetzt als alter Knacker (30+x)? Hier der Code: Code: [AUSKLAPPEN] [EINKLAPPEN] DEFINT A-Z' speeds things up DECLARE SUB initdungeon () 'blanks out dungeon array DECLARE SUB displaydungeon () 'draws dungeon to the screen DECLARE SUB generate (recurdepth) 'main generation function 'checks bounds for halls and rooms DECLARE FUNCTION CheckBounds (x1, x2, y1, y2, direction) DECLARE FUNCTION CheckBoundsHall (x1, x2, y1, y2, direction) 'makes the halls and rooms DECLARE SUB makehall (x1, x2, y1, y2, direction) DECLARE SUB makeroom (x1, x2, y1, y2, direction, recurdepth) 'random number between lowest and highest DECLARE FUNCTION Rand (Lowest, Highest) 'map array DIM SHARED DungeonLayer(150, 150) AS INTEGER 'what this does is makes a list of rooms that were created. 'then if the generator hits a dead end it goes back to a random room 'in the list and takes up generation from there. DIM SHARED RoomHolder(200, 4) AS INTEGER 'max numbers of maps DIM SHARED maxx 'MaxX coord of Dungeon DIM SHARED maxy 'MaxY of Dungeon DIM recurdepth AS INTEGER 'map and engine constants DIM SHARED wall AS INTEGER DIM SHARED floor AS INTEGER DIM SHARED door AS INTEGER DIM SHARED true AS INTEGER DIM SHARED false AS INTEGER DIM SHARED Permwall AS INTEGER DIM SHARED numofrooms AS INTEGER DIM SHARED maxnumofrooms AS INTEGER 'these are the ascii numbers (like angband for the door and walls) door = 43 Permwall = 178 wall = 176 floor = 46 true = 1 false = -1 recurdepth = 0 numofrooms = 0 DIM x1 AS INTEGER' top right coordinates DIM y1 AS INTEGER' top left coordinates DIM x2 AS INTEGER' bottom right coordinates DIM y2 AS INTEGER' bottom left coordinates DIM direction AS INTEGER 'these tie into the DungeonLayer array so the size will have to be 'increased there to increase these numbers maxx = 150 maxy = 150 ' maxnumofrooms is tied into RoomHolder ' at 200 it bogs down and fails a lot try setting to 200 you'll see maxnumofrooms = 150 RANDOMIZE TIMER DO 'this times the generation T! = TIMER initdungeon generate (recurdepth) T2! = TIMER T3! = T2! - T! displaydungeon' I'm not adding this into the timer 'seeing as it only displays the dungeon LOCATE 1, 21: COLOR 4: PRINT "Door color" LOCATE 2, 21: COLOR 8: PRINT "Wall color " LOCATE 3, 21: COLOR 15: PRINT "PermaWall color" LOCATE 6, 21: COLOR 15: PRINT "# of Rooms"; numofrooms LOCATE 9, 21: PRINT "One pixel =" LOCATE 10, 23: PRINT "one ascii tile" LOCATE 21, 1: PRINT "Time to make "; T3!; " Seconds." LOCATE 22, 1: PRINT "Press esc to quit" LOCATE 23, 1: PRINT "Any other key to generate again" SLEEP LOOP UNTIL INKEY$ = CHR$(27) END FUNCTION CheckBounds (x1, x2, y1, y2, direction) CheckBounds = 0 'Makes sure room isn't out of bounds of Dungeon 'Our dungeon is 1 to MaxX and 1 to MaxY IF (x1 - 1) < 1 THEN CheckBounds = false: EXIT FUNCTION IF (y1 - 1) < 1 THEN CheckBounds = false: EXIT FUNCTION IF (x2 + 1) > maxx THEN CheckBounds = false: EXIT FUNCTION IF (y2 + 1) > maxy THEN CheckBounds = false: EXIT FUNCTION FOR x = (x1 - 1) TO (x2 + 1) FOR y = (y1 - 1) TO (y2 + 1) IF DungeonLayer(x, y) = floor THEN CheckBounds = false: EXIT FUNCTION NEXT y NEXT x CheckBounds = true END FUNCTION FUNCTION CheckBoundsHall (x1, x2, y1, y2, direction) CheckBoundsHall = 0 'Makes sure hall isn't out of bounds of Dungeon 'Our dungeon is 1 to MaxX and 1 to MaxY IF (x1 - 1) < 1 THEN CheckBoundsHall = false: EXIT FUNCTION IF (y1 - 1) < 1 THEN CheckBoundsHall = false: EXIT FUNCTION IF (x2 + 1) > maxx THEN CheckBoundsHall = false: EXIT FUNCTION IF (y2 + 1) > maxy THEN CheckBoundsHall = false: EXIT FUNCTION IF direction = 0 OR direction = 2 THEN FOR x = x1 TO x2 FOR y = (y1 - 1) TO (y2 + 1) IF DungeonLayer(x, y) = floor THEN CheckBoundsHall = false: EXIT FUNCTION NEXT y NEXT x END IF IF direction = 1 OR direction = 3 THEN FOR x = (x1 - 1) TO (x2 + 1) FOR y = y1 TO y2 IF DungeonLayer(x, y) = floor THEN CheckBoundsHall = false: EXIT FUNCTION NEXT y NEXT x END IF CheckBoundsHall = true END FUNCTION SUB displaydungeon 'this just draws the dungeon CLS SCREEN 13 FOR x = 1 TO maxx FOR y = 1 TO maxy IF DungeonLayer(x, y) = wall THEN PSET (x, y), 8 IF DungeonLayer(x, y) = Permwall THEN PSET (x, y), 15 IF DungeonLayer(x, y) = door THEN PSET (x, y), 4 IF DungeonLayer(x, y) = floor THEN PSET (x, y), 0 NEXT y NEXT x END SUB SUB generate (recurdepth) 'start with a random room x1 = Rand(2, (maxx - 1)) y1 = Rand(2, (maxy - 1)) x2 = x1 + Rand(2, 4) y2 = y1 + Rand(3, 7) direction = Rand(0, 3) IF CheckBounds(x1, x2, y1, y2, direction) = true THEN CALL makeroom(x1, x2, y1, y2, direction, recurdepth) END IF room = true DO 'these are all to make sure we dont get into an infinite loop hallcount = 0 hallcountmultp = 0 roomcount = 0 roomcountmultp = 0 'ite mean iterations DO ite = ite + 1 direction = Rand(0, 3)'the direction we want to draw towards '0 north(up) : 1 east(right) : 2 south(down) : 3 west(left) hall = false hallcount = hallcount + 1 halllength = Rand(2, 7)'min and max length of halls 'for all hall generation they are basically the same IF direction = 0 THEN 'halls are only 1 square wide dy1 = Rand(y1, y2) dy2 = dy1 'and as long as our halllength variable dx2 = x1 - 2 dx1 = dx2 - halllength ' we check to see if it's in bounds IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN ' if it is we actually put it there CALL makehall(dx1, dx2, dy1, dy2, direction) ' draw a door if it hits a room (this can be change to randomly place any type ' of feature) IF room = true THEN DungeonLayer(dx2 + 1, dy1) = door ELSE 'make it a floor tile if it doesn't hit a room DungeonLayer(dx2 + 1, dy1) = floor END IF 'these are saved to pass to the room creation section below x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 'sets hall to true so we can move on hall = true END IF END IF IF direction = 1 THEN dy1 = y2 + 2 dy2 = dy1 + halllength dx1 = Rand(x1, x2) dx2 = dx1 IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN CALL makehall(dx1, dx2, dy1, dy2, direction) IF room = true THEN DungeonLayer(dx1, dy1 - 1) = door ELSE DungeonLayer(dx1, dy1 - 1) = floor END IF x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 hall = true END IF END IF IF direction = 2 THEN dy1 = Rand(y1, y2) dy2 = dy1 dx1 = x2 + 2 dx2 = dx1 + halllength IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN CALL makehall(dx1, dx2, dy1, dy2, direction) IF room = true THEN DungeonLayer(dx1 - 1, dy1) = door ELSE DungeonLayer(dx1 - 1, dy1) = floor END IF x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 hall = true END IF END IF IF direction = 3 THEN dy1 = (y1 - halllength) - 2 dy2 = dy1 + halllength dx1 = Rand(x1, x2) dx2 = dx1 IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN CALL makehall(dx1, dx2, dy1, dy2, direction) IF room = true THEN DungeonLayer(dx2, dy2 + 1) = door ELSE DungeonLayer(dx2, dy2 + 1) = floor END IF x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 hall = true END IF END IF 'if we cant make a hall after 10 tries then we.... IF hallcount > 10 AND hall = false THEN 'pick a random room from our list RDepth = Rand(1, recurdepth) 'make old room the dimensions of our current room x1 = RoomHolder(RDepth, 0) x2 = RoomHolder(RDepth, 1) y1 = RoomHolder(RDepth, 2) y2 = RoomHolder(RDepth, 3) 'reset hall count hallcount = 0 'increment our hallmult counter and go again hallcountmultp = hallcountmultp + 1 END IF 'if we tried to make a hall more than 1000 times (hallcount * hallcountmultp) 'and no hall was made then we failed IF hallcountmultp > 100 THEN PRINT "FAILED at "; recurdepth; " Rooms": SLEEP numofrooms = recurdepth: EXIT SUB END IF LOOP UNTIL hall = true '************ room creation below room = false IF direction = 0 THEN 'holder is a dummy variable holder = Rand(3, 7) dx2 = x1 - 2 dx1 = dx2 - Rand(2, 4) dy1 = Rand((y1 - holder), y2) dy2 = dy1 + holder 'check to see if our room is in bounds IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN 'if it is, set it in stone(so to speak) CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) 'put a door here cause this is where our hall will begin DungeonLayer(x1 - 1, y1) = door 'put our end room coordiantes into these variables so we can send them 'to our hall creation section above x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 'set to true so we can end room = true END IF END IF IF direction = 1 THEN holder = Rand(2, 4) dx1 = Rand((x1 - holder), x2) dx2 = dx1 + holder dy1 = y2 + 2 dy2 = dy1 + Rand(3, 7) IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) DungeonLayer(x2, y2 + 1) = door x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 room = true END IF END IF IF direction = 2 THEN holder = Rand(3, 7) dx1 = x2 + 2 dx2 = dx1 + Rand(2, 4) dy1 = Rand(y1 - holder, y2) dy2 = dy1 + holder IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) DungeonLayer(x2 + 1, y2) = door x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 room = true END IF END IF IF direction = 3 THEN holder = Rand(2, 4) dx1 = Rand((x1 - holder), x2) dx2 = dx1 + holder dy2 = y1 - 2 dy1 = dy2 - Rand(3, 7) IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) DungeonLayer(x2, y1 - 1) = door x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 room = true END IF END IF 'do 4000 total loops,if it is more than 4000 then fail IF ite > 4000 THEN PRINT "FAILED at"; recurdepth; "Rooms": SLEEP numofrooms = recurdepth: EXIT SUB END IF LOOP UNTIL recurdepth = maxnumofrooms numofrooms = recurdepth END SUB SUB initdungeon 'fill our dungeon with rock FOR x = 1 TO maxx FOR y = 1 TO maxy DungeonLayer(x, y) = wall NEXT y NEXT x ' make the edges permawall FOR y = 1 TO maxy DungeonLayer(maxx, y) = Permwall DungeonLayer(1, y) = Permwall NEXT y FOR x = 1 TO maxx DungeonLayer(x, maxy) = Permwall DungeonLayer(x, 1) = Permwall NEXT x END SUB SUB makehall (x1, x2, y1, y2, direction) 'draw our dungeon always from upper left to lower right FOR x = x1 TO x2 FOR y = y1 TO y2 DungeonLayer(x, y) = floor NEXT y NEXT x END SUB SUB makeroom (x1, x2, y1, y2, direction, recurdepth) 'draw our dungeon always from upper left to lower right FOR x = x1 TO x2 FOR y = y1 TO y2 DungeonLayer(x, y) = floor NEXT y NEXT x recurdepth = recurdepth + 1 ' this holds our rooms so we can choose one at random if we get stuck ' we never save halls or it would be a horrendous mess RoomHolder(recurdepth, 0) = x1 RoomHolder(recurdepth, 1) = x2 RoomHolder(recurdepth, 2) = y1 RoomHolder(recurdepth, 3) = y2 END SUB FUNCTION Rand (Lowest, Highest) DIM a AS INTEGER DIM b AS INTEGER DIM c AS INTEGER a = Lowest b = Highest IF a > b THEN c = a - b ELSEIF b > a THEN c = b - a ELSE Rand = a: EXIT FUNCTION END IF Rand = INT(RND(1) * (c + 1)) + a END FUNCTION

Krischan

Betreff: Dungeon Generator

Do, Jan 11, 2007 19:18
Antworten mit Zitat

Hallo zusammen,

ich habe im Netz einen schönen Dungeon Generator entdeckt, habe aber echte Probleme, den alten QuickBASIC Sourcecode zu lesen geschweigen denn auf BB zu portieren. Hier mal ein Screenshot, was der kann (Dungeons mit Räumen und Türen basteln):

user posted image

Hat einer von Euch Lust den Code umzuschreiben? Nicht dass ich zu faul dazu bin, ich verstehe nur den QB-Code nicht mehr (auch schon wieder 15 Jahre her, dass ich mit QB was gebastelt habe). Es könnte vielleicht auch den einen oder anderen hier interessieren, so als RPG-Basis.

Ich hab da jetzt auch kein konkretes Projekt im Auge, bin nur durch Zufall nach Spielen des Sword of Fargoal-Remake drauf gestossen (ein echter Klassiker Smile

). Oh, und kennt Ihr eigentlich noch Legend of Faerghail oder oute ich mich jetzt als alter Knacker (30+x)?

Hier der Code:

Code: [AUSKLAPPEN]

DEFINT A-Z' speeds things up
DECLARE SUB initdungeon () 'blanks out dungeon array
DECLARE SUB displaydungeon () 'draws dungeon to the screen
DECLARE SUB generate (recurdepth) 'main generation function

'checks bounds for halls and rooms
DECLARE FUNCTION CheckBounds (x1, x2, y1, y2, direction)
DECLARE FUNCTION CheckBoundsHall (x1, x2, y1, y2, direction)

'makes the halls and rooms
DECLARE SUB makehall (x1, x2, y1, y2, direction)
DECLARE SUB makeroom (x1, x2, y1, y2, direction, recurdepth)

'random number between lowest and highest
DECLARE FUNCTION Rand (Lowest, Highest)

'map array
DIM SHARED DungeonLayer(150, 150) AS INTEGER

'what this does is makes a list of rooms that were created.
'then if the generator hits a dead end it goes back to a random room
'in the list and takes up generation from there.
DIM SHARED RoomHolder(200, 4) AS INTEGER

'max numbers of maps
DIM SHARED maxx 'MaxX coord of Dungeon
DIM SHARED maxy 'MaxY of Dungeon
DIM recurdepth AS INTEGER

'map and engine constants
DIM SHARED wall AS INTEGER
DIM SHARED floor AS INTEGER
DIM SHARED door AS INTEGER
DIM SHARED true AS INTEGER
DIM SHARED false AS INTEGER
DIM SHARED Permwall AS INTEGER
DIM SHARED numofrooms AS INTEGER
DIM SHARED maxnumofrooms AS INTEGER

'these are the ascii numbers (like angband for the door and walls)
door = 43
Permwall = 178
wall = 176
floor = 46

true = 1
false = -1

recurdepth = 0
numofrooms = 0

DIM x1 AS INTEGER' top right coordinates
DIM y1 AS INTEGER' top left coordinates
DIM x2 AS INTEGER' bottom right coordinates
DIM y2 AS INTEGER' bottom left coordinates
DIM direction AS INTEGER

'these tie into the DungeonLayer array so the size will have to be
'increased there to increase these numbers
maxx = 150
maxy = 150

' maxnumofrooms is tied into RoomHolder
' at 200 it bogs down and fails a lot try setting to 200 you'll see

maxnumofrooms = 150

RANDOMIZE TIMER

DO
'this times the generation
T! = TIMER
initdungeon
generate (recurdepth)
T2! = TIMER
T3! = T2! - T!

displaydungeon' I'm not adding this into the timer
'seeing as it only displays the dungeon
LOCATE 1, 21: COLOR 4: PRINT "Door color"
LOCATE 2, 21: COLOR 8: PRINT "Wall color "
LOCATE 3, 21: COLOR 15: PRINT "PermaWall color"
LOCATE 6, 21: COLOR 15: PRINT "# of Rooms"; numofrooms
LOCATE 9, 21: PRINT "One pixel ="
LOCATE 10, 23: PRINT "one ascii tile"
LOCATE 21, 1: PRINT "Time to make "; T3!; " Seconds."
LOCATE 22, 1: PRINT "Press esc to quit"
LOCATE 23, 1: PRINT "Any other key to generate again"
SLEEP
LOOP UNTIL INKEY$ = CHR$(27)
END

FUNCTION CheckBounds (x1, x2, y1, y2, direction)
CheckBounds = 0
'Makes sure room isn't out of bounds of Dungeon
'Our dungeon is 1 to MaxX and 1 to MaxY

IF (x1 - 1) < 1 THEN CheckBounds = false: EXIT FUNCTION
IF (y1 - 1) < 1 THEN CheckBounds = false: EXIT FUNCTION
IF (x2 + 1) > maxx THEN CheckBounds = false: EXIT FUNCTION
IF (y2 + 1) > maxy THEN CheckBounds = false: EXIT FUNCTION

FOR x = (x1 - 1) TO (x2 + 1)
FOR y = (y1 - 1) TO (y2 + 1)
IF DungeonLayer(x, y) = floor THEN CheckBounds = false: EXIT FUNCTION
NEXT y
NEXT x
CheckBounds = true
END FUNCTION

FUNCTION CheckBoundsHall (x1, x2, y1, y2, direction)
CheckBoundsHall = 0
'Makes sure hall isn't out of bounds of Dungeon
'Our dungeon is 1 to MaxX and 1 to MaxY

IF (x1 - 1) < 1 THEN CheckBoundsHall = false: EXIT FUNCTION
IF (y1 - 1) < 1 THEN CheckBoundsHall = false: EXIT FUNCTION
IF (x2 + 1) > maxx THEN CheckBoundsHall = false: EXIT FUNCTION
IF (y2 + 1) > maxy THEN CheckBoundsHall = false: EXIT FUNCTION

IF direction = 0 OR direction = 2 THEN
FOR x = x1 TO x2
FOR y = (y1 - 1) TO (y2 + 1)
IF DungeonLayer(x, y) = floor THEN CheckBoundsHall = false: EXIT FUNCTION
NEXT y
NEXT x
END IF

IF direction = 1 OR direction = 3 THEN
FOR x = (x1 - 1) TO (x2 + 1)
FOR y = y1 TO y2
IF DungeonLayer(x, y) = floor THEN CheckBoundsHall = false: EXIT FUNCTION
NEXT y
NEXT x
END IF

CheckBoundsHall = true
END FUNCTION

SUB displaydungeon
'this just draws the dungeon
CLS
SCREEN 13
FOR x = 1 TO maxx
FOR y = 1 TO maxy
IF DungeonLayer(x, y) = wall THEN PSET (x, y), 8
IF DungeonLayer(x, y) = Permwall THEN PSET (x, y), 15
IF DungeonLayer(x, y) = door THEN PSET (x, y), 4
IF DungeonLayer(x, y) = floor THEN PSET (x, y), 0
NEXT y
NEXT x
END SUB

SUB generate (recurdepth)

'start with a random room
x1 = Rand(2, (maxx - 1))
y1 = Rand(2, (maxy - 1))
x2 = x1 + Rand(2, 4)
y2 = y1 + Rand(3, 7)

direction = Rand(0, 3)
IF CheckBounds(x1, x2, y1, y2, direction) = true THEN
CALL makeroom(x1, x2, y1, y2, direction, recurdepth)
END IF

room = true

DO
'these are all to make sure we dont get into an infinite loop
hallcount = 0
hallcountmultp = 0
roomcount = 0
roomcountmultp = 0
'ite mean iterations

DO
ite = ite + 1
direction = Rand(0, 3)'the direction we want to draw towards
'0 north(up) : 1 east(right) : 2 south(down) : 3 west(left)

hall = false
hallcount = hallcount + 1

halllength = Rand(2, 7)'min and max length of halls

'for all hall generation they are basically the same
IF direction = 0 THEN
'halls are only 1 square wide
dy1 = Rand(y1, y2)
dy2 = dy1
'and as long as our halllength variable
dx2 = x1 - 2
dx1 = dx2 - halllength
' we check to see if it's in bounds
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
' if it is we actually put it there
CALL makehall(dx1, dx2, dy1, dy2, direction)
' draw a door if it hits a room (this can be change to randomly place any type
' of feature)
IF room = true THEN
DungeonLayer(dx2 + 1, dy1) = door
ELSE
'make it a floor tile if it doesn't hit a room
DungeonLayer(dx2 + 1, dy1) = floor
END IF
'these are saved to pass to the room creation section below
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
'sets hall to true so we can move on
hall = true
END IF

END IF
IF direction = 1 THEN
dy1 = y2 + 2
dy2 = dy1 + halllength
dx1 = Rand(x1, x2)
dx2 = dx1
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
CALL makehall(dx1, dx2, dy1, dy2, direction)
IF room = true THEN
DungeonLayer(dx1, dy1 - 1) = door
ELSE
DungeonLayer(dx1, dy1 - 1) = floor
END IF
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
hall = true
END IF

END IF

IF direction = 2 THEN
dy1 = Rand(y1, y2)
dy2 = dy1
dx1 = x2 + 2
dx2 = dx1 + halllength
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
CALL makehall(dx1, dx2, dy1, dy2, direction)
IF room = true THEN
DungeonLayer(dx1 - 1, dy1) = door
ELSE
DungeonLayer(dx1 - 1, dy1) = floor
END IF
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
hall = true
END IF
END IF

IF direction = 3 THEN
dy1 = (y1 - halllength) - 2
dy2 = dy1 + halllength
dx1 = Rand(x1, x2)
dx2 = dx1
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
CALL makehall(dx1, dx2, dy1, dy2, direction)
IF room = true THEN
DungeonLayer(dx2, dy2 + 1) = door
ELSE
DungeonLayer(dx2, dy2 + 1) = floor
END IF
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
hall = true
END IF
END IF

'if we cant make a hall after 10 tries then we....
IF hallcount > 10 AND hall = false THEN
'pick a random room from our list
RDepth = Rand(1, recurdepth)
'make old room the dimensions of our current room
x1 = RoomHolder(RDepth, 0)
x2 = RoomHolder(RDepth, 1)
y1 = RoomHolder(RDepth, 2)
y2 = RoomHolder(RDepth, 3)
'reset hall count
hallcount = 0
'increment our hallmult counter and go again
hallcountmultp = hallcountmultp + 1
END IF

'if we tried to make a hall more than 1000 times (hallcount * hallcountmultp)
'and no hall was made then we failed
IF hallcountmultp > 100 THEN
PRINT "FAILED at "; recurdepth; " Rooms": SLEEP
numofrooms = recurdepth: EXIT SUB
END IF

LOOP UNTIL hall = true

'************ room creation below

room = false

IF direction = 0 THEN
'holder is a dummy variable
holder = Rand(3, 7)
dx2 = x1 - 2
dx1 = dx2 - Rand(2, 4)
dy1 = Rand((y1 - holder), y2)
dy2 = dy1 + holder
'check to see if our room is in bounds
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
'if it is, set it in stone(so to speak)
CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
'put a door here cause this is where our hall will begin
DungeonLayer(x1 - 1, y1) = door
'put our end room coordiantes into these variables so we can send them
'to our hall creation section above
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
'set to true so we can end
room = true
END IF

END IF

IF direction = 1 THEN
holder = Rand(2, 4)
dx1 = Rand((x1 - holder), x2)
dx2 = dx1 + holder
dy1 = y2 + 2
dy2 = dy1 + Rand(3, 7)
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
DungeonLayer(x2, y2 + 1) = door
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
room = true
END IF
END IF

IF direction = 2 THEN
holder = Rand(3, 7)
dx1 = x2 + 2
dx2 = dx1 + Rand(2, 4)
dy1 = Rand(y1 - holder, y2)
dy2 = dy1 + holder
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
DungeonLayer(x2 + 1, y2) = door
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
room = true
END IF
END IF

IF direction = 3 THEN
holder = Rand(2, 4)
dx1 = Rand((x1 - holder), x2)
dx2 = dx1 + holder
dy2 = y1 - 2
dy1 = dy2 - Rand(3, 7)
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
CALL makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
DungeonLayer(x2, y1 - 1) = door
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
room = true
END IF
END IF

'do 4000 total loops,if it is more than 4000 then fail
IF ite > 4000 THEN
PRINT "FAILED at"; recurdepth; "Rooms": SLEEP
numofrooms = recurdepth: EXIT SUB
END IF
LOOP UNTIL recurdepth = maxnumofrooms
numofrooms = recurdepth
END SUB

SUB initdungeon
'fill our dungeon with rock
FOR x = 1 TO maxx
FOR y = 1 TO maxy
DungeonLayer(x, y) = wall
NEXT y
NEXT x
' make the edges permawall
FOR y = 1 TO maxy
DungeonLayer(maxx, y) = Permwall
DungeonLayer(1, y) = Permwall
NEXT y
FOR x = 1 TO maxx
DungeonLayer(x, maxy) = Permwall
DungeonLayer(x, 1) = Permwall
NEXT x
END SUB

SUB makehall (x1, x2, y1, y2, direction)
'draw our dungeon always from upper left to lower right
FOR x = x1 TO x2
FOR y = y1 TO y2
DungeonLayer(x, y) = floor
NEXT y
NEXT x
END SUB

SUB makeroom (x1, x2, y1, y2, direction, recurdepth)
'draw our dungeon always from upper left to lower right
FOR x = x1 TO x2
FOR y = y1 TO y2
DungeonLayer(x, y) = floor
NEXT y
NEXT x
recurdepth = recurdepth + 1
' this holds our rooms so we can choose one at random if we get stuck
' we never save halls or it would be a horrendous mess
RoomHolder(recurdepth, 0) = x1
RoomHolder(recurdepth, 1) = x2
RoomHolder(recurdepth, 2) = y1
RoomHolder(recurdepth, 3) = y2
END SUB

FUNCTION Rand (Lowest, Highest)
DIM a AS INTEGER
DIM b AS INTEGER
DIM c AS INTEGER

a = Lowest
b = Highest
IF a > b THEN
c = a - b
ELSEIF b > a THEN
c = b - a
ELSE
Rand = a: EXIT FUNCTION
END IF
Rand = INT(RND(1) * (c + 1)) + a

END FUNCTION

	hectic Sieger des IS Talentwettbewerb 2006	Do, Jan 11, 2007 19:25 Antworten mit Zitat
So wie ich das sehe, kann das meiste einfach übernommen werden. SCREEN 13 --> Graphics 320,240 ;Als Beispiel, keine Ahnung was 13 ist. PSET (x,y),f --> Color fr,fg,fb:Pset x,y DIM a AS INTEGER --> a%=0 Den Rest wird der Debuger schon anmekern. edit1: D2006's Formulierungen (siehe unten) sind, wie ich finde, wieder mal sehr schön formuliert. Zum Code würde ich sagen, dass recht viel geschrieben wurde nur um ein Bild zu erstellen, wo Räume miteinander verbuden sind. Das geht bestimmt um 70% weniger, also auf 30% runter. Zur Not, geht auch eine modifizierte Labyrinth-Funktion.

hectic

Sieger des IS Talentwettbewerb 2006

Do, Jan 11, 2007 19:25
Antworten mit Zitat

So wie ich das sehe, kann das meiste einfach übernommen werden.

SCREEN 13 --> Graphics 320,240 ;Als Beispiel, keine Ahnung was 13 ist.

PSET (x,y),f --> Color fr,fg,fb:Pset x,y

DIM a AS INTEGER --> a%=0

Den Rest wird der Debuger schon anmekern.

edit1: D2006's Formulierungen (siehe unten) sind, wie ich finde, wieder mal sehr schön formuliert. Very Happy

Zum Code würde ich sagen, dass recht viel geschrieben wurde nur um ein Bild zu erstellen, wo Räume miteinander verbuden sind. Das geht bestimmt um 70% weniger, also auf 30% runter. Zur Not, geht auch eine modifizierte Labyrinth-Funktion.

Zuletzt bearbeitet von hectic am Do, Jan 11, 2007 21:35, insgesamt einmal bearbeitet

	Ekrits	Do, Jan 11, 2007 19:38 Antworten mit Zitat
kann nurn n bischl sagen dazu Code: [AUSKLAPPEN] [EINKLAPPEN] RANDOMIZE TIMER -> Seedrnd Millisecs() DO -> Repeat LOOP UNTIL -> Until INKEY() -> GETKEY() CALL -> Subfunktion aufrufen (Subfunktionen sind glaub ich sowas ähnliches wie normale Funktionen) SCREEN 13 -> 13 ist der grafik Modus (graphics und den Modus) PSET -> Plot So, der rest erklärt sich selsbt oder ist in Blitzbasic auch so vorhanden Ich würd aber immer vor jedem programm in QBasic n Cls vorschieben Bei weiteren Problemen einfach ma QBasic.de QB runterladen und in der mitgelieferten Hilfe nachgucken, sind alle Befehle in deutsch erklärt
EKRITSel: Rechtschreibfehler sind gewollt um eure Aufmerksamkeit zutesten! Magians vs. Nekromats 100% COMPLETE

Ekrits

Do, Jan 11, 2007 19:38
Antworten mit Zitat

kann nurn n bischl sagen dazu

Code: [AUSKLAPPEN]

RANDOMIZE TIMER -> Seedrnd Millisecs()
DO -> Repeat
LOOP UNTIL -> Until

INKEY() -> GETKEY()
CALL -> Subfunktion aufrufen (Subfunktionen sind glaub ich sowas ähnliches wie normale Funktionen)

SCREEN 13 -> 13 ist der grafik Modus (graphics und den Modus)
PSET -> Plot

So, der rest erklärt sich selsbt oder ist in Blitzbasic auch so vorhanden

Ich würd aber immer vor jedem programm in QBasic n Cls vorschieben

Bei weiteren Problemen einfach ma QBasic.de QB runterladen und in der mitgelieferten Hilfe nachgucken, sind alle Befehle in deutsch erklärt

EKRITSel: Rechtschreibfehler sind gewollt um eure Aufmerksamkeit zutesten!

Magians vs. Nekromats 100% COMPLETE

	D2006 Administrator	Do, Jan 11, 2007 21:06 Antworten mit Zitat
Nach einigem rumrechnen komme ich zu einem - wie ich finde sensationellem - Ergebnis: Für nur 39,99 € würde ich dir das machen!
Intel Core i5 2500 \| 16 GB DDR3 RAM dualchannel \| ATI Radeon HD6870 (1024 MB RAM) \| Windows 7 Home Premium Intel Core 2 Duo 2.4 GHz \| 2 GB DDR3 RAM dualchannel \| Nvidia GeForce 9400M (256 MB shared RAM) \| Mac OS X Snow Leopard Intel Pentium Dual-Core 2.4 GHz \| 3 GB DDR2 RAM dualchannel \| ATI Radeon HD3850 (1024 MB RAM) \| Windows 7 Home Premium Chaos Interactive :: GoBang :: BB-Poker :: ChaosBreaker :: Hexagon :: ChaosRacer 2

D2006

Administrator

Do, Jan 11, 2007 21:06
Antworten mit Zitat

Nach einigem rumrechnen komme ich zu einem - wie ich finde sensationellem - Ergebnis:

Für nur 39,99 € würde ich dir das machen!

	SpionAtom	Do, Jan 11, 2007 21:36 Antworten mit Zitat
Tut mir leid, D, aber die letzten 20 min war mir langweilig: EDIT: (Aus irgendeinem noch mir unerfindlichem Grund wird die Anzahl der Räume nicht richtig gezählt...) Code: [AUSKLAPPEN] [EINKLAPPEN] ;DEFINT A-Z; speeds things up ;map array Dim DungeonLayer(150, 150) ;what this does is makes a list of rooms that were created. ;Then If the generator hits a dead End it goes back To a random room ;in the list And takes up generation from there. Dim RoomHolder(200, 4) ;max numbers of maps Global maxx ;MaxX coord of Dungeon Global maxy ;MaxY of Dungeon Global recurdepth ;AS INTEGER ;map And engine constants Global wall ;AS INTEGER Global Floor1 ;AS INTEGER Global door ;AS INTEGER ;Global True AS INTEGER ;Global False AS INTEGER Global Permwall ;AS INTEGER Global numofrooms ;AS INTEGER Global maxnumofrooms ;AS INTEGER ;these are the ascii numbers (like angband For the door And walls) door = 43 Permwall = 178 wall = 176 Floor1 = 46 True1 = 1 False1 = -1 recurdepth = 0 numofrooms = 0 x1 = 0; top Right coordinates y1 = 0; top Left coordinates x2 = 0; bottom Right coordinates y2 = 0; bottom Left coordinates direction = 0 ;these tie into the DungeonLayer array so the size will have To be ;increased there To increase these numbers maxx = 150 maxy = 150 ; maxnumofrooms is tied into RoomHolder ; at 200 it bogs down And fails a lot try setting To 200 you;ll see maxnumofrooms = 150 SeedRnd MilliSecs() ;RANDOMIZE TIMER SetFont(LoadFont("courier", 16)) Repeat ;this times the generation T# = TIMER initdungeon generate (recurdepth) T2# = TIMER T3# = T2# - T# displaydungeon; I;m Not adding this into the timer ;seeing as it only displays the dungeon Color 255, 0, 0: Text 170, 0, "Door color" Color 55, 55, 55: Text 170, 16, "Wall color " Color 255, 255, 255: Text 170, 32, "PermaWall color" Color 255, 255, 255: Text 170, 64, "# of Rooms "+ numofrooms Text 170, 96, "One pixel = " Text 200, 112, "one ascii tile" Text 0, 150, "Time to make "+ T3# + " Seconds." Text 0, 166 ,"Press esc to quit" Text 0, 182, "Any other key to generate again" WaitKey;SLEEP Until KeyDown(1) ;INKEY$(27) End Function CheckBounds (x1, x2, y1, y2, direction) CheckBounds = 0 ;Makes sure room isn;t out of bounds of Dungeon ;Our dungeon is 1 To MaxX And 1 To MaxY If (x1 - 1) < 1 Then Return False If (y1 - 1) < 1 Then Return False If (x2 + 1) > maxx Then Return False If (y2 + 1) > maxy Then Return False For x = (x1 - 1) To (x2 + 1) For y = (y1 - 1) To (y2 + 1) If DungeonLayer(x, y) = Floor1 Then Return False Next Next Return True End Function Function CheckBoundsHall (x1, x2, y1, y2, direction) CheckBoundsHall = 0 ;Makes sure hall isn;t out of bounds of Dungeon ;Our dungeon is 1 To MaxX And 1 To MaxY If (x1 - 1) < 1 Then Return False If (y1 - 1) < 1 Then Return False If (x2 + 1) > maxx Then Return False If (y2 + 1) > maxy Then Return False If direction = 0 Or direction = 2 Then For x = x1 To x2 For y = (y1 - 1) To (y2 + 1) If DungeonLayer(x, y) = Floor1 Then Return False Next Next End If If direction = 1 Or direction = 3 Then For x = (x1 - 1) To (x2 + 1) For y = y1 To y2 If DungeonLayer(x, y) = Floor1 Then Return False Next Next End If Return True End Function Function displaydungeon() ;this just draws the dungeon Cls Graphics 320, 200, 0, 2 ;SCREEN 13 For x = 1 To maxx For y = 1 To maxy If DungeonLayer(x, y) = wall Then Color 55, 55, 55:Plot x, y If DungeonLayer(x, y) = Permwall Then Color 255, 255, 255:Plot x, y If DungeonLayer(x, y) = door Then Color 255, 0, 0:Plot x, y If DungeonLayer(x, y) = Floor1 Then Color 0, 0, 0:Plot x, y Next Next Flip() End Function Function generate (recurdepth) ;start with a random room x1 = Rand(2, (maxx - 1)) y1 = Rand(2, (maxy - 1)) x2 = x1 + Rand(2, 4) y2 = y1 + Rand(3, 7) direction = Rand(0, 3) IF CheckBounds(x1, x2, y1, y2, direction) = true THEN makeroom(x1, x2, y1, y2, direction, recurdepth) END IF room = true Repeat ;these are all to make sure we dont get into an infinite loop hallcount = 0 hallcountmultp = 0 roomcount = 0 roomcountmultp = 0 ;ite mean iterations Repeat ite = ite + 1 direction = Rand(0, 3);the direction we want to draw towards ;0 north(up) : 1 east(right) : 2 south(down) : 3 west(left) hall = false hallcount = hallcount + 1 halllength = Rand(2, 7);min and max length of halls ;for all hall generation they are basically the same IF direction = 0 THEN ;halls are only 1 square wide dy1 = Rand(y1, y2) dy2 = dy1 ;and as long as our halllength variable dx2 = x1 - 2 dx1 = dx2 - halllength ; we check to see if it;s in bounds IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN ; if it is we actually put it there makehall(dx1, dx2, dy1, dy2, direction) ; draw a door if it hits a room (this can be change to randomly place any type ; of feature) IF room = true THEN DungeonLayer(dx2 + 1, dy1) = door ELSE ;make it a floor tile if it doesn;t hit a room DungeonLayer(dx2 + 1, dy1) = floor END IF ;these are saved to pass to the room creation section below x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 ;sets hall to true so we can move on hall = true END IF END IF IF direction = 1 THEN dy1 = y2 + 2 dy2 = dy1 + halllength dx1 = Rand(x1, x2) dx2 = dx1 IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN makehall(dx1, dx2, dy1, dy2, direction) IF room = true THEN DungeonLayer(dx1, dy1 - 1) = door ELSE DungeonLayer(dx1, dy1 - 1) = floor END IF x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 hall = true END IF END IF IF direction = 2 THEN dy1 = Rand(y1, y2) dy2 = dy1 dx1 = x2 + 2 dx2 = dx1 + halllength IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN makehall(dx1, dx2, dy1, dy2, direction) IF room = true THEN DungeonLayer(dx1 - 1, dy1) = door ELSE DungeonLayer(dx1 - 1, dy1) = floor END IF x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 hall = true END IF END IF IF direction = 3 THEN dy1 = (y1 - halllength) - 2 dy2 = dy1 + halllength dx1 = Rand(x1, x2) dx2 = dx1 IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN makehall(dx1, dx2, dy1, dy2, direction) IF room = true THEN DungeonLayer(dx2, dy2 + 1) = door ELSE DungeonLayer(dx2, dy2 + 1) = floor END IF x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 hall = true END IF END IF ;if we cant make a hall after 10 tries then we.... IF hallcount > 10 AND hall = false THEN ;pick a random room from our list RDepth = Rand(1, recurdepth) ;make old room the dimensions of our current room x1 = RoomHolder(RDepth, 0) x2 = RoomHolder(RDepth, 1) y1 = RoomHolder(RDepth, 2) y2 = RoomHolder(RDepth, 3) ;reset hall count hallcount = 0 ;increment our hallmult counter and go again hallcountmultp = hallcountmultp + 1 END IF ;if we tried to make a hall more than 1000 times (hallcount * hallcountmultp) ;and no hall was made then we failed IF hallcountmultp > 100 THEN PRINT "FAILED at "; recurdepth; " Rooms": SLEEP numofrooms = recurdepth: Return END IF Until hall = True ;************ room creation below room = false IF direction = 0 THEN ;holder is a dummy variable holder = Rand(3, 7) dx2 = x1 - 2 dx1 = dx2 - Rand(2, 4) dy1 = Rand((y1 - holder), y2) dy2 = dy1 + holder ;check to see if our room is in bounds IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN ;if it is, set it in stone(so to speak) makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) ;put a door here cause this is where our hall will begin DungeonLayer(x1 - 1, y1) = door ;put our end room coordiantes into these variables so we can send them ;to our hall creation section above x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 ;set to true so we can end room = true END IF END IF IF direction = 1 THEN holder = Rand(2, 4) dx1 = Rand((x1 - holder), x2) dx2 = dx1 + holder dy1 = y2 + 2 dy2 = dy1 + Rand(3, 7) IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) DungeonLayer(x2, y2 + 1) = door x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 room = true END IF END IF IF direction = 2 THEN holder = Rand(3, 7) dx1 = x2 + 2 dx2 = dx1 + Rand(2, 4) dy1 = Rand(y1 - holder, y2) dy2 = dy1 + holder IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) DungeonLayer(x2 + 1, y2) = door x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 room = true END IF END IF IF direction = 3 THEN holder = Rand(2, 4) dx1 = Rand((x1 - holder), x2) dx2 = dx1 + holder dy2 = y1 - 2 dy1 = dy2 - Rand(3, 7) IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN makeroom(dx1, dx2, dy1, dy2, direction, recurdepth) DungeonLayer(x2, y1 - 1) = door x1 = dx1 x2 = dx2 y1 = dy1 y2 = dy2 room = true END IF END IF ;do 4000 total loops,if it is more than 4000 then fail IF ite > 4000 THEN PRINT "FAILED at"; recurdepth; "Rooms": SLEEP numofrooms = recurdepth: Return END IF Until recurdepth = maxnumofrooms numofrooms = recurdepth End Function Function initdungeon() ;fill our dungeon with rock For x = 1 To maxx For y = 1 To maxy DungeonLayer(x, y) = wall Next Next ; make the edges permawall For y = 1 To maxy DungeonLayer(maxx, y) = Permwall DungeonLayer(1, y) = Permwall Next For x = 1 To maxx DungeonLayer(x, maxy) = Permwall DungeonLayer(x, 1) = Permwall Next End Function Function makehall (x1, x2, y1, y2, direction) ;draw our dungeon always from Upper Left To Lower Right For x = x1 To x2 For y = y1 To y2 DungeonLayer(x, y) = Floor1 Next Next End Function Function makeroom (x1, x2, y1, y2, direction, recurdepth) ;draw our dungeon always from Upper Left To Lower Right For x = x1 To x2 For y = y1 To y2 DungeonLayer(x, y) = Floor1 Next Next recurdepth = recurdepth + 1 ; this holds our rooms so we can choose one at random If we get stuck ; we never save halls Or it would be a horrendous mess RoomHolder(recurdepth, 0) = x1 RoomHolder(recurdepth, 1) = x2 RoomHolder(recurdepth, 2) = y1 RoomHolder(recurdepth, 3) = y2 End Function
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080

SpionAtom

Do, Jan 11, 2007 21:36
Antworten mit Zitat

Tut mir leid, D, aber die letzten 20 min war mir langweilig:

EDIT:
(Aus irgendeinem noch mir unerfindlichem Grund wird die Anzahl der Räume nicht richtig gezählt...)

Code: [AUSKLAPPEN]

;DEFINT A-Z; speeds things up

;map array
Dim DungeonLayer(150, 150)

;what this does is makes a list of rooms that were created.
;Then If the generator hits a dead End it goes back To a random room
;in the list And takes up generation from there.
Dim RoomHolder(200, 4)

;max numbers of maps
Global maxx ;MaxX coord of Dungeon
Global maxy ;MaxY of Dungeon
Global recurdepth ;AS INTEGER

;map And engine constants
Global wall ;AS INTEGER
Global Floor1 ;AS INTEGER
Global door ;AS INTEGER
;Global True AS INTEGER
;Global False AS INTEGER
Global Permwall ;AS INTEGER
Global numofrooms ;AS INTEGER
Global maxnumofrooms ;AS INTEGER

;these are the ascii numbers (like angband For the door And walls)
door = 43
Permwall = 178
wall = 176
Floor1 = 46

True1 = 1
False1 = -1

recurdepth = 0
numofrooms = 0

x1 = 0; top Right coordinates
y1 = 0; top Left coordinates
x2 = 0; bottom Right coordinates
y2 = 0; bottom Left coordinates
direction = 0

;these tie into the DungeonLayer array so the size will have To be
;increased there To increase these numbers
maxx = 150
maxy = 150

; maxnumofrooms is tied into RoomHolder
; at 200 it bogs down And fails a lot try setting To 200 you;ll see

maxnumofrooms = 150

SeedRnd MilliSecs() ;RANDOMIZE TIMER
SetFont(LoadFont("courier", 16))

Repeat
;this times the generation
T# = TIMER
initdungeon
generate (recurdepth)
T2# = TIMER
T3# = T2# - T#

displaydungeon; I;m Not adding this into the timer
;seeing as it only displays the dungeon
Color 255, 0, 0: Text 170, 0, "Door color"
Color 55, 55, 55: Text 170, 16, "Wall color "
Color 255, 255, 255: Text 170, 32, "PermaWall color"
Color 255, 255, 255: Text 170, 64, "# of Rooms "+ numofrooms
Text 170, 96, "One pixel = "
Text 200, 112, "one ascii tile"
Text 0, 150, "Time to make "+ T3# + " Seconds."
Text 0, 166 ,"Press esc to quit"
Text 0, 182, "Any other key to generate again"
WaitKey;SLEEP
Until KeyDown(1) ;INKEY$(27)
End

Function CheckBounds (x1, x2, y1, y2, direction)
CheckBounds = 0
;Makes sure room isn;t out of bounds of Dungeon
;Our dungeon is 1 To MaxX And 1 To MaxY

If (x1 - 1) < 1 Then Return False
If (y1 - 1) < 1 Then Return False
If (x2 + 1) > maxx Then Return False
If (y2 + 1) > maxy Then Return False

For x = (x1 - 1) To (x2 + 1)
For y = (y1 - 1) To (y2 + 1)
If DungeonLayer(x, y) = Floor1 Then Return False
Next
Next
Return True
End Function

Function CheckBoundsHall (x1, x2, y1, y2, direction)
CheckBoundsHall = 0
;Makes sure hall isn;t out of bounds of Dungeon
;Our dungeon is 1 To MaxX And 1 To MaxY

If (x1 - 1) < 1 Then Return False
If (y1 - 1) < 1 Then Return False
If (x2 + 1) > maxx Then Return False
If (y2 + 1) > maxy Then Return False

If direction = 0 Or direction = 2 Then
For x = x1 To x2
For y = (y1 - 1) To (y2 + 1)
If DungeonLayer(x, y) = Floor1 Then Return False
Next
Next
End If

If direction = 1 Or direction = 3 Then
For x = (x1 - 1) To (x2 + 1)
For y = y1 To y2
If DungeonLayer(x, y) = Floor1 Then Return False
Next
Next
End If

Return True
End Function

Function displaydungeon()
;this just draws the dungeon
Cls
   Graphics 320, 200, 0, 2 ;SCREEN 13

For x = 1 To maxx
For y = 1 To maxy
      If DungeonLayer(x, y) = wall Then Color 55, 55, 55:Plot x, y
      If DungeonLayer(x, y) = Permwall Then Color 255, 255, 255:Plot x, y
      If DungeonLayer(x, y) = door Then Color 255, 0, 0:Plot x, y
      If DungeonLayer(x, y) = Floor1 Then Color 0, 0, 0:Plot x, y
Next
Next
Flip()
End Function

Function generate (recurdepth)

;start with a random room
x1 = Rand(2, (maxx - 1))
y1 = Rand(2, (maxy - 1))
x2 = x1 + Rand(2, 4)
y2 = y1 + Rand(3, 7)

direction = Rand(0, 3)
IF CheckBounds(x1, x2, y1, y2, direction) = true THEN
makeroom(x1, x2, y1, y2, direction, recurdepth)
END IF

room = true

Repeat
;these are all to make sure we dont get into an infinite loop
hallcount = 0
hallcountmultp = 0
roomcount = 0
roomcountmultp = 0
;ite mean iterations

Repeat
ite = ite + 1
direction = Rand(0, 3);the direction we want to draw towards
;0 north(up) : 1 east(right) : 2 south(down) : 3 west(left)

hall = false
hallcount = hallcount + 1

halllength = Rand(2, 7);min and max length of halls

;for all hall generation they are basically the same
IF direction = 0 THEN
;halls are only 1 square wide
dy1 = Rand(y1, y2)
dy2 = dy1
;and as long as our halllength variable
dx2 = x1 - 2
dx1 = dx2 - halllength
; we check to see if it;s in bounds
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
; if it is we actually put it there
makehall(dx1, dx2, dy1, dy2, direction)
; draw a door if it hits a room (this can be change to randomly place any type
; of feature)
IF room = true THEN
DungeonLayer(dx2 + 1, dy1) = door
ELSE
;make it a floor tile if it doesn;t hit a room
DungeonLayer(dx2 + 1, dy1) = floor
END IF
;these are saved to pass to the room creation section below
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
;sets hall to true so we can move on
hall = true
END IF

END IF
IF direction = 1 THEN
dy1 = y2 + 2
dy2 = dy1 + halllength
dx1 = Rand(x1, x2)
dx2 = dx1
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
makehall(dx1, dx2, dy1, dy2, direction)
IF room = true THEN
DungeonLayer(dx1, dy1 - 1) = door
ELSE
DungeonLayer(dx1, dy1 - 1) = floor
END IF
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
hall = true
END IF

END IF

IF direction = 2 THEN
dy1 = Rand(y1, y2)
dy2 = dy1
dx1 = x2 + 2
dx2 = dx1 + halllength
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
makehall(dx1, dx2, dy1, dy2, direction)
IF room = true THEN
DungeonLayer(dx1 - 1, dy1) = door
ELSE
DungeonLayer(dx1 - 1, dy1) = floor
END IF
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
hall = true
END IF
END IF

IF direction = 3 THEN
dy1 = (y1 - halllength) - 2
dy2 = dy1 + halllength
dx1 = Rand(x1, x2)
dx2 = dx1
IF CheckBoundsHall(dx1, dx2, dy1, dy2, direction) = true THEN
makehall(dx1, dx2, dy1, dy2, direction)
IF room = true THEN
DungeonLayer(dx2, dy2 + 1) = door
ELSE
DungeonLayer(dx2, dy2 + 1) = floor
END IF
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
hall = true
END IF
END IF

;if we cant make a hall after 10 tries then we....
IF hallcount > 10 AND hall = false THEN
;pick a random room from our list
RDepth = Rand(1, recurdepth)
;make old room the dimensions of our current room
x1 = RoomHolder(RDepth, 0)
x2 = RoomHolder(RDepth, 1)
y1 = RoomHolder(RDepth, 2)
y2 = RoomHolder(RDepth, 3)
;reset hall count
hallcount = 0
;increment our hallmult counter and go again
hallcountmultp = hallcountmultp + 1
END IF

;if we tried to make a hall more than 1000 times (hallcount * hallcountmultp)
;and no hall was made then we failed
IF hallcountmultp > 100 THEN
PRINT "FAILED at "; recurdepth; " Rooms": SLEEP
numofrooms = recurdepth: Return
END IF

Until hall = True

;************ room creation below

room = false

IF direction = 0 THEN
;holder is a dummy variable
holder = Rand(3, 7)
dx2 = x1 - 2
dx1 = dx2 - Rand(2, 4)
dy1 = Rand((y1 - holder), y2)
dy2 = dy1 + holder
;check to see if our room is in bounds
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
;if it is, set it in stone(so to speak)
makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
;put a door here cause this is where our hall will begin
DungeonLayer(x1 - 1, y1) = door
;put our end room coordiantes into these variables so we can send them
;to our hall creation section above
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
;set to true so we can end
room = true
END IF

END IF

IF direction = 1 THEN
holder = Rand(2, 4)
dx1 = Rand((x1 - holder), x2)
dx2 = dx1 + holder
dy1 = y2 + 2
dy2 = dy1 + Rand(3, 7)
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
DungeonLayer(x2, y2 + 1) = door
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
room = true
END IF
END IF

IF direction = 2 THEN
holder = Rand(3, 7)
dx1 = x2 + 2
dx2 = dx1 + Rand(2, 4)
dy1 = Rand(y1 - holder, y2)
dy2 = dy1 + holder
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
DungeonLayer(x2 + 1, y2) = door
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
room = true
END IF
END IF

IF direction = 3 THEN
holder = Rand(2, 4)
dx1 = Rand((x1 - holder), x2)
dx2 = dx1 + holder
dy2 = y1 - 2
dy1 = dy2 - Rand(3, 7)
IF CheckBounds(dx1, dx2, dy1, dy2, direction) = true THEN
makeroom(dx1, dx2, dy1, dy2, direction, recurdepth)
DungeonLayer(x2, y1 - 1) = door
x1 = dx1
x2 = dx2
y1 = dy1
y2 = dy2
room = true
END IF
END IF

;do 4000 total loops,if it is more than 4000 then fail
IF ite > 4000 THEN
PRINT "FAILED at"; recurdepth; "Rooms": SLEEP
numofrooms = recurdepth: Return
END IF
Until recurdepth = maxnumofrooms

numofrooms = recurdepth
End Function

Function initdungeon()
   ;fill our dungeon with rock
For x = 1 To maxx
For y = 1 To maxy
DungeonLayer(x, y) = wall
Next
Next
; make the edges permawall
For y = 1 To maxy
DungeonLayer(maxx, y) = Permwall
DungeonLayer(1, y) = Permwall
Next
For x = 1 To maxx
DungeonLayer(x, maxy) = Permwall
DungeonLayer(x, 1) = Permwall
Next
End Function

Function makehall (x1, x2, y1, y2, direction)
;draw our dungeon always from Upper Left To Lower Right
For x = x1 To x2
For y = y1 To y2
DungeonLayer(x, y) = Floor1
Next
Next
End Function

Function makeroom (x1, x2, y1, y2, direction, recurdepth)
;draw our dungeon always from Upper Left To Lower Right
For x = x1 To x2
For y = y1 To y2
DungeonLayer(x, y) = Floor1
Next
Next
recurdepth = recurdepth + 1
; this holds our rooms so we can choose one at random If we get stuck
; we never save halls Or it would be a horrendous mess
RoomHolder(recurdepth, 0) = x1
RoomHolder(recurdepth, 1) = x2
RoomHolder(recurdepth, 2) = y1
RoomHolder(recurdepth, 3) = y2
End Function

os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080

	Arrangemonk	Do, Jan 11, 2007 22:23 Antworten mit Zitat
ich würd den graphics befehl trotzdem oben machen, sonst macht der bei jedem tastendruck das fenster neu auf
ingeneur

Arrangemonk

Do, Jan 11, 2007 22:23
Antworten mit Zitat

ich würd den graphics befehl trotzdem oben machen, sonst macht der bei jedem tastendruck das fenster neu auf

ingeneur

	Krischan	Fr, Jan 12, 2007 9:10 Antworten mit Zitat
@SpionAtom: Danke Ich muss mir den Code am Wochenende mal anschauen, ich bin da mit den Subs (im QB-Code) nicht durchgestiegen, aber wahrscheinlich habe ich da zu kompliziert gedacht, wenn ich Deinen Code mal so überfliege D2006 hat Folgendes geschrieben: Nach einigem rumrechnen komme ich zu einem - wie ich finde sensationellem - Ergebnis: Für nur 39,99 € würde ich dir das machen! Scherzkeks Wenn Du daraus ein komplettes Spiel bastelst (am Besten gleich in 3D) würde das vielleicht jemand bezahlen... So ist es eine nette Basis für andere, daraus vielleicht mal ein Spiel zu machen (schaut Euch mal das Sword of Fargoal Remake an, das ist simpel, macht aber unheimlich Spass). Also wenn ich daraus mal was bastel, dann in so eine Richtung, natürlich mit weiteren Extras, ein perfektes Remake gibts ja schon. hectic hat Folgendes geschrieben: Zum Code würde ich sagen, dass recht viel geschrieben wurde nur um ein Bild zu erstellen, wo Räume miteinander verbuden sind. Das geht bestimmt um 70% weniger, also auf 30% runter. Zur Not, geht auch eine modifizierte Labyrinth-Funktion. Ja, der Code ist ziemlich unübersichtlich, ich glaube hier wurde der Algorithmus von Jamis Buck verwendet (http://www.aarg.net/~minam/dungeon_design.html). Es wird aber nicht nur ein Bild erzeugt, sondern im Array der Dungeon gespeichert, und das kann man ganz gut weiterverwenden. Aber schnell ist er, das muss man sagen, und jeder Dungeon scheint in sich schlüssig zu sein und wirkt trotzdem sehr zufällig.

Krischan

Fr, Jan 12, 2007 9:10
Antworten mit Zitat

@SpionAtom: Danke Smile

Ich muss mir den Code am Wochenende mal anschauen, ich bin da mit den Subs (im QB-Code) nicht durchgestiegen, aber wahrscheinlich habe ich da zu kompliziert gedacht, wenn ich Deinen Code mal so überfliege Embarassed

D2006 hat Folgendes geschrieben:

Nach einigem rumrechnen komme ich zu einem - wie ich finde sensationellem - Ergebnis:

Für nur 39,99 € würde ich dir das machen!

Scherzkeks Cool

Wenn Du daraus ein komplettes Spiel bastelst (am Besten gleich in 3D) würde das vielleicht jemand bezahlen... So ist es eine nette Basis für andere, daraus vielleicht mal ein Spiel zu machen (schaut Euch mal das Sword of Fargoal Remake an, das ist simpel, macht aber unheimlich Spass). Also wenn ich daraus mal was bastel, dann in so eine Richtung, natürlich mit weiteren Extras, ein perfektes Remake gibts ja schon.

hectic hat Folgendes geschrieben:

Ja, der Code ist ziemlich unübersichtlich, ich glaube hier wurde der Algorithmus von Jamis Buck verwendet (http://www.aarg.net/~minam/dungeon_design.html). Es wird aber nicht nur ein Bild erzeugt, sondern im Array der Dungeon gespeichert, und das kann man ganz gut weiterverwenden. Aber schnell ist er, das muss man sagen, und jeder Dungeon scheint in sich schlüssig zu sein und wirkt trotzdem sehr zufällig.

Übersicht

BlitzBasic

Allgemein

Nach Oben

BlitzBasic Portal

Dungeon Generator

Krischan

Betreff: Dungeon Generator

hectic

Ekrits

D2006

SpionAtom

Arrangemonk

Krischan