Kirjautuminen

Haku

Tehtävät

Koodit: QB: Labyrintti

Kirjoittaja: J.J.

Kirjoitettu: 03.05.2005 – 03.05.2005

Tagit: koodi näytille, vinkki

Tämä ohjelma generoi labyrintin, jossa on ainoastaan yksi ratkaisu. Umpikujat ovat toisinaan todella pitkiä, tai mitättömän lyhyitä, mutta en enään jaksanut alkaa miettiä millä sitä saisi yksinkertaisesti säädettyä.

Keltainen ruutu tarkoittaa aloituspistettä ja punainen loppua, joka on sijoitettu aloituspisteestä niin kauaksi kuin mahdollista (tämä lienee helppo muuttaa jos kokee sen tarpeelliseksi).

Edit: Lisäsin muunnellun version vanhasta ohjelmasta. Uusi versio tekee klassisemman näköisiä ja ainakin omasta mielestäni parempia labyrintteja. Lisäksi ohjelma kopioi labyrintista tiedoston (jos siitä jollekin on hyötyä).

' LABY.BAS	-JJP

DECLARE SUB Generate ()
DECLARE SUB DisplayMaze ()
DECLARE FUNCTION IsFloor% (x%, y%)
DECLARE FUNCTION Peruuta% (x%, y%)
DECLARE FUNCTION Rand% (a%, b%)
DECLARE SUB Rotate (d%)
DECLARE SUB Siirry (x%, y%, d%)
DECLARE FUNCTION VoikoPiirtaa% (x%, y%, d%)
DEFINT A-Z
CONST sizeX = 80
CONST sizeY = 50

CONST Seina = 1
CONST Lattia = 7
CONST Alku = 14
CONST Loppu = 4

CONST TempTile = -1

CLS
SCREEN 13
DIM SHARED Maze(1 TO sizeX, 1 TO sizeY)

RANDOMIZE TIMER
aika! = TIMER
Generate
aika! = TIMER - aika!
DisplayMaze
PRINT "Aikaa labyrintin luontiin kului:"; aika!; "s."

SUB DisplayMaze
tx = FIX(320 / sizeX)
ty = FIX(200 / sizeY)
IF tx < ty THEN ty = tx ELSE tx = ty
FOR x = 1 TO sizeX
        FOR y = 1 TO sizeY
        LINE (x * tx - tx, y * ty - ty)-(x * tx, y * ty), Maze(x, y), BF
        NEXT y
NEXT x
DO UNTIL NOT INKEY$ = "": LOOP
END SUB

SUB Generate
FOR x = 1 TO sizeX
        FOR y = 1 TO sizeY
        Maze(x, y) = Seina
        NEXT y
NEXT x
Matka = 0
Ennatys = 0
startX = Rand(2, sizeX - 1)
startY = Rand(2, sizeY - 1)
x = startX
y = startY
Maze(startX, startY) = TempTile

DO
d = Rand(1, 2)
IF Rand(0, 1) THEN d = d * -1
FOR Kokeile = 1 TO 4
        IF VoikoPiirtaa(x, y, d) THEN
                Siirry x, y, d
                Matka = Matka + 1
                EiOnnistu = 0
                EXIT FOR
               ELSE
                EiOnnistu = 1
                Rotate d
        END IF
NEXT Kokeile

IF EiOnnistu THEN
                IF Matka > Ennatys THEN
                        Ennatys = Matka
                        EnnX = x
                        EnnY = y
                END IF
                IF Peruuta(x, y) = 0 THEN
                        Maze(startX, startY) = Alku
                        Maze(EnnX, EnnY) = Loppu
                        EXIT SUB
                END IF
                Matka = Matka - 1
END IF
LOOP
END SUB

FUNCTION IsFloor (x, y)
IF Maze(x, y) = Lattia OR Maze(x, y) = TempTile THEN IsFloor = 1 ELSE IsFloor = 0
END FUNCTION

FUNCTION Peruuta (x, y)
Maze(x, y) = Lattia
IF Maze(x - 1, y) = TempTile THEN x = x - 1: Peruuta = 1: EXIT FUNCTION
IF Maze(x + 1, y) = TempTile THEN x = x + 1: Peruuta = 1: EXIT FUNCTION
IF Maze(x, y + 1) = TempTile THEN y = y + 1: Peruuta = 1: EXIT FUNCTION
IF Maze(x, y - 1) = TempTile THEN y = y - 1: Peruuta = 1: EXIT FUNCTION
Peruuta = 0
END FUNCTION

FUNCTION Rand (a, b)
IF a > b THEN
        High = a + 1
        Low = b
       ELSE
        High = b + 1
        Low = a
