\ DDF-1 bearings capturing and forwarding with an Rpi2B \ Andy Korsak KR6DD Nov 15, 2019 \ forth.fanatic@gmail.com \ loop timing tools : t ( n --- ) 0 do loop ; : tt cr ( n --- ) 0 do 1000000 t loop ; \ n*10^6 empty loops \ in 10 sec: 300 tt for gforth-fast, 200 tt for gforth, 50 tt for atlast, 170 for pforth \ in my HP Mini 110 gforth on devuan runs empty loops 50 times faster than "vanilla version" \ gforth on debian in my Rpi 2B require /home/pi/wiringPi_gforth/wiringPi.fs wiringPiSetUpGpio drop \ initially tried using a PWM pin for pulse timing \ 13 constant PWM1 PWM1 OUTPUT pinMode \ 12 constant PWM0 PWM0 OUTPUT pinMode 25 constant BCM25 BCM25 OUTPUT pinMode \ used to measure pulse width and loop time variable pulsepin BCM25 pulsepin ! variable pulsewait 45 pulsewait ! : pulse pulsepin c@ HIGH digitalWrite pulsewait @ t pulsepin c@ LOW digitalWrite pulsewait @ t ; : pulses ( n -- ) 0 do pulse loop ; : ps pulses ; : fastpulse pulsepin c@ HIGH digitalWrite pulsepin c@ LOW digitalWrite ; : fp fastpulse ; : fps ( n -- ) 0 do fastpulse loop ; \ 10,000,000 fps when outputing pulses to pin 25 takes just under 10 sec \ so the highest freq square wave with gforth-fast at that pin is just over 1 MHz 17 constant strobePin strobePin INPUT pinMode : getDDFstrobe ( -- n) strobePin digitalRead ; : gds ( -- n) getDDFstrobe ; 22 constant DDFbit0Pin DDFbit0Pin INPUT pinMode 27 constant DDFbit1Pin DDFbit1Pin INPUT pinMode 23 constant DDFbit2Pin DDFbit2Pin INPUT pinMode 24 constant DDFbit3Pin DDFbit3Pin INPUT pinMode 16 constant Ant1Pin Ant1Pin INPUT pinMode 0 value show-good-fit-bearing-start&end? 0 value show-not-qualified-bearings? 0 value show-U4-clock-clashes? 0 value show-bad-polynomial-fits? 0 value show-bearings-near-to-last? 0 value debug-unstable-bearings-flag 0 value show-sp? 0 value break-in-eval-enum? 0 value allow-pausing? \ My DDF-1 U4 clock actually was runing at nearly 10kHz instead of 8kHz as stated in the manual. \ The strobe pin went high for just under 20us upon a zero crossing of the DDF-1 600Hz tone. \ I modified the circuit by adding a small 50K pot in place of R27 and R28 and tweaked \ the U4 clock to about 500Hz in order to conform with the active bandpass pre-filter at U1A&B. \ The strobe pulse now appears to be about the same width, about 20us. One of 16 DDF-1 bearing \ dispay LED's is selected by 4 data lines being latched on the falling edge of the strobe pulse \ after a time delay set by the calibration knob. The data lines are stable until the next \ strobe no sooner than approximately 2 msec. Zero crossings of the switched capacitor filter \ output waveform trigger the DDF-1 strobe pulse when the audio level LO LED is not lit. \ When the switching tone level is too low the strobe pulse is disabled. \ I connected one of the wires in the ribbon cable at the DDF-1 to the switched capacitor \ output at R18, then I connected the other end to pin 9 of the Rpi connector end and \ connected an RCA audio socket to pin 9 at the Rpi header for that cable. This allows \ viewing the switched capacitor filter output using an oscilloscope. : getBearingNibble ( -- n) DDFbit3Pin digitalRead ( n ) 2* DDFbit2Pin digitalRead + 2* DDFbit1Pin digitalRead + 2* DDFbit0Pin digitalRead + ; : gbn ( -- n ) getBearingNibble ; : sbn gbn . ; 16 constant bearing-data-len variable BearingSlots bearing-data-len 2* allot BearingSlots bearing-data-len 2* 0 fill : seeSlots cr bearing-data-len 0 do BearingSlots i 2* + uw@ 5 .r loop ; : ss seeSlots ; $3FFF value BearingActivityScaleFactor 0 value bearing-time-activity \ dimensionless, \ a fraction <= 1 of BearingActivityScaleFactor 3 value bearing-activity-acceptable-fraction BearingActivityScaleFactor 1 bearing-activity-acceptable-fraction */ value bearing-time-activity-threshold \ acceptable fraction of BearingActivityScaleFactor 100 value bearing-activity-exponential-decay-factor \ dimensionless 20 value avgFactor \ Weighting of stored estimated slot value against 1 for the current slot \ when updating the 16 stored slot values. The "time constant" for the \ "exponential filter" is avgFactor * 2 msec. 10000 value SlotScaleVal \ used as a max slot level value : updateBearingSlot ( slot-index -- ) \ exponential filtering algorthithm: \ updated slot value = [N*(stored_value) + SlotScaleVal] / [N + 1] \ for a slot whose index is the selected LED number 0..15 by a strobe pulse 2* BearingSlots + ( adr ) >r SlotScaleVal r@ uw@ ( SlotScaleVal slotval ) avgFactor * ( SlotScaleVal slotval*avgfac ) + ( SlotScaleVal+slotval*avgfac ) avgFactor 1+ ( 1+avgfac ) / ( ratio=[scaleval+slotval*avgfac]/[1+avgfac] ) r> ( ratio adr ) w! ; : bb ( n --) 0 do getBearingNibble ( n ) updateBearingSlot loop ; : gg cr getBearingNibble getBearingNibble getBearingNibble . . . ; : ggg ( n -- ) 0 do gg loop ; : updateOtherSlot ( slot-index -- ) \ exponential filtering algorthithm: \ updated slot value = [N*(stored_value) + 0] / [N + 1] for the other 15 slots 2* BearingSlots + ( adr ) >r r@ uw@ ( slotval) avgFactor * ( slotval*avgfac ) avgFactor 1+ ( 1+avgfac ) ( 1+slotval*avgfac 1+avgfac ) / ( ratio=[slotval*avgfac]/[1+avgfac] ) r> ( ratio adr ) w! ; : updateAllSlots ( n=bearingSlotNumber -- ) bearing-data-len 0 do dup i = if i updateBearingSlot else i updateOtherSlot then loop drop ; : uu ( slot# n -- ) 0 do dup updateAllSlots loop drop ; \ 1,400,000 per sec 9 value qualifying-width \ the number of the 16 slots surrounding the peak value \ slot in circular order that may have values above \ the max slot value divided by the qualifying factor \ in order for a bearing to be "qualified" 9 value qualifying-factor \ used to decide if a polynomial-fitted peak has \ neighboring slot values relatively low enough to form a \ suitably "peaky" inverted parabola shape SlotScaleVal qualifying-factor / value qualifying-threshold 0 value maxval-slot-index 0 value max-slot-val 0 value bearing-width : find-max-slot-val 0 \ init max-slot-val at tos bearing-data-len 0 do BearingSlots i 2* + uw@ ( max-slot-val-so-far i-th-slotval ) 2dup < if swap drop \ updated max val so far i to maxval-slot-index \ and in which slot it is else drop then loop ( n ) to max-slot-val ; : fmsv find-max-slot-val ; : get-bearing-width \ search left and right looking for where the slot value drops \ below the max slot value divided by the qualifying factor max-slot-val qualifying-factor / to qualifying-threshold 1 \ initial bearing-width at tos \ look leftward before the max slot value index qualifying-width 1+ 1 do maxval-slot-index i - dup 0< if \ rolled off the left edge \ so proceed looking backwards from the the right edge bearing-data-len + then ( width-so-far slot-index ) 2* BearingSlots + uw@ qualifying-threshold ( width-so-far slot-val thresh ) < if \ slotval is below the threshold leave else ( bearing-width-so-far ) dup qualifying-width < if 1+ \ incremented bearing-width at tos else leave then then loop ( width-so-far ) qualifying-width over - dup 0> if \ loop n times n times more to the right of the maxval slot \ where n = qualifying-width - width-so-far ( width-so-far #loops-to-go ) 1+ 1 \ adjust for Forth loop convention do ( width-so-far ) maxval-slot-index i + dup bearing-data-len >= if \ rolled off the right edge bearing-data-len - then ( width-so-far index ) 2* BearingSlots + uw@ qualifying-threshold ( width-so-far slot-val thresh ) < if \ slotval is already below the threshold ( width-so-far ) leave else ( width-so-far ) dup qualifying-width < if 1+ else leave then then loop else ( width 0 ) drop then ( width ) to bearing-width ; \ width is a number of slots : gbw get-bearing-width ; 1000 constant usec/msec 10000 constant usec/centisec 100 constant centisec/sec 6000 constant centisec/min 1000000 constant usec/sec usec/sec 60 * constant usec/min usec/min 60 * constant usec/hr usec/hr 24 * constant usec/day \ still OK for a cell value, only 32 bits, \ but it appears negative so use appropriately \ as an unsigned 32-bit integer 2variable minimal-acceptable-usecs \ Bearings should not be accepted when lasting less than 1/20th of a second \ but we would like to capture kerchunks that can be as short as 1/10th of a second \ or sometimes a bit shorter. 14 ( centisecs ) usec/centisec m* ( d ) minimal-acceptable-usecs 2! \ see https://www.complang.tuwien.ac.at/forth/gforth/Docs-html/Mixed-precision.html#Mixed-precision 500 constant raw-data-buff-recs 2variable raw-data-count 0. raw-data-count 2! 0 value buff-write-pointer 2 cells constant raw-data-rec-len \ #bytes 32 value raw-data-stamp-len raw-data-rec-len raw-data-buff-recs * constant raw-data-buf-len create raw-data-buffer raw-data-buffer raw-data-buf-len raw-data-stamp-len + allot \ utime (64 bits): 2 cells, \ time&date (6 32-bit cell values) \ total date&time stamp takes 8 cells \ We first store time&date and utime at the start of the run of CaptureBearings. \ Different linux installations may differ how utime is related to current real time. \ We then store utime/10^4 (centiseconds) and a strobe selected slot number 0-15 \ after each DDF-1 strobe at most 600 times per second (antenna rotation rate). \ Note: strobes only occur when the DDF-1 doesn't snuff them with its \ low signal level lockout circuitry when the left LED at the upper right \ lights up, so there needs to be a time and date reference for each data record. \ The audio overload circuitry illuminating the rightmost red LED's at the upper right \ on the front of the unit does not kill the strobe, but as the DDF-1 \ manual states on p.10, DDF-1 users may select to have that happen by \ connecting a diode from Q1 collector to U11 pin 1. \ \ Note: utime in microseconds gets snipped at the low 4 digits to centiseconds \ and currently occupies only the low 5 bytes of a 64-bit number, so we may \ safely get away with packing the selected 0-15 slot number into the top \ nibble for decades to come! variable raw-data-buf-adr : write-utime&real-time-to-raw-data-buffer utime raw-data-buf-adr @ 2! raw-data-rec-len raw-data-buf-adr +! \ wrote 8 bytes of utime time&date ( pushes 6 4-byte numbers to tos ) \ now store 24 more bytes 6 0 do ( tos ) raw-data-buf-adr @ ! cell raw-data-buf-adr +! loop \ Stored 32 bytes total: \ #usecs since linux epoch and Gforth real time and date, \ in case clocks at data receiving stations don't exactly match. ; : init-raw-data-buffer raw-data-buffer raw-data-buf-len erase raw-data-buffer raw-data-buf-adr ! write-utime&real-time-to-raw-data-buffer 0. raw-data-count 2! raw-data-stamp-len to buff-write-pointer \ skip past initial date & time at buffer start ; 0. 2variable date&time-stamped-nibble : stuff-slot-index-into-raw-data-buffer ( slot-index=0..15 -- ) >r \ this is invoked after each strobe utime 1 usec/centisec m*/ ( d=centiseconds ) 16 1 m*/ \ shift left by 4 bits to make room for data nibble r> ( slot-index ) s>d d+ 2dup date&time-stamped-nibble 2! ( d ) raw-data-buffer buff-write-pointer + 2! \ raw-data-buf-adr 2! \ faster than doing the above \ the raw-data-buf-adr is always kept = raw-data-buffer + buff-write-pointer \ we keep track of the pointer just to prevent overflowing the RAM buffer ; : stb ( n --- ) cr ." storing raw data #" raw-data-count 2@ d. stuff-slot-index-into-raw-data-buffer ; : advance-raw-data-ring-buf-ptr&count \ Note: buff-write-pointer is the number of bytes from the end of the initial \ utime and real time at the start of raw-data-buffer to the next place \ to write an 8-byte centisec+slot# record. When buff-write-pointer exceeds \ the allocated raw-data-buffer length, it must be wrapped back to the \ start of raw-data-buffer + 32 bytes past the initial utime and real time. \ Meanwile, raw-data-buf-adr is maintained as the physical address to put \ the next data record. buff-write-pointer raw-data-rec-len + ( updated-pointer ) dup raw-data-buf-len >= if drop 32 \ skip past initial date & time at buffer start then dup to buff-write-pointer ( n=updated-pointer ) raw-data-buffer + raw-data-buf-adr ! raw-data-count 2@ 1. d+ raw-data-count 2! ; : ardc advance-raw-data-ring-buf-ptr&count ; : view-slot-values-stored ( n -- ) dup s>d raw-data-count 2@ d- d>s 0> if cr ( n ) drop ." raw data buffer has only " raw-data-count 2@ d>s dup . ." records" then \ tos = n or n1 = data count reduced from d to s dup 0<= ( n flg ) if drop cr ." Bad entry or there are no records stored" exit then raw-data-buffer cr ." Initial utime:" dup 2@ d. 2 cells + ." , initial real date & time:" 6 0 do dup @ . cell + loop ( n adr=raw-data-buffer+8_cells ) swap 0 do cr ( adr ) dup \ 4 + c@ ." maxval-slot-index:" 15 and ( low_4_bits_of_64) 3 .r 2@ d>s ." maxval-slot-index:" 15 and ( low_4_bits_of_64) 3 .r ." at: " dup 2@ 1 16 m*/ ( adr centisecs ) d. ." (utime in centisec)" 2 cells + loop ( adr ) drop ; : vss ( n -- ) view-slot-values-stored ; \ file access words usage references: \ =================================================================================== \ http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/General-files.html#General-files \ http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/Files-Tutorial.html#Files-Tutorial \ Examples in tutorial: \ 0 Value data-in \ 0 Value data-out \ 'addr u' is file name string location and length \ : open-input ( addr u -- ) r/o open-file throw to data-in ; \ : open-output ( addr u -- ) w/o create-file throw to data-out ; \ Scan file for a particular line \ 256 Constant max-line \ Create line-buffer max-line 2 + allot \ \ : scan-file ( addr u -- ) \ begin \ line-buffer max-line data-in read-line throw \ while \ >r 2dup line-buffer r> compare 0= \ until \ else \ drop \ then \ 2drop ; \ AX.25 buffer words \ =================================================================================== 8 cells constant AX.25rec-len 1000 constant AX.25recs AX.25rec-len AX.25recs * value AX.25buf-len variable AX.25buf AX.25buf-len allot \ Pointer to buffer address for storing the next AX.25 data record AX.25buf value AX.25wr-ptr 0 value AX.25buf-to-file-rd-ptr \ Pointer within the AX.25 ring buffer to send the next record \ when writing out to an AX.25 output file. \ This will be set to the start of the last AX.25 data record stored in the ring buffer \ which hasn't yet been written out to the AX.25 data output file. As long as AX.25 data \ continues to be flushed out to the file faster than new qualified bearings arrival, then \ this pointer will remain at the last bearing record (in circular order) not yet written out. \ Normally AX.25buf-to-file-rd-ptr is set to AX.25wr-ptr immediately after each new qualified \ bearing is added to the ring buffer when previous bearings were already flushed out to file. \ As bearings data is flushed out to the file, this pointer advances in circular order. \ Flushing to file is attempted every 50 DDF-1 strobe pulses at their 500 per second rate. \ Bearings are not accepted faster than around 10 times per second, so flushing will normally \ keep up with arrival of bearings in the ring buffer. \ If for some reason flushing to file gets backed up by the OS, AX.25wr-ptr will wrap around \ and catch up to AX.25buf-to-file-rd-ptr and possibly beyond as new bearings are written in \ the ring buffer in circular order. Any such bearing data lost in the local output file \ may have been captured at a remote station collecting AX.25 tansmitted bearings. \ If flushing of raw data was able to keep up, then lost bearings data may be recovered by \ processing stored raw data either at the bearings capturing station or a remote station \ connected via TCP/IP. AX.25buf value AX.25buf-to-serial-IO-ptr \ Pointer to ring buffer address for sending the next AX.25 data record out \ via serial I/O. \ This will be set to the start of each new AX.25 data record stored in the ring buffer \ for each qualified bearing. As serial I/O sends out data for a bearing, this pointer \ advances in circular order. \ If for some reason sending out bearing data gets backed up by the serial I/O connection to \ a remote recording station, AX.25wr-ptr will wrap around and catch up to \ AX.25buf-to-serial-IO-ptr and possibly beyond as new bearings are written in \ the ring buffer in circular order. Any such bearing data lost at the remote data \ collecting station may be recovered by processing raw data stored at the bearings data \ capturing station's raw data file. If TCP/IP is used between remote stations then the \ lost data may be recovered directly at the data collection location. 0 value AX.25data-count : init-AX.25buffer AX.25buf to AX.25wr-ptr AX.25buf to AX.25buf-to-file-rd-ptr 0 to AX.25data-count AX.25buf AX.25buf-len erase ; \ =================================================================================== \ AX.25 file words 0 value AX.25cmnds-in 0 value AX.25data-out : create-AX.25files s" /media/pi/Lexar/DDF-1rawdata/AX.25cmnds.in" w/o create-file ( fileid error ) swap ( error fileid ) to AX.25cmnds-in ( error ) 0<> if cr ." AX.25cmnds.in already exists, " then s" /media/pi/Lexar/DDF-1rawdata/AX.25data.out" w/o create-file ( fileid error ) swap ( error fileid ) to AX.25data-out ( error ) 0<> if cr ." AX.25data.out already exists, " then ; : crax create-AX.25files ; : init-AX.25files s" /media/pi/Lexar/DDF-1rawdata/AX.25cmnds.in" r/o open-file throw to AX.25cmnds-in s" /media/pi/Lexar/DDF-1rawdata/AX.25data.out" r/w open-file throw to AX.25data-out ; : flush-AX.25data-file AX.25data-out flush-file ( wior ) show-sp? if cr ." flush wior=" . else ( wior ) drop then ; : write-record-to-AX.25data-output-file AX.25wr-ptr AX.25rec-len AX.25data-out write-file throw \ write-file advances the file position pointer ; : dump-AX.25data-buf-to-output-file \ used in capture-bearings trial runs to capture bearings ASAP AX.25buf AX.25buf-len AX.25data-out write-file throw ; : dabf dump-AX.25data-buf-to-output-file ; \ =================================================================================== \ Raw data file words 0 value raw-data-out : get-raw-data-file-size ( -- ud wior ) raw-data-out file-size ; : grdfs get-raw-data-file-size ." wior=" . ." size=" d. ; : create-raw-data-file s" /media/pi/Lexar/DDF-1rawdata/raw-data.out" w/o create-file ( fileid error ) swap ( error fileid ) to raw-data-out ( error ) 0<> if cr ." raw-data.out already exists, " get-raw-data-file-size then ; : crdf create-raw-data-file ; : open-raw-data-file s" /media/pi/Lexar/DDF-1rawdata/raw-data.out" r/w open-file throw to raw-data-out ; : ordf open-raw-data-file ; \ Tutorial syntax example: \ write-file c-addr u1 wfileid – wior file “write-file” : dump-raw-data-buffer-to-output-file \ used in scan-slots trial runs to capture bearings ASAP and later read \ back recorded data for simulated bearings capturing raw-data-buffer raw-data-buf-len raw-data-out write-file throw ; : drdb dump-raw-data-buffer-to-output-file ; : write-raw-data-record-to-output-file \ raw-data-buf-adr raw-data-rec-len raw-data-out write-file throw date&time-stamped-nibble ( adr ) raw-data-rec-len raw-data-out write-file throw \ write-file advances the file position pointer \ but the raw data buffer must be also advanced correspondingly advance-raw-data-ring-buf-ptr&count ; : init-raw-data-file-for-writing open-raw-data-file \ copy initial date and time from the start of the raw data buffer \ write initial utime and real time out to the raw data buffer raw-data-buffer raw-data-stamp-len raw-data-out write-file throw \ start writing date/time stamped slot values after the initial date & time raw-data-buffer raw-data-stamp-len + raw-data-buf-adr ! ; : irdffw init-raw-data-file-for-writing ; \ Tutorial syntax example: \ flush-file wfileid – wior file-ext “flush-file” : flush-raw-data-file \ plan to use in scan-slots but not yet 11/11/19 raw-data-out flush-file ( wior ) show-sp? if cr ." flush wior=" . else ( wior ) drop then ; : frdf flush-raw-data-file ; : get-raw-data-file-ptr ( -- ud ) raw-data-out file-position throw ; : grdfp get-raw-data-file-ptr d. ; : set-raw-data-file-ptr ( ud -- ) raw-data-out reposition-file throw ; : srdfp set-raw-data-file-ptr ; : close-raw-data-output ( -- ) raw-data-out close-file throw ; : clrdo close-raw-data-output ; create read-data-buf raw-data-buf-len allot read-data-buf value read-data-buf-adr 2variable records-count \ Tutorial examples: \ read-line c_addr u1 wfileid – u2 flag wior file “read-line” \ read-line ( addr u1 fd -- u2 flag ior ) reads up to u1 bytes into the buffer at addr, \ and returns the number of bytes read, a flag that is false when the end of file is reached, \ and an error code. \ read-file c-addr u1 wfileid – u2 wior file “read-file” \ reposition-file ud wfileid – wior file “reposition-file” : init-read-data-buffer open-raw-data-file read-data-buf raw-data-buf-len erase \ read date & time stored at the start of the raw data file read-data-buf raw-data-stamp-len raw-data-out read-file ( byte-count wior) throw ( byte-count) read-data-buf swap ( byte-count ) dump \ prepare reading date/time stamped slot values after the initial date & time read-data-buf raw-data-stamp-len + read-data-buf-adr ! 0. records-count 2! ; : irdb init-read-data-buffer ; : update-read-ptr&count read-data-buf-adr read-data-buf - raw-data-buf-len >= if \ would write past buffer end \ so wrap pointer back to continue writing after the utime and real time \ stored at the start of the buffer read-data-buf raw-data-stamp-len ( #bytes) else read-data-buf-adr raw-data-rec-len ( #bytes ) then + ( updated-buf-adr ) to read-data-buf-adr 1. records-count 2@ d+ records-count 2! ; : urdba update-read-ptr&count ; : read-line-from-raw-data-file ( -- byte_count flg ) read-data-buf-adr raw-data-rec-len ( #bytes) raw-data-out read-line throw ( u2=#bytes_read flg ) ; : rlfrdf ( -- byte_count flg ) read-line-from-raw-data-file ; : read-record-from-raw-data-file ( -- byte_count ) read-data-buf-adr raw-data-rec-len ( #bytes) raw-data-out read-file throw ( u2=#bytes_read ) ; : rrfrdf read-record-from-raw-data-file ( -- byte_count ) ; : read-raw-data-from-file ( #records -- ) 0 do read-line-from-raw-data-file ( #bytes_read flg ) nip ( flg ) 0= if leave then update-read-ptr&count loop cr ." Read " records-count 2@ d. ." 8-cell (32-byte) records from raw data file" ; : rrdff ( n -- ) read-raw-data-from-file ; : trrdff ( n -- ) clrdo ordf irdb ( n ) rrdff ; : retrieve-raw-data-from-stored-file init-read-data-buffer \ try reading the max possible number of records from the raw data recording raw-data-buff-recs read-raw-data-from-file ; : rrdfsf retrieve-raw-data-from-stored-file ; : check-read-vs-written-data ( n=#bytes -- ) rrdfsf cr raw-data-count 2@ d. ." records were written" raw-data-buffer over dump cr records-count 2@ d. ." were read" read-data-buf swap dump ; : crvwd ( n=#bytes ) ( n ) check-read-vs-written-data ; : vwd 256 crvwd ; : copy-read-data-to-raw-data-buffer read-data-buf raw-data-buffer raw-data-buf-len cmove records-count 2@ raw-data-count 2! ; : crdtr copy-read-data-to-raw-data-buffer ; : close-AX.25input ( -- ) AX.25cmnds-in close-file throw ; : close-AX.25output ( -- ) AX.25data-out close-file throw ; : close-AX.25files close-AX.25input close-AX.25output ; 2 value DegreeDecimals 0.9e1 DegreeDecimals s>f f** f>s value DecimalsFactor 360 DecimalsFactor * value 360limit 0 value x1 0 value y1 0 value x2 0 value y2 0 value x3 0 value y3 0 value good-polynomial-fit? 0 value peakiness 4 value peakiness-decimals 1.0e1 peakiness-decimals s>f f** f>s value PeakinessFactor \ m value in y = -m(x-a)^2 +b will be max 1 when e.g. \ (x1,y1) = (0,0), (x2,y2) = (1,1), (x3,y3) = (2,0). \ We want to scale up the m value as an integer representing a fraction in decimal form. : debug debug-unstable-bearings-flag ." was " dup . -1 xor ." now is " dup . to debug-unstable-bearings-flag ; 0 value init-sp@ : chksp ( n -- ) show-sp? if cr ." Check for stack depth " dup . 2 + 4 * init-sp@ sp@ - dup 4 / 2 - ." depth is " . <> if break: then else ( n ) drop then ; 0 value sx1 0 value sx2 0 value sx3 0 value flag \ The maximum possible peakiness value m obtained by using y = -m*(x-a)^2+b is when, e.g., \ x1 = 1, x2 = 2, x3 = 3, y1 = 0, y2 = SlotScaleVal, y3 = 0, after a long sustained \ steady bearing. In this sample case a would compute to be exactly 2 but it \ will be stored here as 2*DecimalsFactor for display purposes. \ Since exponentially smoothed y values are scaled up by SlotScaleVal, \ m = -(y2 - y1)/[(x2 - a)^2 - (x1 - a)^2] in this sample case has max value SlotScaleVal. \ When peakiness is computed, however, the sx1, sx2, sx3 and "a" values are all scaled up by \ DecimalFactor*360/16, so the above ratio would be simply 1 in this example. \ Therefore a reasonable scale factor for m can be the inverse of that times an extra \ 10^peakiness-decimals factor so as to display a desired number of decimals for m. \ Therefore, to provide the large range of scaled m values with decimal \ points for displaying peakiness as a 32-bit number, the scaling factor is \ PeakinessFactor ( =10^peakiness-decimals ) DecimalsFactor 360 16 */ dup * \ ( PeakinessFactor [DecimalFactor*360/16]^2 ) \ SlotScaleVal */ \ ( PeakinessFactor*{[DecimalFactor*360/16]^2}/SlotScaleVal ) value m-scalefac 10000 value m-scalefac \ so that when m is 1 for (x1,y1)=(0,0), (x2,y2)=(1,1), (x3,y3)=(2,0) and the peakiness \ factor is 10000, then peakiness can be displayed as 1.0000 . \ Not that we need to see so many decimal places, but since I am avoiding floating point \ calculations peakiness may still be "seen" m when the polynomial fitting makes a very low \ curvature for the parabola. PeakinessFactor 5 / value peakiness-threshold : show-m-calc ( num denom -- num denom ) cr ." num:" over . ." denom:" dup . 2dup m-scalefac ." m-scalefac:" dup . swap */ ." scaled ratio:" . ; : set-peakiness ( num denom -- ) \ show-m-calc m-scalefac swap */ \ The ratio is bumped up in scale enough to overcome the scaling of the \ denominator, then it is compensated for the scaling of the numerator \ and scaled up more by DecimalsFactor to have decimal places for peakiness ( ratio ) dup 0<= show-sp? and if cr ." Bad peakiness result! " then to peakiness ; : compute-peakiness ( n=a_coeff -- n ) 0 to peakiness \ initially assume failure \ NOTE: a_coeff was scaled up by DecimalsFactor and 360/16 \ so x1, x2 & x3 also neeed to be scaled up here to match the scale of a_coeff x1 360 16 */ DecimalsFactor * to sx1 x2 360 16 */ DecimalsFactor * to sx2 x3 360 16 */ DecimalsFactor * to sx3 ( n ) >r \ The y values below were scaled up by SlotScaleVal (largest positive 16-bit number). \ This was chosen to store and forward 16 16-bit slot values representig LED \ brightness intensities exponentially averaged as the LED's are selected up to 500 \ times per second for remote processing of data collected to estimate bearings. \ The denominator below is scaled up from the range 0...15 by DecimalsFactor^2. \ The ratio absolute value is therefore expected to be in a range 0 to \ SlotScaleVal/DecimalsFactor^2. \ The m value is desired to be scaled up to show some decimal points. Therefore, \ the ratio will be scaled up by DecimalsFactor^2 and down by SlotScaleVal and then \ scaled up by PeakinessFactor. y1 y3 - ( peakiness_numerator ) dup 0= to flag ( flag1 ) \ NOTE: y values are scaled up by a factor SlotScaleVal. DecimalsFactor dup * * \ scale up to match (x - a)^2 scaling ( numerator=[y3-y1]*DecimalsFactor^2 ) sx3 r@ - dup * sx1 r@ - dup * - \ (x3 - a)^2 - (x1 - a)^2 ( num denom ) dup 0= ( num denom flag2 ) flag or if 2drop \ If the denominator (x3 - a)^2 - (x1 - a)^2 or the numerator y1 - y3 is 0 \ we have to compute m in a different way. We can solve for m using two other \ of the three equations for the two still unknown variables m and b. \ NOTE: we don't care what is the value of b, we need only m, the coefficient \ of the squared term in the parabolic fit. \ y1 = -m*(x1 - a)^2 + b y2 = -m*(x2 - a)^2 + b y3 = -m*(x3 - a)^2 + b y2 y3 - DecimalsFactor dup * * \ scale up to match (x - a)^2 scaling ( peakiness_numerator ) dup 0= ( flag1 ) to flag sx3 r@ - dup * sx2 r@ - dup * - ( num denom ) dup 0= ( num denom flag2 ) flag or if \ Oh well, we're out of luck again; a_coeff is equally distant \ from sx3 and sx2. There's one last chance. y1 y2 - ( peakiness_numerator ) DecimalsFactor dup * * \ scale up to match (x - a)^2 scaling dup 0= ( flag1 ) to flag sx2 r@ - dup * sx1 r@ - dup * - ( num denom ) dup 0= ( flag2 ) flag or if 2drop 0 to peakiness \ Well, time to give up. Something is strange. \ Check into this event sometime later. else ( num denom ) set-peakiness then else ( num denom ) set-peakiness then else ( num denom ) set-peakiness then r> ( a_coeff) ; : cpf ( a_ceoff -- ) break: compute-peakiness . peakiness . ; : compute-a_coefficient ( numerator denominator -- ratio_OK_or_flag ) 2 chksp show-sp? if ss ." begin eval-denom" then \ NOTE: The numerator is a sum of products of x values 0-15 and y values (which are \ scaled up by a factor SlotScaleVal). The denominator is a sum of only y values, \ so in order to get mid range 32-bit numbers for the ratio, which represents \ the m coefficient of the parabolic fit, we need to scale up the numerator \ so that the ratio result will be in units of degrees scaled up by DecimalsFactor \ instead of a nunmber 0-15. break-in-eval-enum? if break: then ( numerator denominator ) over 0> if ( numerator denominator ) 16 * >r \ stash while scaling numerator \ numerator was not yet scaled up by DecimalsFactor in the calling word \ nor was it scaled up to degrees from slot number 0-15 ( numerator ) s>d 360 DecimalsFactor * r> m*/ ( d=num*360*DacimalsFactor/[16*denom] ) \ now combined the effect of two scale factors, 360/16 and DecimalsFactor \ tos = high 32 bits of d dup 0<> if cr ." ScaleFactor is too large: a_coeff exceeds 32 bits:" d. -1 ( error_flag ) false to good-polynomial-fit? else show-sp? if cr ." a_coefficient = " 2dup d. ." centidegrees" then ( d=360*num/[16*denom] ) d>s \ scaling was designed so this fits within the low 32 bits ( ratio ) \ This is the desired parabola-fitted estimated bearing "index" scaled \ up by DecimalsFactor and 360/16 in order to get a_coeff in terms of \ degrees with DegreeDecimals decimal places. Decimal places can \ be shown without needing slower floating point computations. begin dup 360limit 1- > while show-bad-polynomial-fits? if cr ." bearing went over 360 degrees during polynomial fitting" dup . then 360limit - repeat begin dup 0< while show-bad-polynomial-fits? if cr ." bearing went negative during polynomial fitting" dup . then 360limit + repeat ( ratio_OK ) \ NOTE: this ratio is a_coeff scaled up by DecimalsFactor show-sp? if ." A-coeff=ratio:" dup . then \ so now compute the peakiness factor m true to good-polynomial-fit? compute-peakiness ( ratio_OK_or_bad_peakiness_flag=0) dup 0= if false to good-polynomial-fit? then then else ( num denom=0_or_neg ) show-bad-polynomial-fits? if seeSlots .s cr ." Bad polynomial fit: negative or 0 denominator 2y1 - y2 - y3 = " . ." ,useless numerator: " . ( -- ) else ( useless-num bad-denom ) 2drop then ( -- ) -1 ( error_flag ) false to good-polynomial-fit? ( bad-denom-flag=-1 ) then ( ratio_OK_or_error_flag=-1 ) 1 chksp show-sp? if .s ." did eval-denom" then ; : comp-acoeff ( num denom -- a-coeff_or_flg ) break: compute-a_coefficient ; : Lagrange-estimate-bearing ( slot# -- n ) 0 to good-polynomial-fit? \ initialize before Lagrange-estimate-bearing is done \ n = degrees * DecimalsFactor or neg bad fit flag \ Using the peak slot and two neighbor values, use a quadratic Lagrange polynomial fitted \ through them to compute an estimated more accurate bearing than just 360*n/16 \ which is only +- 11.75 degrees resolution. \ There is a lot more information contained via freqency of occurence of Doppler \ tone zero crossings within strobe capture periods. \ Referrence: \ https://homepage.dvms.uiowa.edu/~atkinson/ftp/ENA_Materials/Overheads/sec_4-1.pdf \ The following is a Forth oriented RPN motivated sped up computation using \ scaled integer arithmetic instead of floating point (a common trick among Forth \ programmers) for the simple case of a quadratic polynomial fit. For degrees >> 2 \ the last page of the above reference shows a general way of economical computation \ by nested polynomial evaluation that fits nicely in the Forth paradigm benefiting \ from RPN and stack operations. \ Slot values are scaled to SlotScaleVal (maximum positive 16-bit number) each time a slot \ is sleceted to light up one the DDF-1 bearing display 16 LED's. The seleced slot \ current value is multipled by N and added to SlotVal, then that is divided by N+1 \ and written into that slot value, resulting in an exponential filter having time \ constant = N*(interval between strobes), where N = avgFactor. \ Given a peak slot value y2 at slot x2, previous slot value y1 at slot x1, and next \ slot value y3 at slot x3 (slot values modulo 16 in the circulat slot buffer), the \ general Lagrange polynomial computation boils down to this: \ We let the fitted polynomial be y = -m*(x - a)^2 + b so m is a positive number for an \ upside down parabola fitting the data. Slot index x values are 0...15 indeces for \ a 16-slot array of y values stored as positive 16-bit integers scaled up to \ SlotScaleVal. For polynomial fitting, however, x values must be imagined as points along \ the x-axis in the (x,y) plane, not as coordinates along a circle. Therefore, the index \ intervals x2 - x1 and x3 - x2 are simply 1 for the line view but when looking up their \ corresponding y values, modulo 16 indeces must be used to get y values from the array. \ The general procedure for eliminating m and b by subtracting pairs of equations \ y1 = -m*(x1 - a)^2 + b, etc, yields: \ 2*a = [4*x2*y2 - y1*(2*x2 + 1) - y3*(2*x2 - 1)]/[2*y2 - y1 - y3] \ Scaled integer operations are used here to keep results accurate to about 15 bits \ and then finally the result "a" will be a scaled to degrees*DecimalsFactor. \ The slope factor "m" is a good measure of "peakiness" of the parabola fit to the data. \ After some algebraic manipulation, once "a" is computed then an example formula for m \ is: m = -(y3 - y1) / [ (x3 - a)*2 - (x1 - a)^2 ] ( index ) dup to x2 ( index ) BearingSlots over 2* + uw@ to y2 ( index ) dup 1- dup to x1 ( index index-1 ) dup 0< if 16 + then 2* BearingSlots + uw@ to y1 ( index ) 1+ dup to x3 ( index+1 ) dup 15 > if 16 - then 2* BearingSlots + uw@ to y3 0 chksp show-sp? if .s ." did set x1...y3" then ( -- ) 4 x2 * y2 * x2 2* >r r@ 1+ y1 * - r> 1- y3 * - 2/ \ numerator scaled up to SlotScaleVal y2 2* y1 - y3 - ( numerator denominator ) show-sp? if ." num=" over . ." denom=" dup . then \ The above numerator term for the formula \ \ 4*x2*y2 - y1*(2*x2 + 1) - y3*(2*x2 - 1) \ a = ----------------------------------------- \ 2*(2*y2 - y1 - y3) \ \ is scaled up to the neighborhood of SlotScaleVal times some number in the range \ roughly -1 to 16. \ Note: \ The value a would be -0.5 or slightly more positive if x2=0, x1=15, y1 is nearly or at y2, \ x3=2, and y3 = 0, because then x1 would have been converted to -1 for coordinates on a \ circle and the fitted upside down parabola would peak at x = -0.5. \ Likewise, a would be at or nearly 15.5 when x1 = 14, x2 = 15 and y1 = y2 but y3 is at or \ near y2. \ \ The above denominator is scaled up to SlotScaleVal. The whole idea here is to arrive at \ a sensibly estimated a_coeff value somewhere between x1 and x3 that will be near x2 if \ y1 is about the same as y3. In order to have a useful value having some decimal places \ the numerator is scaled up further by DecimalsFactor later in compute-a_coefficient . ( numerator denominator ) dup 0<= if \ This would mean the fit is a flat line or convex upward curve. The latter cannot \ actually happen because the peak y value would then have to be y1 or y3 with y2 \ being less, contrary to taking a peak value and then going left and right \ along the circle for neighboring y values. show-bad-polynomial-fits? if cr ." Bad denominator for polynomial fit:" dup . then ( numerator denominator ) 2drop -1 false to good-polynomial-fit? else ( numerator denominator ) compute-a_coefficient ( ratio_OK_or_neg_flag ) 1 chksp show-sp? if .s ." did leb" then then ( n ) \ n = degrees*DecimalsFactor or flag = -1 ; : leb ( peak-value-slot# -- n ) \ n = degrees*DecimalsFactor or flag = -1 debug-unstable-bearings-flag if break: then Lagrange-estimate-bearing ; : dopf ( peak-value-slot# -- ) cr leb . ." deg, m=" peakiness . ; 0 value last-bearing 0 value qualified-bearing? 180.0e0 0.9e0 f* f>s value 180deg 2variable bearings-capture-start-time 2variable bearing-start-time 2variable bearing-end-time 2variable bearing-duration \ these are all in usec 30 value ignorable-delta-degrees \ Exponentially smoothed estimated active bearings may not drift by more than this or they \ will get terminated and another tentative bearing value will be initiated. \ Likewise, tentative bearings must stay this close to their initial bearing or they \ will be terminated. ignorable-delta-degrees DecimalsFactor * value ignorable-bearing-delta \ this is the allowed drift amount for a_coeff values \ Tentative and active bearings ought to have their status maintained as long as the \ activity factor remains above a specified fraction of the positive 32-bit number \ used for scaling up bearing-time-activity. 0 value have-active-bearing? 0 value have-tentative-bearing? \ For an active bearing that continues to be sustained for reasons (a) & (b), in \ qualify-bearing-by-slot-values-hump, two more checks are made based on calculations \ that are done only for bearings that were first declared as tentative and then accepted \ as active. \ A more refined estimate of the signal direction is obtained by a Lagrangian polynomial \ fitting to a specified number of slot values surrounding the maxVal-Slot-index taken in \ circular order (mod 16). Currently this SW fits a quadratic polynomial. A sustained \ active bearing must have \ (c) its peakiness factor, the downward "curvature" of an upside down parabola fitted \ to the peak slot and adjacent two slot values, is large enough. \ If not, the fitted curve is considered too "flat", indicating a noisy and/or weak signal. \ (d) Rather than immediately drop a bearing as "unqualified" whenever a "glitch" occurs \ shoving the max-slot-val-index too far away (mod 16, on a circle) from the previous one, \ we just update the current bearing's estimated time activity value. If that falls below \ a specified fraction of $7FFF hen we declare the bearing as unqualifed as it needs to be \ terminated. \ Initially a bearing is first qualified and declared as tentative. If it continues \ being tentative for a specified time duration it is then declared as an active \ bearing. : qualify-by-polynomial-fit-peakiness have-active-bearing? have-tentative-bearing? or if good-polynomial-fit? if peakiness peakiness-threshold > ( flg ) \ (c) else 0 \ disqualify this bearing then ( flg ) to qualified-bearing? then ; : qbpfp break: qualify-by-polynomial-fit-peakiness ; : degrade-bearing-time-activity bearing-activity-exponential-decay-factor dup bearing-time-activity swap 1+ */ to bearing-time-activity ; : dbta break: degrade-bearing-time-activity ; : dbtas cr 0 do degrade-bearing-time-activity bearing-time-activity . loop ; : upgrade-bearing-time-activity bearing-activity-exponential-decay-factor >r r@ bearing-time-activity m* ( d=decayfac*activity ) BearingActivityScaleFactor s>d d+ r> ( decayfac ) 1+ 1 swap ( d=decayfac*activity+$7fff. 1 decayfac+1 ) m*/ ( d=[decayfac*activity+$7fff.]/[decayfac+1] ) d>s to bearing-time-activity ; : ubta break: upgrade-bearing-time-activity ; : ubtas ( n -- ) cr 0 do upgrade-bearing-time-activity bearing-time-activity . loop ; : init-bearing-time-activity BearingActivityScaleFactor 2 bearing-activity-acceptable-fraction */ to bearing-time-activity ; : ibt init-bearing-time-activity ; : ?update-qualified-bearing-time ( -- ) qualified-bearing? if upgrade-bearing-time-activity else degrade-bearing-time-activity then ; : qualify-by-sustained-bearing-time-activity ?update-qualified-bearing-time bearing-time-activity bearing-time-activity-threshold < \ (d) if 0 to qualified-bearing? then ; : qbsb break: qualify-by-sustained-bearing-time-activity ; : qualify-bearing-by-slot-values-hump \ tos not used nor affected \ The DDF-1 display LED's appear to light up to a degree corresponding to relative \ frequency of moments when they are selected by zero crossings of the switched \ capacitor filter. In updateAllSlots "estimated slot values" are averaged using \ a typical "exponential filter" having a "time constant" in avgFactor. \ A bearing "qualifies" if: \ (a) its peak slot value risen high enough above a desired fraction of the average \ slot value, and \ (b) its width, in terms of surrounding slot values that are above a certain threshold, \ is not too large, i.e. the curve of smoothed slot values is not "too flat" \ The above checks are done based on quick and easy to process measurements. max-slot-val ( 0_to_ScaleVal ) qualifying-threshold > ( flag ) \ (a) bearing-width ( #slots ) qualifying-width < and ( flag ) \ (b) ( flag ) to qualified-bearing? ; : qqq gds ." strobe " . gbn ( slot# ) ." slot " dup . ( slot# ) dup 1 ( slot# slot# 1 ) uu ( slot# ) stb ( -- ) ss fmsv gbw max-slot-val . maxval-slot-index . bearing-width . qualified-bearing? . ; : qqqq ( n -- ) 0 do qqq loop ; : qqs begin fastpulse gds until begin pulse gds 0= until cr gbn ( slot# ) ." slot " dup . dup ( slot# slot# ) 1 uu ( slot# ) stb fmsv gbw ." maxslot-val:" max-slot-val . maxval-slot-index . bearing-width . ss qualify-bearing-by-slot-values-hump ; : qqss ( n -- ) 0 do qqs loop ; : show-capture-error ( n1 -- ) cr hex . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . getBearingNibble . decimal time&date 6 0 do . loop ; : show-time ( d -- ) \ time in us split up into days, hrs, min, sec, ms, us 2dup 1 usec/day ( d d1 n2 u3 ) m*/ ( d dquot ) \ dquot={d1*n2}/u2 = no. of days in d as a 64-bit number \ see m*/ in gforth manual pdf 5.5.5 Mixed precision ( d dquot ) 2dup d. ." days " usec/day 1 m*/ ( d1 d2=dquot*usec/day ) ( d1=original_d_total_us d2=us_in_earlier_days ) d- ( d ) \ d = remaining_usec_in_this_day which is only a 32 bit number ( d ) usec/hr ( ud u1 ) um/mod ( u2 u3 ) \ ud = u3*u1 + u2 \ see um/mod in gforth manual pdf 5.5.5 Mixed precision ( n4=remaining_usec hrs ) 2 .r ." hrs " 1 usec/min */mod ( n4=remaining_usec min ) 2 .r ." min " 1 usec/sec */mod ( n4=remaining_usec sec ) 2 .r ." sec " 1 usec/msec */mod ( n4=remaining_usec ms ) 2 .r ." ms " ( n5=remaining_usec ) 2 .r ." us " ; : st ( d -- ) break: show-time ; : update-bearing-in-AX.25buf \ used in terminate-active-bearing 0 chksp show-sp? if .s ." begin updating AX.25buf" then \ jump buf ptr back to start of last added record AX.25wr-ptr AX.25rec-len - ( adr ) dup AX.25buf < if AX.25buf-len + \ jump to last buffer record then ( decremented_pointer_within_ring_buffer ) to AX.25wr-ptr ( -- ) time&date ( sec min hrs day mo yr ) 2000 - \ store only 2 yr digits \ 6 numbers at t.o.s 6 0 do AX.25wr-ptr i + c! loop \ yr-2000, mo, day, hrs, min, sec ( -- ) max-slot-val AX.25wr-ptr 6 + w! \ at last sustained bearing peakiness AX.25wr-ptr 8 + w! \ m coefficient in parabolic fit bearing-start-time 2@ AX.25wr-ptr 10 + 2! \ usecs since this bearing began bearing-duration 2@ AX.25wr-ptr 18 + 2! \ bearing sustained time in us last-bearing AX.25wr-ptr 26 + w! \ last polynomial fitted bearing, \ an unsigned 32-bit integer \ = degrees*0.9*10^DegreeDecimals, \ currently it occupies only 2 bytes bearing-width AX.25wr-ptr 28 + c! \ #slots \ 3 spare bytes are available write-record-to-AX.25data-output-file \ jump buf ptr ahead to start of next record to be added AX.25wr-ptr AX.25buf-len + ( advanced_address) dup AX.25buf AX.25buf-len + > ( adr flg ) if drop AX.25buf \ wrap around back to start of buffer then ( incremented_pointer_in_ring_buffer ) to AX.25wr-ptr 0 chksp show-sp? if .s ." did update AX.25buf" then ; : uba cr ." updating AX.25 record#" AX.25data-count . update-bearing-in-AX.25buf ; : initiate-bearing-in-AX.25buf \ used in process-qualified-bearing \ This is used when converting a tentative bearing to an active bearing \ so as to store bearing start time and rough width in terms of \ active slots before the active bearing gets terminated. \ A packet radio command will allow inquiry about a bearings from monitoring nodes \ while a signal remains on the frequency before this SW declares a terminated \ active bearing and sends out a packet radio report including bearing duration. 0 chksp show-sp? if .s ." begin initiating new AX.25buf record" then time&date ( sec min hrs day mo yr ) 2000 - \ store only 2 yr digits 6 0 do AX.25wr-ptr i + c! loop \ yr-2000, mo, day, hrs, min, sec max-slot-val AX.25wr-ptr 6 + w! \ at last sustained bearing 0 AX.25wr-ptr 8 + w! \ m coefficient in parabolic fit \ peakiness not yet computed bearing-start-time 2@ AX.25wr-ptr 10 + 2! \ usecs since this bearing began \ bearing-duration 2@ AX.25wr-ptr 18 + 2! \ bearing sustained time in us 0. AX.25wr-ptr 18 + 2! \ duration not yet measured until a sustained bearing ends last-bearing AX.25wr-ptr 26 + w! \ last polynomial fitted bearing, \ this is the initial bearing at first qualification acceptance \ an unsigned 32-bit integer \ = degrees*0.9*10^DegreeDecimals, \ currently it occupies only 2 bytes bearing-width AX.25wr-ptr 28 + c! \ #slots \ 3 spare bytes are available write-record-to-AX.25data-output-file \ jump buf ptr ahead to start of next record location AX.25wr-ptr AX.25rec-len + ( next_buf_slot_adr ) AX.25buf AX.25buf-len + over <= ( adr flg ) if drop AX.25buf \ wrap around back to start of buffer then ( advanced_or_wrapped_around_adr ) to AX.25wr-ptr AX.25data-count 1+ to AX.25data-count 0 chksp show-sp? if .s ." did initiate AX.25buf" then ; : iba cr ." initiating AX.25 record#" AX.25data-count . initiate-bearing-in-AX.25buf ; : cancel-tentative-bearing-data&count \ used in reject-tentative-bearing \ jump buf ptr back to start of last added record AX.25wr-ptr AX.25rec-len - dup AX.25buf < if AX.25buf-len + \ jump forward to the last record slot in the ring buffer then ( backed_off_pointer ) to AX.25wr-ptr AX.25wr-ptr AX.25rec-len erase \ clear unaccepted data AX.25data-count 1- ( adjusted_count ) dup 0< if cr ." ERROR! trying to delete more AX.25 records than there are in the buffer!" close-AX.25files close-raw-data-output quit else ( n ) to AX.25data-count then ; : ctbd cr ." canceling AX.25 record#" AX.25data-count . cancel-tentative-bearing-data&count ; : show-angle ( n=angle*DecimalsFactor -- ) ." bearing:" DecimalsFactor /mod 3 u.r ." ." DegreeDecimals u.r ." deg" ; : view-stored-AX.25bearings ( n -- ) dup AX.25data-count > if cr ( n ) drop ." AX.25 buffer has " AX.25data-count dup . ." records" then \ tos = n dup 0<= ( n flg ) if drop cr ." Bad entry or there are no records stored" exit then AX.25buf swap 0 do ( adr ) cr ." Year:20" dup c@ 2 .r ( adr ) 1+ ." mo:" dup c@ 2 .r ( adr ) 1+ ." day:" dup c@ 2 .r ( adr ) 1+ ." time: " dup c@ 2 .r ." :" ( adr ) 1+ dup c@ 2 .r ." :" ( adr ) 1+ dup c@ 2 .r ( adr ) 1+ ." max slot val:" dup uw@ 5 .r ( adr ) 2 + ." peakiness:" ." 0." dup uw@ peakiness-decimals .r ( adr ) 2 + cr ." started:" dup 2@ show-time ( adr ) 2 cells + ." duration:" dup 2@ ( adr us ) 1 usec/centisec m*/ ( adr d=centisec ) centisec/min um/mod ( adr u2=rem_centisec u3=min ) 3 .r ." min " ( adr centisec ) 1 centisec/sec */mod ( adr rem_centisec sec ) 3 .r ( adr centisec ) ." ." 2 .r ." sec" ( adr ) 2 cells + cr dup uw@ show-angle ( adr ) cell + ." width:" dup c@ 3600 16 */ s>f 0.1e0 f* f. ." deg" ( adr ) 2 + loop ( adr ) drop ; : vsa ( n -- ) view-stored-AX.25bearings ; : show-bearing ( bearing -- ) cr ." at " utime bearings-capture-start-time 2@ d- \ us since this code run began show-time ( bearing-in-degrees*DecimalsFactor ) show-angle ; : time-since-capture-start ( -- d ) utime \ usecs since linux epoch bearings-capture-start-time 2@ ( usecs since linux epoch ) d- ; : store-bearing-start-time ( -- ) \ store relative elapsed time (us) since bearing began time-since-capture-start bearing-start-time 2! ; \ AX.25 records times are stored relative to start of capturing bearings : store-bearing-end-time ( -- ) \ store relative elapsed time (us) since bearing began time-since-capture-start bearing-end-time 2! ; \ AX.25 records times are stored relative to start of capturing bearings : store-bearing-duration \ store relative elapsed time (us) since bearing began bearing-end-time 2@ bearing-start-time 2@ d- bearing-duration 2! ; : terminate-active-bearing ( bearing -- ) dup to last-bearing ( bearing-in-degrees*DecimalsFactor ) store-bearing-end-time store-bearing-duration show-good-fit-bearing-start&end? if ss ( bearing ) show-bearing ." active bearing terminated" else ( bearing ) drop then update-bearing-in-AX.25buf 0 to have-active-bearing? ; : reject-tentative-bearing ( bearing -- ) ( bearing-in-degrees*DecimalsFactor ) show-good-fit-bearing-start&end? if ss ( bearing ) show-bearing ." tentative bearing rejected" else ( bearing ) drop then ( -- ) 0 to have-tentative-bearing? \ cancel-tentative-bearing-data&count ; : ?show-new-bearing-affirmed ( bearing -- ) show-good-fit-bearing-start&end? if ss ( bearing ) show-bearing ." new bearing affirmed" else ( bearing ) drop then ; : ?show-new-tentative-bearing ( bearing -- ) show-good-fit-bearing-start&end? if ss ( bearing ) show-bearing ." tentative new bearing began" else ( bearing ) drop then ; : process-qualified-bearing ( bearing -- ) \ used in process-qualified-slot-data 1 chksp show-sp? if ss ." begin pqb" then have-active-bearing? if ( bearing-in-degrees*DecimalsFactor ) dup last-bearing - abs dup 180deg > if 180deg - then show-bearings-near-to-last? if ." bearing delta:" dup . then ( bearing delta_bearing ) ignorable-bearing-delta > if \ the bearing either drifted off too far or \ another signal overrode the previous one \ so terminate this one and after the next qualified \ bearing start a tentative bearing ( bearing-in-degrees*DecimalsFactor ) terminate-active-bearing ( -- ) else show-bearings-near-to-last? if ( bearing ) dup show-bearing ." bearing is near last one" then \ update smoothed bearing and continue with same bearing start time ( bearing ) to last-bearing ( -- ) store-bearing-end-time store-bearing-duration then else have-tentative-bearing? if \ If a tentative bearing remains "stable" for a specified time duration, \ i.e. its corresponding estimated slot value remains within specified bounds \ for a specified count of centiseconds, it will be declared an active bearing. store-bearing-end-time store-bearing-duration \ dbg Aug 27 cr utime show-time ." tentative bearing duration:" bearing-duration 2@ d. bearing-duration 2@ minimal-acceptable-usecs 2@ d> if \ affirm having valid bearing false to have-tentative-bearing? true to have-active-bearing? ( bearing ) ?show-new-bearing-affirmed ( -- ) initiate-bearing-in-AX.25buf else ( bearing ) to last-bearing \ continue tentative bearing status then else \ declare new tentative bearing true to have-tentative-bearing? store-bearing-start-time ( bearing ) dup to last-bearing \ updated smoothed bearing so far ( bearing ) ?show-new-tentative-bearing ( -- ) then then 0 chksp show-sp? if .s ." did pqb" then ; 0 value within-allowed-nibble-offset? 5 value #nibble-tries 5 value allowed-nibble-offset : 1st-check-for-slot#-consistency ( n1=slot1_in_cfsc_or_ttgcbn -- n2 ) \ n2 = avg of #nibble-tries nibble grabs \ used only in 1cfsc and try-to-get-consistent-bearing-nibble 1 chksp show-sp? if cr ." Then look for " #nibble-tries . ." close sequential slot values; first one was " ( n1 ) dup . ." then:" then true to within-allowed-nibble-offset? #nibble-tries 1 \ start loop at 1, not 0, after getting first nibble do getBearingNibble ( n1 n2 ) show-sp? if dup . then ( n1 n2 ) 2dup - abs dup 8 > if ( n1 n2 |n1-n2| ) 16 swap - ( n1 n2 |n1-n2|mod16 ) then allowed-nibble-offset > if ( n1 n2 ) nip show-sp? if cr ." exceeded allowed-nibble-offset " allowed-nibble-offset . ." keep trying" then else ( n1=prev_nibble n2=current_nibble ) nip then ( n2 ) \ n2 replaces n1 for next i in this loop loop ( n n2 ) ; : 1cfsc ( n1 -- n2 ) break: 1st-check-for-slot#-consistency ; : 2nd-check-for-slot#-consistency ( n1=slot1_in_cfsc_or_ttgcbn -- n2 ) \ n2 = avg of #nibble-tries nibble grabs \ used only in 2cfsc and try-to-get-consistent-bearing-nibble 1 chksp show-sp? if cr ." Try again to look for " #nibble-tries . ." close sequential slot values; first one was " ( n1 ) dup . ." then:" then \ true to within-allowed-nibble-offset? \ was set in 1st-..... #nibble-tries 1 \ start loop at 1, not 0, after getting first nibble do getBearingNibble ( n1 n2 ) show-sp? if dup . then ( n1 n2 ) 2dup - abs dup 8 > if ( n1 n2 |n1-n2| ) 16 swap - ( n1 n2 |n1-n2|mod16 ) then allowed-nibble-offset > if ( n1 n2 ) nip show-sp? if cr ." exceeded allowed-nibble-offset " allowed-nibble-offset . ." leaving loop" then leave false to within-allowed-nibble-offset? else ( n1=prev_nibble n2=current_nibble ) swap i * swap + i 1+ / \ (i*avg_n_so_far + n2)/(i + 1) ( n2=updated_weighted_average ) then loop ( n n2 ) ; : 2cfsc ( n1 -- n2 ) break: 2nd-check-for-slot#-consistency ; : try-to-get-consistent-bearing-nibble ( n -- avg_slot# ) getBearingNibble ( n n1 ) show-sp? if cr ." First nibble after the strobe:" over . ." after retry:" dup . then ( n n1 ) nip \ start checking consistency of nibbles after n1 ( n1 ) 1st-check-for-slot#-consistency ( n2 ) ( n1 ) 2nd-check-for-slot#-consistency ( n2 ) \ in case of still unsettled data lines after a strobe falling edge ; : ttgcbn break: try-to-get-consistent-bearing-nibble ( n -- avg_slot# ) ; : get-strobe ( -- flg ) \ used only in tgc for testing with dup . etc. begin getDDFstrobe ( flg ) dup if begin \ loop for about 20us strobe high duration key? if key 66 = if exit then \ in case strobe gets stuck HI then getDDFstrobe ( flg ) 0= until then ( flg ) until ; : tgc ( n -- ) 0 do true to within-allowed-nibble-offset? get-strobe ( flg ) if cr getBearingNibble ( n1 ) . getBearingNibble ( n2 ) dup . #nibble-tries 1 \ start loop at 1, not 0, after getting first nibble do getBearingNibble ( n2 n3 ) dup . over - abs dup 8 > if 16 swap - then allowed-nibble-offset > if false to within-allowed-nibble-offset? leave then loop ( n3 ) drop ." within-allowed-nibble-offset? " within-allowed-nibble-offset? . else cr ." no strobe" then loop ; 0 value pulse-place : ?pulse-here ( n -- ) pulse-place = if fastpulse pulse fastpulse then ; 0 value capturing-bearings? : try-flushing-buffers \ flush-raw-data-file capturing-bearings? if flush-AX.25data-file then ; : pause ." wait a few seconds" 20 tt ." now hit a key again" ; : toggle-debug-showing ( key -- ) \ if key = 'a' ... 'h' or 'p' case ( a) 97 of show-good-fit-bearing-start&end? true xor to show-good-fit-bearing-start&end? endof ( b) 98 of show-not-qualified-bearings? true xor to show-not-qualified-bearings? endof ( c) 99 of show-U4-clock-clashes? true xor to show-U4-clock-clashes? endof ( d) 100 of show-bad-polynomial-fits? true xor to show-bad-polynomial-fits? endof ( e) 101 of show-bearings-near-to-last? true xor to show-bearings-near-to-last? endof ( f) 102 of debug-unstable-bearings-flag true xor to debug-unstable-bearings-flag endof ( g) 103 of show-sp? true xor to show-sp? endof ( h) 104 of break-in-eval-enum? true xor to break-in-eval-enum? endof ( p) 112 of cr ." pausing?" pause key dup 112 = if allow-pausing? true xor to allow-pausing? then 27 ( ESC ) = if capturing-bearings? if ( flush-AX.25data-file) close-AX.25files then ( flush-raw-data-file) close-raw-data-output quit then endof endcase ; : select-pulse-placement ( key -- ) \ if key has ASCII value lower than for '0' or higher than for '6', nothing happens \ if key is '1'....'6' a certain pulse will inserted within the strobe interval \ for measuring time from strobe falling edge to a specific event before the next strobe 48 max 54 min 48 - to pulse-place ; : ?check-for-debug-request key? if key dup 68 ( 'D' ) = if debug then dup toggle-debug-showing dup select-pulse-placement dup 65 = if ( key='A' ) seeSlots last-bearing show-bearing then 113 = if ( key='q' ) \ dump-raw-data-buffer-to-output-file capturing-bearings? if ( flush-AX.25data-file) close-AX.25files then ( flush-raw-data-file) close-raw-data-output quit then then ; : getDDFstrobePulse ( -- flg ) \ used in getStrobe&Nibble&ProcessData \ also used in gdsp and getDDFstrobePulse&ConsistentNibble for testing begin getDDFstrobe ( flg ) dup 0= while ( flg ) drop ?check-for-debug-request try-flushing-buffers repeat ( flg ) dup if ( flg ) begin \ loop for about 20us strobe high duration ?check-for-debug-request try-flushing-buffers getDDFstrobe ( flg ) 0= until then ( flg ) ; : getDDFstrobePulse&ConsistentNibble ( n1 -- n ) \ used only for testing in gdspcn getDDFstrobePulse ( -- flg ) if getBearingNibble ( n1 ) try-to-get-consistent-bearing-nibble ( n2 ) else cr ." got no strobe" false to within-allowed-nibble-offset? false ( returned_n ) then ; : process-stable-slot-data ( n1 -- n1 ) \ used in getStrobe&Nibble&ProcessData 1 ?pulse-here ( n1=slot_index ) 1 chksp show-sp? if ." n1 = n2...n3" then ( n1 ) dup updateAllSlots 1 chksp show-sp? if ." did updateAllSlots" then ( n1 ) find-max-slot-val 1 chksp show-sp? if ss cr ." max-slot-val:" max-slot-val . ." maxval-slot-index:" maxval-slot-index . then ( n1 ) dup stuff-slot-index-into-raw-data-buffer 1 chksp show-sp? if .s ." did stuff...val...buff" then write-raw-data-record-to-output-file 1 chksp show-sp? if .s ." did write...file" then get-bearing-width ( n1 ) 1 chksp show-sp? if ." bearing-width:" bearing-width . then qualify-bearing-by-slot-values-hump ( n1 ) 1 chksp show-sp? if cr ." did qualify-bearing-by-slot-values-hump" then \ qualify-by-polynomial-fit-peakiness \ ( n1 ) \ 1 chksp show-sp? \ if \ cr ." peakiness:" peakiness . \ ." did qualify-by-polynomial-fit-peakiness" \ then qualify-by-sustained-bearing-time-activity ( n1 ) 1 chksp show-sp? if cr ." bearing-time-activity:" bearing-time-activity . ." did qualify-by-sustained-bearing-time-activity" then ; : process-qualified-slot-data ( n1 -- ) \ used in getStrobe&Nibble&ProcessData 2 ?pulse-here 1 chksp show-sp? if .s ." qualified" then ( n1=slot_index ) Lagrange-estimate-bearing ( bearing-in-degrees*DecimalsFactor_or_bad-polynomial-fit-flag ) dup 0< if ( flag ) drop 0 chksp show-sp? if .s ." bad fit" then show-bad-polynomial-fits? if \ some error causing negative bearing \ or a flat line or convex upwards fit ss ." bad slots data for polynomial fit" then ( -- ) else \ Do another qualification based on peakiness of the fitted curve qualify-by-polynomial-fit-peakiness ( bearing-in-degrees*DecimalsFactor ) 1 chksp show-sp? if .s ." good fit" then qualify-by-sustained-bearing-time-activity ( bearing-in-degrees*DecimalsFactor ) process-qualified-bearing ( -- ) 0 chksp show-sp? if .s ." did pqb" then then ( -- ) ; : terminate-unqualified-bearing ( n1 -- ) ( n1 ) \ bearing didn't qualify 3 ?pulse-here 1 chksp show-sp? if .s ." not qualified" then show-not-qualified-bearings? if ( n1 ) dup show-bearing ." not qualified" then have-active-bearing? if ( n1 ) terminate-active-bearing else have-tentative-bearing? if ( n1 ) reject-tentative-bearing else ( n1 ) drop then then ; : process-unstable-slot-data ( n1 -- ) 4 ?pulse-here 1 chksp show-sp? if cr ." in process-unstable-slot-data" .s ." couldn't get close nibble " #nibble-tries . ." times" then show-U4-clock-clashes? if ( n1 ) show-capture-error else ( n1 ) drop then ; : getConsistentNibbles ( -- n ) getBearingNibble ( n1 ) ( n1 ) try-to-get-consistent-bearing-nibble ( n ) ; : getStrobe&Nibble&ProcessData ( -- ) \ used in CaptureBearings getDDFstrobePulse ( -- flg ) if getConsistentNibbles ( n ) 1 chksp show-sp? if ." within-allowed-nibble-offset? " within-allowed-nibble-offset? . then ?check-for-debug-request ( n ) qualify-by-sustained-bearing-time-activity within-allowed-nibble-offset? ( n flag ) if ( n ) process-stable-slot-data ( n ) qualified-bearing? if process-qualified-slot-data else terminate-unqualified-bearing then else ( n1 ) process-unstable-slot-data \ wait for another strobe then ( -- ) else \ got no strobe at the top of the begin loop ?check-for-debug-request then ; : gdsp getDDFstrobePulse ( -- flg ) ; : gsnpd break: getStrobe&Nibble&ProcessData ( -- ) ; : gdspcn getDDFstrobePulse&ConsistentNibble ( -- n_or-1 ) ; : qb qualify-bearing-by-slot-values-hump qualified-bearing? . ; : qb? break: qb ; : pqb ( bearing -- ) break: process-qualified-bearing .s ; : pssd break: process-stable-slot-data ( n1 -- n1 ) ; : pqsd break: process-qualified-slot-data ( n1 -- ) ; : tub break: terminate-unqualified-bearing ( n1 -- ) ; : pusd break: process-unstable-slot-data ( n1 -- ) ; : init-capture-bearings-or-scan-slots clearstacks sp@ to init-sp@ utime ( d ) bearings-capture-start-time 2! cr ." Initial stack check " 0 chksp cr init-raw-data-buffer \ Note: This also independently stores utime at the start of the buffer ; : init-cb init-capture-bearings-or-scan-slots ; : init-debug-params ( a ) 1 to show-good-fit-bearing-start&end? ( b ) 0 to show-not-qualified-bearings? ( c ) 0 to show-U4-clock-clashes? ( d ) 0 to show-bad-polynomial-fits? ( e ) 1 to show-bearings-near-to-last? ( f ) 0 to debug-unstable-bearings-flag ( g ) 0 to show-sp? ( h ) 0 to break-in-eval-enum? ( p ) 0 to allow-pausing? ; : init-dbg init-debug-params ; : CaptureBearings true to capturing-bearings? init-capture-bearings-or-scan-slots init-debug-params init-bearing-time-activity init-AX.25buffer create-AX.25files init-AX.25files create-raw-data-file init-raw-data-file-for-writing begin \ Loop for at least 2ms duration beween strobes, and much more if no strobes \ occur depending on adjustment of the DDF-1 damping and audio level controls. \ First capture a bearing, then process data and send out bearing data via TCP/IP \ and/or AX.25 packets via radio link: \ (a) wait for strobe pin HI \ (b) wait about 20us for a strobe pin LO, meanwhile scan for keystrokes, try \ flushing buffers \ (c) read the 4 data lines for a bearing nibble, then confirm consistency \ in case of an asynchronous clash with latching of data lines \ (d) process bearing data to qualify the bearing captured \ (e) stuff the raw data nibble and a time&date into the raw data buffer \ (f) check if estimated bearing is valid, and if so, stuff it into the \ smoothed data buffer for AX.25 output \ (g) flush buffers to the extent possible during idle times \ 1. when waiting for strobe pin LO \ 2. after processing and qualifying the current bearing nibble getStrobe&Nibble&ProcessData ( -- ) try-flushing-buffers show-sp? if cr ." pausing?" pause key dup 112 = if allow-pausing? true xor to allow-pausing? then 27 ( ESC) = if ( flush-AX.25data-file) ( dump-AX.25data-buf-to-output-file) close-AX.25files ( flush-raw-data-file) close-raw-data-output leave then then again close-AX.25files close-raw-data-output ; : cb CaptureBearings ; : cbd break: cb ; 0 value strobe-count : clear-debug-params ( a ) 0 to show-good-fit-bearing-start&end? ( b ) 0 to show-not-qualified-bearings? ( c ) 0 to show-U4-clock-clashes? ( d ) 0 to show-bad-polynomial-fits? ( e ) 0 to show-bearings-near-to-last? ( f ) 0 to debug-unstable-bearings-flag ( g ) 0 to show-sp? ( h ) 0 to break-in-eval-enum? ( p ) 0 to allow-pausing? ; : scan-slots false to capturing-bearings? init-capture-bearings-or-scan-slots clear-debug-params init-bearing-time-activity create-raw-data-file init-raw-data-file-for-writing begin getDDFstrobePulse ( -- flg ) if getConsistentNibbles ( n ) 1 chksp show-sp? if ." did gcn " then store-bearing-start-time 1 chksp show-sp? if ." did sbst " then within-allowed-nibble-offset? ( n flag ) if \ ( n ) much of code from process-stable-slot-data \ but without Lagrange polynomial fitting 1 ?pulse-here ( n=slot_index ) 1 chksp show-sp? if .s ." n1 = n2...n3" then ( n ) dup updateAllSlots 1 chksp show-sp? if .s ." did updateAllSlots" then ( n ) find-max-slot-val 1 chksp show-sp? if ss cr ." max-slot-val:" max-slot-val . ." maxval-slot-index:" maxval-slot-index . then ( n ) dup stuff-slot-index-into-raw-data-buffer 1 chksp show-sp? if .s ." did stuff...val...buff" then write-raw-data-record-to-output-file 1 chksp show-sp? if .s ." did write...file" then get-bearing-width ( n ) 1 chksp show-sp? if ss ." bearing-width:" bearing-width . then qualify-bearing-by-slot-values-hump ( n ) 1 chksp show-sp? if ss ." did qualify-bearing-by-slot-values-hump" then qualify-by-sustained-bearing-time-activity store-bearing-end-time store-bearing-duration ( n ) 1 chksp show-sp? if cr ." did store bearing end time & duration" then strobe-count 1 50 */mod drop 0= if ss ( n ) 4 .r bearing-duration 2@ 6 d.r bearing-time-activity 6 .r try-flushing-buffers else ( n) drop then strobe-count 1+ to strobe-count else ( n ) process-unstable-slot-data degrade-bearing-time-activity 0 chksp show-sp? if cr ." did degrade-bearing-time-activity" then \ wait for another strobe then ( -- ) else show-sp? if cr ." got no strobe at the top of the begin again loop" then then ?check-for-debug-request again ; : sss scan-slots ; : dscan break: scan-slots ; clearstacks sp@ to init-sp@