#### Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
« on: March 18, 2017 »

A simple logic game. Move all of the Quads from the right side board

to the left side board. All four colors on each quad needs to match nearby

colors.

#### B+

• Full Member
• Posts: 215
« Reply #1 on: March 20, 2017 »
Very nice!

At first I was wondering if the puzzles had a solution at all.

But then a hint, put all colors that can't be matched on the side.

I like the puzzles that make you think a little but don't wear out the brain.
B+

#### Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
« Reply #2 on: March 20, 2017 »
Thank You

I find that NaaLaa and Basic is perfect for this sort of puzzle.
Now ... if I only had a hundred more

#### Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
« Reply #3 on: March 24, 2017 »
Here's another version, that has more colors. It allows a quicker solution with less
trial and error logic.
Because I am slightly color blind, I spent a lot of time selecting the colors so that I could tell them apart.
Code: [Select]

visible:
size;
s1 = 1 ; s2 = 2 ; s3 = 3 ; s4 = 4; s5 = 5 ; s6 = 6 ; s7 = 7 ; s8 = 8 ; s9 = 9
s11 = 10 ; s12 = 10 ; s13 = 10 ; s14 = 10; s15 = 10 ; s16 = 10 ; s17 = 10 ; s18 = 10 ; s19 = 10
t1 = 0 ; t2 = 0 ; t3 = 0 ; t4 = 0

event = 0; count = 0 ; gamenumber = 0
sqrcolor ; quadColor ; mx; my; square = 10; column; row; score;  number1; number2; enter
checksum; gameover = 0 ; sum ; BackGround
z[10]
sq[30]
Piece[12][4]
pc[20][10]

randomize time()
hidden:
set redraw off
procedure start()
ThisIsAPlaceHolder = 1
endproc
set window 0, 0, 1350, 700
proc HowToPlay
proc SetupPieces1
proc SetupPieces2
proc SetupPieces4

proc Shuffle

proc Setup
proc SetupSound
proc SetupZones
proc Swap

do
set color 0,0,0
cls
set color 255,255,255

do
wait 50

set color 0,0,0
cls;
set color 255,255,255

proc CheckMouse
proc DrawBoard
proc MakeSquares

proc DisplayPieces
'     proc PrintText

proc EndGame

redraw
until event = 3
proc AfterGame
proc Reset
until event = 4
end
procedure Reset()
create font 0, "arial", 24

proc SetupPieces1
proc SetupPieces2
proc SetupPieces4

proc Shuffle

proc Setup
proc SetupSound
proc SetupZones
proc Swap
endproc

procedure SetupZones()
create zone 1 , 200, 100, 166, 166
create zone 2 , 367, 100, 166, 166
create zone 3 , 534, 100, 166, 166
create zone 4 , 200, 266, 166, 166
create zone 5 , 367, 266, 166, 166
create zone 6 , 534, 266, 166, 166
create zone 7 , 200, 433, 166, 166
create zone 8 , 367, 433, 166, 166
create zone 9 , 534, 433, 166, 166

create zone 11 , 750, 100, 166, 166
create zone 12 , 916, 100, 166, 166
create zone 13 , 1085, 100, 166, 166
create zone 14 , 750, 266, 166, 166
create zone 15 , 916, 266, 166, 166
create zone 16 , 1085, 266, 166, 166
create zone 17 , 750, 433, 166, 166
create zone 18 , 916, 433, 166, 166
create zone 19 , 1085, 433, 166, 166

endproc

procedure SetupPieces1()
for a = 1 to 9

pc[a][1] = rnd(14)+1
pc[a][3] = rnd(14)+1
next
pc[3][2] = rnd(14)+1
pc[6][2] = rnd(14)+1
pc[9][2] = rnd(14)+1
pc[7][4] = rnd(14)+1
pc[8][4] = rnd(14)+1
pc[9][4] = rnd(14)+1

pc[1][2] = pc[2][1]
pc[2][2] = pc[3][1]
pc[4][2] = pc[5][1]
pc[5][2] = pc[6][1]
pc[7][2] = pc[8][1]
pc[8][2] = pc[9][1]

pc[1][4] = pc[4][3]
pc[2][4] = pc[5][3]
pc[3][4] = pc[6][3]
pc[4][4] = pc[7][3]
pc[5][4] = pc[8][3]
pc[6][4] = pc[9][3]

endproc

procedure SetupPieces2()
for a = 1 to 10
create image a,160,160
next
for a = 1 to 10
set color 100,100,155
set image a
draw rect 0,0,160,160,1
next

