%standard N queens programmed in \mf
%initialize; non-numerics must be declared
screenstrokes; pickup pencircle scaled .08pt;
boolean r[],u[],d[],loop,done;
string s[]; path p[],queen,checkit;
message "how many queens? ";
n=-1+scantokens readstring; 
if n<3: n:=3; fi; if n>92: n:=92; fi;
message "pause after each add (y/n)?";
s2:=readstring; m:=2*n; N:=n+1; w=floor(290/N);
%paths and board
checkit:=(-30,-30)--(0,-80)--(70,-10);
%queen  originally: queen:=unitsquare scaled w;
p1 := (.25w,.15w)--(.15w,.85w)--(.3w,.5w)--(.4w,.85w)--(.5w,.5w);
p2 := p1 reflectedabout ((.5w,0),(.5w,w)); queen := p1..reverse p2--cycle;
%draw board 
for i:=0 upto n+1:
 draw (0,w*i)--(w*N,w*i); draw (w*i,0)--(w*i,w*N);
endfor;
%procedures (ie macros)
%mark a square
def add = b[j]:=i; r[i]:=true; d[j+i]:=true; u[j-i]:=true; 
 fill queen shifted (j*w,i*w);
 if s2="y": 
  message "press enter to continue"; s1:=readstring; 
 fi;
enddef;
%unmark a square
def rem = r[i]:=false; d[j+i]:=false; u[j-i]:=false; 
 unfill queen shifted (j*w,i*w);
enddef;
%backtrack
def back= j:=j-1; i:=b[j];
 forever:
  exitif not ((i=n) and (j>0));
  rem; j:=j-1; i:=b[j];
 endfor;
 if i<n: 
  rem; i:=i+1; 
 else: 
  done:=true;
 fi;
enddef;
%draw check
def printit=
 pickup pencircle xscaled .4pt yscaled .1pt rotated -20;
 draw checkit; message "press enter to continue ";
 s1:=readstring; undraw checkit;
enddef;
%main program
i:=0;j:=0; done:=false;
for k:=0 upto n: r[k]:=false; endfor;
for k:=-n upto n: u[k]:=false; endfor;
for k:=0 upto m: d[k]:=false; endfor;
forever:
 loop:=true;
 if not (r[i] or d[j+i] or u[j-i]):
  add;
  if j=n:
   printit; message "show another solution (y/n)?";
   s3:=readstring;
   if s3="y":
    s2:="n"; rem; back;
   else:
    done:=true;
   fi;
  else:
   j:=j+1; i:=0; loop:=false;
  fi;
 fi;
 if loop:
  if i=n: 
   back; 
  else: i:=i+1;
  fi;
 fi;
 exitif done;
endfor;

if s3="y": message "no more solutions"; fi;
end;


