Page 1 of 1

Hanoi Tower to Go

Posted: Thu Nov 25, 2021 10:11 am
by smbstarv
'y'
REM ****Hanoi Tower Play ***** by smbstarv
IF DEVICE_TYPE$()<>"iPad" THEN
PRINT "for iPad only"
STOP
END IF
SET ORIENTATION 2
i1: 'setup buttons en sprites
GRAPHICS
SET TOOLBAR OFF
SET BUTTONS CUSTOM
FILL COLOR 1,1,1
DRAW COLOR 0,0,0
REFRESH OFF
FOR i=2 TO 9
BUTTON i TEXT STR$(i)&" disks" AT 450,80+i*60 SIZE 100,30
NEXT i
BUTTON 1 TEXT "EXIT" AT 950,30 SIZE 50,30
BUTTON 11 TEXT "<--" AT 50,30 SIZE 50,30
BUTTON 13 TEXT "Demo" AT 300,120 SIZE 100,30
BUTTON 14 TEXT "Play" AT 600,120 SIZE 100,30
BUTTON 15 TEXT "slower" AT 260,120 SIZE 80,80
BUTTON 16 TEXT "faster" AT 680,120 SIZE 80,80
FOR i=1 TO 16
BUTTON i HIDE
NEXT i
'
i2: ' selecteer het aantal ringen
REFRESH ON
GRAPHICS CLEAR 0,0,0
DRAW FONT NAME "Zapfino"
DRAW FONT SIZE 50
DRAW COLOR 1,1,1
DRAW TEXT "Towers of Hanoi" AT 220,0
FOR i=1 TO 9
BUTTON i SHOW
NEXT i
NOTES MIDI 0,12,31
NOTES MIDI 0,9,88,127
NOTES MIDI 9,8,88,0
i=0
DO
i+=1
IF i>9 THEN i=1
UNTIL BUTTON_PRESSED(STR$(i))
IF i=1 THEN GOTO QUIT
aantal_ringen=i
FOR i=2 TO 9
BUTTON i HIDE
NEXT i
'b'
i3: '3 palen, en ringen
ringdikte=30
paalhoogte=600-aantal_ringen*(ringdikte+4)
xpaal(1)=205 'x-coord.
xpaal(2)=505
xpaal(3)=805
DIM p(4,10)
'p(x,0) is het aantal aanwezige ringen op paal x
'p(x,1) is het nummer van de ring op positie 1 op paal x
' etc
p(1,0)=aantal_ringen
p(2,0)=0
p(3,0)=0
FOR i=1 TO aantal_ringen 'positioneer de ringen op paal 1
p(1,aantal_ringen-i+1)=i
NEXT i
'kleur en omvang van de ringen
DATA 1,1,1,1,0,1,0,1,1
DATA 0,0,1,1,.9,.5,1,0,.5
DATA 0,1,.5,0,0,.5,1,.9,0
RESTORE
OPTION SPRITE POS CENTRAL
FOR r=1 TO 9
READ a,b,c 'gekleurde ringen
lft=20+8*(9-r)
rgt=230-8*(9-r)
SPRITE r BEGIN 250,ringdikte*1.2
FILL COLOR a,b,c
FILL RECT lft,5 TO rgt,ringdikte+5
FILL CIRCLE lft,ringdikte/2+5 SIZE ringdikte/2
FILL CIRCLE rgt,ringdikte/2+5 SIZE ringdikte/2
DRAW COLOR 0,0,0
DRAW FONT NAME "Courier"
DRAW FONT SIZE 30
DRAW TEXT STR$(r) AT 120,8
SPRITE END
SPRITE r HIDE
NEXT r
'indicatoren...
SPRITE "van" BEGIN 600,100
DRAW FONT SIZE 40
DRAW COLOR 1,0,0
DRAW TEXT "touch from..." AT 250,25
SPRITE END
SPRITE "van" AT 450,150
SPRITE "van" HIDE
SPRITE "naar" BEGIN 600,100
DRAW FONT SIZE 40
DRAW COLOR 0,1,0
DRAW TEXT "touch to..." AT 250,25
SPRITE END
SPRITE "naar" AT 450,150
SPRITE "naar" HIDE
SPRITE "stipvan" BEGIN 20,20
FILL COLOR 1,0,0
FILL CIRCLE 10,10 SIZE 10
SPRITE END
SPRITE "stipvan" AT 205,paalhoogte-50
SPRITE "stipvan" HIDE
SPRITE "stipnaar" BEGIN 20,20
FILL COLOR 0,1,0
FILL CIRCLE 10,10 SIZE 10
SPRITE END
SPRITE "stipnaar" AT 205,paalhoogte-50
SPRITE "stipnaar" HIDE
' de drie palen
FILL COLOR 0.9,0.5,0
FILL RECT 100,650 TO 920,700
FILL RECT 200,paalhoogte TO 220,700
FILL RECT 500,paalhoogte TO 520,700
FILL RECT 800,paalhoogte TO 820,700
FILL CIRCLE 100,675 SIZE 25
FILL CIRCLE 920,675 SIZE 25
FILL CIRCLE 210,paalhoogte SIZE 10
FILL CIRCLE 510,paalhoogte SIZE 10
FILL CIRCLE 810,paalhoogte SIZE 10
BUTTON 1 SHOW
FOR i=11 TO 14
BUTTON i SHOW
NEXT i
'c'
STRT: 'start met alle ringen op paal 1
FOR rng=1 TO aantal_ringen
SPRITE rng AT xpaal(1),310+(rng+9-aantal_ringen)*(ringdikte+5)
SPRITE rng SHOW
PAUSE .1
NEXT rng
BUTTON 13 SHOW
BUTTON 14 SHOW
loop1:
IF BUTTON_PRESSED(STR$(1)) THEN GOTO QUIT
IF BUTTON_PRESSED(STR$(11)) THEN '--> beginscherm
FOR i=1 TO 20
BUTTON i HIDE
NEXT i
SPRITES DELETE
GOTO i2
END IF
IF BUTTON_PRESSED(STR$(13)) THEN
BUTTON 13 HIDE
BUTTON 14 HIDE
GOSUB demohanoi
PAUSE 1
GOTO i3
END IF
IF BUTTON_PRESSED(STR$(14)) THEN
BUTTON 13 HIDE
BUTTON 14 HIDE
GOSUB playhanoi
END IF
GOTO loop1
'g'
PLAYHANOI:
s0:
PAUSE .5
SPRITE "van" SHOW
SPRITE "naar" HIDE
SPRITE "stipvan" HIDE
van=1 'boolean van / naar
GOSUB gettouch 'wijs een "van"paal aan
FOR i=1 TO 3
IF ABS(tx-xpaal(i))<50 AND p(i,0)>0 THEN
vanpaal=i
van=XOR(van,1)
SPRITE "stipvan" AT xpaal(i),paalhoogte-50
SPRITE (p(i,p(i,0))) AT xpaal(i),paalhoogte'even oprichten van de van-ring ?.
GOTO s1
END IF
NEXT i
GOTO s0

