Board Logo
« Binary clock »

Welcome Guest. Please Login or Register.
Nov 20th, 2017, 6:50pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Binary clock  (Read 161 times)
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3614
xx Binary clock
« Thread started on: Oct 17th, 2017, 3:05pm »

Inspired by that awesome guy who reverse-engineered Seiko UC-2000.
He figured it out and managed to do some programming (Tetris etc)
Last video on a page shows "custom watch faces", among them binary clock.
Code:
'binary clock
'tsh73 Oct 2017

nomainwin

open "Binary c10ck" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "fill black; flush"
#gr "color lightgray"
#gr "color white"
size=20   'cell size
hOff=30
mOff=130
sOff=230

timer 1000, [tick]
[tick]

t$=time$()
'print t$
h=val(word$(t$,1,":"))
m=val(word$(t$,2,":"))
s=val(word$(t$,3,":"))
'print h, m, s
'print bin$(h),  bin$(m),  bin$(s)

offset = hOff
v=h
gosub [drawItem]

offset = mOff
v=m
gosub [drawItem]

offset = sOff
v=s
gosub [drawItem]

wait

[drawItem]
v$=bin$(v)

for j = 0 to 1
    for i = 0 to 3
        ind=4*j+i+1 'from 1!
        x=offset +2*j*size
        y=70 + i*2*size
        if mid$(v$, ind, 1) ="1" then
            #gr "backcolor green"
        else
            #gr "backcolor darkgray"
        end if
        #gr "place "; x;" ";y
        #gr "boxfilled "; x+size;" ";y+size
    next
next

#gr "backcolor black"
#gr "color white"
#gr "place "; offset+25 ;" ";250
#gr "\";v;"   ";
return

[quit]
    timer 0
    close #gr

function bin$(n)    'to 8 bit
    bin$=""
    for i = 1 to 8
        bin$=n mod 2; bin$
        n=int(n/2)
    next
end function
 
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1213
xx Re: Binary clock
« Reply #1 on: Oct 17th, 2017, 8:03pm »

NOT Binary

NOT Analog

NOT Digital

??????????

But also inspired by tsh73 page link...

Code:
' Telling the time.txt for JB (B+=MGA) 2017-10-17

global xmax, ymax  'these two you can easily reset to your needs
'set these to screen width = xmax, screen height = ymax, that you want

xmax = 1100 : ymax = 700  '<<<<<< set this as you need or from plug-in notes

global cellW, cellH
cellW = 14 'pixels wide for characters
cellH = 28 'pixels high for characters
global maxRow, maxCol

'and then these are calclated from above globals
maxCol = int(xmax / cellW)  'these control printing characters
maxRow = int(ymax / cellH)

global lastC, lastR 'for loc8 (locate), pl (print a line), lp (locate and print)
lastC = 1 : lastR = 1
'key events update globals with latest info
global inkee$

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (DisplayWidth-WindowWidth) / 2
UpperLeftY = (DisplayHeight-WindowHeight) / 2

'graphicbox #gr, 2, 2, xmax-2, ymax-2
open "Telling Time" for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "setfocus"
#gr "when characterInput charIn"
#gr "font dejavu_sans_mono ";cellW;" ";cellH
#gr "down"

'=================================================== plug-in main modules here

timer 1000, [tick]
[tick]
scan
call clear 30, 0, 20
call hue 25, 25, 26
call fbox xmax/2 - 400, ymax/2 - 270, xmax/2 + 400, ymax/2 + 270
call hue 80, 80, 75
call fbox xmax/2 - 375, ymax/2 - 235, xmax/2 + 390, ymax/2 + 235
call hue 30, 10, 0
call fbox xmax/2 - 350, ymax/2 - 200, xmax/2 + 380, ymax/2 + 200
call fore 180, 60, 0

t$ = "8:00:0"
t$ = "12:02:00"
t$=time$()
h=val(word$(t$,1,":"))
m=val(word$(t$,2,":"))
s=val(word$(t$,3,":"))

if h > 11 then h = h - 12 : ampm$ = "PM" else ampm$ = "AM"
if h = 0 then h = 12

cellW = 42 : cellH = 84
maxCol = int(xmax / cellW)
#gr "font dejavu_sans_mono ";cellW;" ";cellH
call cp 3, n2w$(h)
call lp 13.5, 5, ampm$

cellW = 24 : cellH = 48
maxCol = int(xmax / cellW)
#gr "font dejavu_sans_mono ";cellW;" ";cellH
m=val(word$(t$,2,":"))
if m = 0 then
    call cp 6.8, "O' Clock"
else
    if m < 10 then
        's$ = "Oh "+ n2w$(m)  EDIT: I am obviously not using s$, comment out a debugging line
        call cp 6.8, "Oh "+ n2w$(m)
    else
        call cp 6.8, n2w$(m)
    end if
end if

cellW = 14 : cellH = 28
maxCol = int(xmax / cellW)
#gr "font dejavu_sans_mono ";cellW;" ";cellH
s=val(word$(t$,3,":"))
call cp 18, "and ";n2w$(s);" seconds"
wait ''

