Author Topic: TriQuad (logic puzzle)  (Read 411 times)

Rick3137

  • Sr. Member
  • ****
  • Posts: 337
  • May the Force be with You
    • View Profile
    • Rick's Programs
TriQuad (logic puzzle)
« on: March 18, 2017 »

                                                                            The game of TriQuad.




                     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
    • View Profile
Re: TriQuad (logic puzzle)
« 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: 337
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: TriQuad (logic puzzle)
« Reply #2 on: March 20, 2017 »
  Thank You :D

  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: 337
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: TriQuadV2
« 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()
     load sound 0,"data\beep2.wav"
     load sound 1,"data\beep3.wav"
     load sound 2,"data\beep6.wav"
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


procedure Triangle1(x1,y1,radius)
      ' left side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 - radius
  p1[3] = y1 - radius

  p1[4] = x1 - radius 
  p1[5] = y1 + radius
draw poly p1, true
endproc

procedure Triangle2(x1,y1,radius)
        ' right side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 + radius
  p1[3] = y1 + radius

  p1[4] = x1 + radius 
  p1[5] = y1 - radius 
draw poly p1, true
endproc

procedure Triangle3(x1,y1,radius)
        ' high side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 + radius
  p1[3] = y1 - radius

  p1[4] = x1 - radius 
  p1[5] = y1 - radius 
draw poly p1, true
endproc

procedure Triangle4(x1,y1,radius)
        ' low side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 - radius
  p1[3] = y1 + radius

  p1[4] = x1 + radius 
  p1[5] = y1 + radius 
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
     quadColor = a
endproc



Mr Nutz

  • Newbie
  • *
  • Posts: 10
    • View Profile
Re: TriQuad (logic puzzle)
« 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: 337
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: TriQuadV3
« 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()
     load sound 0,"data\beep2.wav"
     load sound 1,"data\beep3.wav"
     load sound 2,"data\beep6.wav"
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


procedure Triangle1(x1,y1,radius)
      ' left side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 - radius
  p1[3] = y1 - radius

  p1[4] = x1 - radius 
  p1[5] = y1 + radius
draw poly p1, true
endproc

procedure Triangle2(x1,y1,radius)
        ' right side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 + radius
  p1[3] = y1 + radius

  p1[4] = x1 + radius 
  p1[5] = y1 - radius 
draw poly p1, true
endproc

procedure Triangle3(x1,y1,radius)
        ' high side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 + radius
  p1[3] = y1 - radius

  p1[4] = x1 - radius 
  p1[5] = y1 - radius 
draw poly p1, true
endproc

procedure Triangle4(x1,y1,radius)
        ' low side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 - radius
  p1[3] = y1 + radius

  p1[4] = x1 + radius 
  p1[5] = y1 + radius 
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
     quadColor = a
endproc



Rick3137

  • Sr. Member
  • ****
  • Posts: 337
  • May the Force be with You
    • View Profile
    • Rick's Programs
Re: TriQuadV4
« 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 "  Click Here "
      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()
     load sound 0,"data\beep2.wav"
     load sound 1,"data\beep3.wav"
     load sound 2,"data\beep6.wav"
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


procedure Triangle1(x1,y1,radius)
      ' 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
  p1[2] = x1 - radius
  p1[3] = y1 - radius

  p1[4] = x1 - radius 
  p1[5] = y1 + radius
draw poly p1, true
endproc

procedure Triangle2(x1,y1,radius)
        ' right side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 + radius
  p1[3] = y1 + radius

  p1[4] = x1 + radius 
  p1[5] = y1 - radius 
draw poly p1, true
endproc

procedure Triangle3(x1,y1,radius)
        ' high side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 + radius
  p1[3] = y1 - radius

  p1[4] = x1 - radius 
  p1[5] = y1 - radius 
draw poly p1, true
endproc

procedure Triangle4(x1,y1,radius)
        ' low side
p1[6]
  p1[0] = x1
  p1[1] = y1
  p1[2] = x1 - radius
  p1[3] = y1 + radius

  p1[4] = x1 + radius 
  p1[5] = y1 + radius 
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
     quadColor = a
endproc



« Last Edit: May 07, 2017 by Rick3137 »