#include once "fbgfx.bi"
#include once "vbcompat.bi"
#include once "mdLanguage.bi"
#define BREITE 50
#define MAUSSCHWELLE 20

dim shared as FB.IMAGE ptr grafik(42)
dim shared as uinteger farbe(10) = { 0, &hff0000, &h3333ff, &h00ff00, &h550055, &hffff00, _
                                     &h005500, &haaaaaa, &h000055, &h550000, &hff5500 }

declare function buttontest(x as integer, y as integer, b as integer, h as integer) as integer
declare sub sieganimation(feldbreite as integer)
declare sub tausche(i as integer, k as integer, i2 as integer, k2 as integer, feld() as integer)
declare function test(f() as integer) as integer
declare function testlauf(f() as integer, x as integer, y as integer, r as integer, farbe as integer) as integer
declare sub zeichne(i as integer, k as integer, f() as integer)
randomize

LoadCustomLanguage(language, "default", "", "lang_", ".txt")

screenres BREITE*8 + 200, BREITE*8, 32
windowtitle getTranslation(language, "header")
width BREITE+25, BREITE/2
grafik(0)  = imagecreate(BREITE, BREITE, &hff00ff)
grafik(10) = imagecreate(BREITE, BREITE, &h333333)
for i as integer = 1 to 9
  grafik(i) = imagecreate(BREITE, BREITE)
  bload "gfx/pipe" & i & ".bmp", grafik(i)
next
for i as integer = 0 to 9
  grafik(i+11) = imagecreate(BREITE, BREITE)
  bload "gfx/child" & i & ".bmp", grafik(i+11)
  grafik(i+27) = imagecreate(BREITE, BREITE)
  bload "gfx/present" & i & ".bmp", grafik(i+27)
next

dim as integer leveldatei = freefile, levelnr = 0, schritte = 0
dim as integer feldbreite, feld(), mx, my, mx2, my2, mb, x, y, x2, y2, levelWeiter, f
dim as integer naechster(0 to 9) = {0, 4, 5, 1, 6, 2, 3, 8, 7, 9}
dim as string taste, tempString

' Kinder- und Geschenkebilder mischen
for i as integer = 1 to 100
  swap grafik(int(rnd*10)+11), grafik(int(rnd*10)+11)
  swap grafik(int(rnd*10)+27), grafik(int(rnd*10)+27)
next

