Author Topic: TriQuad  (Read 1571 times)

B+

  • Guest
TriQuad
« on: March 29, 2017, 06:44:27 PM »
I found this game at Naalaa, rick3137 is now up to version 3 there. I played a number of games and then developed a SmallBASIC version independently of Rick's code. The sounds are handmade he-he... It's a cute game to play.

Code: [Select]
' TriQuad.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-26
' inspired by rick3137's recent post at Naalaa of cute puzzle
' I am curious in how few lines, it might take me to do similar.

const tlxB1 = 50
const tlyB12 = 50
const tlxB2 = 400
const sq = 100
const sq2 = 50
const sq4 = 25

bigSplash
label restart
dim b1(3, 3), b2(3, 3), s(9, 4) '9 squares 4 colored triangles, ignore 0 base
assignColors
pen on
while 1
  cls
  showB(1)
  showB(2)
  if pen(3) then
    mx = pen(4) : my = pen(5)
    if tlyB12 <= my and my <= tlyB12 + 3 * sq then
       by = int((my - tlyB12)/sq) + 1
      if tlxB1 <= mx and mx <= tlxB1 + 3 * sq then 'mx in b1
        bx = int((mx - tlxB1)/sq) + 1
        if holdF then 'trying to put the piece on hold here?
          if b1(bx, by) = 0 then
            b1(bx, by) = holdF
            holdF = 0
            sound 2000, 10
            sound 600, 20
          end if
        elseif holdF = 0
          if b1(bx, by) > 0 then
            holdF = b1(bx, by)
            b1(bx, by) = 0
            sound 600, 20
            sound 2000, 10
          end if
        end if
      elseif tlxB2 <= mx and mx <= tlxB2 + 3 * sq  'mx in b2
        bx = int((mx - tlxB2)/sq) + 1
        if holdF then 'trying to put the piece on hold here?
          if b2(bx, by) = 0 then
            b2(bx, by) = holdF
            holdF = 0
            sound 2000, 10
            sound 600, 20         
          end if
        elseif holdF = 0
          if b2(bx, by) > 0 then
            holdF = b2(bx, by)
            b2(bx, by) = 0
            sound 600, 20
            sound 2000, 10
          end if
        end if
      end if 'mx in a board?
    end if 'my out of range
  end if
  if solved() then
    showB(2)
    at tlxB2, tlyB12 + 3 * sq + sq2
    hue 10
    ? "Congratulations puzzle solved!"
    for i = 1 to 5
      sound 3000, 50
      sound 500,10
    next
    exit loop
  end if
  ky = inkey
  if len(ky) then
    if ky = "q" then
      showSolution
      at tlxB2, tlyB12 + 3 * sq + sq2
      hue 10
      ? "Here is solution, Goodbye!"
      sound 500, 150
      exit loop
    end if
  end if
  showpage
  delay 50
wend
showpage
hue 5
at tlxB1 + 150, tlyB12 + 5 * sq
input "press enter to play again, any + enter ends ";again
if len(again) then end else goto restart
pause

func solved()
  local x, y
  solved = 0
  for y = 1 to 3
    for x = 1 to 3
      if b2(x, y)  <> x + 3 * (y - 1) then exit func
    next
  next
  solved = 1
end

sub showSolution
  local x, y, index
  for y = 1 to 3*sq step sq
    for x = 1 to 3*sq step sq
      index = index + 1
      drawSquare(index, x + tlxB2, y + tlyB12)
    next
  next
end

sub showB(board)
  local x, y, index
  for y = 1 to 3
    for x = 1 to 3
      if board = 1 then
        index = b1(x, y)
        drawSquare(index, (x-1) * sq + tlxB1, (y-1) * sq + tlyB12)
      else
        index = b2(x, y)
        drawSquare(index, (x-1) * sq + tlxB2, (y-1) * sq + tlyB12)
      end if
    next
  next
end

sub drawSquare(index, x, y)
  rect x, y, x + 100, y + 100, 0 filled
  rect x, y, x + 100, y + 100, 15
  if index > 0 then
    line x, y, x + 100, y + 100, 15
    line x + 100, y,  x, y + 100, 15
    hue s(index, 1) : paint x + 50, y + 20
    hue s(index, 2) : paint x + 80, y + 50
    hue s(index, 3) : paint x + 50, y + 80
    hue s(index, 4) : paint x + 20, y + 50
  end if
