home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l076 / 1.ddi / HANOI.TRU < prev    next >
Encoding:
Text File  |  1988-08-27  |  2.1 KB  |  86 lines

  1. ! Towers of Hanoi
  2. !
  3. ! Version 2.0 copyright (c) 1988 by True BASIC, Inc.
  4. !
  5. LET disks = 6
  6. CALL setup(disks,1)
  7. CALL hanoi(disks,1,2,3)
  8. CALL ending
  9.  
  10. END
  11.  
  12. MODULE Hanoi
  13.  
  14.     SHARE #1, top(3)
  15.  
  16.     SUB setup(n,a)                ! n disks, on tower a
  17.         OPEN #1: screen .1875,.8125,.2,.8
  18.         SET WINDOW 0,4,0,n+2
  19.         SET back 5
  20.         SET TEXT justify "center","base"
  21.         PLOT TEXT, AT 2,n+2.5: "The Towers of Hanoi"
  22.         SET COLOR 2
  23.         BOX AREA 0,4,0,1
  24.         SET COLOR 0
  25.         PLOT 0,1;4,1
  26.         SET COLOR 3
  27.         FOR i = 1 to 3
  28.             BOX AREA i-.02,i+.02,1,n+1
  29.         NEXT i
  30.         FOR j = n to 1 step -1
  31.             CALL disk(a,n+1-j,j,1)
  32.         NEXT j
  33.         LET top(1) = n
  34.     END SUB
  35.  
  36.     SUB hanoi(n,a,b,c)            ! Recursive routine
  37.         IF n > 0 then
  38.            CALL hanoi(n-1,a,c,b)
  39.            CALL move(n,a,b)
  40.            CALL hanoi(n-1,c,b,a)
  41.         END IF
  42.     END SUB
  43.  
  44.     SUB move(s,a,b)
  45.         CALL disk(a,top(a),s,0)   ! Erase
  46.         LET top(a) = top(a) - 1
  47.         LET top(b) = top(b) + 1
  48.         CALL disk(b,top(b),s,1)   ! Draw
  49.     END SUB
  50.  
  51.     SUB disk(t,h,s,c)             ! Tower no., height, size, color
  52.         LET x1 = t - (s+1)/15
  53.         LET x2 = t + (s+1)/15
  54.         LET y1 = h
  55.         LET y2 = h + 1
  56.         SET COLOR c
  57.         BOX AREA x1,x2,y1,y2
  58.         IF c = 0 then             ! If erasing, replace the tower
  59.            SET COLOR 3
  60.            BOX AREA t-.02,t+.02,y1,y2
  61.         ELSE
  62.            SET COLOR 0            ! Make an empty border
  63.            BOX LINES x1,x2,y1,y2
  64.         END IF
  65.         PAUSE .2
  66.     END SUB
  67.  
  68.     SUB ending
  69.         SET COLOR 2
  70.         PLOT TEXT, AT 2,-1.5: "N I R V A N A"
  71.         ASK MAX COLOR mc
  72.         IF mc<15 then
  73.            FOR i = 1 to 49
  74.                SET back 32*rnd
  75.                PAUSE .05
  76.            NEXT i
  77.         ELSE
  78.            FOR i = 1 to 30
  79.                SET COLOR MIX(0) Max(.5,rnd),Max(.5,rnd),Max(.5,rnd)
  80.                PAUSE .05
  81.            NEXT i
  82.         END IF
  83.     END SUB
  84.  
  85. END MODULE
  86.