Word Clock

[UEZ]

Thanks UEZ.
fb itself is a console compiler, like c/c++ and many others.
Can you run console applications straight off in fb now in Win 11?

Simple print commands are executed also in a Terminal window but not the clock. When running it from the IDE or Explorer, the Terminal window open but nothing appears.

[srvaldez]

@UEZ
please post a link to the clock program that you are having problems with

[neil]

@dodicat
The Console clock you posted runs OK on Windows 10.
I have never seen this type of clock. Who's is it?

[UEZ]

@UEZ
please post a link to the clock program that you are having problems with

It's dodicat's clock in this thread: viewtopic.php?p=299084#p299084

[BasicCoder2]

@neil
You can reduce the number of lines by making your own little font set and character print routine.

Code: Select all

screenres 640,480,32

'CREATE A FONT SET
dim as string datum
dim shared as integer mult = 8
dim shared as any ptr fontSet
fontSet = imagecreate(44*mult,5*mult)

for j as integer = 0 to 4
    read datum
    for i as integer = 0 to 43
        if mid(datum,i+1,1)="#" then
            line fontSet,(i*mult,j*mult)-(i*mult+mult-2,j*mult+mult-2),rgb(0,255,0),bf
        end if
    next i
next j

dim shared as integer curx,cury   'position of cursor

sub printChar(n as integer)
    put (curx,cury),fontSet,(n*32,0)-(n*32+31,40),trans
    curx = curx + 32
end sub

Dim As string t
Dim As UByte hrs1,hrs2,min1,min2,sec1,sec2
Do
    'reset cursor position
    cury = 200
    curx = 190
    
    t = Time

    hrs1 = val(mid(t,1,1))
    hrs2 = val(mid(t,2,1))

    min1 = val(Mid(t, 4, 1))
    min2 = val(Mid(t, 5, 1))

    sec1 = val(Mid(t,7,1))
    sec2 = val(Mid(t,8,1))

    screenlock
    cls
    line (185,195)-(445,245),rgb(255,255,255),b
    printChar(hrs1)
    printChar(hrs2)
    printChar(10)
    printChar(min1)
    printChar(min2)
    printChar(10)
    printChar(sec1)
    printChar(sec2)
    screenunlock

loop until multikey(&H01)

imagedestroy fontSet



data "###   # ### ### # # ### #   ### ### ###    "
data "# #   #   #   # # # #   #     # # # # #  # "
data "# #   # ### ### ### ### ###   # ### ###    "
data "# #   # #     #   #   # # #   # # #   #  # "
data "###   # ### ###   # ### ###   # ###   #    "

[srvaldez]

thank you UEZ
I will play with it and see what happens

[neil]

@BasicCoder2
Thanks for the custom fonts. This make it a lot easier to code.
Now we need to change the font to roman numerals.
A roman numeral digital 24 hour clock.
Except roman numerals doesn't have zero's.

[dodicat]

UEZ
Before I rush out and get Win 11, how does screen 0 hold

Code: Select all

screen 0
dim as long owners=2000000000
dim as long coders=27000000
print "Percentage of computer owners who can write code ";(coders/owners)*100;"%"
sleep
 

PS, Microsoft would probably still prosper if it banished the hoi polloi from using their OS to write code.

Is time running out for hobby coders in Windows?

Code: Select all

#include "vbcompat.bi"
Function GetClock(im as any ptr=0) As String
     Dim As String fbHORSE = _
