mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-28 07:37:47 +00:00
160 lines
3.8 KiB
QBasic
160 lines
3.8 KiB
QBasic
|
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
|