for a = 1 to 9
set image a
a1 = pc[a][1]
a2 = pc[a][2]
a3 = pc[a][3]
a4 = pc[a][4]

proc SetColor a1
proc Triangle1 80,80,80
proc SetColor a2
proc Triangle2 80,80,80
proc SetColor a3
proc Triangle3 80,80,80
proc SetColor a4
proc Triangle4 80,80,80
t1 = a1
t2 = a2
t3 = a3
t4 = a4
next
set image primary
set color 255,255,255

endproc
procedure SetupPieces4()
for a = 1 to 9
set image a
set color 255,255,255
draw line 0,0,160,160
draw line 2,0,162,160
draw line 0,2,158,160
draw line 0,160,160,0
draw line 2,160,162,0
draw line 0,158,158,0
next
set image primary
set color 255,255,255

endproc

procedure Shuffle()
cnt = 1
for a = 1 to 9
z[a] = a
next
s1 = 10 ; s2 = 10 ; s3 = 10 ; s4 = 10; s5 = 10 ; s6 = 10 ; s7 = 10 ; s8 = 10 ; s9 = 10
while cnt<800
a = rnd(9)+1
b = z[a]
c = rnd(9)+1
d = z[c]
if a <> c
z[a] = d
z[c] = b
endif
cnt = cnt + 1
wend

s11 = z[1]
s12 = z[2]
s13 = z[3]
s14 = z[4]
s15 = z[5]
s16 = z[6]
s17 = z[7]
s18 = z[8]
s19 = z[9]
endproc

procedure Setup()
rem Setup Variables and other things here.
gameover = 0
event = 1
endproc

procedure SetupSound()
endproc

procedure DrawBoard()
rem set color 0,10,30
rem cls
'draw image BackGround,0,0
set color 200,200,255
draw rect 200,100,501,499,1 ; draw rect 750,100,501,499,1

endproc

procedure MakeSquares()

set color 0,0,255
draw rect 200,100,168,167,0
draw rect 367,100,168,167,0
draw rect 534,100,168,167,0
draw rect 200,266,168,167,0
draw rect 367,266,168,167,0
draw rect 534,266,168,167,0
draw rect 200,432,168,167,0
draw rect 367,432,168,167,0
draw rect 534,432,168,167,0

draw rect 750,100,168,167,0
draw rect 917,100,168,167,0
draw rect 1084,100,168,167,0
draw rect 750,266,168,167,0
draw rect 917,266,168,167,0
draw rect 1084,266,168,167,0
draw rect 750,432,168,167,0
draw rect 917,432,168,167,0
draw rect 1084,432,168,167,0
set color 255,255,255
endproc

procedure Swap()
sq[1] = s1
sq[2] = s2
sq[3] = s3
sq[4] = s4
sq[5] = s5
sq[6] = s6
sq[7] = s7
sq[8] = s8
sq[9] = s9
sq[11] = s11
sq[12] = s12
sq[13] = s13
sq[14] = s14
sq[15] = s15
sq[16] = s16
sq[17] = s17
sq[18] = s18
sq[19] = s19
endproc

procedure DisplayPieces()
set color 255,255,255

draw image sq[1],204,104
draw image sq[2],371,104
draw image sq[3],538,104
draw image sq[4],204,269
draw image sq[5],371,269
draw image sq[6],538,269
draw image sq[7],204,436
draw image sq[8],371,436
draw image sq[9],538,436

draw image sq[11],754,104
draw image sq[12],921,104
draw image sq[13],1088,104
draw image sq[14],754,269
draw image sq[15],921,269
draw image sq[16],1088,269
draw image sq[17],754,436
draw image sq[18],921,436
draw image sq[19],1088,436

endproc

procedure PrintText()
set caret 10,50
write " MouseX = " ; wln str\$(mx)
write " MouseY = " ; wln str\$(my)
write " Zone = " ; wln str\$( square )
wln str\$(sq[1])
wln str\$(sq[2])
wln str\$(sq[3])
wln str\$(sq[4])
wln str\$(sq[5])
wln str\$(sq[6])
wln str\$(sq[7])
wln str\$(sq[8])
wln str\$(sq[9])
endproc

procedure CheckMouse()
a;b;c;x;y;x2;y2
' square = 1 to 9...  No square = 10
a = zone()
if a>0  and square = 10 and sq[a] < 10 then
square = sq[a]
sq[a] = 10
elseif a>0 and sq[a] = 10 then
sq[a] = square
square = 10
endif

mx= mousex()
my= mousey()

if mousebutton(0,1) then
play sound 0 ;
endif
endproc

