gosub init
repeat
   repeat
      count_moves()
      update_info()
      repeat
         key$ = inkey$
         if key$ = "esc" then
            finish = 1
            break
         end if
      until(mouseb(key$) = - 1)
      if key$ = "esc" break
      x = mousex(key$)
      y = mousey(key$)
      sys$ = system$("wav c:\\windows\\media\\start.wav /Q")

      from_terrace$ = find_terrace$(x, y)
      from_pack$    = find_card$(x, y)
      from_build$   = find_build$(x, y)
      from_stock$   = find_stock$(x, y)
      from_waste$   = find_waste$(x, y)

      if from_terrace$ = "" and from_pack$ = "" and from_build$ = "" and from_stock$ = "" and from_waste$ = "" continue
      // confirm_move_from()

      if from_stock$ <> "" then
         turn_new_card()
         count_moves()
         continue
      end if

      repeat
         key$ = inkey$
         if key$ = "esc" then
            finish = 1
            break
         end if
      until(mouseb(key$) = - 1)
      sys$ = system$("wav c:\\windows\\media\\start.wav /Q")
      x = mousex(key$)
      y = mousey(key$)

      to_terrace$ = find_terrace$(x, y)
      to_pack$    = find_card$(x, y)
      to_build$   = find_build$(x, y)
      to_stock$   = find_stock$(x, y)
      to_waste$   = find_waste$(x, y)

      if to_terrace$ = "" and to_pack$ = "" and to_build$ = "" and to_stock$ = "" and to_waste$ = "" then
         sys$ = system$("wav c:\\windows\\media\\chord.wav /Q")
         continue
      end if

      if illegal() then
         sys$ = system$("wav c:\\windows\\media\\chord.wav")
         continue
      else
         sys$ = system$("wav click.wav")
      end if

      // Legal moves

      set_vars()
      if from_terrace$ <> "" then
         move_card_from_terrace()
      end if

      if from_pack$ <> "" then
         move_card_from_pack()
      end if

      if from_waste$ <> "" then
         move_card_from_waste()
      end if

      if to_pack$ <> "" then
         move_card_to_pack()
      end if

      if to_build$ <> "" then
         move_card_to_build()
      end if

      finish = finish()
   until(finish > 0)
   if finish = 2 then
      celebrate()
      txt$ = "Congratulations."
   else
      beep
      txt$ = "Bad luck."
   end if
   txt$ = txt$ + " Play again?"
   text 0, 500, txt$, "decorative30"
   if lower$(inkey$) = "y" then
      game_over = false
      clear window
      gosub re_init
   else
      game_over = true
   end if
until(game_over)
exit

sub finish()
local n, win
// jump_to_finish() // Cheat for checking win routine
if idx = 105 and widx - 1 = 0 then
   win = check_for_win()
end if
if win then
   return 2
end if
count_moves()
if available_moves = 0 and idx = 105 then
   return true
end if
return false
end sub

sub count_moves()
available_moves = terrace_moves()
available_moves = available_moves + pack_moves()
available_moves = available_moves + waste_moves()
end sub

sub waste_moves()
local c, card, moves, p
reset_globals()
from_waste$ = str$(waste(widx - 1))
// check moves to build area
for p = 1 to 8
   x = build(p, 1)
   y = build(p, 2)
   to_build$ = get_val$(x, y, build(p, 3))
   if not illegal() then
      moves = moves + 1
   end if
next p
to_build$ = ""
// check moves to packing area
for p = 1 to 9
   c = 13
   repeat
      card = pack(p, c, 3)
      if card = 0 c = c - 1
   until(card > 0 or c = 0)
   // if c = 0 continue
   to_pack$ = get_val$(pack(p, c, 1), pack(p, c, 2), card)
   if not illegal() then
      moves = moves + 1
   end if
next p
return moves
end sub

