Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Just for the fun of it: Binary Clock
#1
Code:
option explicit

   declare sub DrawClock()
   declare sub ShakeDots()
   declare sub SetValues()
  
   const ScreenWidth = 800
   const ScreenHeight = 600
   const Columns = 9
   const Rows = 5
   const X = 0
   const Y = 1
   const X_Offset = 2
   const Y_Offset = 3
   const Visible = 4
  
   const bcFALSE = 0
   const bcTRUE  = NOT(bcFalse)
  
   const ShowTime = bcFALSE
   'const ShowTime = bcTRUE
  
   'Less than 255, the lower the darker
   const OffLevel = 55
  
   'Simulates a weak power supply, the higher the more the LEDs
   'fade out
   const FadeAmount = .005
  
   'The amount of rest between shakes
   const CyclePause = 10

   'The random color offset value 255 or less
   const RColor = 150
   Randomize Timer
  
   dim i as integer
   dim j as integer
   dim k as single
   dim l as single
      
   dim shared DC (Columns, Rows, 5) as single
   dim shared Radius as single
   dim shared XRandFactor as single
   dim shared YRandFactor as single
  
   k = ScreenWidth / (Columns + 1)
   l = ScreenHeight / (Rows + 1)
  
   'Play with this to make the dots bigger or smaller
   Radius = k/3
  
   'How far out of the orbit the LED's will shake
   XRandFactor = Radius / 5
   YRandFactor = Radius / 5
  
  
   'Set-up the grid
   for i = 0 to Columns
      for j = 0 to Rows
         DC (i,j,X) = k * (i + 0.5)
         DC (i,j,Y) = l * (j + 0.5)
         DC (i,j,X_Offset) = 0
         DC (i,j,Y_Offset) = 0
         DC (i,j,Visible) = 0
      next j
   next i
  
  
   'if you change this, change the screenwidth and screenheight const above
   '800x600 32bit color, 2 pages, full screen
   screen 19, 32, 2, 1
  
  
   color rgb(255,255,255),rgb(0,0,0)
  
   'Work on Screen 1, display screen 0
   SCREENSET 1, 0

   'It will keep going till you say otherwise
   do while inkey$=""
      cls
      ShakeDots
      SetValues
      DrawClock
      screencopy
      sleep CyclePause
   loop
   end
  
sub SetValues()
   static tTime as string
   static h as integer
   static m as integer
   static s as integer
      
   dim i as integer
   dim j as integer

   if ShowTime = bcTRUE then
      locate 1,1
      ? time$  'h;":";m;":";s you could play with these to make your own output
   end if  

   if tTime = time$ then
      'just fade them a bit
      for i = 0 to columns
         for j = 0 to rows
            if DC (i,j,Visible) <> 0 then DC (i,j,Visible) -= FadeAmount
         next j
      next i
   else
      dim h1 as integer
      dim m1 as integer
      dim s1 as integer
      
      dim s2 as integer
      dim m2 as integer
      dim h2 as integer
  
      dim fColon as integer
      dim sColon as integer
      dim Length as integer
  
      dim bS as string
      dim bS1 as string
  
      dim bM as string
      dim bM1 as string
  
      dim bH as string
      dim bH1 as string  
      
      tTime = time$
      
      Length = len(tTime)
      fColon = instr(1,tTime,":")
      sColon = instr(fColon+1,tTime,":")
  
      h = int(val(left$(tTime,fColon - 1)))
      m = int(val(mid$(tTime,fColon+1,sColon-fColon-1)))
      s = int(val(right$(tTime,Length-sColon)))
      if h > 12 then h -= 12
      
      h1 = int(h\10)
      m1 = int(m\10)
      s1 = int(s\10)
      h2 = h mod 10
      m2 = m mod 10
      s2 = s mod 10
  
      bS = right$(String$(4,"0") + bin$(s2),4)
      bS1 = right$(String$(4,"0") + bin$(s1),4)

      bM = right$(String$(4,"0") + bin$(m2),4)
      bM1 = right$(String$(4,"0") + bin$(m1),4)

      bH = right$(String$(4,"0") + bin$(h2),4)
      bH1 = right$(String$(4,"0") + bin$(h1),4)
      
      for i = 1 to 4
         if mid$(Bs,i,1) = "1" then dc(8,i,Visible) = 10 else dc(8,i,Visible) = -1
         if mid$(Bs1,i,1) = "1" then dc(7,i,Visible) = 10 else dc(7,i,Visible) = -1
        
         if mid$(Bm,i,1) = "1" then dc(5,i,Visible) = 10 else dc(5,i,Visible) = -1
         if mid$(Bm1,i,1) = "1" then dc(4,i,Visible) = 10 else dc(4,i,Visible) = -1
        
         if mid$(Bh,i,1) = "1" then dc(2,i,Visible) = 10 else dc(2,i,Visible) = -1
         if mid$(Bh1,i,1) = "1" then dc(1,i,Visible) = 10 else dc(1,i,Visible) = -1
      next i
   end if