procedure  EndGame()
a = 0
b = 0
if sq[1] = 1 and sq[2] = 2 and sq[3] = 3 and sq[4] = 4 and sq[5] = 5 and sq[6] = 6 and sq[7] = 7 and sq[8] = 8 and sq[9] = 9 then gameover = 1
if gameover = 1
event = 3
redraw
endif
endproc

procedure HowToPlay()
a = 1
create font 0, "arial", 24

set color 255,255,255
set caret 200,100
wln "  The object of this puzzle is : "
wln " to move all of the pieces from the Right Side Board to the Left Side Board."
wln " "
wln "  Each piece has 4 colors and when you place the piece on the left side board,  "
wln " each color should match the color of the piece that it touches. "
wln " "
wln " "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln " Hit any key to continue. "

wln
wln " http://rb23.yolasite.com "

redraw
wait keydown

endproc

procedure AfterGame()
play sound 2
'set color 0,0,0
'cls
create font 0, "arial", 48

set caret 300,40
set color 255,255,255
wln "PUZZLE SOLVED !"
create font 0, "arial", 16
set caret 20,300
wln "  "
wln "  "
wln "  My Web Sites: "
wln " http://rb23.yolasite.com "
wln " http://rb27.synthasite.com "
wln " http://scratch2.yolasite.com "
wln " http://rb26.synthasite.com "
wln " http://rb29.yolasite.com "
wln;wln
set caret 300,630
wln " Hit any key to play again "
event = 2
redraw
wait keydown

endproc

' left side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' right side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' high side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' low side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

procedure SetColor( a )
if a = 1 then   set color 0,255,0
if a = 2 then   set color 0,0,255
if a = 3 then   set color 255,0,0
if a = 4 then   set color 0,255,150
if a = 5 then   set color 200,0,100
if a = 6 then   set color 255,255,0
if a = 7 then   set color 100,0,100
if a = 8 then   set color 150,100,255
if a = 9 then   set color 0,0,120
if a = 10 then   set color 240,240,255
if a = 11 then   set color 20,30,40
if a = 12 then   set color 150,0,0
if a = 13 then   set color 0,150,0
if a = 14 then   set color 255,100,150
sqrcolor = a
endproc

#### Mr Nutz

• Newbie
• Posts: 10
« Reply #4 on: March 26, 2017 »
Very interesting idea.
Displaying a finished image of the puzzle for a few seconds at the start could help the player.

#### Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
« Reply #5 on: March 27, 2017 »
Very interesting idea.
Displaying a finished image of the puzzle for a few seconds at the start could help the player.

OK, It looks too easy, but here it is:

Code: [Select]
visible:
size;
s1 = 1 ; s2 = 2 ; s3 = 3 ; s4 = 4; s5 = 5 ; s6 = 6 ; s7 = 7 ; s8 = 8 ; s9 = 9
s11 = 10 ; s12 = 10 ; s13 = 10 ; s14 = 10; s15 = 10 ; s16 = 10 ; s17 = 10 ; s18 = 10 ; s19 = 10
t1 = 0 ; t2 = 0 ; t3 = 0 ; t4 = 0

event = 0; count = 0 ; gamenumber = 0
sqrcolor ; quadColor ; mx; my; square = 10; column; row; score;  number1; number2; enter
checksum; gameover = 0 ; sum ; BackGround
z[10]
sq[30]
Piece[12][4]
pc[20][10]

randomize time()
hidden:
set redraw off
procedure start()
ThisIsAPlaceHolder = 1
endproc
set window 0, 0, 1350, 700
proc HowToPlay
proc SetupPieces1
proc SetupPieces2
proc SetupPieces4
proc DrawBoard
proc MakeSquares
set color 255,255,255
proc Swap

proc DisplayPieces
redraw
wait 5000
proc Shuffle

proc Setup
proc SetupSound
proc SetupZones
proc Swap

do
set color 0,0,0
cls
set color 255,255,255

do
wait 50

set color 0,0,0
cls;
set color 255,255,255

proc CheckMouse
proc DrawBoard
proc MakeSquares

proc DisplayPieces
'     proc PrintText

proc EndGame

redraw
until event = 3
proc AfterGame
proc Reset
until event = 4
end
procedure Reset()
create font 0, "arial", 24

proc SetupPieces1
proc SetupPieces2
proc SetupPieces4

proc Shuffle

proc Setup
proc SetupSound
proc SetupZones
proc Swap
endproc

procedure SetupZones()
create zone 1 , 200, 100, 166, 166
create zone 2 , 367, 100, 166, 166
create zone 3 , 534, 100, 166, 166
create zone 4 , 200, 266, 166, 166
create zone 5 , 367, 266, 166, 166
create zone 6 , 534, 266, 166, 166
create zone 7 , 200, 433, 166, 166
create zone 8 , 367, 433, 166, 166
create zone 9 , 534, 433, 166, 166

create zone 11 , 750, 100, 166, 166
create zone 12 , 916, 100, 166, 166
create zone 13 , 1085, 100, 166, 166
create zone 14 , 750, 266, 166, 166
create zone 15 , 916, 266, 166, 166
create zone 16 , 1085, 266, 166, 166
create zone 17 , 750, 433, 166, 166
create zone 18 , 916, 433, 166, 166
create zone 19 , 1085, 433, 166, 166

endproc

procedure SetupPieces1()
for a = 1 to 9

pc[a][1] = rnd(14)+1
pc[a][3] = rnd(14)+1
next
pc[3][2] = rnd(14)+1
pc[6][2] = rnd(14)+1
pc[9][2] = rnd(14)+1
pc[7][4] = rnd(14)+1
pc[8][4] = rnd(14)+1
pc[9][4] = rnd(14)+1

pc[1][2] = pc[2][1]
pc[2][2] = pc[3][1]
pc[4][2] = pc[5][1]
pc[5][2] = pc[6][1]
pc[7][2] = pc[8][1]
pc[8][2] = pc[9][1]

pc[1][4] = pc[4][3]
pc[2][4] = pc[5][3]
pc[3][4] = pc[6][3]
pc[4][4] = pc[7][3]
pc[5][4] = pc[8][3]
pc[6][4] = pc[9][3]

endproc

procedure SetupPieces2()
for a = 1 to 10
create image a,160,160
next
for a = 1 to 10
set color 100,100,155
set image a
draw rect 0,0,160,160,1
next

for a = 1 to 9
set image a
a1 = pc[a][1]
a2 = pc[a][2]
a3 = pc[a][3]
a4 = pc[a][4]

proc SetColor a1
proc Triangle1 80,80,80
proc SetColor a2
proc Triangle2 80,80,80
proc SetColor a3
proc Triangle3 80,80,80
proc SetColor a4
proc Triangle4 80,80,80
t1 = a1
t2 = a2
t3 = a3
t4 = a4
next
set image primary
set color 255,255,255

endproc
procedure SetupPieces4()
for a = 1 to 9
set image a
set color 255,255,255
draw line 0,0,160,160
draw line 2,0,162,160
draw line 0,2,158,160
draw line 0,160,160,0
draw line 2,160,162,0
draw line 0,158,158,0
next
set image primary
set color 255,255,255

endproc

procedure Shuffle()
cnt = 1
for a = 1 to 9
z[a] = a
next
s1 = 10 ; s2 = 10 ; s3 = 10 ; s4 = 10; s5 = 10 ; s6 = 10 ; s7 = 10 ; s8 = 10 ; s9 = 10
while cnt<800
a = rnd(9)+1
b = z[a]
c = rnd(9)+1
d = z[c]
if a <> c
z[a] = d
z[c] = b
endif
cnt = cnt + 1
wend

s11 = z[1]
s12 = z[2]
s13 = z[3]
s14 = z[4]
s15 = z[5]
s16 = z[6]
s17 = z[7]
s18 = z[8]
s19 = z[9]
endproc

procedure Setup()
rem Setup Variables and other things here.
gameover = 0
event = 1
endproc

procedure SetupSound()
endproc

procedure DrawBoard()
rem set color 0,10,30
rem cls
'draw image BackGround,0,0
set color 200,200,255
draw rect 200,100,501,499,1 ; draw rect 750,100,501,499,1

endproc

procedure MakeSquares()

set color 0,0,255
draw rect 200,100,168,167,0
draw rect 367,100,168,167,0
draw rect 534,100,168,167,0
draw rect 200,266,168,167,0
draw rect 367,266,168,167,0
draw rect 534,266,168,167,0
draw rect 200,432,168,167,0
draw rect 367,432,168,167,0
draw rect 534,432,168,167,0

draw rect 750,100,168,167,0
draw rect 917,100,168,167,0
draw rect 1084,100,168,167,0
draw rect 750,266,168,167,0
draw rect 917,266,168,167,0
draw rect 1084,266,168,167,0
draw rect 750,432,168,167,0
draw rect 917,432,168,167,0
draw rect 1084,432,168,167,0
set color 255,255,255
endproc

