Anonymous user
Maze solving: Difference between revisions
Added solution for Action!
(Added solution for Action!) |
|||
Line 56:
5<2<1<0
</pre>
=={{header|Action!}}==
Action! language does not support recursion. Therefore an iterative approach with a stack has been proposed.
<lang Action!>DEFINE TOP="0"
DEFINE RIGHT="1"
DEFINE BOTTOM="2"
DEFINE LEFT="3"
DEFINE WIDTH="160"
DEFINE HEIGHT="96"
DEFINE STACK_SIZE="5000"
BYTE ARRAY stack(STACK_SIZE)
INT stackSize
PROC InitStack()
stackSize=0
RETURN
BYTE FUNC IsEmpty()
IF stackSize=0 THEN
RETURN (1)
FI
RETURN (0)
BYTE FUNC IsFull()
IF stackSize>=STACK_SIZE THEN
RETURN (1)
FI
RETURN (0)
PROC Push(BYTE x,y)
IF IsFull() THEN Break() RETURN FI
stack(stackSize)=x stackSize==+1
stack(stackSize)=y stackSize==+1
RETURN
PROC Pop(BYTE POINTER x,y)
IF IsEmpty() THEN Break() RETURN FI
stackSize==-1 y^=stack(stackSize)
stackSize==-1 x^=stack(stackSize)
RETURN
PROC Push3(BYTE x,y,d)
IF IsFull() THEN Break() RETURN FI
stack(stackSize)=x stackSize==+1
stack(stackSize)=y stackSize==+1
stack(stackSize)=d stackSize==+1
RETURN
PROC Pop3(BYTE POINTER x,y,d)
IF IsEmpty() THEN Break() RETURN FI
stackSize==-1 d^=stack(stackSize)
stackSize==-1 y^=stack(stackSize)
stackSize==-1 x^=stack(stackSize)
RETURN
PROC FillScreen()
BYTE POINTER ptr ;pointer to the screen memory
INT screenSize=[3840]
ptr=PeekC(88)
SetBlock(ptr,screenSize,$55)
Color=0
Plot(0,HEIGHT-1) DrawTo(WIDTH-1,HEIGHT-1) DrawTo(WIDTH-1,0)
RETURN
PROC GetNeighbors(BYTE x,y BYTE ARRAY n BYTE POINTER count)
DEFINE WALL="1"
count^=0
IF y>2 AND Locate(x,y-2)=WALL THEN
n(count^)=TOP count^==+1
FI
IF x<WIDTH-3 AND Locate(x+2,y)=WALL THEN
n(count^)=RIGHT count^==+1
FI
IF y<HEIGHT-3 AND Locate(x,y+2)=WALL THEN
n(count^)=BOTTOM count^==+1
FI
IF x>2 AND Locate(x-2,y)=WALL THEN
n(count^)=LEFT count^==+1
FI
RETURN
PROC DrawConnection(BYTE POINTER x,y BYTE dir)
Plot(x^,y^)
IF dir=TOP THEN
y^==-2
ELSEIF dir=RIGHT THEN
x^==+2
ELSEIF dir=BOTTOM THEN
y^==+2
ELSE
x^==-2
FI
DrawTo(x^,y^)
RETURN
PROC Maze(BYTE x,y)
BYTE ARRAY stack,neighbors
BYTE dir,nCount
FillScreen()
Color=2
InitStack()
Push(x,y)
WHILE IsEmpty()=0
DO
Pop(@x,@y)
GetNeighbors(x,y,neighbors,@nCount)
IF nCount>0 THEN
Push(x,y)
dir=neighbors(Rand(nCount))
DrawConnection(@x,@y,dir)
Push(x,y)
FI
OD
RETURN
BYTE FUNC IsConnection(BYTE x,y,dir)
DEFINE WAY="2"
IF dir=TOP AND y>2 AND Locate(x,y-1)=WAY THEN
RETURN (1)
ELSEIF dir=RIGHT AND x<WIDTH-3 AND Locate(x+1,y)=WAY THEN
RETURN (1)
ELSEIF dir=BOTTOM AND y<HEIGHT-3 AND Locate(x,y+1)=WAY THEN
RETURN (1)
ELSEIF dir=LEFT AND x>2 AND Locate(x-1,y)=WAY THEN
RETURN (1)
FI
RETURN (0)
PROC Solve(BYTE x1,y1,x2,y2)
BYTE dir,x,y,lastX,lastY,back
Color=3
Plot(x1,y1)
Plot(x2,y2)
InitStack()
Push3(x1,y1,TOP)
WHILE IsEmpty()=0
DO
Pop3(@x,@y,@dir)
IF back THEN
Color=2
Plot(lastX,lastY)
DrawTo(x,y)
FI
IF IsConnection(x,y,dir) THEN
Color=3
Push3(x,y,dir+1)
DrawConnection(@x,@y,dir)
IF x=x2 AND y=y2 THEN
RETURN
FI
Push3(x,y,TOP)
back=0
ELSEIF dir<=LEFT THEN
Push3(x,y,dir+1)
back=0
ELSE
lastX=x
lastY=y
back=1
FI
OD
RETURN
PROC Main()
BYTE CH=$02FC,COLOR0=$02C4,COLOR1=$02C5,COLOR2=$02C6
BYTE x,y,x2,y2
Graphics(7+16)
COLOR0=$0A
COLOR1=$04
COLOR2=$A6
x=Rand((WIDTH RSH 1)-1) LSH 1+1
y=Rand((HEIGHT RSH 1)-1) LSH 1+1
Maze(x,y)
x=Rand((WIDTH RSH 1)-1) LSH 1+1
y=Rand((HEIGHT RSH 1)-1) LSH 1+1
x2=Rand((WIDTH RSH 1)-1) LSH 1+1
y2=Rand((HEIGHT RSH 1)-1) LSH 1+1
Solve(x,y,x2,y2)
DO UNTIL CH#$FF OD
CH=$FF
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Maze_solving.png Screenshot from Atari 8-bit computer]
=={{header|Ada}}==
| |||