home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FORTHCMP.ZIP / QUEENS.4TH < prev    next >
Encoding:
Text File  |  1992-03-30  |  1.5 KB  |  65 lines
  1. \ Eight Queens Problem, by Jerry Levan,  from Forth Dimensions II/1 page 6
  2.  
  3. \ NOTE: DEFINE CONSTANT IBM-COMPAT TO BE ZERO IF NOT IBM COMPATIBLE
  4.     
  5. \ DEFINE THE CONSTANT PRINTIT TO BE ZERO IF NO PRINTING OF RESULTS
  6. \ IS DESIRED (FASTER FOR BENCHMARKING)
  7.  
  8. \ DEFINE THE CONSTANT VID-DELAY TO BE -1 IF SCREEN IS SNOWY
  9.  
  10. 128 MSDOS
  11. FIND PRINTIT #IF DROP #ELSE -1 CONSTANT PRINTIT #THEN
  12. FIND IBM-COMPAT #IF DROP #ELSE -1 CONSTANT IBM-COMPAT #THEN
  13.  
  14. IBM-COMPAT #IF INCLUDE DISPLAY1 #THEN
  15.  
  16. 8  ARRAY A
  17. 16 ARRAY B
  18. 16 ARRAY C
  19. 8  ARRAY X
  20.  
  21. H:  FILLARRAY  ( address cells -- , fill with 1's )
  22.     0 DO  -1 OVER !  2+ LOOP  DROP ;
  23.  
  24. 0 A  8 FILLARRAY  
  25. 0 B 16 FILLARRAY  
  26. 0 C 16 FILLARRAY
  27. 0 X  8 FILLARRAY
  28.  
  29. 2 1 IN/OUT
  30. : SAFE  DUP A @ IF SWAP 2DUP - 7 + C @ IF + B @ EXIT THEN THEN
  31.      2DROP 0 ;
  32.  
  33. 2 0 IN/OUT
  34. : MARK  SWAP  2DUP 2DUP - 7 + C OFF
  35.    + B OFF   DROP  A OFF ; 
  36.  
  37. 2 0 IN/OUT
  38. : UNMARK  SWAP  2DUP 2DUP - 7 + C ON
  39.    + B ON  DROP  A ON ;
  40.  
  41. VARIABLE TRIES
  42. PRINTIT #IF
  43. 0 0 IN/OUT
  44. : PRINTSOL  ." found on try " TRIES @ 6 .R   ." : "
  45.   8 0 DO  I X @ 1+ 5 .R LOOP  CR ;
  46. #THEN
  47.  
  48. 1 0 IN/OUT
  49. : TRY  8 0 DO  1 TRIES +! 
  50.         DUP I SAFE IF DUP I MARK I OVER X !  DUP 7 <
  51.          IF DUP 1+ TRY ( recurse )
  52.             PRINTIT #IF ELSE PRINTSOL #THEN  THEN
  53.        DUP I UNMARK THEN  LOOP  DROP ;
  54.  
  55. : MAIN IBM-COMPAT #IF SETUP-VID  #THEN
  56.        0 TRIES ! ." Starting..." CR 0 TRY
  57.       ." Done!"  CR
  58.       IBM-COMPAT #IF UNSETUP-VID #THEN ;
  59.  
  60.  
  61. IBM-COMPAT #IF INCLUDE DISPLAY2 #THEN
  62. INCLUDE FORTHLIB
  63. END
  64.  
  65.