17 Bit Software 3: The Continuation/17-Bit_The_Continuation_Disc.iso/amigan/amigan 21/recursion/compil_bas/tour4.bas

BASIC Source File | 1994-01-27 | 5.2 KB | 143 lines

' Tour4. A knight's tour of an 4 x 4 board with option of screen printout.
' Originally written in True Basic; revised by Terry Peterson with TB materal
' commented out by apostrophes and A/C routines substituted as required.
' Both straight and recursive moves are graphically visible. This program has
' been compiled into the A/C Basic runtime package. RUN tour4.bas.run at any
' CLI prompt. You do NOT need to load Amiga Basic.

option base 1: defint a-z
' ask color user
' set mode "high4"     ' So we can Amiga N and M in and out & multitask
cls                    ' clear
print "A quick-and-dirty Knight's Tour from recursion"
let size = 4
let sizesq = size*size
dim board(size,size), best(size,size)

' Define possible moves in sets: a for x axis, b for the y.
dim a(8), b(8)
data 2, 1, -1, -2, -2, -1, 1, 2
data 1, 2, 2, 1, -1, -2, -2, -1
MatRead a()
MatRead b()

color 3                 ' set color "red"
locate 3,1              ' set cursor 3,1
print "Print all moves? Enter 'y' for yes or 'n' for no. ";
while (visible<>asc("y"))and(visible<>asc("n")) ' do
  visible=asc(inkey$+chr$(0))                           ' get key visible
wend                ' loop until visible = asc("y") or visible = asc("n")
let visible = (visible = asc("y"))
color 1                                  ' set color user
print
cls               ' clear
                  ' set cursor 1,1
Print "Pass:"
' open #4: printer             ' Uncomment this to print all squares
                               ' of a given size in subroutine.
let board(1,1) = 1             ' We start on a corner square
call try((2), (1), (1))        ' Second move, starting at x = 1, y = 1
if ok = 1 then
  print "SUCCESS!"
  MatPrint board()             ' We did it!
else
  color 3           ' set color "red"  ' Sorry, Sam--no way from here to there.
  print
  print "No solution, Sam. Here's the best board we got:"
  MatPrint best()
end if
print "We generated"; totalmoves; "legal moves to find this out--"
print "And of those,"; legalmoves; "were to open squares."
print "We made a total of"; pass; "computer passes through the code."
waitkey
end

sub waitkey
        x%=pos(x%):y%=csrlin
        locate 23,27
        color 3: print "Press any key to continue.";: color 1
        while inkey$="" :wend
        locate 23,27:print "                          ";
        locate y%,x%:print
end sub

sub try(movenbr, x, y)

  shared ok, size, sizesq, pass, visible    'Global vars from main routine
  shared bestboard, totalmoves, legalmoves  ' (all other vars local)
  shared a(), b(), board(), best()

  let oldx=x : let oldy=y               ' Save initial pos. at this level
  let trynbr = 0                        ' Start trying at the beginning
  let ok = 0                            ' OK later says a move succeeded.
  while (ok<1)and(trynbr<8)
    if not visible then
      locate 1,6                 ' set cursor 1,6
      print pass
    end if
    let trynbr = trynbr + 1          ' The eight possible moves of a Knight.
    let pass = pass + 1              ' Total passes made by program
    let nextx = x + a(trynbr)
    let nexty = y + b(trynbr)
    if nextx => 1 and nextx <= size and nexty >= 1 and nexty <= size then
      let totalmoves = totalmoves + 1
      if board(nextx,nexty) = 0 then                    'Not been here before
        let board(nextx,nexty) = movenbr                'Ah, sweet success.
        let ok = 1
        let legalmoves = legalmoves + 1
        if visible then
          print "Pass:"; pass; " Move #:"; movenbr
          MatPrint board()
          waitkey
        end if
        if movenbr > bestboard then    ' Store our best board or recursion
          let bestboard = movenbr      ' will destroy the last moves.
          ' let Mat best = board                Sorry....
              for i%=lbound(best,1) to ubound(best,1)
                for j%=lbound(best,2) to ubound(best,2)
                  best(i%,j%)=board(i%,j%)
                next j%
              next i%
        end if
       ' if movenbr => 15 then         ' Uncomment this to print
       '  print #4: "Pass no:"; pass   'all squares of given size to check
       '    mat print #4: board;       ' for duplicates. None found.
       ' end if
        if movenbr < sizesq then   ' Parens around parms in recursive call force
          let x = nextx            ' call by value, not by reference
          let y = nexty
          call try(movenbr + 1, (x), (y))  'Recursive try for next move.
          if ok = 0 then                   'Nope, didn't work. Back up!
            let board(x,y) = 0
            let x = oldx
            let y = oldy
          end if
          if visible then
            color 3                        ' set color "red"
            print "Uncoil from recursion.";
            print " Move No."; movenbr
            MatPrint board()
            waitkey
          end if
        else
          let ok = 1                    'By George, we've got it!
        end if
      end if
    end if
  wend                             ' loop until ok = 1 or trynbr = 8
end sub

sub MatRead (x())
   for i%=lbound(x) to ubound(x)
     read x(i%)
   next i%
end sub

sub MatPrint (x(2))
  for i%=lbound(x,1) to ubound(x,1)
    for j%=lbound(x,2) to ubound(x,2)
      print using "###"; x(i%,j%);
    next j%: print
  next i%
end sub