sub pack_moves()
local b, card, m, moves, n, x, y
reset_globals()
for n = 1 to 9
   m = 13
   // find bottom card on pack(n)
   repeat
      card = pack(n, m, 3)
      if card = 0 m = m - 1
   until(card > 0 or m = 0)
   if m = 0 continue
   from_pack$ = get_val$(pack(n, m, 1), pack(n, m, 2), pack(n, m, 3))
   // see how many places in the build stacks is available
   for b = 1 to 8
      to_build$ = get_val$(build(b, 1), build(b, 2), build(b, 3))
      if not illegal() then
         moves = moves + 1
      end if
   next b
   // now count the legal moves to the pack area
   to_build$ = ""
   for b = 1 to 9
      if b = n continue // don't check it's own position
      m = 13
      repeat
         card = pack(b, m, 3)
         if card = 0 m = m - 1
      until(card > 0 or m = 0)
      if card = 0 continue
      to_pack$ = get_val$(pack(b, m, 1), pack(b, m, 2), pack(b, m, 3))
      if not illegal() then
         moves = moves + 1
      end if
   next b
next n
return moves
end sub

sub terrace_moves()
local moves, n, x, y
// check for more plays by simulating a move
// simulate a terrace card being clicked.
x = 15 * (tidx - 1)
y = 0
reset_globals()
from_terrace$ = find_terrace$(x, y)
for n = 1 to 8
   to_build$ = get_val$(build(n, 1), build(n, 2), build(n, 3))
   if not illegal() then
      moves = moves + 1
   end if
next n
return moves
end sub

sub reset_globals()
from_pack$ = ""
from_build$ = ""
from_waste$ = ""
from_stock$ = ""
from_terrace$ = ""
to_pack$ = ""
to_terrace$ = ""
to_stock$ = ""
to_waste$ = ""
to_build$ = ""
end sub

sub jump_to_finish() // Cheat for checking win routine
local n
widx = 1
idx = 105
build(1, 3) = Card_Value("A", "H")
build(2, 3) = Card_Value("A", "H")
build(3, 3) = Card_Value("A", "S")
build(4, 3) = Card_Value("A", "S")
build(5, 3) = Card_Value("A", "D")
build(6, 3) = Card_Value("A", "D")
build(7, 3) = Card_Value("A", "C")
build(8, 3) = Card_Value("A", "C")
Top$ = "A"
for n = 1 to 8
   Card(build(n, 1), build(n, 2), build(n, 3))
next n
end sub

sub check_for_win()
local done, n
for n = 1 to 8
   if Rank$(build(n, 3)) = Top$ done = done + 1
next n
if done = 8 then
   return true
else
   return false
end if
end sub

sub celebrate()
// Needs a little more imagination!
local sys$
sys$ = system$("wav c:\\windows\\media\\tada.wav /q")
end sub

label init
open window 800, 600
text 0, 400, "Terrace", "decorative230" // I like the look of this but I need a system to replace the lettering when the cards are removed.
poke("textalign"), "lt"
import deck
import libdeck
// import misc        // Used for debugging and other purposes, not needed otherwise
dim cards(104)
dim build(8, 3)    // contains the top card on each stack of the building row, if the stack has no cards then the coresponding element contains 0
dim pack(9, 13, 3) // x,y co-ords of the top LH corner of each position cards can be played the third element = the id number of the card
dim terrace(11)    // contains the cards in the terrace
dim waste(104)     // contains the cards on the waste stack
dim v$(1)          // For Tokens
clear screen
clear window
label re_init
tidx = 11 // terrace index
widx = 1 // waste pile index
cx1 = 397 // x and y coords for the comment area
cy1 = 2
cx2 = 788
cy2 = 94
available_moves = 0
calc_coords_for_pack() // also resets contents identifying the positions of cards
InitDecks(cards())
Double_Shuffle(cards(), 52)
build_terrace()
choose_bases()
draw_stock_and_waste_piles()
return

sub draw_stock_and_waste_piles()
local n
Sx = 235
Sy = 0
Card(Sx, Sy, 0)
Wx = Sx + 80
Wy = 0
FrameCard(Wx, Wy)
//box cx1 - 2, cy1 - 2, cx2 + 2, cy2 + 2
end sub

sub calc_coords_for_pack()
local col, row, x, y
// Packing_stacks
x = 0 // inc x by 90
y = 220 // inc y by 20
for row = 1 to 13
   for col = 1 to 9
      pack(col, row, 1) = x
      pack(col, row, 2) = y
      pack(col, row, 3) = 0
      x = x + 90
   next col
   x = 0
   y = y + 20