END IF
Dif = High - Low
Rand = INT(RND * Dif) + Low
END FUNCTION

SUB Rotate (d)
SELECT CASE (d)
        CASE 1
                d = -1
                EXIT SUB
        CASE -1
                d = 2
                EXIT SUB
        CASE 2
                d = -2
                EXIT SUB
        CASE -2
                d = 1
                EXIT SUB
END SELECT
END SUB

SUB Siirry (x, y, d)
SELECT CASE (d)
        CASE -1
                y = y - 1
        CASE 1
                y = y + 1
        CASE -2
                x = x - 1
        CASE 2
                x = x + 1
END SELECT
Maze(x, y) = TempTile
END SUB

FUNCTION VoikoPiirtaa (x, y, d)

SELECT CASE (d)
        CASE 1
                IF y + 1 >= sizeY THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x + scan, y + 2) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x + scan, y + 1) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
        CASE -1
                IF y - 1 <= 1 THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x + scan, y - 2) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x + scan, y - 1) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
        CASE 2
                IF x + 1 >= sizeX THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x + 2, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x + 1, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
        CASE -2
                IF x - 1 <= 1 THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x - 2, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x - 1, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
END SELECT
VoikoPiirtaa = 1
END FUNCTION
' LABY.BAS v2 -JJP

DECLARE SUB KirjoitaTiedosto ()
DECLARE SUB Generate ()
DECLARE SUB DisplayMaze ()
DECLARE FUNCTION IsFloor% (x%, y%)
DECLARE FUNCTION Peruuta% (x%, y%)
DECLARE FUNCTION Rand% (a%, b%)
DECLARE SUB Rotate (d%)
DECLARE SUB Siirry (x%, y%, d%)
DECLARE FUNCTION VoikoPiirtaa% (x%, y%, d%)
DEFINT A-Z
CONST sizeX = 81
CONST sizeY = 61

CONST Seina = 1
CONST Lattia = 0
CONST Alku = 14
CONST Loppu = 4
CONST TempTile = -1

CONST Tiedosto$ = "LABY.DAT"


CLS
SCREEN 12
DIM SHARED Maze(1 TO sizeX, 1 TO sizeY)

RANDOMIZE TIMER
aika! = TIMER
Generate
aika! = TIMER - aika!
DisplayMaze
PRINT "Aikaa labyrintin luontiin kului:"; aika!; "s."
KirjoitaTiedosto
END

SUB DisplayMaze
tx = FIX(640 / sizeX)
ty = FIX(480 / sizeY)
IF tx < ty THEN ty = tx ELSE tx = ty
FOR x = 1 TO sizeX
        FOR y = 1 TO sizeY
        LINE (x * tx - tx, y * ty - ty)-(x * tx, y * ty), Maze(x, y), BF
        NEXT y
NEXT x
DO UNTIL NOT INKEY$ = "": LOOP
END SUB

SUB Generate
FOR x = 1 TO sizeX
        FOR y = 1 TO sizeY
        Maze(x, y) = Seina
        NEXT y
NEXT x
Matka = 0
Ennatys = 0
startX = Rand(1, FIX((sizeX - 1) / 2)) * 2
startY = Rand(1, FIX((sizeY - 1) / 2)) * 2

x = startX
y = startY
Maze(startX, startY) = TempTile

DO
d = Rand(1, 2)
IF Rand(0, 1) THEN d = d * -1
FOR Kokeile = 1 TO 4
        IF VoikoPiirtaa(x, y, d) THEN
                Siirry x, y, d
                Matka = Matka + 1
                EiOnnistu = 0
                EXIT FOR
               ELSE
                EiOnnistu = 1
                Rotate d
        END IF
NEXT Kokeile

IF EiOnnistu THEN
                IF Matka > Ennatys THEN
                        Ennatys = Matka
                        EnnX = x
                        EnnY = y
                END IF
                IF Peruuta(x, y) = 0 THEN
                        Maze(startX, startY) = Alku
                        Maze(EnnX, EnnY) = Loppu
                        EXIT SUB
                END IF
                Matka = Matka - 1
END IF
LOOP
END SUB

FUNCTION IsFloor (x, y)
IF Maze(x, y) = Lattia OR Maze(x, y) = TempTile THEN IsFloor = 1 ELSE IsFloor = 0
END FUNCTION

