home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FPC225_2.ZIP / MISC.ZIP / NHANOI.SEQ < prev    next >
Encoding:
Text File  |  1988-01-21  |  2.7 KB  |  94 lines
  1. \ TOWERS-1
  2. \ The Famous Towers of Hanoi by Peter Midnight.
  3. \ From FORTH Dimensions Volume 2 Number 2.
  4. \ Converted to Laxen and Perry F83 by Jack Brown.
  5. \ The original author left out the stack comments and I don't
  6. \ have time to put them in today. Send me a copy with them in!
  7. : CLS  ( --  -- ) dark ; \ Clear screen.
  8. \ CODE AT  ( row col  -- )  \ position cursor.
  9. \        AX POP DX POP AL DH MOV BH BH XOR 2 # AH MOV 16 INT
  10. \        NEXT END-CODE
  11. \ : 4DUP  ( a b c d   a b c d a b c d ) 2OVER 2OVER ;
  12. 12 CONSTANT NMAX  VARIABLE (N) NMAX (N) !
  13. : N ( --  n ) (N) @ ; \ fetch value of n.
  14. 219 CONSTANT COLOR
  15.    VARIABLE HFO    3 HFO !
  16.    VARIABLE RING   N ALLOT
  17. \ TOWERS-2
  18.  
  19. : DELAY ( n   -- )
  20.         0 DO 17 0 DO 127 127 * DROP LOOP LOOP ;
  21. : POS  ( n   n' )
  22.         N 2* 1+ * N + ;
  23. : HALFD  ( char size   -- )
  24.         0 DO DUP EMIT LOOP DROP ;
  25. : <DISP> ( row char size   -- )
  26.         2DUP HALFD ROT 3 < IF BL ELSE ( ASCII H) 219
  27.         THEN EMIT HALFD ;
  28. : DISPLAY
  29.         SWAP >R -ROT OVER - R@  AT
  30.         R> -ROT <DISP> ;
  31.  
  32. \ TOWERS-3
  33.  
  34. : PRESENCE ( n    flag )
  35.         RING + C@ = ;
  36. : LINE
  37.         4 SWAP N 0 DO DUP I PRESENCE 1+
  38.         ROT + SWAP LOOP DROP ;
  39. : RAISE
  40.         DUP POS SWAP LINE 2 SWAP
  41.         DO 2DUP I BL DISPLAY 2DUP I 1- COLOR DISPLAY
  42.         -1 +LOOP 2DROP ;
  43. : LOWER
  44.         DUP POS SWAP LINE 1+ 2
  45.         DO 2DUP I 1- BL DISPLAY 2DUP I COLOR DISPLAY
  46.         LOOP 2DROP ;
  47.  
  48. \ TOWERS-4
  49. : MOVELEFT
  50.         POS SWAP POS 1- DO DUP I 1+ 1 BL DISPLAY
  51.         DUP I 1 COLOR DISPLAY -1 +LOOP DROP ;
  52.  
  53. : MOVERIGHT
  54.         POS 1+ SWAP POS 1+ DO DUP I 1- 1 BL DISPLAY
  55.         DUP I 1 COLOR DISPLAY LOOP DROP ;
  56.  
  57. : TRAVERS
  58.         2DUP > IF MOVELEFT ELSE MOVERIGHT THEN ;
  59.  
  60. : MOVE1
  61.         KEY? IF 0 16 AT  ABORT THEN
  62.         -ROT 2DUP RAISE >R 2DUP R> ROT TRAVERS
  63.         2DUP RING + 1- C! SWAP LOWER ;
  64. \ TOWERS-5
  65. : MULTIMOV   RECURSIVE
  66.         3 PICK 1 = IF DROP MOVE1 ELSE
  67.         >R >R  SWAP 1- SWAP R> R> 4DUP SWAP MULTIMOV
  68.         4DUP DROP ROT 1+ -ROT MOVE1
  69.         -ROT SWAP MULTIMOV THEN ;
  70. : MAKETOWER
  71.         POS 4 N + 3 DO DUP I AT 219 EMIT LOOP DROP ;
  72. : MAKEBASE
  73.         0 N 4 + AT N 6 * 3 + 0 DO 219 EMIT LOOP ;
  74. : MAKERING
  75.         2DUP RING + 1- C! SWAP LOWER ;
  76. : SETUP
  77.         CLS N 1+ 0 DO 1 RING I + C! LOOP 3 0 DO I
  78.         MAKETOWER LOOP MAKEBASE 1 N DO 0 I MAKERING -1 +LOOP ;
  79.  
  80. \ TOWERS-6
  81. \ Values of n larger than 7 take a fair amount of time.
  82. : TOWERS  ( n   -- )
  83.         1 MAX NMAX MIN (N) !
  84.         SETUP N 2 0 1 BEGIN
  85.         OVER POS N 4 + AT N 0
  86.         DO BEEP 5 DELAY LOOP
  87.         ROT 4DUP MULTIMOV
  88.         HFO @ 1- DUP HFO ! UNTIL
  89.         2DROP 2DROP
  90.         0 0 AT
  91.         N 0 DO BEEP 5 DELAY LOOP ;
  92.  
  93. : HANOI  7 TOWERS ;
  94.