mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-07-03 17:01:21 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
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
|