SUB KirjoitaTiedosto
OPEN Tiedosto$ FOR OUTPUT AS #1
FOR y = 1 TO sizeY
        rivi$ = ""
        FOR x = 1 TO sizeX
        SELECT CASE (Maze(x, y))
                CASE Seina
                        rivi$ = rivi$ + "Û"
                CASE Lattia
                        rivi$ = rivi$ + "."
                CASE Alku
                        rivi$ = rivi$ + "A"
                CASE Loppu
                        rivi$ = rivi$ + "L"
        END SELECT
        NEXT x
        PRINT #1, rivi$
NEXT y
CLOSE #1
END SUB

FUNCTION Peruuta (x, y)
Maze(x, y) = Lattia
IF Maze(x - 1, y) = TempTile THEN Maze(x - 1, y) = Lattia: x = x - 2: Peruuta = 1: EXIT FUNCTION
IF Maze(x + 1, y) = TempTile THEN Maze(x + 1, y) = Lattia: x = x + 2: Peruuta = 1: EXIT FUNCTION
IF Maze(x, y + 1) = TempTile THEN Maze(x, y + 1) = Lattia: y = y + 2: Peruuta = 1: EXIT FUNCTION
IF Maze(x, y - 1) = TempTile THEN Maze(x, y - 1) = Lattia: y = y - 2: Peruuta = 1: EXIT FUNCTION
Peruuta = 0
END FUNCTION

FUNCTION Rand (a, b)
IF a > b THEN
        High = a + 1
        Low = b
       ELSE
        High = b + 1
        Low = a
END IF
Dif = High - Low
Rand = INT(RND * Dif) + Low
END FUNCTION

SUB Rotate (d)
SELECT CASE (d)
        CASE 1
                d = -1
                EXIT SUB
        CASE -1
                d = 2
                EXIT SUB
        CASE 2
                d = -2
                EXIT SUB
        CASE -2
                d = 1
                EXIT SUB
END SELECT
END SUB

SUB Siirry (x, y, d)
SELECT CASE (d)
        CASE -1
                Maze(x, y - 1) = TempTile
                y = y - 2
        CASE 1
                Maze(x, y + 1) = TempTile
                y = y + 2
        CASE -2
                Maze(x - 1, y) = TempTile
                x = x - 2
        CASE 2
                Maze(x + 1, y) = TempTile
                x = x + 2
END SELECT
Maze(x, y) = TempTile
END SUB

FUNCTION VoikoPiirtaa (x, y, d)

SELECT CASE (d)
        CASE 1
                IF y + 2 >= sizeY THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x + scan, y + 3) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x + scan, y + 2) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
        CASE -1
                IF y - 2 <= 1 THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x + scan, y - 3) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x + scan, y - 2) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
        CASE 2
                IF x + 2 >= sizeX THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x + 3, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x + 2, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
        CASE -2
                IF x - 2 <= 1 THEN VoikoPiirtaa = 0: EXIT FUNCTION
                FOR scan = -1 TO 1
                        IF IsFloor(x - 3, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                        IF IsFloor(x - 2, y + scan) THEN VoikoPiirtaa = 0: EXIT FUNCTION
                NEXT scan
END SELECT
VoikoPiirtaa = 1
END FUNCTION

Kommentit

T.M. [05.05.2005 16:29:06]

#

Outo, mutta toimii hienosti :o
Värit vaihdoin toisinpäin, koska tuntui siltä että seinä oli aluetta josta pystyi kulkea.

hunajavohveli [05.05.2005 17:02:08]

#

Heh, minäkin katsoin katsoin ensin väärinpäin seinää ja lattiaa. :) Algoritmi generoi kivoja labyrintteja.

mikeful [07.05.2005 01:34:21]

#

Yritin joskus thedä vastaavaa kun kaikenlaisten generointisysteemit kiinostaa, mutta ei siitä oikein tullut mitään. Nyt kuitenkin olen saanut yhden haaveeni vähän valmiimmaksi tekemällä Infinite Arenaan satunnaiskarttageneraattorin.

baabloo [20.05.2005 15:58:33]

#

Minulla loi tyhmän labyrintin, josta pääsi helposti pisteestä a pisteeseen b. Ne oli vierekkäin eikä välissä ollut seinää.

siansaksamies [25.05.2005 17:03:30]

#

Tohon kun viittisit vielä soveltaa tulostusmahdollisuuden, ettei tarviis koko ajan ruudun edessä kököttää. Onhan Print Screen-toiminto tietysti keksitty, mutta taas jos haluaa tulostaa isomman erän, niin huomaat kyllä homman hitauden. Toinen ehdotus olisi ukon luonti labyrinttiin.
Muuten kyllä ihan simppeli.

Kirjoita kommentti

Muista lukea kirjoitusohjeet.
Tietoa sivustosta