To run online, click here: RUN ONLINE
Code:
' PROGRAM The Towers of Hanoi
' (c) Zarsoft 2022 Pascalated BASIC
' (c) Zarsoft 2023 Pascalated Boriel ZX BASIC
' Pascalated Sinclair BASIC (c) 1987 by ZarSoft
' Pascalated BASIC Converter (c) 2021 by Zarsoft
' Pascalated Boriel (c) 2023 by ZarSoft
' ZX BASIC Compiler (c) 2008 by Boriel
#include <input.bas> ' number = VAL INPUT(12)
#include <screen.bas> ' SCREEN$ function
#include <attr.bas> ' ATTR function
'--- Pascalated Boriel ---
#define PROGRAM REM
#define BEGIN REM
'#define CONST CONST
#define VAR DIM
#define INTEGER LONG
#define REAL FLOAT
#define CHAR STRING
'#define STRING STRING
#define BOOLEAN UBYTE
#define TYPE AS
'#define WHILE WHILE
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
CONST TRUE TYPE BOOLEAN = 1
CONST FALSE TYPE BOOLEAN = 0
PROGRAM The Towers of Hanoi
' CONSTant declarations
CONST black TYPE INTEGER = 0
CONST blue TYPE INTEGER = 1
CONST green TYPE INTEGER = 4
CONST white TYPE INTEGER = 7
CONST MinDisks TYPE INTEGER = 6
CONST PoleLine TYPE INTEGER = 16
' VAR - Global variables
VAR DiskShape(11) TYPE STRING ' :REM disk ARRAY (0..10) OF ARRAY (1..19) OF CHAR;
VAR Pole(3,11) TYPE INTEGER ' pole ARRAY (1..03) OF ARRAY (1..10) OF INTEGER;
VAR PoleLen(3) TYPE INTEGER :REM REM PoleLen :ARRAY (1..03) OF INTEGER;
VAR PoleCol(3) TYPE INTEGER :REM REM PoleCol :ARRAY (1..03) OF INTEGER;
VAR f,t TYPE INTEGER ' from, to
VAR MaxDisks TYPE INTEGER
VAR movement TYPE INTEGER
VAR LegalMove TYPE BOOLEAN
VAR abort TYPE BOOLEAN
VAR TheEnd TYPE BOOLEAN
PROCEDURE CheckEnd
LET TheEnd = TRUE
IF abort THEN LET TheEnd = FALSE
IF (MaxDisks < MinDisks)
LET TheEnd = FALSE
PRINT AT PoleLine+2,0;
PRINT INK 3;" =-- NOT ENOUGH DISKS --="
PRINT INK 2;" Try again "
ELSEIF (MaxDisks >= MinDisks) AND (movement > 2^MaxDisks-1)
LET TheEnd = FALSE
PRINT AT PoleLine+2,0;
PRINT INK 3;" =-- TOO MUCH MOVEMENTS --="
PRINT INK 2;" Try again "
PAUSE 10
ENDIF
PRINT AT 21,0;PAPER 1;" Press any key to continue "
PAUSE 10
PAUSE 10
PAUSE 0
END PROCEDURE
PROCEDURE finalization
PRINT AT PoleLine+2,0;
PRINT INK 3;" ===-- CONGRATULATIONS! --==="
PRINT INK 2;" "
: FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
PAUSE 0
END PROCEDURE
PROCEDURE MoveDisk (f TYPE INTEGER,t TYPE INTEGER)
VAR column TYPE INTEGER
VAR l,col TYPE INTEGER
BEGIN
LET movement = movement+1
PRINT AT 2,0;"This move: ";movement
LET PoleLen(t) = PoleLen(t)+1
LET Pole(t,PoleLen(t)) = Pole(f,PoleLen(f))
LET Pole(f,PoleLen(f)) = 0
LET PoleLen(f) = PoleLen(f)-1
REM move up
LET col = PoleCol(f)
FOR l = PoleLine-PoleLen(f)-2 TO PoleLine-11 STEP -1
PRINT AT l,col;INK green;DiskShape$(Pole(t,PoleLen(t))+1);
PRINT AT l+1,col;INK blue;DiskShape$(0+1);
NEXT l
REM left/right
IF f < t
REM move right
LET col = PoleCol(f)+2
WHILE col < PoleCol(t)
PRINT AT PoleLine-11,col-2;INK green;" ";DiskShape$(Pole(t,PoleLen(t))+1);
LET col = col+2
END WHILE
ELSE
REM move left
LET col = PoleCol(f)-2
WHILE col > PoleCol(t)
PRINT AT PoleLine-11,col;INK green;DiskShape$(Pole(t,PoleLen(t))+1);" ";
LET col = col-2
END WHILE
ENDIF
PRINT AT PoleLine-11,PoleCol(t);" ";
PRINT AT PoleLine-11,0;" ";
PRINT AT PoleLine-10,PoleCol(t);INK green;DiskShape$(Pole(t,PoleLen(t))+1);
REM move down
LET col = PoleCol(t)
FOR l = PoleLine-9 TO PoleLine-PoleLen(t)
PRINT AT l,col;INK green;DiskShape$(Pole(t,PoleLen(t))+1);
PRINT AT l-1,col;INK blue;DiskShape$(0+1);
NEXT l
END PROCEDURE
PROCEDURE CheckLegalMove
REM (VAR f,t:INTEGER);
LET LegalMove = TRUE
IF (f = t) OR (PoleLen(f) = 0)
LET LegalMove = FALSE
ELSEIF PoleLen(t) <> 0
IF NOT( Pole(f,PoleLen(f)) < Pole(t,PoleLen(t)) ) THEN LET LegalMove = FALSE
ENDIF
END PROCEDURE
PROCEDURE InputMove
REM (VAR f,t:INTEGER);
VAR k$ TYPE STRING
BEGIN
PRINT AT PoleLine+2,1;"MOVE FROM... ";
REPEAT
PAUSE 0
LET k$ = INKEY$
UNTIL k$ >= "0" AND k$ <= "9"
BEEP .1,5
LET f = VAL (k$)
LET k$ = "X"
IF f=0 THEN LET abort = TRUE: LET k$="0"
PRINT AT PoleLine+2,1;"MOVE FROM ";f;" TO... ";
WHILE NOT(abort) AND NOT (k$ >= "0" AND k$ <= "9")
PAUSE 0
LET k$ = INKEY$
END WHILE
BEEP .1,5
LET t = VAL k$
IF t=0 THEN LET abort = TRUE
IF abort THEN LET f = 1: LET t = 1
PRINT AT PoleLine+2,1;" ";
END PROCEDURE
PROCEDURE PrintPole (PoleNumber TYPE INTEGER)
VAR col TYPE INTEGER
VAR i TYPE INTEGER
BEGIN
LET col = PoleCol(PoleNumber)
FOR i = 1 TO 10
IF Pole(PoleNumber,i) = 0 THEN INK blue
IF Pole(PoleNumber,i) <> 0 THEN INK green
PRINT AT PoleLine-i,col;DiskShape$(Pole(PoleNumber,i)+1);
NEXT i
INK white
END PROCEDURE
PROCEDURE Initialization
VAR i TYPE INTEGER
BEGIN
LET TheEnd = FALSE
LET abort = FALSE
LET PoleCol(1) = 1
LET PoleCol(2) = 1+9+2
LET PoleCol(3) = 1+9+2+9+2
LET DiskShape$( 1) = " | "
LET DiskShape$( 2) = " 1 "
LET DiskShape$( 3) = " \A2\C "
LET DiskShape$( 4) = " \B3\B "
LET DiskShape$( 5) = " \A\B4\B\C "
LET DiskShape$( 6) = " \B\B5\B\B "
LET DiskShape$( 7) = " \A\B\B6\B\B\C "
LET DiskShape$( 8) = " \B\B\B7\B\B\B "
LET DiskShape$( 9) = "\A\B\B\B8\B\B\B\C"
LET DiskShape$(10) = "\B\B\B\B9\B\B\B\B"
FOR i = 1 TO 10
LET Pole(1,i) = 0
LET Pole(2,i) = 0
LET Pole(3,i) = 0
NEXT i
FOR i = 1 TO MaxDisks
LET Pole(1,i) = MaxDisks-(i-1)
NEXT i
LET PoleLen(1) = MaxDisks
LET PoleLen(2) = 0
LET PoleLen(3) = 0
INK blue
PRINT AT PoleLine,PoleCol(1);
PRINT "\::\::\::\::1\::\::\::\::";
PRINT " ";
PRINT "\::\::\::\::2\::\::\::\::";
PRINT " ";
PRINT "\::\::\::\::3\::\::\::\::";
INK white
LET movement = 0
PRINT AT 0,7;INK green;"THE TOWERS OF HANOI"
PRINT AT 2,19;"Minimum: ";2^MaxDisks-1
PAPER blue: INK green
PRINT AT 21,0;"1,2,3 - Select pole 0 - ABORT"
PAPER black
END PROCEDURE
PROCEDURE AskMaxDisks
VAR k$ TYPE CHAR
BEGIN
INK green
PRINT AT PoleLine+3,0;"NUMBER OF DISKS = [1..9] ";
REPEAT
PAUSE 0
LET k$ = INKEY$
UNTIL k$ >= "1" AND k$ <= "9"
BEEP .1,5
LET MaxDisks = VAL (k$)
IF MaxDisks=0 THEN LET MaxDisks = 10
PRINT AT PoleLine+2,1;
END PROCEDURE
PROCEDURE Introduction
REM VAR s :BOOLEAN
BEGIN
BORDER black: PAPER black: INK green: CLS
PRINT " THE TOWERS OF HANOI"
PRINT
INK white
PRINT "In the great temple of Brahma","in Benares of India, there is ","a plate with 3 diamond needles","under the dome that marks the","center of the world."
PRINT
PRINT "At the creation, God placed 64","disks of pure gold in the order of their sizes, from largest to smallest."
PRINT
PRINT "This is the Tower of Brahma."
PRINT
PRINT "Day and night unceasingly the","monks of the temple move the","disks from one diamond needle","to another."
PRINT
PRINT AT 21,0;PAPER 1;"Press any key to read the rules"
PAUSE 0
INK 6
CLS
PRINT INK 3;"RULES:"
PRINT
PRINT " 1 - Only one disk can be moved at a time."
PRINT
PRINT " 2 - A disk can only be placed","on a larger disk (or no smaller disk below)."
PRINT
PRINT " 3 - All disks must go to the","third needle."
PRINT
INK 7
PRINT "When all disks are moved from","the first needle to the third","needle forming the Tower of","Brahma, then will come the end","of the universe and all will","turn to dust."
PRINT
END PROCEDURE
PROCEDURE DefineChars
VAR n TYPE INTEGER
'RESTORE DataChars
READ b$
REPEAT
FOR i=0 TO 7
READ n
POKE USR b$+i,n
NEXT i
READ b$
UNTIL b$ = ""
END PROCEDURE
PROCEDURE DataChars
DATA "A"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00001111
DATA BIN 00001111
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA "B"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA "C"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 11110000
DATA BIN 11110000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA ""
END PROCEDURE
PROCEDURE MainRoutine
DefineChars
REPEAT
Introduction
AskMaxDisks
CLS
Initialization
PrintPole(1)
PrintPole(2)
PrintPole(3)
REPEAT
InputMove: REM (f,t)
CheckLegalMove: REM (f,t)
IF LegalMove THEN MoveDisk(f,t)
UNTIL (PoleLen(3) = MaxDisks) OR abort
CheckEnd
UNTIL TheEnd
finalization
END PROCEDURE
BEGIN
CLS
PRINT "Demo for Pascalated BASIC"
MainRoutine
END