Hanoi DEMO

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Mysoft
Posts: 778
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Hanoi DEMO

Postby Mysoft » Jun 04, 2007 18:40

here it is, one demonstration of the algorithm for the game hanoi (the resolution actually) using some gfx good tricks...

the code can be a little confuse, since i doesnt have well strutured it, and isnt fully otimized, but is fast ...

**fixed** the HANOI algorithm uses recursive call... but for it to work i had to create two identical subs... (i wonder why) **fixed**

Code: Select all

type PIE_STRUCT
  MAX as integer
  CIL(8) as byte
  NUM as byte
end type

declare sub ShowPies(NOHANOI as integer=0)
declare sub MoveAC(A as PIE_STRUCT ptr,B as PIE_STRUCT ptr)
declare sub TranslateXPIE(PIE as integer,PX as integer,PY as integer)
declare function Shade(COR as uinteger,PERCENT as integer) as uinteger
declare sub Hanoi(N as integer, A as PIE_STRUCT ptr, B as PIE_STRUCT ptr, C as PIE_STRUCT ptr)

const PI = 3.14592/180
const BGCOR = rgba(200,0,200,255)

dim shared as PIE_STRUCT XPIE(2)
dim shared as any ptr BAK(9),PIC(9)
dim shared as integer COR(9),OPX(9),OPY(9)
dim shared as integer TOHALT,DOANIM,SPD=512
dim as double BT
dim as integer R,G,B,PX,PY,OX,OY
dim as integer COUNT,PT
dim as string TECLA

