'************************
'* THE TOWERS OF BRAHMA *
'************************
'****** WRITTEN BY ******
'**** GARY WILKINSON ****
'************************
'***** Recursive Demo Mode ******
'**added by Chris Lusby Taylor **
'*who also tidied the whole thing up quite a lot
'
SCREEN #1 GRAPHICS 8000 FIXED,5000 FIXED:WINDOW #1 MOUSE 2:go=0
CLS RESET:WINDOW #1 FULL ON
WINDOW #1 OPEN
WINDOW #1 TITLE "********* INSTRUCTIONS *********"
SET COLOUR 12 POINTS 8
LOCATE #1,8;16
PRINT "THE OBJECT OF THE GAME IS TO TRANSFER THE RINGS FROM PILLAR   TO PILLAR  , ONE AT A TIME."
LOCATE #1,8;17
PRINT "AT           MAY A LARGER Ring be placed ON top of a smaller ring. the rings may be moved"
LOCATE #1,8;18
PRINT "BY PRESSING THE KEY CORRESPONDING TO THE COLUMN NUMBER OR BY CLICKING THE COLUMN WITH THE"
LOCATE #1,8;19
PRINT "MOUSE. THE GAME MAY BE RESTARTED BY PRESSING THE      KEY. TO QUIT  THE  GAME PRESS THE"
LOCATE #1,8;20
PRINT "KEY. YOU MAY ALSO RESTART OR QUIT BY CLICKING THE MOUSE ON THE     AND     SYMBOLS."
SET COLOUR 1:LOCATE #1,8;21
PRINT"PLEASE PRESS D FOR A DEMO OR ANY OTHER KEY TO PLAY"
SET COLOUR 10 EFFECTS &X1
LOCATE #1,53;16:PRINT "1":LOCATE #1,62;16:PRINT "3"
SET EFFECTS &X0:LOCATE #1,11;17:PRINT "NO TIME":LOCATE #1,46;19:PRINT "R"
LOCATE #1,74;19:PRINT "X":LOCATE #1,56;20:PRINT"R":LOCATE #1,62;20:PRINT"X"
BOX 775;1700,6750,400 FILL WITH 28 COLOUR 3

DIM h(3):REM depth of each pile

REM Draw pillars by undrawing a fictitious disk on each pillar
FOR v=1 TO 3
  h(v)=8
  GOSUB undraw
NEXT

SET COLOUR 10 POINTS 10 EFFECTS &X1,&X100
LOCATE #1,21;3:PRINT "1":LOCATE #1,40;3:PRINT "2":LOCATE #1,59;3:PRINT "3"

REM Draw all disks
DATA 13,14,1,2,4,5,6,7
DIM c(8):REM array of colours for each disk
u=1
FOR t=8 TO 1 STEP -1
  READ c(t)
  GOSUB drawdisk
NEXT
SET COLOUR 4 POINTS 8 EFFECTS &X0
REM Wait for space or "D" then erase instructions
REPEAT
mode$=INKEY$:UNTIL mode$<>""
WINDOW #1 TITLE "********* THE TOWERS OF BRAHMA *********"
WINDOW #1 MOUSE 3

BOX 600;100,7000,1450 FILL WITH 8 COLOUR 0
BOX 7180;3960,600,600 STYLE 1 WIDTH 5 COLOUR 3 ROUNDED
SET COLOUR 10 POINTS 16 EFFECTS &X1
LOCATE #1,73;4:PRINT "R"
BOX 330;3960,600,600 STYLE 1 WIDTH 5 COLOUR 3 ROUNDED
LOCATE #1,6;4:PRINT "X"

DIM a(3,8)
FOR x=1 TO 3
FOR y=1 TO 8
IF x=1 THEN a(x,y)=y
IF x>1 THEN a(x,y)=0
NEXT y
NEXT x
SET EFFECTS &X0 POINTS 10

IF mode$<>"D" AND mode$<>"d" THEN GOTO loop1
REM Demo mode - using recursion !

DIM s(8),d(8):REM current src, dest pile no.
r=8:s(8)=1:d(8)=3:REM source for all 8 is pile 1, dest is pile 3
GOSUB movepile
t=TIME
REPEAT:UNTIL TIME=t+500
RUN


REM MOVEPILE subroutine: to move a pile of r disks from s(r) to d(r)
REM where r is 9 minus the current recursion depth (max 8).
REM We do it by observing that we can move all but the bottom one
REM to the spare pile, then the bottom one to the destination, then
REM the remainder back from the spare pile.  Whenever we need to move
REM more than one disk we simply call the movepile routine
REM recursively.  Elegant, huh?

LABEL movepile
IF r=1 GOTO moveone
s(r-1)=s(r):REM First move from the source pile...
d(r-1)=6-s(r)-d(r):REM ... to the spare one.
r=r-1
GOSUB movepile:REM move the pile off the top of the r'th disk
r=r+1
LABEL moveone:REM move the r'th disk alone
v=s(r)
u=d(r)
t=r
GOSUB graphic
IF r=1 THEN RETURN
r=r-1
s(r)=d(r):REM now move from the spare pile...
d(r)=d(r+1):REM ...to the intended destination.
GOSUB movepile
r=r+1
RETURN




