The software of my seti station
Below you find all the programs i use for my seti station.
What you have to do to use my seti-software suite:
The programs are written for the Pure Basic compiler.
You can download the Pure Basic compiler from the internet.
There are 2 versions: a completely free version and an
version which costs about 100 Euro.
the last version has some more utilities.
Pure basic is as fast as C++ compilers.
My programs below do work with the 100 Euro version.
I do not know how good the free version will work.
Please inform me about that.
Put the masterprogram (meet_reken_masterprog118.pb ) ,
the measuring program ( meet106.pb ),
and the plotting program (plot_fft_output.pb ) in an empty directory.
Compile the measuring and the plotting program to .exe files.
Make the er_is_signal.dat text file with only the number 4000 in it.
Start the masterprogram in the Pure Basic environment
and just wait....
After one minute, the measuring program starts listening 14 seconds
to the sound of the microfone channel of the computer.
After that the FFT diagram will be plotted on the screen.
Then the program waits until next measurement starts.
.WAV files with signal will be saved.
You can just listen to this files with windows programs and hear
with your ears what the program received.
You have to play around a bit with microfone levels etc to get a good
working system.
Good luck
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
; meet_reken_masterprog118.pb
; Seti measuring master program. (For Windows systems)
; Internet version 1.01 Drs. W. Apon 3-1-2013
; Please send me an e-mail when you did download
; this program, so i can see if it is worth all
; the work......
; my e-mail adress: wim-aponxxx@kpnmail.nl
; omit the xxx ( anti spam)
; This program is written for the Pure Basic Compiler
; A free version of this compiler is available on the internet.
; It looks very much like Quick Basic but has more windows
; capabilities and calculates as fast as C programs!
; This program start every minute a measuring program (meet106.exe)
; meet106 listens 15 seconds to the micropone jack of the computer
; and makes a .WAV file of it.
; The name of the .WAV file is for example 21001505.wav
; The first 4 figures are a daynumber the next 4 figures
; represent the time from 0 to 2359
; The master program reads the .wav file in and does an
; FFT calculation and gives the frequency spectrum of it
; on the screen by means of the program: plot_fft_output.exe
; When the .wav file is measured, the master program decides
; wheter it must be saved or deleted.
; The minimum value to save the .wav file is in the
; file: er_is_signaal.dat and is the green horizontal line
; in the graph.
; the file: er_is_signal.dat is a TXT file with only one
; number in it. For example 4000
; This value can be changed in the file by normal ascii editing.
; The output of the FFT is temporarely saved in fft_output.dat
; This program is not for commercial use and may contain bugs....
; Please don't shoot the pianoplayer .....
; What you need to use this Seti-program is a radio-receiver and
; a windows (xp or so).computer. The receiver must use a LSB or USB
; detector.
; The receiver may receive at every frequency where is normaly
; no signal. So the lowest frequency will be 30 MHz and
; the maximum frequency is .... i don'n know.
; For example you can use a Televison disk and a LNB and a
; communication receiver which can receive about 1000 MHz.
; This days there are Usb receivers which can receive the 1000 MHz...
; So you can set up an Seti statioin with very low cost!!
; My idee is: the more people do listen the more chance we have to
; find extra terrestrial intelligence
; Wim Apon
Declare FFT()
Declare berekenamplitude()
Declare setvariabelenopnul()
; de variabelen voor de FFT
Global xax.i =262144 ; ( = 2 ^18 ) 524288 ; ( = 2 ^ 19 )
Global Dim REX.d(xax)
Global Dim XIMX.d(xax)
Global n = xax ; 16
Global Dim amp.d (xax)
Global N.i
Global NM1.i , ND2.i , M.i
Global M.i , j.i , i.i , K.i , L.i , LE.i , LE2.i , JM1.i , IP.i
Global TI.d , TR.d , UR.d , UI.d , SR.d , SI.d
Global er_is_signaal ; = 4000 ; intern uit de FFT komt een getal dat
; 1000 maal zo groot is...
; ; alle andere progs houden hier rekening mee
; ; ik doe dit om het plot prog beter te
; kunnen lezen...!
Procedure.s StrSec(Seconds.i)
Result$ = ""
Help = Seconds / (60 * 60 * 24)
Result$ = Str(Help) + "d"
Seconds - (Help * 60 * 60 * 24)
Help = Seconds / (60 * 60)
Result$ + " " + Str(Help) + "h"
Seconds - (Help * 60 * 60)
Help = Seconds / 60
Result$ + " " + Str(Help) + "m"
Seconds - (Help * 60)
Result$ + " " + Str(Seconds) + "s"
ProcedureReturn Result$
EndProcedure
OpenWindow(0, 0, 0, 1, 1, "", #PB_Window_Invisible)
CreatePopupMenu(0)
MenuItem(1, "Info")
MenuItem(2, "Quit")
LoadImage(0, #PB_Compiler_Home + "Examples\Sources - Advanced\MoviePlayer\Icons\Pause.ico")
LoadImage(1, #PB_Compiler_Home + "Examples\Sources - Advanced\MoviePlayer\Icons\Play.ico")
AddSysTrayIcon(0, WindowID(0), ImageID(0))
SysTrayIconToolTip(0, "I'm Wims meassure program")
AddWindowTimer(0, 0, 60*1000) ; a 60 sec timer (for the Sampler())
Starttime = ElapsedMilliseconds()
Exit = #False
Repeat
Select WaitWindowEvent()
Case #PB_Event_Timer
If EventTimer() = 0
; Hier moet mijn meetprogramma gestart worden.
ChangeSysTrayIcon(0, ImageID(1))
RunProgram ("meet106.exe")
Delay ( 20000) ; om Icoontje van het meten even lang te zien als er gemeten wordt
ChangeSysTrayIcon(0, ImageID(0))
; lees nu de naam van de outputfile van het meetprogramma in. vb 13831765.wav
ReadFile(0, "wegschrijffilenaam.dat")
wegschrijffilenaam.s = ReadString(0)
CloseFile(0)
; ga nu de .wav file inlezen en het array voor de fft vullen
If ReadFile(0, wegschrijffilenaam)
; DIT MOET KORTER ..... IN 1 KLAP
; lees chunkID uit 4 bytes
byte1.b = ReadByte(0)
char1.s = Chr(byte1)
byte1.b = ReadByte(0)
char2.s = Chr(byte1)
byte1.b = ReadByte(0)
char3.s = Chr(byte1)
byte1.b = ReadByte(0)
char4.s = Chr(byte1)
chunkid.s = char1 + char2 + char3 + char4
;Debug "(chunkid)"
;Debug chunkid
; lees chunk size in ( long) 4 bytes
chunksize.l = ReadLong(0)
;Debug "(chunksize)"
;Debug chunksize
; lees format in 4 bytes
byte1.b = ReadByte(0)
char1.s = Chr(byte1)
byte1.b = ReadByte(0)
char2.s = Chr(byte1)
byte1.b = ReadByte(0)
char3.s = Chr(byte1)
byte1.b = ReadByte(0)
char4.s = Chr(byte1)
format.s = char1 + char2 + char3 + char4
;Debug "(format)"
;Debug format
; lees subchunk1id 4 bytes
byte1.b = ReadByte(0)
char1.s = Chr(byte1)
byte1.b = ReadByte(0)
char2.s = Chr(byte1)
byte1.b = ReadByte(0)
char3.s = Chr(byte1)
byte1.b = ReadByte(0)
char4.s = Chr(byte1)
subchunk1id.s = char1 + char2 + char3 + char4
;Debug "(subchunk1id)"
;Debug subchunk1id
; lees subchunk1size1 4 bytes
subchunk1size1.l = ReadLong(0)
;Debug "(subchunk1size)"
;debug subchunk1size1
; lees audioformat 2 bytes
byte1.b = ReadByte(0)
byte1.b = ReadByte(0)
; lees numchannels 2 bytes
byte1.b = ReadByte(0)
byte1.b = ReadByte(0)
; lees samplerate 4 bytes
samplerate.l = ReadLong(0)
;Debug "(samplerate)"
;Debug samplerate
; lees byterate 4 bytes
byterate.l = ReadLong(0)
;Debug "(byterate)"
;Debug byterate
; lees blockalign 2 bytes
byte1.b = ReadByte(0)
byte1.b = ReadByte(0)
; lees bits per sample 2 bytes
byte1.b = ReadByte(0)
byte1.b = ReadByte(0)
; even voor test 2 extra bytes inlezen Hierna gaat ie weer goed... hoe komt dit nu????
byte1.b = ReadByte(0)
byte1.b = ReadByte(0)
; lees subchunk2id 4 bytes
byte1.b = ReadByte(0)
char1.s = Chr(byte1)
byte1.b = ReadByte(0)
char2.s = Chr(byte1)
byte1.b = ReadByte(0)
char3.s = Chr(byte1)
byte1.b = ReadByte(0)
char4.s = Chr(byte1)
subchunk2id.s = char1 + char2 + char3 + char4
;Debug "(subchunk2id)"
;Debug subchunk2id ;
; leesin subchunk2size 4bytes
subchunk2size.l = ReadLong(0)
;Debug "subchunk2size"
;Debug subchunk2size
; Nu komt de data
;================
; zet nu het REX() en XIMX() array en amp() op 0
For i = 0 To xax
REX(i) = 0
XIMX(i) = 0
amp(i) = 0
Next i
; stop deze data nu in het fft array REX()
; sla eerst wat data over
For i = 1 To 20000 ; 50000
woord.w = ReadWord(0)
woord = ReadWord(0)
Next i
itel.i = 0
For itel = 1 To xax
woord.w= ReadWord (0) ; sla linker kanaal over
waarde = woord
woord.w = ReadWord (0) ; lees rechter kanaal in
REX(itel) = woord
XIMX(itel) = 0 ; om voor volgende keren zeker op 0 te starten
Next itel
CloseFile(0)
; zet nu alle door de fft gebruikte variabelen op 0
setvariabelenopnul()
; ga nu de FFT berekenen
fft()
; bereken nu de Amplitude per frequentie
berekenamplitude()
; schrijf nu de output van de FFT weg naar file: fft_output.dat
; hierin zit dus het frequentie spectrum
CreateFile(98,"fft_output.dat")
For ii = 1 To xax
nep$ = StrF(amp(ii))
WriteStringN(98,nep$)
Next ii
CloseFile(98)
RunProgram ("plot_fft_output.exe")
; kijk nu of de .wav file bewaard moet worden
;===============================================
; grenswaarde even uit file: er_is_signaal.dat halen
If ReadFile(0, "er_is_signaal.dat")
a$ = ReadString(0)
er_is_signaal = Val(a$)
Else
MessageRequester("Information","Kan file: er_is_signaal.dat niet openen. " )
EndIf
CloseFile(0)
er_is_signaal2.d = er_is_signaal * 1000 ;4000000 ; waarde nog precies uitzoeken
; als er een waarde groter is dan
; dit getal blijft de .wav file
; bewaard
; bepaal de grootste waarde
hoogstewaarde.d = 0 ; dit het max van de meting
For i = 5000 To 80000 ; voor 10 Khz ongeveer 37500 ; voor 3 KHz bandbreedte
If Amp(i) > hoogstewaarde
hoogstewaarde = Amp(i) ; dus de waarde zonder gedeeld door 1000
EndIf
Next i
oei$ = "hoogstewaarde = " + StrD(hoogstewaarde / 1000) ; wordt overal gedaan.. voor leesbaarheid
Debug oei$
If hoogstewaarde < er_is_signaal2
oei$ = wegschrijffilenaam + " wordt weggegooid"
Debug oei$
result = DeleteFile(wegschrijffilenaam)
Else
oei$ = wegschrijffilenaam + " wordt bewaard"
Debug oei$
EndIf
Debug " " ; om een lege regel te krijgen
Delay(15000) ; om ondertussen het plaatje te kunnen bekijken
Else
MessageRequester("Information","Kan file: "+ wegschrijffilenaam + " niet openen. " ) ; Maak dir: "+path)
EndIf
EndIf
Case #PB_Event_SysTray
If EventType() = #PB_EventType_RightClick
DisplayPopupMenu(0, WindowID(0))
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 1
Text$ = "I'm Wims meassure program." + #CR$
Text$ + "Running since " + StrSec((ElapsedMilliseconds() - Starttime) / 1000)
MessageRequester("Hi!", Text$)
Case 2
Exit = #True
EndSelect
EndSelect
Until Exit
End
;===================================================================
Procedure berekenamplitude()
; bereken nu de amplitudes...per frequentie
For ii = 1 To xax
amp(ii) = Sqr( Pow(REX(ii),2) + Pow(XIMX(ii),2))
Next ii
EndProcedure
;===================================================================
;===================================================================
Procedure FFT ()
calculateFFT:
;======================
A1050: pi = 3.14159265
A1060: NM1 = N - 1
A1070: ND2 = N / 2
A1080: M = Round(Log(N) / Log(2), #PB_Round_Nearest)
A1090: J = ND2
A1100: ;
A1110: For i= 1 To N - 2 ; BIT REVERSAL SORTING
A1120: If i >= J
Goto A1190
EndIf
A1130: TR = REX(J)
A1140: TI = XIMX(J)
A1150: REX(J) = REX(i)
A1160: XIMX(J) = XIMX(i)
A1170: REX(i) = TR
A1180: XIMX(i) = TI
A1190: K = ND2
A1200: If K > J
Goto A1240
EndIf
A1210: J = J - K
A1220: K = K / 2
A1230: Goto A1200
A1240: J = J + K
A1250: Next i
A1260:
A1270: For L = 1 To M ; LOOP For EACH STAGE
A1280: LE = Round( Pow(2,L) , #PB_Round_Nearest)
A1290: LE2 = LE / 2
A1300: UR = 1
A1310: UI = 0
A1320: SR = Cos(pi / LE2) ; CALCULATE SINE & COSINE VALUES
A1330: SI = -Sin(pi / LE2)
A1340: For J = 1 To LE2
A1350: JM1 = J - 1
iii = JM1
Repeat ;loop for each butterfly
A1370: IP = iii + LE2
A1380: TR = REX(IP) * UR - XIMX(IP) * UI
A1390: TI = REX(IP) * UI + XIMX(IP) * UR
A1400: REX(IP) = REX(iii) - TR
A1410: XIMX(IP) = XIMX(iii) - TI
A1420: REX(iii) = REX(iii) + TR
A1430: XIMX(iii) = XIMX(iii) + TI
iii = iii + Le
Until iii > NM1
A1450: TR = UR
A1460: UR = TR * SR - UI * SI
A1470: UI = TR * SI + UI * SR
A1480: Next J
A1490: Next L
A1500:
EndProcedure
;===================================================================
;===================================================================
Procedure setvariabelenopnul ()
;setvariabelenopnul:
;'==================
NM1 = 0
ND2 = 0
M = 0
j = 0
i = 0
TR = 0
TI = 0
K = 0
L = 0
LE = 0
LE2 = 0
UR = 0
UI = 0
SR = 0
SI = 0
JM1 = 0
IP = 0
;Return
EndProcedure
;===================================================================
; End of program: meet_reken_masterprog118.pb
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
; meet106.pb
; this program listens to the microphone jack and make a .wav file.
Declare Delete(*obj.IUnknown)
Declare Error_Msg(String.s)
Declare File_Save()
Declare DateToJulian(DateString$)
Declare berekenfilenaam()
Global schijf$ = "c:"
#CHANNELS = 2
#SAMPLE_RATE = 22050
#BIT_DEPTH = 16
#WAVE_FORMAT_PCM = $0001
#DS_OK = 0
#LOOP_FLAG = 0
#DSCBLOCK_ENTIREBUFFER = 1
#SECONDS = 14
Global my_wfe.WAVEFORMATEX ;THE FAMILIAR WAVEFORMATEX STRUCTURE
my_wfe\wFormatTag = #WAVE_FORMAT_PCM
my_wfe\nChannels = #CHANNELS ;dwPrimaryChannels;
my_wfe\nSamplesPerSec = #SAMPLE_RATE ;dwPrimaryFreq;
my_wfe\wBitsPerSample = #BIT_DEPTH ;dwPrimaryBitRate;
my_wfe\nBlockAlign = (my_wfe\wBitsPerSample / 8 * my_wfe\nChannels)
my_wfe\nAvgBytesPerSec = (my_wfe\nSamplesPerSec * my_wfe\nBlockAlign)
my_wfe\cbSize = 0
Global *bufptr ;POINTER TO CAPTURE BUFFER
Global bufsize.l ;SIZE OF CAPTURE BUFFER
Global dagnr.i
Global filenr.s
Global wegschrijffilenaam.s
;DIRECTSOUND BUFFER
Structure DSCBUFFERDESC
dwSize.l ; Size of the structure, in bytes. This member must be initialized before the structure is used.
dwFlags.l ; Flags specifying the capabilities of the buffer
dwBufferBytes.l ; Size of capture buffer to create, in bytes.
dwReserved.l ; Must be 0
*lpwfxFormat ; Address of a WAVEFORMATEX or WAVEFORMATEXTENSIBLE structure specifying the waveform format for the buffer.
EndStructure
start:
berekenfilenaam()
;CREATE DIRECTSOUND CAPTURE OBJECT
*DirectSound.IDirectSoundCapture
result.l = DirectSoundCaptureCreate_(0, @*DirectSound, 0)
If Result <> #DS_OK
Error_Msg("Can't do DirectSoundCaptureCreate : " + Str(Result.l))
EndIf
;SET UP CAPTURE BUFFER
dscbd.DSCBUFFERDESC ; Set up structure
dscbd\dwSize = SizeOf(DSCBUFFERDESC) ; Save structure size
dscbd\dwFlags = 0 ; It is the primary Buffer (see DSound.h)
dscbd\dwBufferBytes = my_wfe\nAvgBytesPerSec * #SECONDS
dscbd\dwReserved = 0
dscbd\lpwfxFormat = @my_WFE
result = *DirectSound\CreateCaptureBuffer(@dscbd, @*pDSCB.IDirectSoundCaptureBuffer, 0)
If result <> #DS_OK
Error_Msg("Can't set up directsound buffer : " + Str(Result))
EndIf
;START RECORDING
result = *pDSCB.IDirectSoundCaptureBuffer\Start(#LOOP_FLAG)
If result <> #DS_OK
Error_Msg("Can't start : " + Str(Result))
Else
Debug "Recording started"
EndIf
;RECORD FOR SPECIFIED NUMBER OF SECONDS
Delay(#SECONDS * 1000)
;STOP RECORDING
result = *pDSCB.IDirectSoundCaptureBuffer\Stop()
If result <> #DS_OK
Error_Msg("Can't stop : " + Str(Result))
Else
Debug "Recording stopped"
EndIf
;LOCK THE BUFFER BEFORE SAVING
result = *pDSCB.IDirectSoundCaptureBuffer\Lock(0, my_wfe\nAvgBytesPerSec * seconds, @*bufptr, @bufsize, 0, 0, #DSCBLOCK_ENTIREBUFFER)
If result <> #DS_OK
Error_Msg("Can't lock : " + Str(Result))
EndIf
;SAVE BUFFER CONTENTS AS A WAV FILE
Debug "Saving"
File_Save()
;UNLOCK THE BUFFER
result = *pDSCB.IDirectSoundCaptureBuffer\Unlock(*bufptr, bufsize, 0, 0)
If result <> #DS_OK
Error_Msg("Can't unlock : " + Str(Result))
EndIf
Debug "Normal program termination"
End
;===================================================================
Procedure Delete(*obj.IUnknown)
ProcedureReturn *Obj\Release()
EndProcedure
;===================================================================
;===================================================================
Procedure Error_Msg(String.s)
MessageRequester("Error",String.s,0)
End
EndProcedure
;===================================================================
;===================================================================
Procedure File_Save()
;SAVE BUFFER AS A WAV FILE
Debug "wegschrijffilenaam = " + wegschrijffilenaam
If CreateFile(1, wegschrijffilenaam) = 0
MessageRequester("Error", "Unable to create file: "+ wegschrijffilenaam, #MB_ICONERROR)
End
ProcedureReturn
EndIf
subchunk1size.l = SizeOf(WAVEFORMATEX)
subchunk2size.l = bufsize
chunksize = 4 + (8 + SizeOf(WAVEFORMATEX)) + (8 + subchunk2size)
samprate.l = my_wfe\nSamplesPerSec
byterate.l = my_wfe\nSamplesPerSec * my_wfe\nAvgBytesPerSec ;IS THIS RIGHT?
blockalign.w = my_wfe\nChannels * (my_wfe\wBitsPerSample / 8)
bitspersample.w = my_wfe\wBitsPerSample
my_WFE\cbSize = 0
chunksize = chunksize + my_WFE\cbSize
my_WFE\wFormatTag = #WAVE_FORMAT_PCM
;WRITE WAV HEADER
WriteString(1, "RIFF") ; 4 bytes
WriteLong(1, chunksize) ; 4 bytes
WriteString(1, "WAVE") ; 4 bytes
WriteString(1, "fmt ") ; 4 bytes
WriteLong(1, subchunk1size) ; 4 bytes
WriteData(1, my_WFE, SizeOf(WAVEFORMATEX))
;END OF WAVEFORMATEX STRUCTURE
WriteString(1, "data", #PB_Ascii) ; 4 bytes
WriteLong(1, subchunk2size) ; 4 bytes
;END OF FILE HEADER
;WRITE AUDIO DATA AFTER WAV HEADER
WriteData(1, *bufptr, bufsize)
CloseFile(1)
EndProcedure
;===================================================================
;===================================================================
Procedure DateToJulian(DateString$)
; deze procedure maakt doet het werk om een dagnummer te maken.
;komt van het PB-forum
;DateString$ must be in YYYYMMDD
Protected Elapsed.l
If Len(DateString$)<>8
ProcedureReturn
EndIf
Year=Val(Left(DateString$,4))
month=Val(Mid(DateString$,5,2))
day=Val(Right(DateString$,2))
If month<3 ; January Or February?
month+12 ; 13th or 14th month ....
year-1 ; .... of prev. year
EndIf
Elapsed=Int((year+4712)*365.25) ; years elapsed
Elapsed=Elapsed-(year/100) ; substract century leapdays
Elapsed=Elapsed+(year/400) ; re-add valid ones
Elapsed=Elapsed+Int(30.6*(month-1)+0.2) ; months elapsed + adjustm.
ProcedureReturn Elapsed+day ; days of final month
EndProcedure
;====================================================================
;===================================================================
Procedure berekenfilenaam()
; deze procedure rekent in 1 keer alle file gegevens uit... (lekker duidelijk ! )
; en het dagnummer 1371
; het filenummer 13712350
; wegschrijffilenaam c:\ra_data\1371\13712350
; bereken eerst het dagnummer
a$ = FormatDate("%mm/%dd/%yyyy", Date())
dag$= Mid(a$,4,2)
maand$ = Mid(a$,1,2)
jaar$ = Mid(a$,7,4)
datestring$ =jaar$+maand$+dag$
dagnr= DateToJulian(datestring$) - DateToJulian("20100101") + 1000
;bepaal nu de tijd-naam van de file
a.s = FormatDate("%hh:%ii:%ss", Date())
uur.s = Mid(a,1,2)
min.s = Mid(a,4,2)
wegschrijffilenaam.s = Str(dagnr) + uur + min + ".wav"
CreateFile (50, "wegschrijffilenaam.dat")
WriteStringN(50,wegschrijffilenaam)
CloseFile(50)
;Debug wegschrijffilenaam
EndProcedure
;===================================================================
; end of program: meet106.pb
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
; plot_fft_output.pb
; dit prog plot fft output data van de file fft_output.dat
; deze file wordt aangemaakt door meet_reken_masterprog118
; LET OP: alle y labels bij de y-as zijn door 1000 gedeeld....
; anders zijn de getallen te groot om te kunnen lezen
Declare MakeGraph()
Declare Verschaal()
#ImageXPos = 0
#ImageYPos = 0
Enumeration
#Win
#Image
#ImGad
EndEnumeration
; De minima en maxima van mijn grafiek in mijn coordinaten
Global Xmin.d
Global Xmax.d
Global Ymin.d
Global Ymax.d
Global x.d, y.d, xw.d, yw.d
Global Xoffset.d = 70.0
Global Yoffset.d = 40.0
Global stapje.f
Global label.s
Global tekenhetgrid$ = "j"
Global ImageW.d = 950
Global ImageH.d = 400 ; het onderste stuk van het scherm blijft open voor buttons
; Open nu het windowsscherm met windows-coordinaten
WinX = 73 ;50
WinY = 30
WinW = 950; Window Width -- de max x en y van het grafiekenscherm in windows coordinaten
WinH = 500; Window Height
; Create an offscreen image
; It will be displayed later
; maak nu het grafische scherm in windows coordinaten
; dus het onderste stuk blijft open voor buttons etc
OpenWindow(#Win, WinX, WinY, WinW, WinH, "Drs. W. Apon Seti - Software")
CreateImage(#Image, ImageW, ImageH)
ImageGadget(#ImGad, #ImageXPos, #ImageYPos, ImageW, ImageH, ImageID(#Image))
; start nu automatisch het plot programma
makegraph()
Delay(30000)
End
;===================================================================
Procedure MakeGraph()
StartDrawing(ImageOutput(#Image))
Xmin = 0
Xmax = 125000
Ymin = 0
Ymax = 10000 ; 10000000
; haal even de er_is_signaal data op
Global er_is_signaal ; = 4000 ; intern uit de FFT komt een getal dat
; 1000 maal zo groot is...
; ; alle andere progs houden hier rekening mee
; ; ik doe dit om het plot prog beter te
; kunnen lezen...!
; even uit file: er_is_signaal.dat halen
If ReadFile(0, "er_is_signaal.dat")
a$ = ReadString(0)
er_is_signaal = Val(a$)
Else
MessageRequester("Information","Kan file: er_is_signaal.dat niet openen. " )
EndIf
CloseFile(0)
; Ga hier nu de data plotten...
filenaam$ = "fft_output.dat"
If ReadFile(0, filenaam$)
While Eof(0) = 0
regel$ = ReadString(0)
i = i + 1
a.d = ValD(Mid(regel$,1,20)) / 1000
x = i
y = a
verschaal()
xw1 = xw
yw1 = yw
y = Ymin
verschaal()
xw2 = xw
yw2 = yw
LineXY(xw1, yw1, xw2, yw2 , RGB(255,0,0)) ; rood
Wend
CloseFile(0)
Else
even$ = "Kan " + filenaam$ + " niet openen"
MessageRequester("Information",even$)
EndIf
; Trek nu de freq. ijkljnen
For i = Ymax - (Ymax - Ymin)/4 To Ymax
x = 16340
y = i
verschaal()
Circle(xw,yw,1,RGB(255,255,0)) ; geel
Next i
; 2000 Hz
For i = Ymax - (Ymax - Ymin)/4 To Ymax
x = 28079
y = i
verschaal()
Circle(xw,yw,1,RGB(255,255,0)) ; geel
Next i
; 3000 Hz
For i = Ymax - (Ymax - Ymin)/4 To Ymax
x = 39977
y = i
verschaal()
Circle(xw,yw,1,RGB(255,255,0)) ; geel
Next i
; 4000 Hz
For i = Ymax - (Ymax - Ymin)/4 To Ymax
x = 51795
y = i
verschaal()
Circle(xw,yw,1,RGB(255,255,0)) ; geel
Next i
; 5000 Hz
For i = Ymax - (Ymax - Ymin)/4 To Ymax
x = 63670
y = i
verschaal()
Circle(xw,yw,1,RGB(255,255,0)) ; geel
Next i
; nu nog tekst erbij even alleen label 5000 Hz
x = 60000
y = Ymax-(Ymax-Ymin)/4
Verschaal()
DrawText(xw,yw,"5000 Hz")
; nu een horizontale groene lijn plotten voor er_is_signaal
For i = Xmin To Xmax
x = i
y = er_is_signaal ; * 1000
verschaal()
Circle(xw,yw,1,RGB(0,255,0)) ;.
Next i
; ga nu de x-as en y-as tekenen
;*===========================================*
; even de x-as tekenen
;;---------------------
x = Xmin
y = Ymin
Verschaal()
xw1 = xw
yw1 = yw
x = Xmax
y = Ymin
Verschaal()
xw2 = xw
yw2 = yw
LineXY(xw1,yw1,xw2,yw2,RGB(255,255,0))
;nu de streepjes om de 10 eenheden
x = Xmin
stapje = (Xmax-Xmin)/10
Repeat
x = x; grin
y = Ymin
Verschaal()
xw1 = xw
yw1 = yw
y = Ymin - (Ymax-Ymin)/30
Verschaal()
xw2 = xw
yw2 =yw
LineXY(xw1,yw1,xw2,yw2,RGB(255,255,0))
xw = xw -ImageW /50; om het eerste cijfer wat naar links te schuiven
label = Left(StrF(x),6)
DrawText(xw,yw,label)
x = x+stapje
Until x > Xmax
;even de y-As tekenen
;;--------------------
; LineXY(Xoffset,0, Xoffset,400)
x = Xmin
y = Ymin
Verschaal()
xw1 = xw
yw1 = yw
x = Xmin
y = Ymax
Verschaal()
xw2 = xw
yw2 = yw
LineXY(xw1,yw1,xw2,yw2,RGB(255,255,0))
;nu de streepjes om de 10 eenheden
y = ymin
stapje = (Ymax-Ymin)/10
Repeat
x = Xmin; grin
y = y
Verschaal()
xw1 = xw
yw1 = yw
x = Xmin - (Xmax-Xmin)/80
Verschaal()
xw2 = xw
yw2 =yw
LineXY(xw1,yw1,xw2,yw2,RGB(255,255,0))
xw = xw - ImageW / 20; om het eerste cijfer wat naar links te schuiven
yw = yw - ImageH / 60
label = Left(StrF(y),7)
DrawText(xw,yw,label)
y = y+stapje
Until y > Ymax
;Nu verticale en horizontale lijnen trekken in een vage grijze kleur
If tekenhetgrid$ = "j"
; trek nu 8 grijze vertikale lijnen
x = Xmin
stapje = (Xmax-Xmin)/10
Repeat
x = x+stapje
x = x; grin
y = Ymin
Verschaal()
xw1 = xw
yw1 = yw
y = Ymax ; Ymin - (Ymax-Ymin)/30
Verschaal()
xw2 = xw
yw2 =yw
LineXY(xw1,yw1,xw2,yw2,RGB(50,50,50))
Until x > Xmax
; trek nu 8 grijze horizontale lijnen
y = ymin
stapje = (Ymax-Ymin)/10
Repeat
y = y+stapje
x = Xmin; grin
y = y
Verschaal()
xw1 = xw
yw1 = yw
x = Xmax ; - (Xmax-Xmin)/80
Verschaal()
xw2 = xw
yw2 =yw
LineXY(xw1,yw1,xw2,yw2,RGB(50,50,50))
Until y > Ymax
EndIf
StopDrawing(); Einde plotten
; breng nu het gamaakte plaatje naar het scherm
ImageGadget(#ImGad, 0, 0, ImageW, ImageH, ImageID(#Image)); Create a gadget to display our
EndProcedure
;===================================================================
;===================================================================
Procedure Verschaal()
xw = (x-Xmin) / (Xmax-Xmin) * (ImageW - Xoffset) + Xoffset
yw = (ImageH - Yoffset) -( (y - Ymin) / (Ymax-Ymin) * (ImageH - Yoffset))
EndProcedure
;===================================================================
; End of program: plot_fft_output.pb