next row
// Now for the building stacks
x = 75
y = 110
for n = 1 to 8
   build(n, 1) = x
   build(n, 2) = y
   build(n, 3) = 0
   x = x + 80
next n
end sub

sub build_terrace()
local n, x, y
x = 0
y = 0
// First up, place terrace.
for idx = 1 to 11 // idx =global index for cards()
   Card(x, y, cards(idx))
   terrace(idx) = cards(idx) // add this card to the terrace array
   x = x + 15
next idx // idx = 12 - the next card in cards() to be played
x = 75
y = 110
line 0, 103, 800, 103
// and re-draw building squares
for n = 1 to 8
   FrameCard(x, y)
   x = x + 80
next n
line 0, 213, 800, 213
end sub

sub comment$(status$, a$, b$, c$, d$)
local x, xd
local text_style$
// 32 chars per line
// 4 lines of text
// 6 pixels above and below text
text_style$ = "modern20"
xd = (cx2 - cx1) / 2
colour status$
fill box cx1, cy1, cx2, cy2
colour black$
x = cx1 + calc_x(xd, a$)
text x, cy1 + 6, a$, text_style$
x = cx1 + calc_x(xd, b$)
text x, cy1 + 26, b$, text_style$
x = cx1 + calc_x(xd, c$)
text x, cy1 + 46, c$, text_style$
x = cx1 + calc_x(xd, d$)
text x, cy1 + 66, d$, text_style$
end sub

sub calc_x(xd, t$)
local half_size
half_size = 12 * (len(t$) / 2) // convert letters to pixels
return xd - half_size
end sub

sub choose_bases()
local card, n, num, pos, tmp, x, y
local key$, value$
local v$(1)
x = 0
y = 220
for n = 1 to 4
   Card(x, y, cards(idx))
   pack(n, 1, 3) = cards(idx)
   x = x + 90
   idx = idx + 1
next n
text 0, 340, "Click one card to use as a foundation.", "dontcare20"
Base$ = ""
repeat
   key$ = inkey$
   sys$ = system$("wav c:\\windows\\media\\start.wav /Q")
   x = mousex(key$)
   y = mousey(key$)
   value$ = find_card$(x, y)
   if value$ <> "" then
      num = token(value$, v$(), "#")
      tmp = val(v$(3))
      Base$ = Rank$(tmp)
   end if
until(Base$ <> "")
clear fill box 0, 320, 600, 400
pos = 1
for n = 1 to 9
   if Rank$(pack(n, 1, 3)) = Base$ then
      card = pack(n, 1, 3)
      pack(n, 1, 3) = 0
      build(pos, 3) = card
      Card(build(pos, 1), build(pos, 2), card)
      pos = pos + 1
   end if
   if pack(n, 1, 3) = 0 then
      pack(n, 1, 3) = cards(idx)
      idx = idx + 1
      Card(pack(n, 1, 1), pack(n, 1, 2), pack(n, 1, 3))
   end if
next n
// If Base$ contains the first card on the stacks then Top$ contains the last card on the stack
if Base$ >= "3" and Base$ <= "9" then
   Top$ = str$(val(Base$) - 1)
else
   switch Base$
      case "A"
         Top$ = "K"
         break
      case "2"
         Top$ = "A"
         break
      case "10"
         Top$ = "9"
         break
      case "J"
         Top$ = "10"
         break
      case "Q"
         Top$ = "J"
         break
      case "K"
         Top$ = "Q"
         break
   end switch
end if
end sub

sub illegal()
local build_error, mistake, packing_error
local from$, from_col$, tmp$, to$, to_col$
if to_build$ <> "" then
   build_error = check_build()
   if build_error > 0 then
      mistake = true
   end if
end if
if to_pack$ <> "" and from_waste$ = "" then
   packing_error = check_packing()
   if packing_error then
      mistake = true
   end if
end if
if from_waste$ <> "" and widx = 1 then
   mistake = true
end if
if from_build$ <> "" then
   mistake = true
end if
if from_terrace$ <> "" and to_build$ = "" then
   mistake = true
end if
if to_terrace$ <> "" then
   mistake = true
end if
if to_waste$ <> "" or to_stock$ <> "" then
   mistake = true
end if
if (to_pack$ <> "" or to_build$ <> "") and mistake = false then
   if colour_clash() then
      mistake = true
   end if
   if build_error = 0 and bad_rank_sequence() then
      mistake = true
   end if