LABEL loop1:SET COLOUR 4:LOCATE #1,8;16:PRINT "FROM WHICH PILLAR DO YOU WISH TO REMOVE THE RING?"
GOSUB getmove
v=u
IF h(v)<9 THEN t=a(v,h(v)):GOTO loop2
SET COLOUR 14
PRINT CHR$(7):LOCATE #1,8;18
PRINT "THERE'S NO RING ON THE PILLAR YOU SELECTED   "
GOTO loop1


LABEL loop2
SET COLOUR 2:LOCATE #1,8;18:PRINT STRING$(45," ")
LOCATE #1,8;16:PRINT "TO WHICH PILLAR DO YOU WISH TO TRANSFER THE RING?"
GOSUB getmove
IF u=v THEN PRINT CHR$(7):SET COLOUR 15:LOCATE #1,8;18:PRINT"THE RING IS ALREADY ON THAT PILLAR               ":GOTO loop1
IF h(u)<9 THEN IF a(u,h(u))<t THEN GOTO invalid
a(u,h(u)-1)=t:GOSUB graphic
GOTO loop1



LABEL getmove
  IF BUTTON<>-1 THEN REPEAT:UNTIL BUTTON=-1:REM Wait until button up if down
  REPEAT
    REPEAT
      in$=INKEY$
    UNTIL (in$<>"" OR BUTTON<>-1):REM Wait until button down
    mx1=XMOUSE:my1=YMOUSE
    u=INSTR("123",in$)
    IF u>0 THEN RETURN
    IF mx1>122 AND mx1<212 AND my1>70  AND my1<160 THEN u=1:RETURN
    IF mx1>270 AND mx1<360 AND my1>70  AND my1<160 THEN u=2:RETURN
    IF mx1>427 AND mx1<512 AND my1>70  AND my1<160 THEN u=3:RETURN
    IF mx1>24  AND mx1<75  AND my1>140 AND my1<163 THEN in$="X"
    IF mx1>558 AND mx1<611 AND my1>140 AND my1<163 THEN in$="R"
    IF in$="R" OR in$="r" THEN alrt_val=ALERT 1 TEXT"ARE YOU SURE ","YOU WANT TO ","RESTART?" BUTTON "YES","NO":IF alrt_val=1 THEN RUN
    IF in$="X" OR in$="x" THEN alrt_val=ALERT 1 TEXT"ARE YOU SURE ","YOU WANT TO","QUIT?" BUTTON "YES","NO":IF alrt_val=1 THEN STOP
  UNTIL u>0
RETURN


LABEL invalid :PRINT CHR$(7):SET COLOUR 10:LOCATE #1,8;18:PRINT"YOU CANNOT PLACE A LARGE RING ON A SMALL RING"
GOTO loop1





LABEL undraw:REM Undraw the disk on pillar v at height h(v)
  xl1=v*1951-691
  col=xl1+751
  yl1=4132-h(v)*254
  hgt=4275-yl1
  BOX xl1;yl1,1710,250 FILL WITH 5 COLOUR 0
  BOX col;yl1,220,hgt FILL WITH 28 COLOUR 3
  h(v)=h(v)+1:REM set the new height on pillar v
RETURN


LABEL drawdisk:REM Draw disk t on pillar u at height h(u)
  h(u)=h(u)-1
  x1=u*1951+109-100*t
  y1=4132-h(u)*254
  x2=110+t*200
  BOX x1;y1,x2,250 FILL WITH 5 COLOUR c(t) ROUNDED
RETURN


LABEL graphic
go=go+1
GOSUB undraw
GOSUB drawdisk

IF a(3,1)<>1 THEN RETURN

CLS RESET: WINDOW #1 FULL ON:WINDOW #1 OPEN
WINDOW #1 TITLE "********** !CONGRATULATIONS! **********"
WINDOW #1 MOUSE 4
BOX 0;0,9000,9000 FILL WITH 8 COLOUR 1
FOR a=-1 TO 4700 STEP 100
LINE 0;4700-a,a;0 STYLE 1 WIDTH 1 COLOUR 6
LINE 0;314+a,a;5014 STYLE 1 WIDTH 1 COLOUR 6
LINE 8170;4700-a,8170-a;0 STYLE 1 WIDTH 1 COLOUR 6
LINE 8170;314+a,8170-a;5014 STYLE 1 WIDTH 1 COLOUR 6
NEXT a
SET COLOUR 6 EFFECTS &X1000000 POINTS 20
LOCATE #1,24;4:PRINT "CONGRATULATIONS!"
SET COLOUR 7 POINTS 16
LOCATE #1,15;8:PRINT "YOU'VE SOLVED THE PUZZLE WHICH THE"
LOCATE #1,12;10:PRINT "SUPREME HINDU DEITY, BRAHMA, IS SAID TO"
LOCATE #1,22;12:PRINT"HAVE GIVEN HIS DISCIPLES"
SET COLOUR 5
LOCATE #1,15;16:PRINT "THE PUZZLE WAS SOLVED IN";go;"MOVES"
SET COLOUR 2 POINTS 10
LOCATE #1,24;19:PRINT "<PRESS THE SPACE BAR TO PLAY AGAIN>"
REPEAT
in$=INKEY$
UNTIL in$=" "
RUN
'
'                   <C>  GARY WILKINSON  <C>
'                        SEPTEMBER 1987