tower of hanoi game

[ron77_db]

#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