'                         IQ Pathfinder
'
' This is a program that finds a way to get from Point A to Point B in
' a world of walls and free spaces.
'
' Maybe you have already thought it: I am a german schoolboy and I am pride
' if you understand what I say...
' So if there is anyone who can write these sentences in correct grammar, he
' should please overwrite this ones.
'
' I havent documented the File because its hard to say something in english
' that I am not even sure in german.
' But here is how the Mainroutine works:
' First is computed if the Point to go to is left or right, upside or down.
' Than, whether the X-Distance to B is bigger (DoX = 1) or the Y-Distance
' (DoX = 0). This is done in the Sub Direction.
' So we only can do a horizontal or a vertival step not both at once.
' If there is a wall, the other dir. is choosen.
' If there is no way to go there, MauerStep is called and trys to walk along
' the wall until it ends.
' Sometimes stops or returns the same steps often.
' And caused of that Rounds is added once every step. If we don't reach Point
' B in 100 steps, we do some random steps to get a new, better position.
'
'   Maybe someone uses it in his programs, games for example.
'          Hopefully to win the Basic-Competition I wrote this Program for,
'
'                                     S T A N Z Y

DECLARE SUB LevelPaint ()
DECLARE SUB SwapDoX ()
DECLARE SUB RndWerte ()
DECLARE FUNCTION MauerStep% ()
DECLARE FUNCTION GoStep% (X%, Y%)
DECLARE FUNCTION Wand% ()
DECLARE SUB MoveX ()
DECLARE SUB MoveY ()
DECLARE SUB ShowLevel ()
DECLARE SUB PageFlip ()
DECLARE SUB direction ()
DEFINT A-Z

COMMON SHARED XPlus, YPlus, Sx, Sy, Zx, Zy, X, Y, DoX, NewX, NewY, OldX, OldY
COMMON SHARED Rounds, LastX, LastY, Rand

SCREEN 9, , 0, 0

LOCATE 3, 1
COLOR 7: PRINT "Grey:    Wall"
COLOR 8: PRINT "Black:   Space"
PRINT
COLOR 1: PRINT "Blue:    Start"
COLOR 2: PRINT "Green:   End"
PRINT
PRINT
PRINT "Press 'N' if you don't want random start- and ending-positions. "
Sp$ = INPUT$(1)
Rand = 1
IF Sp$ = "N" OR Sp$ = "n" THEN Rand = 0
CLS

RANDOMIZE TIMER

DIM SHARED Level(1 TO 128, 1 TO 70)

FOR X = 2 TO 127
FOR Y = 2 TO 69
  IF INT(RND * 5) <> 0 THEN
    Level(X, Y) = 1
  END IF
NEXT
NEXT

DO
  Sx = INT(RND * 125) + 2
  Sy = INT(RND * 67) + 2
LOOP UNTIL Level(Sx, Sy)

DO
  Zx = INT(RND * 125) + 2
  Zy = INT(RND * 67) + 2
LOOP UNTIL Level(Zx, Zy)

IF Rand = 0 THEN Sx = 2: Sy = 2: Zx = 127: Zy = 69
X = Sx: Y = Sy
NewX = X: NewY = Y

ShowLevel
LevelPaint
PCOPY 1, 0
ShowLevel
LOCATE 13, 20: PRINT "Press any key to start or wait 5 Sec!"
SLEEP 5
PCOPY 1, 0
ShowLevel

DO
  OldX = NewX: OldY = NewY
  FreeStep = 1
  direction
  IF Wand = 1 THEN
    SELECT CASE DoX
    CASE 0: DoX = 1
    CASE 1: DoX = 0
    END SELECT
    'IF Wand = 1 THEN FreeStep = 0
      IF Wand = 1 THEN
          IF XPlus = 0 THEN XPlus = 1
          IF YPlus = 0 THEN YPlus = 1
          IF Wand = 1 THEN
            XPlus = XPlus * -1
            YPlus = YPlus * -1
              IF Wand = 1 THEN FreeStep = 0
          END IF
      END IF

  END IF
  IF FreeStep THEN
    IF DoX THEN