end

sub assignColors()
  local fa, s1, rc, i, t, x, y, index
  fa = "124578" ' assign 6 squares with square to thir right
  for i = 1 to 6
    s1 = val(mid(fa, i, 1)) : rc = rand(1, 9)
    s(s1, 2) = rc : s(s1 + 1, 4) = rc
  next
  for i = 1 to 6 'assign 6 squares that have a square under
    rc = rand(1, 9) : s(i, 3) = rc : s(i + 3, 1) = rc
  next
  'random color to edges
  s(1, 1) = rand(1, 9) : s(2, 1) = rand(1, 9) : s(3, 1) = rand(1, 9)
  s(3, 2) = rand(1, 9) : s(6, 2) = rand(1, 9) : s(9, 2) = rand(1, 9)
  s(7, 3) = rand(1, 9) : s(8, 3) = rand(1, 9) : s(9, 3) = rand(1, 9)
  s(1, 4) = rand(1, 9) : s(4, 4) = rand(1, 9) : s(7, 4) = rand(1, 9)
  'load pieces box
  dim t(1 to 9)
  for i = 1 to 9 : t(i) = i : next
  for i = 9 to 2 step -1 : rc = rand(1, i) : swap t(i), t(rc) : next
  for y = 1 to 3
    for x = 1 to 3
      index = index + 1 : b1(x, y) = t(index)
    next
  next
end

sub hue(n)
  select case n
  case 0 : color 0
  case 1 : color rgb(168, 0, 98) 
  case 2 : color rgb(0, 0, 80)
  case 3 : color rgb(240, 120, 60)
  case 4 : color 12
  case 5 : color rgb(0, 128, 0)
  case 6 : color 9
  case 7 : color rgb(255, 100, 255)   
  case 8 : color 14
  case 9 : color 11
  case 10 : color 15 
  end select
end

func rand(n1, n2)
  local hi, lo 
  if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
  rand = (rnd * (hi - lo + 1)) \ 1 + lo
end

sub text(x, y, size, mess)
  l.w = window() : l.w.setfont(size, "pt", 0, 0)
  at x, y : ? mess
end

sub bigSplash   
  hue 6
  text 250, 200, 128, "TriQuad"
  hue 4
  text 265, 350, 24, "for SmallBASIC by [B+=MGA] 2017-03-26
  hue 3
  text 130, 400, 24, "Thanks to rick3137 whose Naalaa version inspired this one."
  hue 5
  text 355, 580, 24, "press any to continue..."
  showpage
  pause
  intro
end

sub intro
  cls
  hue 3
  text 230, 200, 48, "TriQuad Instructions:"
  hue 4
  text 50, 300, 18, "The Board on the left:"
  hue 10
  text 50, 335, 18, "Contains 9 squares with 4 triangles."
  text 50, 360, 18, "You may move any piece to an empty"
  text 50, 385, 18, "space on either board by:"
  text 50, 410, 18, "1st clicking the piece to disappear it,"
  text 50, 435, 18, "then clicking any empty space for it to"
  text 50, 460, 18, "reappear. You may press q to quit and"
  text 50, 485, 18, "see the solution displayed."
  hue 6
  text 500, 300, 18, "The Board on the right:"
  hue 10
  text 500, 335, 18, "Is where you match the colors and build"
  text 500, 360, 18, "the solution to the puzzle."
  text 500, 395, 18, "Hint: the colors without matching"
  text 500, 420, 18, "complement, are edge pieces."
  text 600, 455, 18, "Good luck!"
  hue 5
  text 360, 580, 18, "press any to continue..." 
  showpage
  pause
end

Rick3137

  • Guest
Re: TriQuad
« Reply #1 on: March 30, 2017, 03:33:14 PM »
 Nice translation. Works good on my Windows10.

B+

  • Guest
Re: TriQuad
« Reply #2 on: March 30, 2017, 07:14:21 PM »
Hi Rick,

Not translation, the code was developed independently from playing a few games. In fact, all I looked at in Naalaa code version 1, was how many colors and settings you used and saw something like 504 lines plus the sound files!

But I think you just meant to compliment, so thanks!  ;)  (especially for introducing that great game!)  :D