XProfan

Deutsch

p.specht

In Mikroprozessoren werden digitale Filter verwendet - beispielsweise zur Erkennung der Tonwahl-Doppeltöne modener Telefonanlagen. Im Profan-Interpretermodus sind da natürlich nur geringste Frequenzen detektierbar, z.B. nachstehend 4-5 Hertz, die man durch Drücken der Linken Maustaste simulieren kann. Das Ding reagiert dann irgendwann mal. Compiliert wird die Sache schon eher interessant: Ein Drummer könnte damit sein Rhytmusgefühl trainieren!

Kompilieren Markieren Separieren

WindowTitle "Goertzel-Algorithmus, Realtime-Version"
' (D)2011 P. Specht, Demoware, Verwendung auf alleinige Gefahr des Anwenders.
AppendMenuBar 10,"Linke Maustaste mit ca. 5 Hz drücken. Ende mit ESC"
Font 2:Randomize:Cls rnd(8^8)
Var p2!=6.2831853071795864769252867665590
Declare x!,x1!,x2!,s!,LM%,Ende%,pwr!
Var SampleFreq!=100'Hz (> 2*FrequOfInterest!)
Var FreqOfInterest!=5'Hz
var cps!=FreqOfInterest!/SampleFreq!
Var c!=2*cos(p2!*cps!)
UserMessages  $201,$202
SetTimer 1000/SampleFreq!
locate 5,2:Print "                                |                           "

REPEAT

    WhileLoop 40

        WaitInput

        if (%key=2) OR (%key=27):Ende%=1:BREAK :Endif

            If %umessage=$201

                ifnot LM%=1:LM%=1:endif

                ElseIf %umessage=$202

                    ifnot LM%=2:LM%=2:endif

                    EndIf

                    if lm%=1

                        'print "+";
                        x!= 0.5
                        s!=x!+c!*x1!-x2!
                        x2!=x1!
                        x1!=s!

                    elseif lm%=2

                        'print "_";
                        x!=-0.5
                        s!=x!+c!*x1!-x2!
                        x2!=x1!
                        x1!=s!

                    endif

                Endwhile

                pwr!=int(x2!*x2!+x1!*x1!-c!*x1!*x2!)
                s!=0:x!=0:x1!=0:x2!=0
                locate 6,2:print left$(mkstr$("#",pwr!/3)+mkstr$(" ",60-pwr!/3),60)
                case pwr!>100:beep
                case Ende%:Break

            UNTIL Ende%

            UserMessages 0
            beep
            KillTimer
            End