 Author Topic: TriQuad  (Read 1358 times)

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 = 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)
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
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 « Reply #1 on: March 30, 2017, 03:33:14 pm »
Nice translation. Works good on my Windows10.

B+

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