Recent Posts

Pages: 1 ... 8 9 [10]
91
Code snippets / Re: Line/circle collision
« Last post by Marcus on May 05, 2017 »
It might take me awhile to figure out what you just did, but it works good.

Not too complicated :)  I calculate the minimum distance between a circle's center and a line, and if the distance is less than the radius of the circle I move the circle out to the desired distance. It doesn't care where the circle or the line "came" from (movement or rotation) but only looks at the current positions. I'm actually surprised it works :D
92
Code snippets / Re: Line/circle collision
« Last post by Rick3137 on May 05, 2017 »
   Wow!

 It might take me awhile to figure out what you just did, but it works good.
93
Code snippets / Line/circle collision
« Last post by Marcus on May 05, 2017 »
Experimented some with collision handling between a user controlled circle and some static and rotating lines. Was just making a test of how to handle some things in a 3D game. Usually I handle collisions WHILE moving an object, but here I do tests AFTER moving by "pushing" the circle away if there's an intersection.


Code: [Select]
import "Keycodes.lib"
import "Math.lib"

lines#[4][4]
lines[1][0] = 100.0
lines[1][1] = 100.0
lines[1][2] = 500.0
lines[1][3] = 300.0
lines[2][0] = 100.0
lines[2][1] = 100.0
lines[2][2] = 132.0
lines[2][3] = 400.0


circleX# = 100.0
circleY# = 200.0
circleR# = 32.0

set redraw off

lineA# = 0.0
do
dx# = 0.0
dy# = 0.0
if keydown(VK_LEFT) then dx# = dx# - 4.0
if keydown(VK_RIGHT) then dx# = dx# + 4.0
if keydown(VK_UP) then dy# = dy# - 4.0
if keydown(VK_DOWN) then dy# = dy# + 4.0
circleX = circleX + dx
circleY = circleY + dy

lineA = lineA + 1.0
lines[0][0] = 360.0 - cos(lineA)*160.0
lines[0][1] = 240.0 - sin(lineA)*160.0
lines[0][2] = 360.0 + cos(lineA)*160.0
lines[0][3] = 240.0 + sin(lineA)*160.0

lines[3][0] = 400.0 - cos(lineA*0.5)*100.0
lines[3][1] = 300.0 - sin(lineA*0.5)*100.0
lines[3][2] = 400.0 + cos(lineA*0.5)*100.0
lines[3][3] = 300.0 + sin(lineA*0.5)*100.0


' draw.
set color 0, 0, 0
cls

set color 255, 255, 255
for i = 0 to sizeof(lines, 0) - 1
draw line int(lines[i][0]), int(lines[i][1]), int(lines[i][2]), int(lines[i][3])
dx# = lines[i][2] - lines[i][0]
dy# = lines[i][3] - lines[i][1]
next

steps = 0
do
collision = false
for i = 0 to sizeof(lines, 0) - 1
if CLInt(circleX, circleY, circleR, lines[i][0], lines[i][1], lines[i][2], lines[i][3])
collision = true
endif
next
steps = steps + 1
until collision = false or steps = 4

set color 255, 255, 0
draw pixel int(circleX), int(circleY)
for i = 0 to 12
a1# = float(i)*360.0/12.0
a2# = float(i + 1)*360.0/12.0
x1 = int(circleX + cos(a1)*circleR)
y1 = int(circleY + sin(a1)*circleR)
x2 = int(circleX + cos(a2)*circleR)
y2 = int(circleY + sin(a2)*circleR)
draw line x1, y1, x2, y2
next

redraw
wait 16
until keydown(27, true)

function CLInt(&cx#, &cy#, cr#, lx1#, ly1#, lx2#, ly2#)
c#[] = [cx - lx1, cy - ly1]
l#[] = [lx2 - lx1, ly2 - ly1]
lineLen# = V_Size(l)
param#
' p is the clost point ON the line to c.
p#[] = V_ProjectGet2(c, l, param)

' is the projection on the line?
if param >= 0.0 and param <= lineLen
dv#[] = V_SubGet(c, p)
if V_Size(dv) < cr
' dv is actually the normal of the line in the correct direction.
' so we can get the corrected position.
_V_Normalize dv
cx = lx1 + p[0] + dv[0]*cr
cy = ly1 + p[1] + dv[1]*cr
return true
else
return false
endif
' check closest distance to vertices.
else
' closest to first vertex?
if param < 0.0
ed# = DistanceF(cx, cy, lx1, ly1)
if ed < cr
' push out.
dv#[] = [cx - lx1, cy - ly1]
_V_Normalize dv
cx# = lx1 + dv[0]*cr
cy# = ly1 + dv[1]*cr
return true
else
return false
endif
' cosest to second vertex.
else
ed# = DistanceF(cx, cy, lx2, ly2)
if ed < cr
dv#[] = [cx - lx2, cy - ly2]
_V_Normalize dv
cx# = lx2 + dv[0]*cr
cy# = ly2 + dv[1]*cr
return true
else
return false
endif
endif
return false
endif

endfunc

function V_ProjectGet2#[](&u#[], &v#[], &p#)
n#[] = V_NormalizeGet(v)
s# = V_Dot(u, n)
p = s
return [n[0]*s, n[1]*s]
endfunc
94
Showcase / Re: TriQuadV3
« Last post by Rick3137 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


95
Showcase / Re: TriQuad (logic puzzle)
« Last post by Mr Nutz 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.

96
Showcase / Re: TriQuadV2
« Last post by Rick3137 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


97
Showcase / Re: TriQuad (logic puzzle)
« Last post by Rick3137 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  ::)
98
Showcase / Re: TriQuad (logic puzzle)
« Last post by B+ 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.
99
Showcase / Re: Treasure Hunt 3D Version2
« Last post by Rick3137 on March 19, 2017 »
   I forgot one little detail when I posted this game.
   I added a map to the maze.
   Hit enter key to see the map, and then hit space bar to return.

   The game is too hard, if you don't use the map. I was wondering why there were no comments.
   Maybe I should use smaller maps, with, several levels?
100
Showcase / TriQuad (logic puzzle)
« Last post by Rick3137 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.
Pages: 1 ... 8 9 [10]