DECLARE SUB INSTRUCT ()
DECLARE SUB AUTO ()
DECLARE SUB PLAYGAME ()
DECLARE SUB MOVEPILE (N%, START%, FINISH%)
DECLARE SUB MOVEDISC (START%, FINISH%)
DECLARE SUB SHOWDISCS ()
DEFINT A-Z

'CONST NUMDISCS = 8 ' alter this line to change number of discs
DIM SHARED NUMDISCS
NUMDISCS = 8

DIM SHARED TOWERS(0 TO 2, 1 TO NUMDISCS), TOP(0 TO 2), COLORS(1 TO NUMDISCS), NUMMOVES AS LONG
CLS
TOP(0) = NUMDISCS: TOP(1) = 0: TOP(2) = 0
FOR I = 1 TO NUMDISCS
TOWERS(0, I) = NUMDISCS - I + 1
READ COLORS(I)
NEXT
DATA 6, 9, 4, 10, 11, 12, 13, 14
DATA 6, 9, 4, 10, 11, 12, 13, 14
LOCATE 1, 26
PRINT CHR$(218); STRING$(14, CHR$(196)); CHR$(191)
LOCATE 2, 26
PRINT CHR$(179); "TOWER OF HANOI"; CHR$(179)
LOCATE 3, 26
PRINT CHR$(192); STRING$(14, CHR$(196)); CHR$(217)
PRINT STRING$(80, CHR$(196))
PRINT
PRINT "1: AUTO"
PRINT "2: HUMAN"
PRINT STRING$(20, CHR$(196))
WHILE CHOICE <> 1 AND CHOICE <> 2
INPUT "CHOOSE ONE: ", CHOICE
WEND
IF CHOICE = 1 THEN CALL AUTO ELSE CALL PLAYGAME

SUB AUTO
CALL SHOWDISCS
CALL MOVEPILE(NUMDISCS, 0, 2)
END SUB

SUB INSTRUCT
PRINT "The TOWER OF HANOI is a mathematical game or puzzle. It consists"
PRINT "of three pegs and a number of discs which can slide onto any peg."
PRINT "The puzzle starts with the discs stacked in order of size on one peg."
PRINT
PRINT "The object of the game is to move the entire stack onto another peg,"
PRINT "obeying the following rules:"
PRINT TAB(2); CHR$(248); " Only one disc may be moved at a time."
PRINT TAB(2); CHR$(248); " Each move consists of taking the upper disc from"
PRINT TAB(4); "one peg and sliding it onto another peg, on top of any discs"
PRINT TAB(4); "that may already be on that peg."
PRINT TAB(2); CHR$(248); " No disc may be placed on top of another disc."
PRINT "PRESS ANY KEY TO CONTINUE..."
NULL$ = INPUT$(1)
END SUB

SUB MOVEDISC (START, FINISH)
DIM T AS SINGLE
TOWERS(FINISH, TOP(FINISH) + 1) = TOWERS(START, TOP(START))
TOP(FINISH) = TOP(FINISH) + 1
TOWERS(START, TOP(START)) = 0
TOP(START) = TOP(START) - 1
NUMMOVES = NUMMOVES + 1
CALL SHOWDISCS
T = TIMER
WHILE TIMER - T < .2:
IF INKEY$ = CHR$(27) THEN END
WEND
END SUB

SUB MOVEPILE (N, START, FINISH)
IF N > 1 THEN CALL MOVEPILE(N - 1, START, 3 - START - FINISH)
CALL MOVEDISC(START, FINISH)
IF N > 1 THEN CALL MOVEPILE(N - 1, 3 - START - FINISH, FINISH)
END SUB

SUB PLAYGAME
DO
INPUT "WOULD YOU LIKE INSTRUCTIONS"; NULL$
NULL$ = UCASE$(LEFT$(LTRIM$(NULL$), 1))
IF NULL$ = "Y" THEN CALL INSTRUCT: EXIT DO
IF NULL$ = "N" THEN EXIT DO
LOOP
CALL SHOWDISCS
DO
LOCATE 1, 1
COLOR 7
PRINT "TYPE NUMBER OF START PEG FOLLOWED BY NUMBER OF END PEG"
PRINT "LEFT = 1", "MIDDLE = 2", "RIGHT=3"
DO
KEY$ = INKEY$
SELECT CASE KEY$
CASE CHR$(27)
END
CASE "1"
START = 0
EXIT DO
CASE "2"
START = 1
EXIT DO
CASE "3"
START = 2
EXIT DO
END SELECT
LOOP
DO
KEY$ = INKEY$
SELECT CASE KEY$
CASE CHR$(27)
END
CASE "1"
FINISH = 0
EXIT DO
CASE "2"
FINISH = 1
EXIT DO
CASE "3"
FINISH = 2
EXIT DO
END SELECT
LOOP
IF TOP(START) = 0 THEN PRINT "There are no discs on that peg.": GOTO 1
IF START = FINISH THEN PRINT "The start peg is the same as the end peg.": GOTO 1
IF TOP(FINISH) > 0 THEN
IF TOWERS(START, TOP(START)) > TOWERS(FINISH, TOP(FINISH)) THEN PRINT "You may not put a larger disc on top of a smaller disc.": GOTO 1
END IF
CALL MOVEDISC(START, FINISH)
IF TOP(0) = 0 AND TOP(1) = 0 THEN EXIT DO
IF TOP(0) = 0 AND TOP(2) = 0 THEN EXIT DO
1 LOOP
END SUB

SUB SHOWDISCS
CLS
LOCATE 1, 60: PRINT "MOVES: "; NUMMOVES
LOCATE 25, 1
PRINT STRING$(80, CHR$(196));
FOR I = 1 TO TOP(0)
LOCATE 25 - I, I + 1
X = TOWERS(0, I)
IF X = 0 THEN EXIT FOR
COLOR COLORS(X): PRINT STRING$(X * 2, CHR$(219));
NEXT
FOR I = 1 TO TOP(1)
LOCATE 25 - I, I + NUMDISCS * 3
X = TOWERS(1, I)
IF X = 0 THEN EXIT FOR
COLOR COLORS(X): PRINT STRING$(X * 2, CHR$(219));
NEXT
FOR I = 1 TO TOP(2)
LOCATE 25 - I, I + NUMDISCS * 6
X = TOWERS(2, I)
IF X = 0 THEN EXIT FOR
COLOR COLORS(X): PRINT STRING$(X * 2, CHR$(219));
NEXT

END SUB