"S1C0BM345,150M+5,-27M+3,-25M+4,-21M+6,-10M+15,-10"_
&"M+5,-4M+11,-4M+8,0M+2,4M+48,1M+15,7"_
&"M+15,7M+12,10M+12,13M+19,27M+7,15M+6,13"_
&"M+7,7M+23,5M+39,-9M+37,-10M+20,-1M+24,3"_
&"M+30,5M+18,-10M+34,-23M+15,-3M+18,6M+15,11"_
&"M+12,15M+2,28M+5,39M+-5,18M+-17,38M+-7,14"_
&"M+-20,34M+-12,21M+-4,9M+-2,3M+-1,37M+4,9"_
&"M+-4,1M+-9,-7M+-7,-17M+-3,-30M+6,-38M+23,-59"_
&"M+4,-29M+-3,-21M+-13,-17M+-10,-6M+-13,-4M+-17,0"_
&"M+-6,3M+5,18M+11,28M+0,27M+-3,15M+-7,13"_
&"M+-10,16M+-12,11M+-9,11M+-9,10M+6,19M+8,13"_
&"M+5,6M+6,12M+-4,11M+-12,17M+-14,13M+-10,13"_
&"M+-8,13M+-7,10M+-4,11M+-12,6M+-8,3M+-5,11"_
&"M+0,6M+-28,-9M+3,-12M+8,-8M+13,-7M+8,-5"_
&"M+12,-10M+9,-16M+10,-15M+12,-15M+0,-10M+-3,-13"_
&"M+-2,-8M+-5,1M+-3,12M+-8,9M+-12,13M+-10,13"_
&"M+-7,16M+-8,15M+-5,8M+-8,11M+-9,9M+-13,12"_
&"M+-3,9M+273,4M+0,13M+-382,-1M+-1,-12M+71,-3"_
&"M+20,-21M+27,-20M+28,-41M+6,-14M+5,-20M+-19,-35"_
&"M+-7,-10M+-8,-7M+-9,-4M+-16,7M+-12,3M+-29,0"_
&"M+-22,1M+-14,21M+-13,27M+-13,19M+-12,30M+-7,22"_
&"M+-4,19M+-7,22M+31,3M+-1,15M+-171,-1M+-2,-13"_
&"M+95,-2M+13,-8M+15,-9M+8,-13M+8,-21M+5,-32"_
&"M+5,-22M+9,-21M+8,-22M+8,-19M+-3,-4M+-17,5"_
&"M+-9,3M+-69,0M+-4,7M+-4,12M+5,17M+9,10"_
&"M+13,14M+11,10M+10,3M+12,4M+4,11M+-2,12"_
&"M+-8,7M+-8,-4M+-20,-14M+-15,-13M+-36,-56M+-2,-19"_
&"M+7,-14M+15,-8M+48,-20M+-7,-26M+5,-11M+1,-11"_
&"M+7,-7M+6,-11M+8,-18M+3,-18M+-1,-14M+-4,-10"_
&"M+-6,-11M+-8,1M+-14,12M+-7,10M+-3,15M+-6,8"_
&"M+-12,-2M+-16,-6M+-4,-17M+1,-16"_
&"BM+191,77P4294967295,0"
    Dim As String S1,tmp
    dim as long Xpos=400,Ypos=300,rad=395
    #macro thickline(x,y,x2,y2,thickness,col,g,flag2)
    Scope
        Dim As Long xc,yc
        Var _x=Int(x),_y=Int(y),_x2=Int(x2),_y2=Int(y2)
        Dim As Single h=Sqr((_x2-_x)*(_x2-_x)+(_y2-y)*(_y2-y))  'hypotenuse
        Dim As Single s=(y-_y2)/h                               'sine
        Dim As Single c=(_x2-_x)/h                              'cosine
        If flag2=1 Then
            g+="S6BM" +str(_x) +"," +str(_y)'hands
            xc=(_x+_x2)\2:yc=(_y+_y2)\2
        Else
            g+="S6BM" +str(xpos) +"," +str(ypos)'digits
            g+="BM+" +str(_x-xpos) +"," +str(_y-ypos)
            xc=((_x+_x\2)-xpos\2+c*thickness):yc=((_y+_y\2)-ypos\2-s*thickness)
        End If
        g+="C" +str(col)
        g+="M+" +str(s*thickness\2) +"," +str(c*thickness\2)
        g+="M+" +str(_x2-_x) +"," +str(_y2-_y)
        g+="M+" +str(-s*thickness\1) +"," +str(-c*thickness\1)
        g+="M+" +str(_x-_x2) +"," +str(_y-_y2)
        g+="M+" +str(s*thickness\1) +"," +str(c*thickness\1)
        g+="BM" +str(xc) +"," +str(yc) +"P" +str(col+2) +"," +str(col)
    End Scope
    #endmacro
    
    #define rd .0174532925199433
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    
    #macro mod12(n,m)
    m= n Mod 12
    If m=0 Then m=12 
    #endmacro
    
    #macro lineto(xx1,yy1,xx2,yy2,d,col,flag2,fract)
    thickline(xx1,yy1,(xx1+(xx2-xx1)*d),(yy1+(yy2-yy1)*d),(rad/fract),col,tmp,flag2)
    s1+=tmp
    #endmacro
    
    #macro drawline(x,y,ang,length,col,x2,y2,flag,flag2)
    ang2=ang:ang2=ang2*.0174532925199433
    x2=(x)+length*Cos(ang2)
    y2=(y)-length*Sin(ang2)
    If flag>1 Then :thickline(x,y,x2,y2,(rad/flag),col,tmp,flag2):s1+=tmp:End If
    
    #endmacro
 
    #macro one(x,y,fract,a)
    drawline((x+210*Cos((90-a)*rd)),(y-210*Sin((90-a)*rd)),90-(a),fract,grey,tmp1,tmp2,100,1)
    #endmacro
    
    #macro V(x,y,fract,a)
    drawline((x+210*Cos((90-a)*rd)),(y-210*Sin((90-a)*rd)),90-(a-12),fract,grey,tmp1,tmp2,100,1)
    drawline((x+210*Cos((90-a)*rd)),(y-210*Sin((90-a)*rd)),90-(a+12),fract,grey,tmp1,tmp2,100,1)
    #endmacro
    
    #macro X(x,y,fract,a)
    drawline((x+210*Cos((90-(a+2))*rd)),(y-210*Sin((90-(a+2))*rd)),90-(a-18),fract,grey+1,tmp1,tmp2,100,1)
    drawline((x+210*Cos((90-(a-2))*rd)),(y-210*Sin((90-(a-2))*rd)),90-(a+18),fract,grey,tmp1,tmp2,100,1)
    #endmacro
    
    Dim As Ulong grey =Rgb(220,220,221)
    Static As Long newsm,firstrun,firstmin
    Static As Single firstfrac
    Dim As Long m2
    Dim As Single b1,b2,tmp1,tmp2,ang2
    Static As Single delta,secs
       if im<>0 then
    'numbers
    one(400,300,30,30)     '1
    
    one(400,300,30,58.75)  '2
    one(400,300,30,61.25)
    
    one(400,300,30,87.5)   '3
    one(400,300,30,90)
    one(400,300,30,92.5)
    
    one(400,300,30,117.5)  '4
    V(400,300,30,122.5)
    
    V(400,300,30,150)      '5
    
    V(400,300,30,177.5)    '6
    one(400,300,30,182.5)
    
    V(400,300,30,207.5)    '7
    one(400,300,30,212.5)
    one(400,300,30,215)
    
    V(400,300,30,236)      '8
    one(400,300,30,241)
    one(400,300,30,243.5)
    one(400,300,30,246)
    
    one(400,300,30,266.5)
    X(400,300,32,271)      '9
    
    X(400,300,32,300)      '10
    
    X(400,300,32,329)      '11
    one(400,300,30,333.5)
    
    X(400,300,32,357)      '12
    one(400,300,30,1.5)
    one(400,300,30,4.5)
    end if
    If firstrun=0  Then
        newsm=Valint(Mid(Time,4,2))
        firstrun=1
        delta=Timer
        firstfrac=Valint(Right(Time,2))
    End If
   
    Dim As String t=Time
    Dim As Single hm=Valint(Left(t,2)),mm=Valint(Mid(t,4,2))
    If newsm<>mm Then 
        firstmin=1
        delta=Timer
    End If
    newsm=mm
    
    If firstmin=0 Then secs=(Timer-delta)+firstfrac Else secs=(Timer-delta)
    
    mod12(hm,m2)
    Dim As Single h=map(0,12,m2,360,0)
    Dim As Single m=map(0,60,mm,360,0)
    Dim As Single s=map(0,60,(secs),360,0)
    Dim As Long R=rad/2
    if im<>0 then
    For z As Long=0 To 359 Step 6
        drawline((Xpos),(Ypos),z,R,15,b1,b2,1,0)
        If z=90 Then: lineto(b1,b2,(Xpos),(Ypos),.1,Rgb(200,0,0),0,50):End If 
        If z Mod 30=0 Then 
            If z<>90 Then:   lineto(b1,b2,(Xpos),(Ypos),.1,Rgb(200,0,0),0,50) :End If
        Else
            lineto(b1,b2,Xpos,Ypos,.05,Rgb(0,0,200),0,50)
        End If
    Next z
    else
    drawline(Xpos,Ypos,(h+90)-5*(360-m)/60,.6*R,Rgb(10,100,200),tmp1,tmp2,50,1)'hour 
    drawline(Xpos,Ypos,(m+90)-(360-s)/60,.85*R,Rgb(10,100,201),tmp1,tmp2,50,1)  'minute 
    drawline(Xpos,Ypos,(s+90),.92*R,Rgb(150,0,0),tmp1,tmp2,100,1)              'second 
    end if
    if im<>0 then draw im, fbHORSE+ s1
    Function= s1
