A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

General FreeBASIC programming questions.
Post Reply
KLBear
Posts: 113
Joined: Jul 23, 2008 9:32

A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by KLBear »

deleted
Last edited by KLBear on Mar 16, 2022 3:45, edited 3 times in total.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by srvaldez »

Hi KLBear :-)
very nice clock
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by dodicat »

So long as it keeps good time there is no need to examine the workings.
But I note you use out.
So I tried the old sound example in the help file (for the first time in about 14 years), in win 10.
I got:

Aborting due to runtime error 8 (no privileges) at line 4 of . . .\FBIDETEMP.bas::SOUND()

I suppose no privileges might be because I bought this machine off Ebay?
But never mind, your clock runs well.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by srvaldez »

dodicat, please post the code
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by srvaldez »

is this what you tried?
viewtopic.php?p=20441#p20441

Code: Select all

' Sound Function v0.3 For DOS/Linux/Win by yetifoot
'
' Tested on:
'    Slackware 10.2
'    Win98
'    WinXP
'    DOS
'
' Credits:
'    http://www.frontiernet.net/~fys/snd.htm
'    http://delphi.about.com/cs/adptips2003/a/bltip0303_3.htm
'
' Notes:
'    On windows >= NT, direct port access is not allowed, in this instance
'    however we can use the WinAPI Beep function, which allows freq and duration
'   

'        Octave 0    1    2    3    4    5    6    7
'        Note
'        C     16   33   65  131  262  523 1046 2093
'        C#    17   35   69  139  277  554 1109 2217
'        D     18   37   73  147  294  587 1175 2349
'        D#    19   39   78  155  311  622 1244 2489
'        E     21   41   82  165  330  659 1328 2637
'        F     22   44   87  175  349  698 1397 2794
'        F#    23   46   92  185  370  740 1480 2960
'        G     24   49   98  196  392  784 1568 3136
'        G#    26   52  104  208  415  831 1661 3322
'        A     27   55  110  220  440  880 1760 3520
'        A#    29   58  116  233  466  932 1865 3729
'        B     31   62  123  245  494  988 1975 3951

#ifdef __FB_WIN32__
  #include once "windows.bi"
#endif

Sub Sound_DOS_LIN(Byval freq As Uinteger, dur As Uinteger)
  Dim t As Double
  Dim fixed_freq As uShort
 
    fixed_freq = 1193181 \ freq
   
    ASM
      mov  dx, &H61                  ' turn speaker on
      in   al, dx
      or   al, &H03
      out  dx, al
      mov  dx, &H43                  ' get the timer ready
      mov  al, &HB6
      out  dx, al
      mov  ax, word ptr [fixed_freq] ' move freq to ax
      mov  dx, &H42                  ' port to out
      out  dx, al                    ' out low order
      xchg ah, al                   
      out  dx, al                    ' out high order
    End ASM
   
    t = Timer
    While ((Timer - t) * 1000) < dur ' wait for out specified duration
      Sleep(1)
    Wend
   
    ASM
      mov  dx, &H61                  ' turn speaker off
      in   al, dx
      and  al, &HFC
      out  dx, al
    End ASM
   
End Sub

Sub Sound(Byval freq As Uinteger, dur As Uinteger)
  #ifndef __FB_WIN32__
    ' If not windows Then call the asm version.
    Sound_DOS_LIN(freq, dur)
  #else
    ' If Windows
    Dim osv As OSVERSIONINFO
   
      osv.dwOSVersionInfoSize = sizeof(OSVERSIONINFO)
      GetVersionEx(@osv)
     
      Select Case osv.dwPlatformId
        Case VER_PLATFORM_WIN32_NT       
          ' If NT then use Beep from API
          Beep_(freq, dur)
        Case Else
          ' If not on NT then use the same as DOS/Linux
          Sound_DOS_LIN(freq, dur)
      End Select
  #endif
End Sub

' TEST

Sound(523, 60)  'C5
Sound(587, 60)  'D5
Sound(659, 60)  'E5
Sound(698, 60)  'F5
Sound(784, 60)  'G5
Sound(880, 60)  'A5
Sound(988, 60)  'B5
Sound(1046, 60) 'C6
it works here, through the sound card
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by dodicat »

srvaldez.
It is the example in the help file under OUT keyword.

Code: Select all

Sub Sound(ByVal freq As UInteger, dur As UInteger)
  Dim t As Double,f1 As Unsigned Short
    f1 = 1193181 \ freq
    Out &h61,Inp(&h61) Or 3
    Out &h43,&hb6
    Out &h42,LoByte(f1)
    Out &h42,HiByte(f1)
    t=Timer 
    While ((Timer - t) * 1000) < dur
      Sleep 0,1
    Wend
    Out &h61,Inp(&h61) And &hfc
End Sub

Sound(523, 60)  'C5
Sound(587, 60)  'D5
Sound(659, 60)  'E5
Sound(698, 60)  'F5
Sound(784, 60)  'G5
Sound(880, 60)  'A5
Sound(988, 60)  'B5
Sound(1046, 60) 'C6 

 
The one you posted is OK.
KLBear
Posts: 113
Joined: Jul 23, 2008 9:32

Re: A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by KLBear »

deleted
Last edited by KLBear on Mar 16, 2022 3:46, edited 2 times in total.
KLBear
Posts: 113
Joined: Jul 23, 2008 9:32

Re: A new standard binary 24 hour clock. Inspired by the MrSwiss Binary clock.

Post by KLBear »

deleted
Last edited by KLBear on Mar 16, 2022 3:44, edited 1 time in total.
KLBear
Posts: 113
Joined: Jul 23, 2008 9:32

Re: A new standard binary 24 hour clock

Post by KLBear »

deleted
Post Reply