IF vanpaal=1 AND p(1,0)=0 THEN GOTO s0
IF vanpaal=2 AND p(2,0)=0 THEN GOTO s0
IF vanpaal=3 AND p(3,0)=0 THEN GOTO s0

s1:
PAUSE .5
SPRITE "van" HIDE
SPRITE "naar" SHOW
SPRITE "stipvan" SHOW
GOSUB gettouch 'wijs een "naar"paal aan
SPRITE "stipvan" HIDE

FOR j=1 TO 3
IF ABS(tx-xpaal(j))<50 AND van=0 THEN
naarpaal=j
van=XOR(van,1)
SPRITE "stipnaar" AT xpaal(j),paalhoogte-50
SPRITE "stipnaar" SHOW
GOTO s2
END IF
NEXT j
GOTO s0

s2:
GOSUB MOVERING


SPRITE "stipnaar" SHOW

IF van THEN
SPRITE "van" HIDE
SPRITE "naar" SHOW
ELSE
SPRITE "van" SHOW
SPRITE "naar" HIDE
END IF
SPRITE "stipnaar" HIDE
GOTO s0
END

'c'
gettouch:
FOR i=0 TO 9
GET TOUCH i AS tx,ty
IF tx>0 THEN GOTO gt2
NEXT i
IF BUTTON_PRESSED(STR$(1)) THEN GOTO QUIT
IF BUTTON_PRESSED(STR$(11)) THEN '--> beginscherm
FOR i=1 TO 20
BUTTON i HIDE
NEXT i
SPRITES DELETE
GOTO i2
END IF
GOTO gettouch
gt2:WHILE TOUCH_X (i)<>-1
END WHILE 'wacht op einde toets
RETURN