end if
return mistake
end sub

sub check_packing()
local num
local v$(1)
num = token(to_pack$, v$(), "#")
if v$(3) = "0" return true
end sub

sub colour_clash()
local bad, new_num, old_num
local new$, new_rank$, new_suit$, old$, old_rank$, old_suit$
local new$(1), old$(1)
if to_build$ <> "" then
   if right$(to_build$, 2) = "#0" then // special case, placing card on new stack so checking colours is not needed
      return
   end if
end if
if from_pack$    <> "" old$ = from_pack$
if from_terrace$ <> "" old$ = from_terrace$
if from_stock$   <> "" old$ = from_stock$
if from_waste$   <> "" old$ = from_waste$
old_num = token(old$, old$(), "#")
if old_num > 1 then
   old_card = val(old$(3))
else
   old_card = val(old$)
end if
if to_pack$    <> "" new$ = to_pack$
if to_build$   <> "" new$ = to_build$
new_num = token(new$, new$(), "#")
new_card = val(new$(new_num))
if new_card = 0 return // card is placed in an empty space in the pack area
old_rank$ = Rank$(old_card)
old_suit$ = Suit$(old_card)
new_rank$ = Rank$(new_card)
new_suit$ = Suit$(new_card)
if Suit_Colour$(new_rank$, new_suit$) = Suit_Colour$(old_rank$, old_suit$) then
   bad = true
else
   bad = false
end if
return bad
end sub

sub bad_rank_sequence()
local bad, new_num, new_value, old_num, old_value
local new$, new_rank$, old$, old_rank$, target$
local new$(1), old$(1)
if from_pack$    <> "" old$ = from_pack$
if from_terrace$ <> "" old$ = from_terrace$
if from_stock$   <> "" old$ = from_stock$
if from_waste$   <> "" old$ = from_waste$
old_num = token(old$, old$(), "#")
if old_num > 1 then
   old_card = val(old$(3))
else
   old_card = val(old$)
end if
if to_pack$    <> "" new$ = to_pack$
if to_build$   <> "" new$ = to_build$
new_num = token(new$, new$(), "#")
new_card = val(new$(new_num))
if new_card = 0 return // Card being played to an empty gap in the packing area
old_rank$ = Rank$(old_card)
new_rank$ = Rank$(new_card)
old_value = val(old_rank$)
target$ = find_next_card$(old_value, old_rank$, old_card)
if target$ <> new_rank$ then
   bad = true
else
   bad = false
end if
return bad
end sub

sub find_next_card$(value, rank$, old_card)
if value = 0 then
   if to_pack$ <> "" then
      if rank$ = "J" target$ = "Q"
      if rank$ = "Q" target$ = "K"
      if rank$ = "K" target$ = "A"
      if rank$ = "A" target$ = "2"
   else
      if rank$ = "J" target$ = "10"
      if rank$ = "Q" target$ = "J"
      if rank$ = "K" target$ = "Q"
      if rank$ = "A" target$ = "K"
   end if
end if
if value > 2 and value < 10 then
   if to_build$ <> "" then
      target$ = str$(value - 1)
   else
      target$ = str$(value + 1)
   end if
end if
if value = 2 then
   if to_build$ <> "" then
      target$ = "A"
   else
      target$ = "3"
   end if
end if

if value = 10 then
   if to_pack$ <> "" then
      target$ = "J"
   else
      target$ = "9"
   end if
end if
if to_build$ <> "" and old_card = 0 target$ = Base$
return target$
end sub

sub confirm_move_from()
local num
local from$
local v$(1)
if from_terrace$ <> "" then
   num = token(from_terrace$, v$(), "#")
   card = val(v$(3))
   from$ = "Terrace"
end if
if from_pack$ <> "" then
   num = token(from_pack$, v$(), "#")
   card = val(v$(3))
   from$ = "Pack"
end if
if from_stock$ <> "" from$ = "Stock pile."
if from_waste$ <> "" then
   card = val(from_waste$)
   from$ = "Waste pile."
end if
if from_build$ <> "" then
   num = token(from_build$, v$(), "#")
   card = val(v$(3))
   from$ = "Stacks!"
