Maak een perfecte doolhof programma

Opgaven en tips voor programmeerwedstrijden.

Maak een perfecte doolhof programma

Berichtdoor Gordon » zo feb 24, 2008 12:05 pm

Op het Amerikaanse forum http://libertybasic.conforums.com/index.cgi
is een uitdaging gaande.
Daarbij kunt u een doolhof spelletje programmeren.

Ik heb iemand op weg willen helpen met de volgende listing
en ik heb tevens een les (lesson) op het internet geplaatst.

Code: Selecteer alles
dim CC(9+1,9+1), s(79)
nomainwin
open "testwindow " for graphics as #m
#m "trapclose [quit]"

'initiate array CC(9,9) --------------
'nybble = 15
    for y = 1 to 9
        for x = 1 to 9
        CC(x,y) = 15    'nybble
        next x
    next y
'------------------------------------
'select a random cell to initiate
p = int(rnd(0)*9+1):q = int(rnd(0)*9+1)

for try = 1 to 79
[h]
ch = 0 :foundCell = 0
x = p
y = q

'--------------------------------
'find neightbours
if x-1 >0 and CC(x-1,y)=15 then ch=ch+1
if x+1 <10 and CC(x+1,y)=15 then ch=ch+1
if y-1 >0 and CC(x,y-1)=15 then ch=ch+1
if y+1 <10 and CC(x,y+1)=15 then ch=ch+1

'----------------------------------
'print ch; " possibilities"
if ch = 0 then             'if no rooms
p = int(s(ta)/10)          'check the stack
q = s(ta)-p*10
ta = ta -1
goto [h]
wait           'done
end if         '<<< looked into the stack >>>>

'------------------------------------------------------
'choose one of the rooms
[r]
r = int(rnd(0)*4+1)
select case r
case 1
if x-1 >0 and CC(x-1,y)=15 then foundCell = 1
case 2
if x+1 <10 and CC(x+1,y)=15 then foundCell = 2
case 3
if y-1 >0 and CC(x,y-1)=15 then foundCell = 3
case 4
if y+1 <10 and CC(x,y+1)=15 then foundCell = 4
end select

if foundCell = 0 and ch>0 then goto [r]

'-------------------------------------------------------
'knock wall down between the rooms

select case foundCell
case 1
CC(x,y)=(CC(x,y) xor 2^3)        'west opening wall
CC(x-1,y)=(CC(x-1,y) xor 2^1)    'east opening wall
if x>1 then p=x-1                'new CurrrentCell
ta = ta +1 :s(ta) = 10*x + y     'build stack
case 2
CC(x,y)=(CC(x,y) xor 2^1)        'east opening wall
CC(x+1,y)=(CC(x+1,y) xor 2^3)    'west opening wall
if x<9 then p=x+1
ta = ta +1 :s(ta) = 10*x + y
case 3
CC(x,y)=(CC(x,y) xor 2^0)        'north opening wall
CC(x,y-1)=(CC(x,y-1) xor 2^2)    'south opening wall
if y>1 then q=y-1
ta = ta +1 :s(ta) = 10*x + y
case 4
CC(x,y)=(CC(x,y) xor 2^2)        'south opening wall
CC(x,y+1)=(CC(x,y+1) xor 2^0)    'north opening wall
if y <9 then q=y+1
ta = ta +1 :s(ta) = 10*x + y
end select

next try

'-------------[drawMaze]----------------------
    '#m "cls"
    for b = 1 to 9
        for a = 1 to 9
            #m "place ";(a*20)+30;" ";(b*20)+30
            #m "down"
            if (CC(a,b) and 2^0) = 0 then #m "up"
            #m "turn 90"
            #m "go 20"

            #m "down"
            if (CC(a,b) and 2^1) = 0 then #m "up"
            #m "turn 90"
            #m "go 20"

            #m "down"
            if (CC(a,b) and 2^2) = 0 then #m "up"
            #m "turn 90"
            #m "go 20"

            #m "down"
            if (CC(a,b) and 2^3) = 0 then #m "up"
            #m "turn 90"
            #m "go 20"
         next a
    next b
wait


[quit]
close #m
end




Gordon
Bijlagen
maze1.zip
Genereer een Perfect Maze (doolhof)
(3.3 KiB) 171 keer gedownload
Avatar gebruiker
Gordon
Site Admin
 
Berichten: 684
Geregistreerd: zo mei 22, 2005 12:50 am

Re: Maak een perfecte doolhof programma

Berichtdoor Abcott » za mei 17, 2008 12:18 pm

Ik had het eerder niet in de gaten, totdat ik de file maze1.zip
(hierboven) had gedownload.
Deze maze1.zip listing is een Liberty BASIC les (lesson)
waarin de beginselen van het schrijven van een doolhof
heel gedetailleerd uit de doeken wordt gedaan.

Abcott
Avatar gebruiker
Abcott
 
Berichten: 115
Geregistreerd: wo mei 25, 2005 9:58 pm


Keer terug naar Uitdagingen en wedstrijden

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron