'Routes.bas
Defint A-Z
Const alt = -1, up = -1, max = 999
Dim shared Sq[100,100] 

PrintAllRoutes 6,13  '6x13 rectangle
Input "Press Enter to Exit";x$
System

Sub PrintAllRoutes(nr,nc)
For route=0 to 47
  typ$= InByRoute$(nr,nc,route)
  typ$=Typ$+RJust$(route\12+1,1)
  Print "===== Route: ";typ$;" ====="
  Prtsq nr,nc
  Input "<Enter>";x$
Next Route
End Sub 'PrintAllRoutes(nr,nc)

Sub ReverseEachRow(r,c)
For ri=1 to r
  For ci=1 to c\2
    Swap sq[ri,ci],sq[ri,c-ci+1]
  Next ci
Next ri
End Sub 'ReverseEachRow

Sub ReverseEachCol(r,c)
For ci=1 to c
  For ri=1 to r\2
    Swap sq[ri,ci],sq[r-ri+1,ci]
  Next ri
Next ci
End Sub 'ReverseEachCol

Sub ReverseNto1Sq(nr,nc)
'1,2,3... are swapped with n,n-1,n-2
n = nr*nc + 1
For r=1 to nr
  For c=1 to nc
    sq[r,c] = n - sq[r,c]
  Next c
Next r
End Sub 'ReverseNto1Sq

Sub Lin(Nsq,br,bc,llen,rinc,cinc,rmin,rmax,cmin,cmax)
r=br : c=bc
For i=1 to llen 'llen is line length
  if r>=rmin and r<=rmax then
     if c>=cmin and c<=cmax then
        Sq[r,c]=Nsq
        Nsq=Nsq+1
     end if
  end if
  r = r+rinc : c = c+cinc
Next i
End Sub 'Lin


Sub Horiz(nr,nc,alt)
Nsq=1
For r=1 to nr
  if not alt then 'normal rows
     Lin Nsq,r,1,nc,0,1,1,nr,1,nc
  elseif r mod 2 then 'even row
     Lin Nsq,r,1,nc,0,1,1,nr,1,nc
  else 'reverse odd row direction
     Lin Nsq,r,nc,nc,0,-1,1,nr,1,nc
  end if
Next r
End Sub 'Horiz

Sub Vert(nr,nc,alt)
Nsq=1
For c=1 to nc
 if not alt then 'normal columns
   Lin Nsq,1,c,nr,1,0,1,nr,1,nc
 elseif c mod 2 then 'even columns
   Lin Nsq,1,c,nr,1,0,1,nr,1,nc
 else  'reverse odd column direction
   Lin Nsq,nr,c,nr,-1,0,1,nr,1,nc
 end if
Next c
End Sub 'vert

Sub Diag(nr,nc,up,alt)
Nsq=1 : Limit=nr+nc-1
for N=1 to Limit
 Nodd= -(N mod 2)
 if not alt then
   if up then 'upward diagonals
    Lin Nsq,nr,N-nr+1,nr,-1,1,1,nr,1,nc
   else       'downward diagonals
    Lin Nsq,1,N,nr,1,-1,1,nr,1,nc
   end if
 elseif (up eqv Nodd) then 'alternate
    Lin Nsq,nr,N-nr+1,nr,-1,1,1,nr,1,nc
 else
  Lin Nsq,1,N,nr,1,-1,1,nr,1,nc
 end if
Next N
End Sub 'Diag

Sub SpiralRevCW(n,rn,cn,rb,cb)
Lin n,rb,cb,cn,0,1,0,max,0,max
br=rb+rn-1 : bc=cb+cn-1 'begin r&c
if rn>1 then 
  Lin n,rb+1,bc,rn-1,1,0,0,max,0,max
  Lin n,br,bc-1,cn-1,0,-1,0,max,0,max
end if 
if cn > 1 then 
  Lin n,br-1,cb,rn-2,-1,0,0,max,0,max
end if  'finished with one revolution
End Sub 'of spiral (clockwise)

Sub SpiralRevCCW(n,rn,cn,rb,cb)
Lin n,rb,cb,rn,1,0,0,max,0,max
br=rb+rn-1 : bc=cb+cn-1 'begin r&c
if cn>1 then
  Lin n,br,cb+1,cn-1,0,1,0,max,0,max
  Lin n,br-1,bc,rn-1,-1,0,0,max,0,max
end if
if rn > 1 then 
  Lin n,rb,bc-1,cn-2,0,-1,0,max,0,max
end if  'finished with one revolution
End Sub 'of spiral (counterclockwise)

Sub SpiralCW(rn,cn)
  i=1:n=1:r=rn:c=cn
  while r>0 and c>0
    spiralRevCW n, r, c, i, i
    i=i+1: r = r-2 : c = c-2
  wend
End Sub 'SpiralCw

Sub SpiralCCW(rn,cn)
  i=1 : n=1 : r=rn : c=cn
  while r>0 and c>0
    SpiralRevCCW n, r, c, i, i
    i=i+1 : r = r-2 : c = c-2
  wend
End Sub 'SpiralCCw

Function RJust$(I,L)
  Tmp$ = Space$(L) + Ltrim$(Str$(I))
  RJust$ = Right$(Tmp$,L)
End Function 'RJust$

Sub Prtsq(nr,nc)
for r=1 to nr
  For c=1 to nc
    print RJust$(Sq[r,c],3);
  Next c
  print
Next r
End Sub 'Prtsq

Function InByRoute$(nr,nc,Rnum) Static
if T$="" then
T$="    H   AH    V   AV  CWS CCWS C"
T$=T$+"WRSCCWRS   UD   DD  AUD  ADD"
End If
Typ  = Rnum mod 12
Select Case Rnum
 case  0
   Horiz nr,nc,Not alt
 case  1
   Horiz nr,nc,alt
 case  2
   Vert nr,nc,Not alt
 case  3
   Vert nr,nc,alt
 case  4
   SpiralCW nr,nc
 case  5
   SpiralCCW nr,nc
 case  6
   SpiralCCW nr,nc
   ReverseNto1Sq nr,nc
 case  7
   SpiralCW nr,nc
   ReverseNto1Sq nr,nc
 case  8
   Diag nr, nc,up,Not alt
 case  9
   Diag nr,nc,Not up,Not alt
 case 10
   Diag nr, nc,  up, alt
 case 11
   Diag nr, nc, Not up, alt
 case Else
  rquo=Rnum\12 : rrem=Rnum mod 12
  Tmp$=InByRoute$(nr,nc,rrem)
  If (rquo=1) Then
   ReverseEachRow nr,nc
   if typ and 4 then typ=typ xor 1
   Elseif rquo=3 Then
     ReverseEachCol nr,nc
     if typ and 12 then typ=typ xor 1
   Else 
     ReverseEachRow nr,nc
     ReverseEachCol nr,nc
     if typ and 8 then typ=typ xor 1
   End if
  End Select
  InByRoute$= Mid$(T$,5*Typ+1,5) 
End Sub  'InByRoute$