do
  ' Hauptschleife - Levelorganisation
  levelnr += 1
  schritte = 0
  if open("level/level" & levelnr & ".lev" for input as #leveldatei) then exit do
  levelWeiter = fileexists("level/level" & levelnr+1 & ".lev")
  input #leveldatei, feldbreite
  redim feld(feldbreite+1, feldbreite+1)
  screenlock
  cls
  ' Menueleiste: Pfeile
  f = iif(levelnr > 1, &hffffff, &h7f7f7f)
  line (BREITE*8+20, 45)-step(25, 25),f, b
  line (BREITE*8+21, 46)-step(23, 23),f, b
  line (BREITE*8+24, 58)-step(8, -8), f
  line -step(0, 5), f
  line -step(9, 0), f
  line -step(0, 6), f
  line -step(-9, 0), f
  line -step(0, 5), f
  line -step(-8, -8), f
  paint step(5, 0), f, f
  f = iif(levelWeiter, &hffffff, &h7f7f7f)
  line (BREITE*8+145, 45)-step(25, 25),f, b
  line (BREITE*8+146, 46)-step(23, 23),f, b
  line (BREITE*8+166, 58)-step(-8, -8), f
  line -step(0, 5), f
  line -step(-9, 0), f
  line -step(0, 6), f
  line -step(9, 0), f
  line -step(0, 5), f
  line -step(8, -8), f
  paint step(-5, 0), f, f
  tempString = getTranslation(language, "level") & " " & levelnr
  draw string (BREITE*8+95-4*len(tempString), 50), tempString
  ' Menueleiste: Buttons
  tempString = getTranslation(language, "steps", str(schritte))
  draw string (BREITE*8+95-4*len(tempString), 90), tempString
  line (BREITE*8+20, 160)-step(150, 25),, b
  line (BREITE*8+21, 161)-step(148, 23),, b
  tempString = getTranslation(language, "retry")
  draw string (BREITE*8+95-4*len(tempString), 166), tempString
  line (BREITE*8+20, 200)-step(150, 25),, b
  line (BREITE*8+21, 201)-step(148, 23),, b
  tempString = getTranslation(language, "quit")
  draw string (BREITE*8+95-4*len(tempString), 206), tempString
  ' Spielfeld
  for i as integer = 0 to feldbreite+1
    for k as integer = 0 to feldbreite+1
      if i > 0 or k > 0 then input #leveldatei, feld(i, k)
      zeichne i, k, feld()
    next
  next
  screenunlock
  close #leveldatei
  do
    ' Level spielen
    getmouse mx, my,, mb
    taste = inkey
    x = mx/BREITE -3.5 + feldbreite/2
    y = my/BREITE -3.5 + feldbreite/2
    x2 = x
    y2 = y
    if mb = 1 then
      if buttontest(BREITE*8+20, 160, 150, 25) then                     ' Neustart
        levelnr -= 1
        continue do, do
      end if
      if buttontest(BREITE*8+20, 200, 150, 25) then exit do, do         ' Ende
      if levelWeiter andalso buttontest(BREITE*8+145, 45, 25, 25) then  ' Level vor
        exit do
      end if
      if levelnr > 1 andalso buttontest(BREITE*8+20, 45, 25, 25) then   ' Level zurueck
        levelnr -= 2
        exit do
      end if
      ' verschieben
      if x < 1 or y < 1 or x > feldbreite or y > feldbreite then
        sleep 1
        continue do
      end if
      do
        getmouse mx2, my2,, mb
        screenlock
        if x2 > 0 and x2 <= feldbreite and y2 > 0 and y2 <= feldbreite then
          put ((x +3-feldbreite/2)*BREITE, (y +3-feldbreite/2)*BREITE),  grafik(10), xor
          put ((x2+3-feldbreite/2)*BREITE, (y2+3-feldbreite/2)*BREITE),  grafik(10), xor
        end if
        if abs(mx2-mx) > MAUSSCHWELLE and abs(my2-my) < abs(mx2-mx)\2 then
          x2 = x+sgn(mx2-mx)
          y2 = y
        elseif abs(my2-my) > MAUSSCHWELLE and abs(mx2-mx) < abs(my2-my) then
          x2 = x
          y2 = y+sgn(my2-my)
        else
          x2 = x
          y2 = y
        end if
        if x2 > 0 and x2 <= feldbreite and y2 > 0 and y2 <= feldbreite then
          put ((x +3-feldbreite/2)*BREITE, (y +3-feldbreite/2)*BREITE),  grafik(10), xor
          put ((x2+3-feldbreite/2)*BREITE, (y2+3-feldbreite/2)*BREITE),  grafik(10), xor
        end if
        screenunlock
        sleep 1
      loop until mb = 0
      if x2 <> x or y2 <> y then
        if x2 > 0 and x2 <= feldbreite and y2 > 0 and y2 <= feldbreite then
          tausche x, y, x2, y2, feld()
          schritte += 1
          line (BREITE*8+20, 90)-step(150, 20), 0, bf
          tempString = getTranslation(language, "steps", str(schritte))
          draw string (BREITE*8+95-4*len(tempString), 90), tempString
        end if
      end if
      if test(feld()) then sieganimation feldbreite : exit do
    elseif mb = 2 then
      ' drehen
      if x < 1 or y < 1 or x > feldbreite or y > feldbreite then
        sleep 1
        continue do
      end if
      if feld(x, y) <> naechster(feld(x, y)) then
        feld(x, y) = naechster(feld(x, y))
        schritte += 1
        zeichne x, y, feld()
        line (BREITE*8+20, 90)-step(150, 20), 0, bf
        tempString = getTranslation(language, "steps", str(schritte))
        draw string (BREITE*8+95-4*len(tempString), 90), tempString
      end if
      do
        getmouse mx2, my2,, mb
        sleep 1
      loop until mb = 0 
      if test(feld()) then sieganimation feldbreite : exit do
    end if     
    sleep 1
    if taste = chr(255,107) then exit do, do
  loop
  ' Kinder- und Geschenkebilder neu mischen
  for i as integer = 1 to 100
    swap grafik(int(rnd*10)+11), grafik(int(rnd*10)+11)
    swap grafik(int(rnd*10)+27), grafik(int(rnd*10)+27)
  next
loop

'aufraeumen
for i as integer = 0 to 42
  if grafik(i) then imagedestroy grafik(i)
next

function buttontest(x as integer, y as integer, b as integer, h as integer) as integer
  dim as integer mx, my, mb, switch = -1
  dim as FB.IMAGE ptr tempimg
  getmouse mx, my,, mb
  if mb = 1 and mx > x and mx < x+b and my > y and my < y+h then
    tempimg = imagecreate(b-4, h-4, &hffffff)
    put (x+2, y+2), tempimg, xor
    do
      getmouse mx, my,, mb
      if switch then
        if mx <= x or mx >= x+b or my <= y or my >= y+h then
          switch = 0
          put (x+2, y+2), tempimg, xor
        end if
      else
        if mx > x and mx < x+b and my > y and my < y+h then
          switch = -1
          put (x+2, y+2), tempimg, xor
        end if
      end if
      sleep 1
    loop until mb = 0
    imagedestroy tempimg
    if switch then
      put (x+2, y+2), tempimg, xor
      return -1
    end if
  end if
  return 0
end function

sub sieganimation(feldbreite as integer)
  dim as FB.IMAGE ptr tempimg = imagecreate(BREITE*feldbreite, BREITE*feldbreite, &h5f5f5f)
  dim as integer x = (4-feldbreite/2)*BREITE, y = (4-feldbreite/2)*BREITE, i = 0
  do
    put (x+i, y+i), tempimg, (0, 0)-(BREITE*feldbreite-2*i, BREITE*feldbreite-2*i), xor
    i += 1
    put (x+i, y+i), tempimg, (0, 0)-(BREITE*feldbreite-2*i, BREITE*feldbreite-2*i), xor
    sleep 10
  loop until i = (BREITE*feldbreite) \ 2
  sleep 100
end sub

sub tausche(i as integer, k as integer, i2 as integer, k2 as integer, f() as integer)
  dim as integer anz = ubound(f, 1)-1
  if i<1 or i>anz or k<1 or k>anz or i2<1 or i2>anz or k2<1 or k2>anz then exit sub
  dim as integer x  = (i +3-anz/2)*BREITE, y  = (k +3-anz/2)*BREITE
  dim as integer x2 = (i2+3-anz/2)*BREITE, y2 = (k2+3-anz/2)*BREITE
  for s as integer = 2 to BREITE step 2
    screenlock
    line (x +1, y +1)-step(BREITE-2, BREITE-2), 0, bf
    line (x2+1, y2+1)-step(BREITE-2, BREITE-2), 0, bf
    line (x,  y) -step(BREITE, BREITE), &hffffff, b
    line (x2, y2)-step(BREITE, BREITE), &hffffff, b
    put (x +s*sgn(x2-x), y +s*sgn(y2-y)), grafik(f(i,  k)),  trans
    put (x2+s*sgn(x-x2), y2+s*sgn(y-y2)), grafik(f(i2, k2)), trans
    screenunlock
    sleep 10
  next
  swap f(i, k), f(i2, k2)
end sub

function test(f() as integer) as integer
  dim as integer anz = ubound(f, 1)-1, t(anz+1, anz+1), farbe, richtung
  for i as integer = 0 to anz+1
    for k as integer = 0 to anz+1
      t(i, k) = f(i, k)
    next
  next
  ' testen
  for i as integer = 1 to anz
    if t(i, anz+1) > 0 then
      farbe = t(i, anz+1)
      t(i, anz+1) = 0
      richtung = 1
      if testlauf(t(), i, anz+1, richtung, farbe mod 16) = 0 then return 0
    end if
  next
  for i as integer = 1 to anz
    if t(i, 0) > 0 then
      farbe = t(i, 0)
      t(i, 0) = 0
      richtung = 2
      if testlauf(t(), i, 0, richtung, farbe mod 16) = 0 then return 0
    end if
  next
  for i as integer = 1 to anz
    if t(0, i) > 0 then
      farbe = t(0, i)
      t(0, i) = 0
      richtung = 4
      if testlauf(t(), 0, i, richtung, farbe mod 16) = 0 then return 0
    end if
  next
  for i as integer = 1 to anz
    if t(anz+1, i) > 0 then
      farbe = t(anz+1, i)
      t(anz+1, i) = 0
      richtung = 8
      if testlauf(t(), anz+1, i, richtung, farbe mod 16) = 0 then return 0
    end if
  next
  ' noch unerledigte Rohre vorhanden?
  for i as integer = 0 to anz
    for k as integer = 0 to anz
      if t(i, k) <> 0 then return 0
    next
  next
  return -1
end function

function testlauf(f() as integer, x as integer, y as integer, r as integer, farbe as integer) as integer
  select case r
    case 1 : y -= 1
    case 2 : y += 1
    case 4 : x += 1
    case 8 : x -= 1
  end select
  if x = 0 or y = 0 or x = ubound(f, 1) or y = ubound(f, 1) then
    if (f(x, y) mod 16) = farbe then
      f(x, y) = 0
      return -1
    else
      return 0
    end if
  end if
  if r = 1 then
    select case as const f(x, y)
      case 2 : f(x, y) = 0 : return testlauf(f(), x, y, 1, farbe)
      case 4 : f(x, y) = 0 : return testlauf(f(), x, y, 4, farbe)
      case 6 : f(x, y) = 0 : return testlauf(f(), x, y, 8, farbe)
      case 7 : f(x, y) = 1 : return testlauf(f(), x, y, 8, farbe)
      case 8 : f(x, y) = 3 : return testlauf(f(), x, y, 4, farbe)
      case 9 : f(x, y) = 5 : return testlauf(f(), x, y, 1, farbe)
      case else : return 0
    end select
  elseif r = 2 then
    select case as const f(x, y)
      case 1 : f(x, y) = 0 : return testlauf(f(), x, y, 4, farbe)
      case 2 : f(x, y) = 0 : return testlauf(f(), x, y, 2, farbe)
      case 3 : f(x, y) = 0 : return testlauf(f(), x, y, 8, farbe)
      case 7 : f(x, y) = 6 : return testlauf(f(), x, y, 4, farbe)
      case 8 : f(x, y) = 4 : return testlauf(f(), x, y, 8, farbe)
      case 9 : f(x, y) = 5 : return testlauf(f(), x, y, 2, farbe)
      case else : return 0
    end select
  elseif r = 4 then
    select case as const f(x, y)
      case 3 : f(x, y) = 0 : return testlauf(f(), x, y, 1, farbe)
      case 5 : f(x, y) = 0 : return testlauf(f(), x, y, 4, farbe)
      case 6 : f(x, y) = 0 : return testlauf(f(), x, y, 2, farbe)
      case 7 : f(x, y) = 1 : return testlauf(f(), x, y, 2, farbe)
      case 8 : f(x, y) = 4 : return testlauf(f(), x, y, 1, farbe)
      case 9 : f(x, y) = 2 : return testlauf(f(), x, y, 4, farbe)
      case else : return 0
    end select
  elseif r = 8 then
    select case as const f(x, y)
      case 1 : f(x, y) = 0 : return testlauf(f(), x, y, 1, farbe)
      case 4 : f(x, y) = 0 : return testlauf(f(), x, y, 2, farbe)
      case 5 : f(x, y) = 0 : return testlauf(f(), x, y, 8, farbe)
      case 7 : f(x, y) = 6 : return testlauf(f(), x, y, 1, farbe)
      case 8 : f(x, y) = 3 : return testlauf(f(), x, y, 2, farbe)
      case 9 : f(x, y) = 2 : return testlauf(f(), x, y, 8, farbe)
      case else : return 0
    end select
  end if
end function

sub zeichne(i as integer, k as integer, f() as integer)
  dim as integer anz = ubound(f, 1)-1
  if (i = 0 or i > anz) and (k = 0 or k > anz) then exit sub
  dim as integer x = (i+3-anz/2)*BREITE, y = (k+3-anz/2)*BREITE
  line (x, y)-step(BREITE, BREITE), &hffffff, b
  if i = 0 or i = anz+1 or k = 0 or k = anz+1 then
    line (x+1, y+1)-step(BREITE-2, BREITE-2), farbe(f(i, k) and 15), bf
    if f(i, k) > 0 then put (x, y), grafik(f(i, k) + 10), trans
  else
    line (x+1, y+1)-step(BREITE-2, BREITE-2), 0, bf
    put (x, y), grafik(f(i, k)), trans
  end if
end sub
