Post by Deleted on May 3, 2021 7:39:53 GMT -5
hi all 
here is a tower of Hanoi game code
ron77
here is a tower of Hanoi game code
'coded by mysoft
#include "fbgfx.bi"
#include "crt.bi"
type Pole
bDiscs(8-1) as byte 'disc number on each slot on the pole
iNumDiscs as integer 'discs on this pole
end type
CONST AS SHORT scr_w = 800, scr_h = 600 ' screen constants
static shared as Pole aPoles(2) = {type({7,6,5,4,3,2,1,0},8)}
Sub cPrint(row AS INTEGER, s AS STRING)
LOCATE row ,(LOWORD(width) - LEN(s)) Shr 1 : PRINT s
END SUB
sub DrawDisc( iPosX as integer , iPosY as integer , iDisc as integer )
'color can be on an array
static as ulong uDiscColor(8-1) = { _
RGB(255,200,180) , RGB( 0,0,255) , RGB( 30, 0 ,120) , RGB( 0 ,120,120) , _
RGB( 0 ,255, 0 ) , RGB(50,0,100) , RGB(150,100, 0 ) , RGB(255, 0 , 0 ) _
}
dim as integer iPoleWid = 5+iDisc*10 , iPoleHei = iif((iDisc and 3)=0,11,8)
line ( iPosX-iPoleWid , iPosY-iPoleHei ) - ( iPosX+iPoleWid , iPosY+iPoleHei ) , uDiscColor(iDisc) , bf
end sub
sub drawscreen()
screenlock
COLOR(RGB(255,0,0) ,RGB(255,255,255))
CLS
CPRINT(4,"THE TOWER OF HANOI")
for X as integer = 0 to (3-1)
'element of this pole
with aPoles(X)
for Y as integer = 0 to .iNumDiscs-1
DrawDisc( 140+X*250 , 400-Y*25 , .bDiscs(Y) )
next Y
end with
next X
screenunlock
end sub
SUB movedisc(sourcePole AS INTEGER, targetPole AS INTEGER)
aPoles(sourcePole).iNumDiscs -= 1
aPoles(targetPole).bDiscs(aPoles(targetPole).iNumDiscs) = aPoles(sourcePole).bDiscs(aPoles(sourcePole).iNumDiscs)
aPoles(targetPole).iNumDiscs += 1
END SUB
function tower(a AS INTEGER ,from AS INTEGER ,aux AS integer,_to AS integer) AS INTEGER
if multikey(fb.SC_Q) then return 0
IF (a=1) THEN
puts("Move disc " & a & " from pole " & from & " to pole " & _to)
MoveDisc(from,_to):DrawScreen():sleep 250,1
RETURN 1
ELSE
tower(a-1,from,_to,aux)
puts("Move disc " & a & " from pole " & from & " to pole " & _to)
MoveDisc(from,_to):DrawScreen():sleep 250,1
tower(a-1,aux,from,_to)
END IF
END FUNCTION
SCREENRES(scr_w,scr_h,32)
WIDTH scr_w \ 8, scr_h \ 16
DIM AS STRING inptS, inptT
do
DRAWSCREEN()
'INPUT "enter number of start pole to move disc from (0-2): ", inptS
'INPUT "enter number of start pole to move disc from (0-2): ", inptT
'MOVEDISC(VAL(inptS),VAL(inptT))
if tower(8,0,1,2)=0 then exit do
if tower(8,2,1,0)=0 then exit do
LOOP UNTIL inptS = "q" OR inptT = "q"
sleep
ron77