end sub

sub ShakeDots()
   dim i as integer
   dim j as integer
      for i = 0 to Columns
         for j = 0 to Rows
            if dc(i,j,Visible) then
               dc(i,j,x_offset) = ((-1)^int(rnd + .5) + 1) * rnd*XRandFactor
               dc(i,j,y_offset) = ((-1)^int(rnd + .5) + 1) * rnd*YRandFactor
            end if
         next j
      next i
end sub

sub DrawClock()
   dim i as integer
   dim j as integer
      for i = 1 to 2
         for j = 1 to Rows-1
            if dc(i,j,visible) > 0 then
               circle (dc(i,j,x)+ dc(i,j,x_offset),dc(i,j,y) + dc(i,j,y_offset)),radius, rgb(255 / (11-dc(i,j,visible)),int(rnd*RColor) / (11-dc(i,j,visible)),0),,,,F
            else
               circle (dc(i,j,x),dc(i,j,y)),radius, rgb(OffLevel,0,0),,,,F
            end if
         next j
      next i
      for i = 4 to 5
         for j = 1 to Rows-1
            if dc(i,j,visible) > 0 then
               circle (dc(i,j,x)+ dc(i,j,x_offset),dc(i,j,y) + dc(i,j,y_offset)),radius, rgb(0,255 / (11-dc(i,j,visible)),int(rnd*RColor)/ (11-dc(i,j,visible))),,,,F
            else
               circle (dc(i,j,x),dc(i,j,y)),radius, rgb(0,OffLevel,0),,,,F
            end if
         next j
      next i
      for i = 7 to 8
         for j = 1 to Rows-1
            if dc(i,j,visible) > 0 then
               circle (dc(i,j,x)+ dc(i,j,x_offset),dc(i,j,y) + dc(i,j,y_offset)),radius, rgb(int(rnd*RColor)/ (11-dc(i,j,visible)),0,255 / (11-dc(i,j,visible))),,,,F
            else
               circle (dc(i,j,x),dc(i,j,y)),radius, rgb(0,0,OffLevel),,,,F
            end if
         next j
      next i      
end sub

Man, I need to get a hobby :bounce:
Reply
#2
Heh, I had to build one of these for an electronics class long ago.Very cool.
his sig left intentionally blank
Reply
#3
As an undergrad in physics we had to as well.... it wasn't pretty, but it worked. This took a lot less time...lol
Reply
#4
Very cool indeed. Now, how do you read the darn thing? :o
Reply
#5
Each Column, from bottom to top.


8
4
2
1

So if a dot is lit up just add its place value to that column. Think Geek carries them (and has an image there to show you how to read them) and I am rather fond of them... although my wife hates them. :lol:
Reply
#6
Smile Very nice, thu I had alot of probs with...

Expexting "=" Found "-"

I remember line 109, but I can't remember the other.. its were you have: "-=".. :???: .. I just moved "-" to the other side, wether it worked or not, can't read the clock to tell... I'll have to check the site, heh.. :wink:
Kevin (x.t.r.GRAPHICS)

[Image: 11895-r.png]
Reply
#7
I had the same problem, changed 'x -= y' to 'x = x - y' and it works. Which version of FB are you using keeling?
Reply
#8
I am using the newest one... 0.12b I believe

It works fine for me.

Sorry about that.
Reply
#9
Oops, I thought I was using 0.12b but after further investigation I found I was still using 0.11b. Sorry.
Reply
#10
I have that clock from think geek ^-^ It's next to my bed.
[Image: sig.php]
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)