'r'
MOVERING: 'verplaats ring van paal a naar paal b
a=vanpaal
b=naarpaal
IF p(a,p(a,0))<p(b,p(b,0)) OR p(b,0)=0 THEN
p(b,0)+=1
SPRITE STR$(p(a,p(a,0))) AT xpaal(b),310+(10-p(b,0))*(ringdikte+5)
p(b,p(b,0))=p(a,p(a,0))
p(a,0)-=1
ELSE
bleep
SPRITE STR$(p(a,p(a,0))) AT xpaal(a),310+(10-p(a,0))*(ringdikte+5)
END IF
IF a=b THEN SPRITE STR$(p(a,p(a,0))) AT .xpaal(a),310+(10-p(a,0))*(ringdikte+5)
RETURN 'movering
'y'
DEF bleep
NOTES MIDI 0,12,12
NOTES SET "v75sc5e"
NOTES PLAY
END DEF
'g'
DEMOHANOI:
DIM MOVES(1100)
BUTTON 15 SHOW
BUTTON 16 SHOW
speed=3
'zet ringen terug op paal1
FOR rng=1 TO aantal_ringen
SPRITE rng AT xpaal(1),310+(rng+9-aantal_ringen)*(ringdikte+5)
SPRITE rng SHOW
PAUSE .01
NEXT rng
PAUSE 1
FOR i=1 TO aantal_ringen
p(1,aantal_ringen-i+1)=i
NEXT i
p(1,0)=aantal_ringen
mcnt=0
hanoi(aantal_ringen,1,3,2)
mcnt=0
DO
vanpaal=MOVES(mcnt)
naarpaal=MOVES(mcnt+1)
mcnt+=2
IF BUTTON_PRESSED(STR$(1)) THEN GOTO QUIT
IF BUTTON_PRESSED(STR$(11)) THEN '--> beginscherm
FOR i=1 TO 20
BUTTON i HIDE
NEXT i
SPRITES DELETE
GOTO i2
END IF
IF BUTTON_PRESSED(STR$(15)) THEN
speed-=1
speed=MAX(speed,1)
END IF
IF BUTTON_PRESSED(STR$(16)) THEN
speed+=1
speed=MIN(speed,10)
END IF
IF speed=1 THEN BUTTON 15 HIDE ELSE BUTTON 15 SHOW
IF speed=10 THEN BUTTON 16 HIDE ELSE BUTTON 16 SHOW
PAUSE 2/speed
GOSUB movering
UNTIL MOVES(mcnt)=0
PAUSE .5
BUTTON 15 HIDE
BUTTON 16 HIDE
bleep
PAUSE 1
RETURN 'demohanoi
'r'
DEF hanoi(a,bron,doel,hulp)
IF a=1 THEN
.MOVES(.mcnt)=bron
.MOVES(.mcnt+1)=doel
.mcnt+=2
ELSE
b=bron
d=doel
h=hulp
hanoi(a-1,b,h,d)
hanoi(1,b,d,h)
hanoi(a-1,h,d,b)
END IF
END DEF
'g'
QUIT:
FOR i=1 TO 20
BUTTON i DELETE
NEXT i
SPRITES DELETE
GRAPHICS CLEAR 0,0,0
DRAW COLOR 1,1,1
DRAW FONT NAME "Zapfino"
DRAW FONT SIZE 70
DRAW TEXT "STOPPED" AT 230,260
NOTES SET "1: v60 tc7b6agfedcb5agfedcb4agfedcb3ag"
NOTES PLAY
PAUSE 2
NOTES MIDI 0,12,31
NOTES MIDI 0,9,88,99
NOTES MIDI 9,8,88,0
GRAPHICS CLEAR 0,0,0
SET TOOLBAR ON
PAUSE 2
TEXT
END

Re: Hanoi Tower to Go

Posted: Fri Nov 26, 2021 9:57 am
by Henko
Very nice user interface!
A classic example of a solution by recursion.