' ****************************** HANOI TITLE XDDDDDD ****************************
dim as byte DIFF(1069),ACT(1069)
dim as integer TITLE(1069) = {-1,63,22,63,32,61,46,60,52,60,66,60,89,60,101,61,106,63,115,64, _
120,-1,128,32,127,43,127,63,127,84,127,101,127,115,127,129,127,143,131,155,131,159,130,160, _
-1,127,82,123,83,114,83,105,83,98,83,92,83,86,83,80,83,75,83,71,83,70,83,66,83,64,83,56,84, _
-1,195,34,193,34,188,45,184,54,178,71,176,88,170,107,168,114,167,123,164,128,163,136, _
161,140,-1,193,44,196,45,199,51,205,60,209,69,212,78,214,85,217,94,220,107,221,111,226, _
115,230,119,-1,219,90,208,90,196,90,179,93,175,93,168,93,164,93,-1,262,134,263,112,264, _
91,265,74,264,61,264,57,265,53,266,51,267,48,268,44,269,41,269,40,271,45,279,68,286,85, _
290,97,295,113,299,123,299,124,299,125,300,117,301,93,302,66,303,54,-1,345,37,356,41,365, _
46,373,58,375,71,375,84,375,101,368,119,361,130,354,133,346,135,338,130,326,105,320,92, _
317,75,321,62,323,55,331,45,334,37,342,34,347,34,-1,403,42,407,42,417,42,431,42,439,42, _
457,42,464,42,-1,433,44,434,48,435,62,435,77,435,92,436,98,436,103,436,107,436,121,436, _
122,-1,397,135,405,135,423,135,434,135,451,135,461,135,470,135,467,135,-1,439,122,439,123, _
439,128,440,128,440,130,440,131,-1,437,121,438,122,442,130,442,132,-2,-12517568,-1,444, _
151,444,152,444,156,444,160,444,164,444,168,443,169,443,170,444,167,444,162,444,158,444, _
154,444,152,444,149,444,148,446,148,450,148,452,148,453,149,454,150,454,152,454,155,450, _
158,448,158,446,159,445,159,442,159,441,159,442,159,445,159,448,160,449,161,451,161,452, _
161,452,163,452,165,450,166,448,168,447,169,446,170,444,170,443,170,-1,461,149,462,150, _
463,153,463,154,464,155,465,158,465,159,465,160,466,160,467,159,468,155,468,153,469,150, _
470,149,-1,465,155,465,158,465,159,466,160,466,163,466,164,467,164,467,166,468,168,468, _
169,468,171,468,172,-1,478,154,479,154,480,154,480,156,480,157,481,157,482,157,481,158, _
480,159,479,159,477,160,476,160,477,158,478,157,478,156,478,155,479,154,-1,478,167,479, _
167,481,168,481,170,480,171,479,171,478,171,476,170,476,168,476,166,478,166,-1,492,175, _
493,173,496,168,499,161,499,155,499,150,499,145,500,141,500,139,500,138,501,138,503,138, _
504,142,504,148,506,153,508,157,509,158,510,161,511,163,515,159,517,153,519,148,520,145, _
521,143,521,141,522,139,522,141,522,147,522,151,522,154,523,157,524,158,525,158,-1,522, _
155,523,158,524,158,524,162,524,165,525,166,526,168,526,170,527,170,527,171,527,175,528, _
177,-1,532,144,533,145,535,148,536,149,537,152,537,154,538,155,539,155,539,156,541,157, _
541,158,542,159,543,160,544,160,548,155,550,151,550,149,551,147,552,147,552,146,553,144, _
-1,545,160,545,162,545,164,545,167,545,168,545,169,546,170,546,173,546,175,-1,572,145, _
570,145,569,145,566,146,564,147,561,148,559,149,558,150,558,151,559,153,562,155,563,156, _
566,157,568,157,569,158,570,160,571,162,571,163,571,164,571,166,570,166,569,166,567,166, _
566,167,562,170,-1,587,145,590,145,592,147,594,148,595,151,597,155,598,163,600,164,600, _
167,600,170,598,171,595,171,594,171,589,172,588,171,588,165,586,161,583,155,583,152,583, _
149,583,148,585,147,585,146,586,146,595,147,-1,609,146,609,150,609,153,609,159,609,163, _
609,166,609,168,610,170,610,172,610,176,-1,607,149,609,149,612,149,613,149,614,149,615, _
149,616,149,-1,608,162,609,162,612,162,613,162,614,162,-1,625,152,627,152,631,152,633,152, _
634,152,638,152,639,152,641,152,643,152,-1,634,154,635,154,635,155,635,157,635,161,635,163, _
635,164,635,165,635,167,635,168,635,171,635,172,635,173,-1,538,39,539,39,542,39,545,39,546, _
40,547,42,549,48,549,52,548,56,546,56,539,59,535,55,535,51,533,50,533,47,534,43,535,40,537, _
39,537,38,540,37,541,37,542,37,543,37,545,37,546,37,-1,587,35,589,37,593,38,596,41,597,46, _
598,48,598,53,598,56,596,58,592,60,591,61,589,61,584,59,582,57,579,55,577,53,577,50,577,48, _
577,44,578,41,580,39,582,38,583,36,584,36,587,34,589,34,590,34,591,34,592,34,592,35,593,35, _
-1,566,73,565,74,563,76,561,80,558,84,557,85,-1,567,75,568,75,568,77,569,78,571,81,571,84, _
572,85,573,86,573,87,574,87,575,87,-1,513,72,514,80,515,82,516,84,517,90,518,93,520,96,522, _
99,524,101,530,104,536,109,542,110,546,112,551,113,558,114,564,114,570,114,575,114,581,110,_
584,110,586,108,593,103,599,99,601,96,602,94,603,92,605,90,608,87,610,85,611,83,612,81,614, _
79,614,78 }

' **** Screen,Title,Colors and buffers ****
screenres 700,400,32
WindowTitle ">> HANOI <<  (by:Mysoft)"
for COUNT = 1 to 9
  read R,G,B
  COR(COUNT)= rgba(R,G,B,255)
  PIC(COUNT) = ImageCreate(203,35)
  BAK(COUNT) = ImageCreate(203,35)
next COUNT

' ************** Drawing and Buffering Pies ****************
screenlock
for COUNT = 9 to 1 step -1
  line(320-100,200-18)-(320+100,200+16),rgba(255,0,255,255),bf
  ' ***** bottom *****
  for PY = 208 to 208-16 step -1
    circle(320,PY),(COUNT+1)*10,BGCOR,,,.1,f
  next PY
  ' ***** top *****
  if COUNT = 9 then
    for PX = ((COUNT+1)*10) to 1 step -1
      circle(320,PY),PX,Shade(COR(COUNT),PX-3*(PX and 5)),,,.1,f 
    next PX
  else
    circle(320,PY),((COUNT+1)*10),COR(COUNT),,,.1,f
  end if
  ' ************* Shading the pie ***************
  for PY = 208-16 to 208+17
    for PX = 320-100 to 320+100
      if (point(PX,PY) and &HFFFFFF) = (BGCOR and &HFFFFFF) then
        PT = (sqr((((PX-320)*(100/((COUNT+1)*10)))^2)+(((PY-200)*4)^2)) and -1)
        PT = 100-PT       
        pset(PX,PY),Shade(COR(COUNT),PT)
      end if
    next PX
  next PY
  ' *********** Buffering ******
  get(320-100,200-18)-(320+100,200+16),PIC(COUNT) 