function n2w$(n)
  if n < 20 then
    select case n
    case 0 : t$ = "Zero"
    case 1 : t$ = "One"
    case 2 : t$ = "Two"
    case 3 : t$ = "Three"
    case 4 : t$ = "Four"
    case 5 : t$ = "Five"
    case 6 : t$ = "Six"
    case 7 : t$ = "Seven"
    case 8 : t$ = "Eight"
    case 9 : t$ = "Nine"
    case 10 : t$ = "Ten"
    case 11 : t$ = "Eleven"
    case 12 : t$ = "Twelve"
    case 13 : t$ = "Thirteen"
    case 14 : t$ = "Fourteen"
    case 15 : t$ = "Fifteen"
    case 16 : t$ = "Sixteen"
    case 17 : t$ = "Seventeen"
    case 18 : t$ = "Eighteen"
    case 19 : t$ = "Nineteen"
    end select
  else
    if 20 <= n and n < 30 then
      if n - 20 = 0 then
        t$ = "Twenty"
      else
        t$ = "Twenty " + n2w$(n - 20)
      end if
    end if
    if 30 <= n and n < 40 then
      if n - 30 = 0 then
        t$ = "Thirty"
      else
        t$ = "Thirty " + n2w$(n - 30)
      end if
    end if
    if 40 <= n and n < 50 then
      if n - 40 = 0 then
        t$ = "Forty"
      else
        t$ = "Forty " + n2w$(n - 40)
      end if
    end if
    if 50 <= n and n < 60 then
      if n - 50 = 0 then
        t$ = "Fifty"
      else
        t$ = "Fifty " + n2w$(n - 50)
      end if
    end if
  end if
  n2w$ = t$
end function

' end plug-in section ======================================================================
'========================== DE procedures color, drawing, events very useful subs or functions

sub charIn hdl$, c$
    call quit hdl$
end sub

sub quit hdl$
    timer 0
    close #gr
    end
end sub

sub clear r, g, b 'clear screen to new RGB color and set backcolor
' and set up so pl (print line) will start at line 1, cell column 1)
    #gr "fill ";r;" ";g;" ";b
    #gr "backcolor ";r;" ";g;" ";b
    lastC = 1 : lastR = 1
end sub

sub loc8 x, y   'locate xColumnCell, yRowCell for printing
    if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
        lastC = x
        lastR = y
    end if
end sub

sub pl mess$ 'print line (feed)
    startR = lastR
    for i = 1 to len(mess$)
        scan
        call lp lastC, lastR, mid$(mess$, i, 1)
        if lastR <> startR then exit for
    next
    lastC = 1
    lastR = startR + 1
    if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
    'if locate = x col and y row then and top left corner locates as 1, 1
    c = x - 1: r = y
    if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
        #gr "place ";c * cellW;" ";r * cellH - 4
        #gr "|";mess$
        lastC = x + len(mess$)
        if lastC > maxCol then lastC = 1 : lastR = lastR + 1
        if lastR > maxRow then lastR = maxRow 'yuck!
    end if
end sub

sub cp y,cpText$ 'cp Center Print on line y the cpText$
    call lp int((maxCol - len(cpText$))/2 + 2), y, cpText$
    lastC = 1 : lastR = y + 1
end sub

sub inp prmpt$, byref var$   'input
'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

    inkee$ = "" 'clear last key (new fix for DE5)
    call lp lastC, lastR, prmpt$;"{"
    'this will update lastR and lastC to the starting point of input variable
    pRow = lastR : pCol = lastC 'save these for redrawing var
    call lp pCol, pRow, "}"
    OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
    OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
    do
        scan
        if instr(OK$, inkee$) then
            if inkee$ = Chr$(8) then
                if t$ <> "" then
                    if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
                end if
            else
                if inkee$=Chr$(13) or inkee$=Chr$(27) then
                    'new D5, I was expecting nothing in return for my esc
                    if inkee$ = chr$(27) then t$ = ""
                    exit do
                else
                    t$=t$;inkee$
                end if
            end if
            call lp pCol, pRow, t$;"} "
            inkee$ = ""
        end if
    loop until done
    var$ = t$
    lastC = 1 : lastR = pRow + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
    #gr "place ";xPix;" ";yPix
    #gr "|";char$ 
end sub

function wait4key$() 'updated for DE6 from sub to function like input$(1)
'This function stops program flow for keypress, and returns keypress
    inkee$ = ""
    while len(inkee$) = 0 : scan : k$ = inkee$ : wend
    wait4key$ = k$
end function

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

sub hue r, g, b 'fore and back
    #gr "color ";r;" ";g;" ";b
    #gr "backcolor ";r;" ";g;" ";b
end sub

sub fore r, g, b
    #gr "color ";r;" ";g;" ";b
end sub

sub fbox x0, y0, x1, y1
    #gr "place ";x0;" ";y0
    #gr "boxfilled ";x1+1;" ";y1+1
end sub

 


Obviously I am just writing new code in Plug-In section and adding a couple of tested graphics subs from DE plug-in system. Why rewrite all this stuff over and over? Just plug-in the new code in plug-in section. That's why you are seeing all the unused subs below the End Plug-In ================= line.
« Last Edit: Oct 18th, 2017, 2:15pm by bplus » User IP Logged

B+
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls