Data commit

Task/Maze-solving/Action-/maze-solving.action

@@ -0,0 +1,190 @@
+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