'      Level(NewX, NewY) = -1
      NewX = NewX + XPlus
    ELSE
'      Level(NewX, NewY) = -1
      NewY = NewY + YPlus
    END IF
  ELSE
    IF MauerStep = 1 THEN
      SELECT CASE DoX
      CASE 0: DoX = 1
      CASE 1: DoX = 0
      END SELECT
      IF MauerStep = 1 THEN
          IF XPlus = 0 THEN XPlus = 1
          IF YPlus = 0 THEN YPlus = 1
          IF MauerStep = 1 THEN
            XPlus = XPlus * -1
            YPlus = YPlus * -1

'              IF MauerStep = 1 THEN CLS : PRINT "No way out!": SLEEP: END
          END IF
      END IF
    END IF
  END IF
  ShowLevel
IF LastX = NewX AND LastY = NewY THEN Rounds = 100
LastX = NewX: LastY = NewY
LOOP UNTIL NewX = Zx AND NewY = Zy

SLEEP

SUB direction

Rounds = Rounds + 1

XPlus = -1
IF Zx > NewX THEN XPlus = 1
IF Zx = NewX THEN XPlus = 0

YPlus = -1
IF Zy > NewY THEN YPlus = 1
IF Zy = NewY THEN YPlus = 0

DoX = 0
IF ABS(Zx - NewX) > ABS(Zy - NewY) THEN DoX = 1

IF Rounds >= 100 THEN RndWerte
IF Rounds = 115 THEN Rounds = 20

END SUB

FUNCTION GoStep (X, Y)
  IF Level(X, Y) = 1 THEN
    NewX = X: NewY = Y: GoStep = 1
  END IF
END FUNCTION

SUB LevelPaint

SCREEN 9, , 1, 1
CLS
FOR X = 0 TO 127
FOR Y = 0 TO 69
  IF Level(X + 1, Y + 1) = 0 THEN
    LINE (X * 5, Y * 5)-(X * 5 + 3, Y * 5 + 3), 7, BF
  ELSEIF Level(X + 1, Y + 1) = -1 THEN
    LINE (X * 5, Y * 5)-(X * 5 + 3, Y * 5 + 3), 8, BF
  END IF
NEXT
NEXT

END SUB

FUNCTION MauerStep

OldX = NewX: OldY = NewY
SELECT CASE DoX
CASE 0
  IF GoStep(NewX + XPlus * -1, NewY) = 1 THEN
'    Level(OldX, OldY) = -1
  ELSE
    MauerStep = 1
  END IF
CASE 1
  IF GoStep(NewX, NewY + YPlus * -1) = 1 THEN
 '   Level(OldX, OldY) = -1
  ELSE
    MauerStep = 1
  END IF
END SELECT

END FUNCTION

SUB RndWerte

XPlus = 1
IF INT(RND * 2) + 1 = 1 THEN
  XPlus = -1
END IF
YPlus = 1
IF INT(RND * 2) + 1 = 1 THEN
  YPlus = -1
END IF
FOR Mal = 1 TO INT(RND * 10) + 1
  SwapDoX
NEXT

END SUB

SUB ShowLevel

SCREEN 9, , 0, 0
'PCOPY 1, 0
   
    NewX = NewX - 1: NewY = NewY - 1
    Zx = Zx - 1: Zy = Zy - 1
LINE (NewX * 5, NewY * 5)-(NewX * 5 + 3, NewY * 5 + 3), 1, BF
LINE (Zx * 5, Zy * 5)-(Zx * 5 + 3, Zy * 5 + 3), 2, BF
    NewX = NewX + 1: NewY = NewY + 1
    Zx = Zx + 1: Zy = Zy + 1


END SUB

SUB SwapDoX

IF DoX = 1 THEN
  DoX = 0
ELSE
  DoX = 1
END IF

END SUB

FUNCTION Wand

SELECT CASE DoX
  CASE 0
    IF Level(NewX, NewY + YPlus) <= 0 THEN
      Wand = 1
    END IF
  CASE 1
    IF Level(NewX + XPlus, NewY) <= 0 THEN
      Wand = 1
    END IF
END SELECT

END FUNCTION