next COUNT
line(0,0)-(699,399),rgb(16,32,64),bf
screenunlock

' **************** Default Pies **************
XPIE(0).MAX = 8:XPIE(0).NUM = 0
XPIE(1).NUM = 1:XPIE(2).NUM = 2
for COUNT = 1 to 8
  XPIE(0).CIL(COUNT) = 9-COUNT
next COUNT

' **************** intro ************
ShowPies 1
line(0,0)-(699,180),0,bf
line(0,0)-(699,175),rgb(64,128,255),bf
'line(5,5)-(694,184),BGTWO,bf

' ********* Drawing the title animation *********
BT = timer
for G = 2 to 1069 step 4
  PT = rgb(255,64,64)
  screenlock
  for COUNT = 0 to G step 2
    if TITLE(COUNT) = -1 then
      OX = TITLE(COUNT+1)   
      OY = TITLE(COUNT+2)
      COUNT += 1
    elseif TITLE(COUNT) = -2 then
      PT = TITLE(COUNT+1)   
    else   
      PX = TITLE(COUNT)   
      PY = TITLE(COUNT+1)   
      line(OX,OY)-(PX,PY),PT   
      line(OX+1,OY)-(PX,PY+1),PT
      if COUNT < 320 then
        line(OX,OY+2)-(PX+1,PY+2),(PT shr 1)
        line(OX+1,OY+2)-(PX+1,PY+2),(PT shr 1)
      else
        line(OX,OY+2)-(PX+1,PY+2),rgb(16,32,64)
        line(OX+1,OY+2)-(PX+1,PY+2),rgb(16,32,64)
      end if
      OX = PX
      OY = PY   
    end if       
    pset(rnd*699,rnd*175),rgb(64,128,255)
  next COUNT 
 
  ' ******** Apllying the filter twice every frame ********
 
  for B = 1 to 2
    R = screenptr
    asm   
      mov ESI,[R]
      mov ECX,700*185
      _NXPTX_:
      shr dword ptr [ESI],1
      and dword ptr [ESI],0x7F7F7F
      mov eax,[ESI+4]
      shr eax,2
      and eax,0x3F3F3F
      add dword ptr [ESI],eax
      mov eax,[ESI+2800]   
      shr eax,2
      and eax,0x3F3F3F
      add dword ptr [ESI],eax   
      add ESI,4
      dec ecx
      jnz _NXPTX_   
    end asm   
  next B
  screenunlock
 
  while (timer-BT) < 1/30
    sleep 1
  wend
  BT += 1/30
  if inkey$ <> "" goto _KEYPR_
 
next G

'sleep 2000
_KEYPR_:
Draw String (238,190),"Do you want animation (Y/N)?",rgb(63,127,255)

' ***** Macro Para Suavizar animação *******

#macro Adjust(WHERE)
if DIFF(WHERE) = ACT(WHERE) then
  DIFF(WHERE) = -3+rnd*6
end if
if ACT(WHERE) > DIFF(WHERE) then
  ACT(WHERE) -= 1
end if
if ACT(WHERE) < DIFF(WHERE) then
  ACT(WHERE) += 1
end if
#endmacro