end if
if card = 0 and from_stock$ = "" return
if from_stock$ = "" then
   comment$(neutral$, "Moving the", Long_Name$(card), "from", "the " + from$)
else
   comment$(neutral$, "Turning over", "a new card")
end if
end sub

// Mouse/card Routines

sub find_stack(a(), x, y)
local col, dims, found, px1, px2, py1, py2, row
dims = arraydim(a())
if dims = 3 then
   for col = 1 to 9
      for row = 1 to 13
         px1 = pack(col, row, 1)
         py1 = pack(col, row, 2)
         px2 = px1 + 72
         py2 = py1 + 96
         if px1 <= x and px2 >= x and py1 <= y and py2 >= y then
            found = true
         end if
         if found break
      next row
      if found break
   next col
else
   for col = 1 to 8
      px1 = build(col, 1)
      py1 = build(col, 2)
      px2 = px1 + 72
      py2 = py1 + 96
      if px1 <= x and px2 >= x and py1 <= y and py2 >= y then
         found = true
      end if
      if found break
   next col
end if
if found then
   return col
else
   return - 1 // not found - BUG
end if
end sub

sub find_card$(x, y)
local col, found, px1, px2, py1, py2, row
for col = 1 to 9
   for row = 1 to 13
      px1 = pack(col, row, 1)
      py1 = pack(col, row, 2)
      px2 = px1 + 72
      py2 = py1 + 96
      if px1 <= x and px2 >= x and py1 <= y and py2 >= y then
         if row + 1 < 13 then
            if pack(col, row + 1, 3) = 0 found = true
         else
            if pack(col, row, 3) <> 0 found = true
         end if
      end if
      if found break
   next row
   if found break
next col
if found then
   return get_val$(col, row, pack(col, row, 3))
else
   return ""
end if
end sub

sub find_terrace$(x, y)
local x1, x2, y1, y2
x1 = 15 * (tidx - 1)
y1 = 0
x2 = x1 + 72
y2 = 96
if not(x1 <= x and x2 >= x and y1 <= y and y2 >= y) return ""
return get_val$(x1, y1, terrace(tidx))
end sub

sub find_build$(x, y)
local found, n, x1, x2, y1, y2
for n = 1 to 8
   x1 = build(n, 1)
   y1 = build(n, 2)
   x2 = x1 + 72
   y2 = y1 + 96
   if x >= x1 and x <= x2 and y >= y1 and y <= y2 then
      found = true
      break
   end if
next n
if found then
   return get_val$(x1, y1, build(n, 3))
end if
end sub

sub find_stock$(x, y)
local x1, x2, y1, y2
if idx = 105 return
x1 = Sx
y1 = Sy
x2 = x1 + 72
y2 = y1 + 96
if x >= x1 and x <= x2 and y >= y1 and y <= y2 then
   return str$(cards(idx))
end if
end sub

sub find_waste$(x, y)
local x1, x2, y1, y2
x1 = Wx
y1 = Wy
x2 = x1 + 72
y2 = y1 + 96
if x >= x1 and x <= x2 and y >= y1 and y <= y2 then
   return str$(waste(widx - 1))
end if
end sub

sub get_val$(a, b, c)
return str$(a) + "#" + str$(b) + "#" + str$(c)
end sub

sub store_pack(a(), x, y, card)
local col, found, row
for col = 1 to 9
   for row = 1 to 13
      if a(col, row, 1) = x and a(col, row, 2) = y then
         found = true
         break
      end if
   next row
   if found then
      break
   end if
next col
if not found error str$(x) + "," + str$(y) + " not found within pack()"
a(col, row, 3) = card
end sub

sub turn_new_card()
local r, x, y
if idx = 105 return
Card(Wx, Wy, cards(idx))
waste(widx) = cards(idx)
idx = idx + 1
widx = widx + 1
if idx = 105 then
   colour 0, 150, 0
   fill box Sx, Sy, Sx + 72, Sy + 96
   x = Sx + 36
   y = 48
   colour 150, 0, 0
   for r = 15 to 30
      circle x, y, r
   next r
   // comment$(neutral$, "There are no more", "cards left.")
end if
end sub

sub set_vars()
local col, num, row
local new$, old$
local v$(1)