procedure Swap()
sq[1] = s1
sq[2] = s2
sq[3] = s3
sq[4] = s4
sq[5] = s5
sq[6] = s6
sq[7] = s7
sq[8] = s8
sq[9] = s9
sq[11] = s11
sq[12] = s12
sq[13] = s13
sq[14] = s14
sq[15] = s15
sq[16] = s16
sq[17] = s17
sq[18] = s18
sq[19] = s19
endproc

procedure DisplayPieces()
set color 255,255,255

draw image sq[1],204,104
draw image sq[2],371,104
draw image sq[3],538,104
draw image sq[4],204,269
draw image sq[5],371,269
draw image sq[6],538,269
draw image sq[7],204,436
draw image sq[8],371,436
draw image sq[9],538,436

draw image sq[11],754,104
draw image sq[12],921,104
draw image sq[13],1088,104
draw image sq[14],754,269
draw image sq[15],921,269
draw image sq[16],1088,269
draw image sq[17],754,436
draw image sq[18],921,436
draw image sq[19],1088,436

endproc

procedure PrintText()
set caret 10,50
write " MouseX = " ; wln str\$(mx)
write " MouseY = " ; wln str\$(my)
write " Zone = " ; wln str\$( square )
wln str\$(sq[1])
wln str\$(sq[2])
wln str\$(sq[3])
wln str\$(sq[4])
wln str\$(sq[5])
wln str\$(sq[6])
wln str\$(sq[7])
wln str\$(sq[8])
wln str\$(sq[9])
endproc

procedure CheckMouse()
a;b;c;x;y;x2;y2
' square = 1 to 9...  No square = 10
a = zone()
if a>0  and square = 10 and sq[a] < 10 then
square = sq[a]
sq[a] = 10
elseif a>0 and sq[a] = 10 then
sq[a] = square
square = 10
endif

mx= mousex()
my= mousey()

if mousebutton(0,1) then
play sound 0 ;
endif
endproc

procedure  EndGame()
a = 0
b = 0
if sq[1] = 1 and sq[2] = 2 and sq[3] = 3 and sq[4] = 4 and sq[5] = 5 and sq[6] = 6 and sq[7] = 7 and sq[8] = 8 and sq[9] = 9 then gameover = 1
if gameover = 1
event = 3
redraw
endif
endproc

procedure HowToPlay()
a = 1
create font 0, "arial", 24

set color 255,255,255
set caret 200,100
wln "  The object of this puzzle is : "
wln " to move all of the pieces from the Right Side Board to the Left Side Board."
wln " "
wln "  Each piece has 4 colors and when you place the piece on the left side board,  "
wln " each color should match the color of the piece that it touches. "
wln " "
wln " "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln " Hit any key to continue. "

wln
wln " http://rb23.yolasite.com "

redraw
wait keydown

endproc

procedure AfterGame()
play sound 2
'set color 0,0,0
'cls
create font 0, "arial", 48

set caret 300,40
set color 255,255,255
wln "PUZZLE SOLVED !"
create font 0, "arial", 16
set caret 20,300
wln "  "
wln "  "
wln "  My Web Sites: "
wln " http://rb23.yolasite.com "
wln " http://rb27.synthasite.com "
wln " http://scratch2.yolasite.com "
wln " http://rb26.synthasite.com "
wln " http://rb29.yolasite.com "
wln;wln
set caret 300,630
wln " Hit any key to play again "
event = 2
redraw
wait keydown

endproc

' left side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' right side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' high side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' low side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

procedure SetColor( a )
if a = 1 then   set color 0,255,0
if a = 2 then   set color 0,0,255
if a = 3 then   set color 255,0,0
if a = 4 then   set color 0,255,150
if a = 5 then   set color 200,0,100
if a = 6 then   set color 255,255,0
if a = 7 then   set color 100,0,100
if a = 8 then   set color 150,100,255
if a = 9 then   set color 0,0,120
if a = 10 then   set color 240,240,255
if a = 11 then   set color 20,30,40
if a = 12 then   set color 150,0,0
if a = 13 then   set color 0,150,0
if a = 14 then   set color 255,100,150
sqrcolor = a
endproc

#### Rick3137

• Sr. Member
• Posts: 347
• May the Force be with You
« Reply #6 on: May 06, 2017 »

