checker grid pattern

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

checker grid pattern

Post by BasicCoder2 »

Numeral keys [1] and [2] will change the size of the squares.
Numeral keys [3] and [4] will change the number of squares.
The checker pattern can be moved by holding down the left mouse button.
I probably should have written this as a checker pattern object.

Code: Select all

screenres 800,600,32
color rgb(0,0,0),rgb(255,255,255):cls
dim as integer mx,my,ox,oy,mb,xd,yd

type CheckerPattern
  as integer x
  as integer y
  as integer w  'in squares
  as integer h  'in squares
  as integer s  'size of square
  as ulong   c1 'alternate colors
  as ulong   c2
end type

dim shared as CheckerPattern cp1
cp1.x = 10
cp1.y = 10
cp1.w = 8    'in squares not pixels
cp1.h = 8
cp1.c1 = rgb(100,50,0)
cp1.c2 = rgb(200,100,0)
cp1.s  = 40


sub drawCheckerPattern(cp as CheckerPattern)
  dim as integer counter,s,px,py
  s = cp.s
  px = cp.x
  py = cp.y
  for j as integer = 0 to cp.h-1
    for i as integer = 0 to cp.w-1
      if counter mod 2 = 0 then
        line (i*s+px,j*s+py)-(i*s+s+px,j*s+s+py),cp.c1,bf
      else
        line (i*s+px,j*s+py)-(i*s+s+px,j*s+s+py),cp.c2,bf
      end if
      counter = counter + 1
    next i
    if cp.w mod 2 = 0 then counter = counter + 1
  next j
end sub

sub update()
  screenlock
  cls
  drawCheckerPattern(cp1)
  screenunlock
end sub

dim as string key

do
  update()
  getmouse mx,my,,mb
  if mb = 1 then
    if mx>cp1.x and mx<cp1.x+cp1.w*cp1.s and my>cp1.y and my<cp1.y+cp1.h*cp1.s then 'over grid
      ox = mx
      oy = my
      update()
      while mb = 1
        getmouse mx,my,,mb
        if mx<>ox or my<>oy then 'mouse has moved
          xd = mx-ox
          yd = my-oy
          cp1.x = cp1.x + xd     'add movement to checkerPattern position
          cp1.y = cp1.y + yd
          ox = mx                'save new position
          oy = my
          update()
        end if
        sleep 2  'put in loop
      wend
    end if
  end if
  key = inkey
  while inkey<>"":wend
  if key="1" then cp1.s = cp1.s - 1
  if key="2" then cp1.s = cp1.s + 1
  if cp1.s < 1 then cp1.s = 1
  if key="3" then
    cp1.w = cp1.w + 1
    cp1.h = cp1.h + 1
  end if
  if key="4" then
    cp1.w = cp1.w - 1
    if cp1.w < 1 then cp1.w = 1
    cp1.h = cp1.w
  end if
  
  sleep 2
loop until multikey(&H01)

sleep
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: checker grid pattern OO version

Post by BasicCoder2 »

Here is my first attempt to create an OOP version.
I had to make my variables public for it to work and will remedy that later.
Will add the ability to change square sizes and dimensions later.
You can move the checker pattern around with left mouse button down.

Code: Select all

screenres 800,600,32
color rgb(0,0,0),rgb(255,255,255):cls
dim as integer mx,my,ox,oy,mb,xd,yd

type CheckerPattern
  Public:
  as integer x
  as integer y
  as integer w  'width in squares not pixels
  as integer h
  as integer s  'size of squares
  as ulong   c1 'border color
  as ulong   c2 'fill color
  Public:
  declare sub drawCheckerPattern()
  Declare Constructor()
  Declare Constructor(x As Integer, y As Integer, w As Integer,_ 
                        h As Integer, s as integer, c1 As ulong, c2 As ulong)
end type

sub CheckerPattern.drawCheckerPattern()
  dim as integer counter,s,px,py
  s = this.s
  px = this.x
  py = this.y
  for j as integer = 0 to this.h-1
    for i as integer = 0 to this.w-1
      if counter mod 2 = 0 then
        line (i*s+px,j*s+py)-(i*s+s+px,j*s+s+py),this.c1,bf
      else
        line (i*s+px,j*s+py)-(i*s+s+px,j*s+s+py),this.c2,bf
      end if
      counter = counter + 1
    next i
    if this.w mod 2 = 0 then counter = counter + 1
  next j
end sub

Constructor CheckerPattern
    this.x = 30
    this.y = 30
    this.w = 10
    this.h = 10
    this.c2 = rgb(200,200,255)
    this.c1 = rgb(0,0,0)
End Constructor


Constructor CheckerPattern (xx As Integer, yy As Integer, ww As Integer,_ 
                        hh As Integer, ss as integer, oc As ulong, fc As ulong)
    this.x = xx
    this.y = yy
    this.w = ww
    this.h = hh
    this.s = ss
    this.c1 = oc
    this.c2 = fc