if from_terrace$ <> "" old$ = from_terrace$
if from_stock$ <> "" old$ = from_stock$
if from_waste$ <> "" old$ = from_waste$
if from_pack$ <> "" old$ = from_pack$

if to_pack$ <> "" new$ = to_pack$
if to_build$ <> "" new$ = to_build$

num = token(old$, v$(), "#")
from_card = val(v$(num))
if from_terrace$ <> "" then
   from_x = val(v$(1))
   from_y = val(v$(2))
end if
if from_stock$ <> "" then
   from_x = Sx
   from_y = Sy
end if
if from_waste$ <> "" then
   from_x = Wx
   from_y = Wy
end if
if from_pack$ <> "" then
   col = val(v$(1))
   row = val(v$(2))
   from_x = pack(col, row, 1)
   from_y = pack(col, row, 2)
   from_col = col
   from_row = row
end if

num = token(new$, v$(), "#")
to_card = val(v$(3))
if to_pack$ <> "" then
   col = val(v$(1))
   row = val(v$(2))
   if not(row = 1 and pack(col, row, 3) = 0) then
      row = row + 1
   end if
   to_x = pack(col, row, 1)
   to_y = pack(col, row, 2)
   to_col = col
   to_row = row
else
   to_x = val(v$(1))
   to_y = val(v$(2))
   to_col = get_stack(to_x, to_y)
end if
end sub

sub get_stack(x, y)
local col
for col = 1 to 8
   if x = build(col, 1) and y = build(col, 2) return col
next col
end sub

sub check_build()
local card, num, stack, x, y
local a$, rank$
local v$(1)
if from_terrace$ <> "" a$ = from_terrace$
if from_pack$ <> "" a$ = from_pack$
if from_stock$ <> "" then
   a$ = from_stock$
   card = val(a$)
end if
if from_waste$ <> "" then
   a$ = from_waste$
   card = val(a$)
end if
num = token(a$, v$(), "#")
if num > 1 then
   card = val(v$(3))
end if
num = token(to_build$, v$(), "#")
stack = get_stack(val(v$(1)), val(v$(2)))
rank$ = Rank$(card)
if build(stack, 3) = - 1 return true // Stack is finished
if build(stack, 3) = 0 then
   if rank$ = Base$ then
      return false // first card on stack
   else
      return true // not a base card
   end if
end if
rank$ = Rank$(build(stack, 3))
if rank$ = Top$ then
   build(stack, 3) = - 1 // stack full
end if
return false
end sub

sub move_card_from_terrace()
local x, y
x = from_x
y = from_y
tidx = tidx - 1
if tidx < 1 then
   // comment$(warning$, "The terrace", "is empty")
   pause 2
   return
end if
x = x - 15
clear fill box from_x, from_y, from_x + 72, from_y + 96
Card(x, y, terrace(tidx))
end sub

sub move_card_to_build()
Card(to_x, to_y, from_card)
build(to_col, 3) = from_card
end sub

sub move_card_to_pack()
Card(to_x, to_y, from_card)
pack(to_col, to_row, 3) = from_card
end sub

sub move_card_from_pack()
clear fill box from_x, from_y, from_x + 72, from_y + 96
if from_row = 1 then
   FrameCard(from_x, from_y)
else
   Card(from_x, pack(from_col, from_row - 1, 2), pack(from_col, from_row - 1, 3))
end if
pack(from_col, from_row, 3) = 0
end sub

sub move_card_from_waste()
widx = widx - 1
if widx = 1 then
   clear fill box Wx, Wy, Wx + 72, Wy + 96
   FrameCard(Wx, Wy)
else
   Card(Wx, Wy, waste(widx - 1))
end if
end sub

sub update_info()
local card$
switch Base$
   case "A"
      card$ = "Aces"
      break
   case "J"
      card$ = "Jacks"
      break
   case "Q"
      card$ = "Queens"
      break
   case "K"
      card$ = "Kings"
      break
   default
      card$ = Base$ + "s"
      break
end switch
text cx1, 15, "Foundation cards    = " + card$, "modern"
clear fill box cx1 + 176, 30, cx1 + 200, cy2
text cx1, 30, "Cards in stock pile = " + str$(105 - idx)
text cx1, 45, "Cards in waste heap = " + str$(widx - 1)
// text cx1, 60, "Moves available     = " + str$(available_moves)
end sub