This one has 16 squares to sort. It looked too hard at first, so I added a Peak button to hit when you get stuck.
Code: [Select]
visible:
size;
s1 = 1 ; s2 = 2 ; s3 = 3 ; s4 = 4; s5 = 5 ; s6 = 6 ; s7 = 7 ; s8 = 8 ; s9 = 9 ; s10 = 10 ; s11 = 11 ; s12 = 12 ; s13 = 13 ; s14 = 14 ; s15 = 15 ; s16 = 16
s101 = 100 ; s102 = 100 ; s103 = 100 ; s104 = 100; s105 = 100 ; s106 = 100 ; s107 = 100 ; s108 = 100 ; s109 = 100 ; s110 = 100
s111=100; s112 = 100 ; s113 = 100 ; s114 = 100 ; s115 = 100 ; s116 = 100
loop1 = 1
loop2 = 1
t1 = 0 ; t2 = 0 ; t3 = 0 ; t4 = 0

event = 0; count = 0 ; gamenumber = 0 ; xzone = 0
sqrcolor ; quadColor ; mx; my; square = 100; column; row; score;  number1; number2; enter
checksum; gameover = 0 ; sum ; BackGround
z[20]
sq[120]
Piece[20][4] ;        ' Holds 4 triangle colors per piece  (16 squares)
pc[20][10]

randomize time()
hidden:
set redraw off
procedure start()
ThisIsAPlaceHolder = 1
endproc
set window 0, 0, 1350, 700
proc HowToPlay
' move data to arrays
proc Swap
' Load array pc[16] [4] with random colors
proc SetupPieces1
' Create 16 images, draw 1 rectangle on each image, and then draw 4 triangles.
proc SetupPieces2
' draw 2 diagonal lines on each piece.
proc SetupPieces4

proc Shuffle
gameover = 0 ;  event = 1
proc Setup
' Load 3 sounds from file
proc SetupSound

proc SetupZones

do
set color 0,0,0
cls
set color 255,255,255
loop2 = 1
xzone = 0
do
wait 50
set color 0,0,0
cls
set color 255,255,255
proc CheckMouse
proc DrawBoard
proc MakeSquares
proc DisplayPieces
if xzone = 20
proc Peak
redraw
endif
proc EndGame
redraw

until loop2 = 0

proc AfterGame
proc Reset

until loop1 = 0
end
procedure Reset()
create font 0, "arial", 24
proc Swap

proc SetupPieces1
proc SetupPieces2
proc SetupPieces4

proc Shuffle

proc Setup
proc SetupSound
proc SetupZones
endproc

procedure SetupZones()

create zone 20, 10, 140, 150, 150
create zone 1 , 200, 100, 125, 125
create zone 2 , 325, 100, 125, 125
create zone 3 , 450, 100, 125, 125
create zone 4 , 575, 100, 125, 125

create zone 5 , 200, 225, 125, 125
create zone 6 , 325, 225, 125, 125
create zone 7 , 450, 225, 125, 125
create zone 8 , 575, 225, 125, 125

create zone 9 , 200, 350, 125, 125
create zone 10 , 325, 350, 125, 125
create zone 11 , 450, 350, 125, 125
create zone 12 , 575, 350, 125, 125

create zone 13 , 200, 475, 125, 125
create zone 14 , 325, 475, 125, 125
create zone 15 , 450, 475, 125, 125
create zone 16 , 575, 475, 125, 125

create zone 101 , 750, 100, 125, 125
create zone 102 , 875, 100, 125, 125
create zone 103 , 1000, 100, 125, 125
create zone 104 , 1125, 100, 125, 125

create zone 105 , 750, 225, 125, 125
create zone 106 , 875, 225, 125, 125
create zone 107 , 1000, 225, 125, 125
create zone 108 , 1125, 225, 125, 125

create zone 109 , 750, 350, 125, 125
create zone 110 , 875, 350, 125, 125
create zone 111 , 1000, 350, 125, 125
create zone 112 , 1125, 350, 125, 125

create zone 113 , 750, 475, 125, 125
create zone 114 , 875, 475, 125, 125
create zone 115 , 1000, 475, 125, 125
create zone 116 , 1125, 475, 125, 125

endproc

procedure SetupPieces1()
for a = 1 to 16
'   Paint all 16 pieces 4 random colors
pc[a][1] = rnd(14)+1
pc[a][2] = rnd(14)+1
pc[a][3] = rnd(14)+1
pc[a][4] = rnd(14)+1
next
for a = 1 to 15
' align horizontal colors
pc[a][2] = pc[a+1][1]
next
'  align vertical colors
for a = 1 to 12
pc[a][4] = pc[a+4][3]

next

endproc

procedure SetupPieces2()
for a = 1 to 16
create image a,117,117
next
set color 100,100,155
create image 100,117,117
set image 100
draw rect 2,2,117,117,1
set color 100,100,255
create image 20,120,100
set image 20
draw rect 0,0,120,100,1
set color 0,0,55
set caret 0,15
wln "       To "
wln "      Peak "
draw rect 2,2,116,96,0
draw rect 4,4,112,92,0

