Quite BASIC -- Towers of Hanoi

Output

Canvas

BASIC Program

1000 REM Towers of Hanoi
1010 REM Quite BASIC Puzzle Project
1020 CLS
1030 PRINT "Towers of Hanoi"
1040 PRINT
1050 PRINT "This is a recursive solution for seven discs."
1060 PRINT
1070 PRINT "See the REM statements in the program if you didn't think that recursion was possible in classic BASIC!"
1080 REM Yep, recursive GOSUB calls works in Quite BASIC!  
1090 REM However, to actually write useful recursive algorithms, it helps to have variable scoping and parameters to subroutines -- something classic BASIC is lacking.  In this case we have only one "parameter" -- the variable N.  And subroutines are always called with N-1.  This is lucky for us because we can keep track of the value by decrementing it when we enter subroutines and incrementing it back when we exit.
1100 REM If we had subroutine parameters we could have written a single subroutine for moving discs from peg P to peg Q where P and Q were subroutine parameters, but no such luck.  Instead we have to write six different subroutines for moving from peg to peg.  See Subroutines 4000, 5000, 6000, 7000, 8000, and 9000.
1110 REM ===============================
2000 REM A, B, and C are arrays holding the discs
2010 REM We refer to the corresponding pegs as peg A, B, and C
2020 ARRAY A
2030 ARRAY B
2040 ARRAY C
2050 REM Fill peg A with seven discs
2060 FOR I = 0 TO 6
2070 LET A[I] = 7 - I
2080 NEXT I
2090 REM X, Y, Z hold the number of discs on pegs A, B, and C
2100 LET X = 7
2110 LET Y = 0
2120 LET Z = 0
2130 REM Disc colors
2140 ARRAY P
2150 LET P[1] = "cyan"
2160 LET P[2] = "blue"
2170 LET P[3] = "green"
2180 LET P[4] = "yellow"
2190 LET P[5] = "magenta"
2200 LET P[6] = "orange"
2210 LET P[7] = "red"
2220 REM Draw initial position -- all discs on the A peg
2230 FOR I = 0 TO 6
2240 FOR J = 8 - A[I] TO 8 + A[I]
2250 PLOT J, I, P[A[I]]
2260 NEXT J
2270 NEXT I 
2280 REM N is the number of discs to move
2290 LET N = 7
2320 REM Move all discs from peg A to peg B
2310 GOSUB 6000
2320 END
3000 REM The subroutines 3400, 3500, 3600, 3700, 3800, 3900 
3010 REM handle the drawing of the discs on the canvas as we
3020 REM move discs from one peg to another.
3030 REM These subroutines also update the variables X, Y, and Z
3040 REM which hold the number of discs on each peg.
3050 REM ============================== 
3400 REM Subroutine -- Remove disc from peg A
3410 LET X = X - 1
3420 FOR I = 8 - A[X] TO 8 + A[X]
3430 PLOT I, X, "gray"
3440 NEXT I
3450 RETURN
3500 REM Subroutine -- Add disc to peg A
3510 FOR I = 8 - A[X] TO 8 + A[X]
3520 PLOT I, X, P[A[X]]
3530 NEXT I
3540 LET X = X + 1
3550 PAUSE 400 * (5 - LEVEL) + 10 
3560 RETURN
3600 REM Subroutine -- Remove disc from peg B
3610 LET Y = Y - 1
3620 FOR I = 24 - B[Y] TO 24 + B[Y]
3630 PLOT I, Y, "gray"
3640 NEXT I
3650 RETURN
3700 REM Subroutine -- Add disc to peg B
3710 FOR I = 24 - B[Y] TO 24 + B[Y]
3720 PLOT I, Y, P[B[Y]]
3730 NEXT I
3740 LET Y = Y + 1
3750 PAUSE 400 * (5 - LEVEL) + 10 
3760 RETURN
3800 REM Subroutine -- Remove disc from peg C
3810 LET Z = Z - 1
3820 FOR I = 40 - C[Z] TO 40 + C[Z]
3830 PLOT I, Z, "gray"
3840 NEXT I
3850 RETURN
3900 REM Subroutine -- Add disc to peg C
3910 FOR I = 40 - C[Z] TO 40 + C[Z]
3920 PLOT I, Z, P[C[Z]]
3930 NEXT I
3940 LET Z = Z + 1
3950 PAUSE 400 * (5 - LEVEL) + 10 
3960 RETURN
4000 REM ======================================
4010 REM Recursive Subroutine -- move N discs from peg B to peg A
4020 REM First move N-1 discs from peg B to peg C
4030 LET N = N - 1
4040 IF N <> 0 THEN GOSUB 9000
4050 REM Then move one disc from peg B to peg A 
4060 GOSUB 3600
4070 LET A[X] = B[Y]
4080 GOSUB 3500
4090 REM And finally move N-1 discs from peg C to peg A
4100 IF N <> 0 THEN GOSUB 5000
4110 REM Restore N before returning
4120 LET N = N + 1
4130 RETURN
5000 REM ======================================
5010 REM Recursive Subroutine -- Move N discs from peg C to peg A
5020 REM First move N-1 discs from peg C to peg B
5030 LET N = N - 1
5040 IF N <> 0 THEN GOSUB 8000
5050 REM Then move one disc from peg C to peg A
5060 GOSUB 3800
5070 LET A[X] = C[Z]
5080 GOSUB 3500
5090 REM And finally move N-1 discs from peg B to peg A
5100 IF N <> 0 THEN GOSUB 4000
5120 REM Restore N before returning
5130 LET N = N + 1
5140 RETURN
6000 REM ======================================
6000 REM Recursive Subroutine -- Move N discs from peg A to peg B
6010 REM First move N-1 discs from peg A to peg C
6020 LET N = N - 1
6030 IF N <> 0 THEN GOSUB 7000
6040 REM Then move one disc from peg A to peg B
6050 GOSUB 3400
6060 LET B[Y] = A[X]
6070 GOSUB 3700
6090 REM And finally move N-1 discs from peg C to peg B
6100 IF N <> 0 THEN GOSUB 8000
6110 REM Restore N before returning
6120 LET N = N + 1
6130 RETURN
7000 REM ======================================
7010 REM Recursive Subroutine -- Move N discs from peg A to peg C
7020 REM First move N-1 discs from peg A to peg B
7030 LET N = N - 1
7040 IF N <> 0 THEN GOSUB 6000
7050 REM Then move one disc from peg A to peg C
7060 GOSUB 3400
7070 LET C[Z] = A[X]
7080 GOSUB 3900
7090 REM And finally move N-1 discs from peg B to peg C
7100 IF N <> 0 THEN GOSUB 9000
7110 REM Restore N before returning
7120 LET N = N + 1
7130 RETURN
8000 REM ======================================
8010 REM Recursive Subroutine -- Move N discs from peg C to peg B
8020 REM First move N-1 discs from peg C to peg A
8030 LET N = N - 1
8040 IF N <> 0 THEN GOSUB 5000
8050 REM Then move one disc from peg C to peg B
8060 GOSUB 3800
8070 LET B[Y] = C[Z]
8080 GOSUB 3700
8090 REM And finally move N-1 discs from peg A to peg B
8100 IF N <> 0 THEN GOSUB 6000
8110 REM Restore N before returning
8120 LET N = N + 1
8130 RETURN
9000 REM ======================================
9010 REM Recursive Subroutine -- Move N discs from peg B to peg C
9020 REM First move N-1 discs from peg B to peg A
9030 LET N = N - 1
9040 IF N <> 0 THEN GOSUB 4000
9050 REM Then move one disc from peg B to peg C
9060 GOSUB 3600
9070 LET C[Z] = B[Y]
9080 GOSUB 3900
9090 REM And finally move N-1 discs from peg A to peg C
9100 IF N <> 0 THEN GOSUB 7000
9110 REM Restore N before returning
9120 LET N = N + 1
9130 RETURN

Controls

Line:

Expr:

Value:

>QUITE BASIC
>

fun and learning for smart kids

nostalgia for the rest of us

>QUITE BASIC>

fun and learning for smart kids

nostalgia for the rest of us

>QUITE BASIC
>