End Function

Function intToRoman(num As Longint) As String
    
    Dim As String m(...) = { "", "M", "MM", "MMM" }
    Dim As String c(...) = { "",  "C",  "CC",  "CCC",  "CD", _
    "D", "DC", "DCC", "DCCC", "CM" }
    Dim As String x(...) = { "",  "X",  "XX",  "XXX",  "XL", _
    "L", "LX", "LXX", "LXXX", "XC" }
    Dim As String i(...) = { "",  "I",  "II",  "III",  "IV", _
    "V", "VI", "VII", "VIII", "IX" }
    Dim As String thousands = m(num \ 1000)
    Dim As String hundreds = c((num Mod 1000) \ 100)
    Dim As String tens = x((num Mod  100) \ 10)
    Dim As String ones = i(num Mod 10)
    
    Dim As String ans = thousands + hundreds + tens + ones
    
    Return ans
End Function

Function romandate As String
    Var dt= Format( Now, "dd-mmmm-yyyy" )
    Var p1= Iif(Mid(dt,1,1)="0",Left("0"+Str(Val(dt)),2),Left(dt,2))
    Var i=Instr(dt,"-")
    Var i2=Instr(i+1,dt,"-")
    Var p2=Mid(dt,i,(i2-i+1))
    Var p3=Mid(dt,i2+1)
    p1=inttoroman(Val(p1))
    p3=inttoroman(Val(p3))
    Return p1+p2+p3