for a = 1 to 16
set image a
draw rect 2,2,117,117,1
next

for a = 1 to 16
set image a
a1 = pc[a][1]
a2 = pc[a][2]
a3 = pc[a][3]
a4 = pc[a][4]

proc SetColor a1
proc Triangle1 58,58,62
proc SetColor a2
proc Triangle2 58,58,62
proc SetColor a3
proc Triangle3 58,58,62
proc SetColor a4
proc Triangle4 58,58,62
t1 = a1
t2 = a2
t3 = a3
t4 = a4
next
set image primary
set color 255,255,255

endproc
procedure SetupPieces4()
for a = 1 to 16
set image a
set color 255,255,255
draw line 0,0,125,125
set color 150,150,255
draw line 2,0,125,123
draw line 0,2,125,127
set color 255,255,255
draw line 0,116,116,0
set color 150,150,255
draw line 0,114,114,-1
draw line 0,118,118,0
next
set image primary
set color 255,255,255

endproc

procedure Shuffle()
cnt = 1
while cnt<800
r1 = rnd(16)+1
r2 = rnd(16)+1
if r1 <> r2
a = sq[r1]
b = sq[r2]
sq[r1]=b
sq[r2]=a
endif
cnt = cnt + 1
wend

for a = 1 to 16
sq[a + 100] = sq[a]
next
for a = 1 to 16
sq[a] = 100
next
endproc

procedure Setup()
rem Setup Variables and other things here.
gameover = 0
event = 1
endproc

procedure SetupSound()
endproc

procedure DrawBoard()
rem Draws two rectangles for placing pieces on.
set color 0,0,255
draw rect 180,80,540,540,1 ; draw rect 730,80,540,540,1
set color 240,240,255
draw rect 200,100,500,500,1 ; draw rect 750,100,500,500,1

endproc

procedure MakeSquares()

set color 0,0,255
draw rect 200,100,125,125,0
draw rect 325,100,125,125,0
draw rect 450,100,125,125,0
draw rect 575,100,125,125,0

draw rect 200,225,125,125,0
draw rect 325,225,125,125,0
draw rect 450,225,125,125,0
draw rect 575,225,125,125,0

draw rect 200,350,125,125,0
draw rect 325,350,125,125,0
draw rect 450,350,125,125,0
draw rect 575,350,125,125,0

draw rect 200,475,125,125,0
draw rect 325,475,125,125,0
draw rect 450,475,125,125,0
draw rect 575,475,125,125,0

draw rect 750,100,125,125,0
draw rect 875,100,125,125,0
draw rect 1000,100,125,125,0
draw rect 1125,100,125,125,0

draw rect 750,225,125,125,0
draw rect 875,225,125,125,0
draw rect 1000,225,125,125,0
draw rect 1125,225,125,125,0

draw rect 750,350,125,125,0
draw rect 875,350,125,125,0
draw rect 1000,350,125,125,0
draw rect 1125,350,125,125,0

draw rect 750,475,125,125,0
draw rect 875,475,125,125,0
draw rect 1000,475,125,125,0
draw rect 1125,475,125,125,0

set color 255,255,255
endproc

procedure Swap()
' swaps data to arrays...  simulates data statements.
sq[1] = s1
sq[2] = s2
sq[3] = s3
sq[4] = s4
sq[5] = s5
sq[6] = s6
sq[7] = s7
sq[8] = s8
sq[9] = s9
sq[10] = s10
sq[11] = s11
sq[12] = s12
sq[13] = s13
sq[14] = s14
sq[15] = s15
sq[16] = s16

sq[101] = s101
sq[102] = s102
sq[103] = s103
sq[104] = s104
sq[105] = s105
sq[106] = s106
sq[107] = s107
sq[108] = s108
sq[109] = s109
sq[110] = s110
sq[111] = s111
sq[112] = s112
sq[113] = s113
sq[114] = s114
sq[115] = s115
sq[116] = s116

endproc

procedure Peak()
draw image 1,204,104
draw image 2,329,104
draw image 3,454,104
draw image 4,579,104

draw image 5,204,229
draw image 6,329,229
draw image 7,454,229
draw image 8,579,229

draw image 9,204,354
draw image 10,329,354
draw image 11,454,354
draw image 12,579,354

draw image 13,204,479
draw image 14,329,479
draw image 15,454,479
draw image 16,579,479
redraw
wait 3000

endproc

procedure DisplayPieces()
set color 255,255,255
' sq[1] is located at zone 1 and contains the sprite number for that square.
draw image 20,35,150

