#### B+

• Guest
« 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 = 50const tlyB12 = 50const tlxB2 = 400const sq = 100const sq2 = 50const sq4 = 25bigSplashlabel restartdim b1(3, 3), b2(3, 3), s(9, 4) '9 squares 4 colored triangles, ignore 0 baseassignColorspen onwhile 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 50wendshowpagehue 5at tlxB1 + 150, tlyB12 + 5 * sq input "press enter to play again, any + enter ends ";againif len(again) then end else goto restartpausefunc 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 = 1end 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  nextendsub 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  nextendsub 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 ifend 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  nextendsub 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 selectendfunc 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 : ? messendsub 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  introendsub 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  pauseend`

#### Rick3137

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

• Guest