End Function

'===========================  START =====================>>

Screen 19,32
dim as any ptr image=imagecreate(800,600,rgb(200,200,200))
GetClock(image) 'init image with dial
windowtitle "Roman Clock  " + romandate

Do
    windowtitle "Roman Clock  " + romandate
    Var clockstring= GetClock
    Screenlock
    Cls
    put(0,0),image,pset
    Draw Clockstring
    Screenunlock
    Sleep 1,1
Loop Until Inkey=Chr(27)
Sleep
imagedestroy image

  
   

[srvaldez]

dodicat
I think that the problem with your cock at viewtopic.php?p=299084#p299084 is that you access the console via it's handle

[UEZ]

I would suggest to move this discussion to viewtopic.php?p=299056#p299056 not to hijack this thread.

[dodicat]

neil.
Roman for zero doesn't exist.
Here is the time in roman .

Code: Select all

Function intToRoman(num As Longint) As String
    
    Dim As String m(...) = { "", "M", "MM", "MMM" }
    Dim As String c(...) = { "",  "C",  "CC",  "CCC",  "CD", _
    "D", "DC", "DCC", "DCCC", "CM" }
    Dim As String x(...) = { "",  "X",  "XX",  "XXX",  "XL", _
    "L", "LX", "LXX", "LXXX", "XC" }
    Dim As String i(...) = { "",  "I",  "II",  "III",  "IV", _
    "V", "VI", "VII", "VIII", "IX" }
    Dim As String thousands = m(num \ 1000)
    Dim As String hundreds = c((num Mod 1000) \ 100)
    Dim As String tens = x((num Mod  100) \ 10)
    Dim As String ones = i(num Mod 10)
    
    Dim As String ans = thousands + hundreds + tens + ones
    If num=0 Then ans="NULLA"
    
    Return ans