End Constructor

dim as string key

Dim shared chkPat1 As CheckerPattern = CheckerPattern(20, 20, 10, 10,40, rgb(100,200,100), rgb(200,100,20))

sub update()
  screenlock
  cls
  chkPat1.DrawCheckerPattern
  screenunlock
end sub


do
  update()
  '===========================================
  getmouse mx,my,,mb
  if mb = 1 then
    if mx>chkPat1.x and mx<chkPat1.x+chkPat1.w*chkPat1.s and my>chkPat1.y and my<chkPat1.y+chkPat1.h*chkPat1.s then 'over grid
      ox = mx
      oy = my
      update()
      while mb = 1
        getmouse mx,my,,mb
        if mx<>ox or my<>oy then 'mouse has moved
          xd = mx-ox
          yd = my-oy
          chkPat1.x = chkPat1.x + xd     'add movement to checkerPattern position
          chkPat1.y = chkPat1.y + yd
          ox = mx                'save new position
          oy = my
          update()
        end if
        sleep 2  'put in loop
      wend
    end if
  end if  
  '===========================================
  sleep 2
loop until multikey(&H01)
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: checker grid pattern

Post by sancho3 »

I tried the oop version.
The movement is smooth. It looks good.
How about moving the update function into the object?
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: checker grid pattern

Post by BasicCoder2 »

sancho3 wrote:How about moving the update function into the object?
Well I haven't really written OO programs before and it never occurred to me.
Here I have added another checker patterned rectangle to move about.

Code: Select all

screenres 800,600,32
color rgb(0,0,0),rgb(255,255,255):cls
dim shared as integer mx,my,ox,oy,mb,xd,yd

type CheckerPattern
  Public:
  as integer x
  as integer y
  as integer w  'width in squares not pixels
  as integer h
  as integer s  'size of squares
  as ulong   c1 'border color
  as ulong   c2 'fill color
  Public:
  declare sub drawCheckerPattern()
  Declare Constructor()
  Declare Constructor(x As Integer, y As Integer, w As Integer,_ 
                        h As Integer, s as integer, c1 As ulong, c2 As ulong)
end type

sub CheckerPattern.drawCheckerPattern()
  dim as integer counter,s,px,py
  s = this.s
  px = this.x
  py = this.y
  for j as integer = 0 to this.h-1
    for i as integer = 0 to this.w-1
      if counter mod 2 = 0 then
        line (i*s+px,j*s+py)-(i*s+s+px,j*s+s+py),this.c1,bf
      else
        line (i*s+px,j*s+py)-(i*s+s+px,j*s+s+py),this.c2,bf
      end if
      counter = counter + 1
    next i
    if this.w mod 2 = 0 then counter = counter + 1
  next j
end sub

Constructor CheckerPattern
    this.x = 30
    this.y = 30
    this.w = 10
    this.h = 10
    this.c2 = rgb(200,200,255)
    this.c1 = rgb(0,0,0)
End Constructor


Constructor CheckerPattern (xx As Integer, yy As Integer, ww As Integer,_ 
                        hh As Integer, ss as integer, oc As ulong, fc As ulong)
    this.x = xx
    this.y = yy
    this.w = ww
    this.h = hh
    this.s = ss
    this.c1 = oc
    this.c2 = fc
End Constructor

Dim shared chkPat1 As CheckerPattern = CheckerPattern(20, 20, 10, 10,10, rgb(100,200,100), rgb(200,100,20))
dim shared chkPat2 as CheckerPattern = CheckerPattern(100,100,5,5,30,rgb(255,100,0),rgb(200,200,10))

sub update()
  screenlock
  cls
  chkPat1.DrawCheckerPattern
  chkPat2.DrawCheckerPattern
  screenunlock
end sub

sub movePattern(chk as CheckerPattern)
      ox = mx
      oy = my
      update()
      while mb = 1
        getmouse mx,my,,mb
        if mx<>ox or my<>oy then 'mouse has moved
          xd = mx-ox
          yd = my-oy
          chk.x = chk.x + xd     'add movement to checkerPattern position
          chk.y = chk.y + yd
          ox = mx                'save new position
          oy = my
          update()
        end if
        sleep 2  'put in loop
      wend
end sub
  
do
  update()
  '===========================================
  getmouse mx,my,,mb
  if mb = 1 then
    
    if mx>chkPat1.x and mx<chkPat1.x+chkPat1.w*chkPat1.s and my>chkPat1.y and my<chkPat1.y+chkPat1.h*chkPat1.s then
      movePattern(chkPat1)
    elseif mx>chkPat2.x and mx<chkPat2.x+chkPat2.w*chkPat2.s and my>chkPat2.y and my<chkPat2.y+chkPat2.h*chkPat2.s then
      movePattern(chkPat2)
    end if
    
  end if  
  '===========================================
  sleep 2
loop until multikey(&H01)
Post Reply