draw image sq[1],204,104
draw image sq[2],329,104
draw image sq[3],454,104
draw image sq[4],579,104

draw image sq[5],204,229
draw image sq[6],329,229
draw image sq[7],454,229
draw image sq[8],579,229

draw image sq[9],204,354
draw image sq[10],329,354
draw image sq[11],454,354
draw image sq[12],579,354

draw image sq[13],204,479
draw image sq[14],329,479
draw image sq[15],454,479
draw image sq[16],579,479

draw image sq[101],754,104
draw image sq[102],879,104
draw image sq[103],1004,104
draw image sq[104],1129,104

draw image sq[105],754,229
draw image sq[106],879,229
draw image sq[107],1004,229
draw image sq[108],1129,229

draw image sq[109],754,354
draw image sq[110],879,354
draw image sq[111],1004,354
draw image sq[112],1129,354

draw image sq[113],754,479
draw image sq[114],879,479
draw image sq[115],1004,479
draw image sq[116],1129,479

endproc

procedure PrintText()
set caret 10,50
write " MouseX = " ; wln str\$(mx)
write " MouseY = " ; wln str\$(my)
write " Zone = " ; wln str\$( square )
wln str\$(sq[1])
wln str\$(sq[2])
wln str\$(sq[3])
wln str\$(sq[4])
wln str\$(sq[5])
wln str\$(sq[6])
wln str\$(sq[7])
wln str\$(sq[8])
wln str\$(sq[9])
endproc

procedure CheckMouse()
a;b;c;x;y;x2;y2
' square = 1 to 16...  No square = 100
a = zone()
if a>0  and square = 100 and sq[a] < 100 and a <> 20 then
square = sq[a]
sq[a] = 100

elseif a>0 and sq[a] = 100 and a <> 20 then
sq[a] = square
square = 100

endif
xzone = a

mx= mousex()
my= mousey()

if mousebutton(0,1) then
play sound 0 ;

endif
endproc

procedure  EndGame()
a = 0
b = 0
if sq[1] = 1 and sq[2] = 2 and sq[3] = 3 and sq[4] = 4 and sq[5] = 5 and sq[6] = 6 and sq[7] = 7 and sq[8] = 8 and sq[9] = 9 then a = 1
if sq[10] = 10 and sq[11] = 11 and sq[12] = 12 and sq[13] = 13 and sq[14] = 14 and sq[15] = 15 and sq[16] = 16 and a = 1 then gameover = 1

if gameover = 1
loop2 = 0
redraw
endif
endproc

procedure HowToPlay()
a = 1
create font 0, "arial", 24

set color 255,255,255
set caret 200,100
wln "  The object of this puzzle is : "
wln " to move all of the pieces from the Right Side Board to the Left Side Board."
wln " "
wln "  Each piece has 4 colors and when you place the piece on the left side board,  "
wln " each color should match the color of the piece that it touches. "
wln " "
wln " "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln "  "
wln " Hit any key to continue. "

wln
wln " http://rb23.yolasite.com "

redraw
wait keydown

endproc

procedure AfterGame()
play sound 2
'set color 0,0,0
'cls
create font 0, "arial", 48

set caret 300,40
set color 255,255,255
wln "PUZZLE SOLVED !"
create font 0, "arial", 16
set caret 20,300
wln "  "
wln "  "
wln "  My Web Sites: "
wln " http://rb23.yolasite.com "
wln " http://rb27.synthasite.com "
wln " http://scratch2.yolasite.com "
wln " http://rb26.synthasite.com "
wln " http://rb29.yolasite.com "
wln;wln
set caret 300,630
wln " Hit any key to play again "
loop2=0

redraw
wait keydown
set color 0,0,0
cls
redraw

endproc

' left side    x1,y1 is center of square     radius is distance from center of square to side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' right side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' high side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

' low side
p1[6]
p1[0] = x1
p1[1] = y1

draw poly p1, true
endproc

procedure SetColor( a )
if a = 1 then   set color 0,255,0
if a = 2 then   set color 0,0,255
if a = 3 then   set color 255,0,0
if a = 4 then   set color 0,255,150
if a = 5 then   set color 200,0,100
if a = 6 then   set color 255,255,0
if a = 7 then   set color 100,0,100
if a = 8 then   set color 150,100,255
if a = 9 then   set color 0,0,120
if a = 10 then   set color 240,240,255
if a = 11 then   set color 20,30,40
if a = 12 then   set color 150,0,0
if a = 13 then   set color 0,150,0
if a = 14 then   set color 255,100,150
sqrcolor = a