' ******************** Animação do titulo *****************
BT = timer
do
 
  ' ******* The intro title again, but now, in the "second" stage *********
 
  screenlock
  'line(5,5)-(694,184),BGTWO,bf
  PT = rgb(255,64,64)
  for COUNT = 0 to 1069 step 2
    if TITLE(COUNT) = -1 then
      Adjust(COUNT+1)
      OX = TITLE(COUNT+1)-ACT(COUNT+1)
      Adjust(COUNT+2)
      OY = TITLE(COUNT+2)-ACT(COUNT+2)
      COUNT += 1
    elseif TITLE(COUNT) = -2 then
      PT = TITLE(COUNT+1)   
    else
      Adjust(COUNT)
      PX = TITLE(COUNT)-ACT(COUNT)
      Adjust(COUNT+1)
      PY = TITLE(COUNT+1)-ACT(COUNT+1)
      line(OX,OY)-(PX,PY),PT   
      line(OX+1,OY)-(PX,PY+1),PT
      if COUNT < 320 then
        line(OX,OY+2)-(PX+1,PY+2),(PT shr 1)
        line(OX+1,OY+2)-(PX+1,PY+2),(PT shr 1)
      else
        line(OX,OY+2)-(PX+1,PY+2),rgb(16,32,64)
        line(OX+1,OY+2)-(PX+1,PY+2),rgb(16,32,64)
      end if
      OX = PX
      OY = PY   
    end if
  next COUNT 
 
  ' ***** Randomize blue points *****
  for COUNT = 0 to 512
    PX = rnd*699:PY = rnd*175   
    pset(rnd*699,rnd*175),rgb(64,128,255)   
  next COUNT
 
  ' ************* Filter ***********
  PT = screenptr
  for COUNT = 1 to 3 '(timer and 3)+1
    asm
      mov ESI,[PT]
      mov ECX,700*185
      _NXPT_:
      shr dword ptr [ESI],1
      and dword ptr [ESI],0x7F7F7F
      mov eax,[ESI+4]
      shr eax,2
      and eax,0x3F3F3F
      add dword ptr [ESI],eax
      mov eax,[ESI+2800]   
      shr eax,2
      and eax,0x3F3F3F
      add dword ptr [ESI],eax   
      add ESI,4
      dec ecx
      jnz _NXPT_
    end asm   
  next COUNT 
  screenunlock
 
  ' ****** sync e keys *****
  while timer-BT < 1/30
    sleep 1
  wend
  BT += 1/30
  TECLA = lcase$(inkey$)
  if TECLA = chr$(27) then end
loop until TECLA = "y" or TECLA = "n"
if TECLA = "y" then DOANIM = 1

' *********** "fadeout* ************
view screen(0,0)-(699,199)
BT = timer
for COUNT = 1 to 500 step 17
  circle(350,100),COUNT,rgb(16,32,64),,,.33,f
  while timer-BT < 1/60
    sleep 1
  wend
  BT += 1/60
next COUNT
view screen(0,0)-(699,399)
sleep 250

' **************** Starting Animation *****************
Draw String (98,5),"Press + to SPEEDUP the animation or - to SLOWDOWN the animation",rgb(63,127,255)
Hanoi(8,@XPIE(0).MAX,@XPIE(1).MAX,@XPIE(2).MAX)
ShowPies 1
Draw String (266,150),"Press any key to end.",rgb(63,127,255)
sleep

' *********** Color Data *************
data 252,200,200 'cream =]
data 150,0,150 'dark magenta
data 252,252,252 'white
data 252,150,0 'orange
data 0,252,0 'green
data 252,252,0 'yellow
data 252,0,0 'red
data 0,0,252 'blue
data 120,80,30 'wood =]

' *********************************************************
' ****************** Create Shading Color *****************
' *********************************************************
function Shade(COR as uinteger,PERCENT as integer) as uinteger
  if PERCENT < 0 then PERCENT = 0
  if PERCENT > 100 then PERCENT = 100
  dim as integer R,G,B,A
  R = ((((COR shr 16) and 255)/100)*PERCENT)
  G = ((((COR shr 8) and 255)/100)*PERCENT)
  B = (((COR and 255)/100)*PERCENT) 
  A = (COR shr 24) and 255
  return rgba(R,G,B,A)
end function

' ************************************************************
' ****************** Show the Pies on screen *****************
' ************************************************************
sub ShowPies(NOHANOI as integer=0)
  dim as integer COUNT,PX,X,Y,C
  dim as string TECLA 
 
  if TOHALT<>0 and NOHANOI=0 then SPD=1
 
  screenlock
  line(0,190)-(699,399),rgb(16,32,64),bf
 
  ' ***** wood pie *****
  for PX = 25 to 25+225*2 step 225
    put(PX,200+9*18),PIC(9),trans 
  next PX
  ' **** other pies *****
  for PX = 0 to 2
    for COUNT = 1 to XPIE(PX).MAX       
      ' ** pos **
      X = 25+225*PX
      Y = 200+((9-COUNT)*18)
      C = XPIE(PX).CIL(COUNT)     
      ' *** Get Background ***
      if DOANIM<>0 or NOHANOI<>0 then
        get(X,Y)-(X+200,Y+34),BAK(C)
        OPX(C)=X:OPY(C)=Y       
      end if
      ' ** put pie **
      put(X,Y),PIC(C),trans   
    next COUNT
  next PX
 
  screenunlock
 
  ' **** Sync and keys ****
  if NOHANOI = 0 then
    sleep SPD
    TECLA = inkey$
    if TECLA = "+" or TECLA = "=" and SPD > 1 then
      SPD shr= 1
    elseif TECLA = "-" or TECLA = "_" and SPD < 2048 then
      SPD shl= 1
    elseif TECLA = chr$(27) then
      TOHALT = 1
    end if
  end if
  while inkey$ <> ""
    sleep 1
  wend 
 