End Function

Function romantime As String
    Var t=Time
    Print t
    Var p1=Val(Mid(t,1,2))
    Var p2=Val(Mid(t,4,2))
    Var p3=Val(Mid(t,7))
    Return Left(inttoroman(p1)+"     ",5)+":"+Left(inttoroman(p2)+"       ",7)+":"+Left(inttoroman(p3)+"       ",7)
End Function

Type _D2
    As Double x,y
    As Ulong col
End Type

Sub drawstring(xpos As Long,ypos As Long,text As String,colour As Ulong,size As Single,im As Any Pointer=0)
    Static As _D2 cpt(),XY()
    Static As Long runflag
    If runflag=0 Then   
        Redim  XY(128,127)
        Redim cpt(1 To 64*2)
        Screen 8
        Width 640\8,200\16
        Dim As Ulong Pointer img
        Dim count As Long
        For ch As Long=1 To 127
            img=Imagecreate(640,200)
            Draw String img,(1,1),Chr(ch)
            For x As Long=1 To 8 
                For y As Long=1 To 16
                    If Point(x,y,img)<>0 Then
                        count=count+1
                        XY(count,ch)=Type<_D2>(x,y)
                    End If
                Next y
            Next x
            count=0
            Imagedestroy img
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As _D2 np,t
    #macro Scale(p1,p2,d)
    np.col=p2.col
    np.x=d*(p2.x-p1.x)+p1.x
    np.y=d*(p2.y-p1.y)+p1.y
    #endmacro
    
    Dim As _D2 c=Type<_D2>(xpos,ypos)
    Dim As Long dx=xpos,dy=ypos
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        For _x1 As Long=1 To 64*2
            t=Type<_D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy,colour)         
            Scale(c,t,size)
            cpt(_x1)=np
            
            If XY(_x1,asci).x<>0 Then
                If Abs(size)>1 Then
                    Line im,(cpt(_x1).x-size/2,cpt(_x1).y-size/2)-(cpt(_x1).x+size/2,cpt(_x1).y+size/2),cpt(_x1).col,bf
                Else
                    Pset im,(cpt(_x1).x,cpt(_x1).y),cpt(_x1).col
                End If
            End If
        Next _x1
        dx=dx+8
    Next z6
End Sub

Sub initfont Constructor 'automatic loader
    drawstring(0,0,"",0,0)
    Screen 0, , , &h80000000
End Sub

Screenres 700,100
Width 600\8,100\16
Color ,2

Do
    Screenlock
    Cls
    
    drawstring(20,20,romantime,4,4)
    Screenunlock
    Sleep 100
    Loop Until Len(Inkey)
 

[neil]

@dodicat
Roman numeral zero = none.
So if the time string has a zero. Print nothing.
That's how you got around it. Nice clock.

[dodicat]

The wiki says you could use nulla.
So just before return ans, put if num=0 then ans="NULLA"

[BasicCoder2]

My understanding is that the Romans used numbers the way we do for days on a calenda. We don't use zero for the first day and they don't use zero for the first hour. Hour 1 means during the first hour not an instance in time. We might say 6:20 and if they had used minutes that would be 7th hour and the 21st minute for them? When were the horses fed? They were fed during the second hour of the day. So whereas when we use roman numerals on a clock and they align with a point on the circle of the clock the romans would have divided the circle into 12 segments each starting with segment 1.

At least that is how I see it.

Units of time can be seen as objects to be counted the reason we might use,

Code: Select all

dim as integer array(1 to 10)

instead of,

Code: Select all

dim as integer array(0 to 9)

[neil]

Instead of using a zero NULLA works.

Here's a question about time. Guess the language.
De'n uair a tha e?