end sub

' ****************************************************************
' **************************** HANOI 1 ***************************
' ****************************************************************
sub Hanoi(N as integer, A as PIE_STRUCT ptr, B as PIE_STRUCT ptr, C as PIE_STRUCT ptr)
 
  if N > 0 then   
    Hanoi(N-1,A,C,B)
    if DOANIM then
      MoveAC(A,C)
    else
      C->MAX += 1
      C->CIL(C->MAX) = A->CIL(A->MAX)   
      A->MAX -= 1
      ShowPies
    end if
    Hanoi(N-1,B,A,C)   
  end if 
end sub

' *************** Movimento TOP of A to TOP of C ****************
sub MoveAC(A as PIE_STRUCT ptr,C as PIE_STRUCT ptr)
  dim as double XPIE,XX,YY,X,Y,CNT,PY
  dim as double BT,COY,COYY 
  dim as string TECLA
 
  ' ******** Getting X/Y position ********
  X = 25+225*(A->NUM)
  Y = 200+((9-(A->MAX))*18)
  C->MAX += 1
  XPIE = A->CIL(A->MAX)
  C->CIL(C->MAX) = XPIE
  A->MAX -= 1
  XX = 25+225*(C->NUM)
  YY = 200+((9-(C->MAX))*18)
  COY = -acos((344-Y)/250)
  COYY = acos((344-YY)/250)
 
  ' ******* Animating the ARC moviment ******
  BT = timer 
  for CNT = X to XX step ((XX-X)/45)*(1024/SPD)
    PY = 344-cos(COY+(((COYY-COY)/(XX-X))*(CNT-X)))*250
    TranslateXPIE(XPIE,CNT,PY) 
    while (timer-BT) < 1/60
      sleep 1
    wend
    BT += 1/60
    ' ***** Control Speed *****
    TECLA = inkey$
    if TECLA = "+" or TECLA = "=" then
      if SPD > 1 then
        SPD shr= 1
      end if
    elseif TECLA = "-" or TECLA = "_" then
      if SPD < 2048 then
        SPD shl= 1
      end if
    elseif TECLA = chr$(27) then
      DOANIM = 0:SPD = 1:exit for
    end if   
  next CNT
  TranslateXPIE(XPIE,XX,YY)
 
end sub

sub TranslateXPIE(XPIE as integer,PX as integer,PY as integer)
  ' ***** Put old background... getting new, and putting the pie =]
  screenlock
  put(OPX(XPIE),OPY(XPIE)),BAK(XPIE),pset
  get(PX,PY)-(PX+200,PY+34),BAK(XPIE)
  put(PX,PY),PIC(XPIE),trans
  OPX(XPIE)=PX:OPY(XPIE)=PY
  screenunlock
end sub
[/u]
Last edited by Mysoft on Jun 05, 2007 1:36, edited 2 times in total.
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Jun 04, 2007 19:04

Cool ^^, btw it works without hanoi2 here...
Mysoft
Posts: 778
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Postby Mysoft » Jun 05, 2007 1:33

indeed.... the final version, works ok with only one HANOI function... i guess that when i changed some things i fixed it accidentally... (maybe i had one overload of calls to ShowPies function)

edit: erased the second sub in the source =]
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Postby KristopherWindsor » Jun 05, 2007 1:52

Nice intro graphics! XD
JohnB
Posts: 236
Joined: Jul 22, 2005 3:53
Location: Minnesota Arizona

Postby JohnB » Jun 05, 2007 3:27

Very nice.

JohnB
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » Jun 05, 2007 3:41

Cool stuff.
D.J.Peters
Posts: 8027
Joined: May 28, 2005 3:28
Contact:

Postby D.J.Peters » Jun 05, 2007 3:47

Nice gfx's

Joshy
redcrab
Posts: 619
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Postby redcrab » Jun 05, 2007 6:42

Kewl gfx !

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests