// ---------------------------------------------------------------------------- // key.c -- bayesian morse code decoder // // Copyright (C) 2012-2014 // (C) Mauri Niininen, AG1LE // // This file is part of Bayesian Morse code decoder // bmorse is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 3 of the License, or // (at your option) any later version. // // bmorse is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with bmorse. If not, see . // --------------------------------------------------------------------------- #ifdef __cplusplus extern "C" { #endif #include "f2c.h" /* Common Block Declarations */ struct blkend_1_ { integer iend; }; #define blkend_1 (*(struct blkend_1_ *) &blkend_) struct { real tau; } blk1_; #define blk1_1 blk1_ struct { real dmean, xdur, esep[6], edev[6]; } blk6_; #define blk6_1 blk6_ struct { integer itext[200]; } blktxt_; #define blktxt_1 blktxt_ /* Initialized data */ struct { integer e_1; } blkend_ = { 0 }; /* Table of constant values */ static integer c__1 = 1; /* Subroutine */ int key_(real *dur, real *x) { /* Initialized data */ static integer ltr = 1; static integer nelm = 0; static integer n = 0; static integer nltr = 1; static integer morse[400] = { 1,3,2,0,0,0,0,0,0,0, 2,3,1,3,1,3,1,0,0,0, 2,3,1,3,2,3,1,0,0,0, 2,3,1,3,1,0,0,0,0,0, // ABCD 1,0,0,0,0,0,0,0,0,0, 1,3,1,3,2,3,1,0,0,0, 2,3,2,3,1,0,0,0,0,0, 1,3,1,3,1,3,1,0,0,0, // EFGH 1,3,1,0,0,0,0,0,0,0, 1,3,2,3,2,3,2,0,0,0, 2,3,1,3,2,0,0,0,0,0, 1,3,2,3,1,3,1,0,0,0, // IJKL 2,3,2,0,0,0,0,0,0,0, 2,3,1,0,0,0,0,0,0,0, 2,3,2,3,2,0,0,0,0,0, 1,3,2,3,2,3,1,0,0,0, // MNOP 2,3,2,3,1,3,2,0,0,0, 1,3,2,3,1,0,0,0,0,0, 1,3,1,3,1,0,0,0,0,0, 2,0,0,0,0,0,0,0,0,0, // QRST 1,3,1,3,2,0,0,0,0,0, 1,3,1,3,1,3,2,0,0,0, 1,3,2,3,2,0,0,0,0,0, 2,3,1,3,1,3,2,0,0,0, // UVWX 2,3,1,3,2,3,2,0,0,0, 2,3,2,3,1,3,1,0,0,0, 1,3,2,3,2,3,2,3,2,0, 1,3,1,3,2,3,2,3,2,0, // YZ12 1,3,1,3,1,3,2,3,2,0, 1,3,1,3,1,3,1,3,2,0, 1,3,1,3,1,3,1,3,1,0, 2,3,1,3,1,3,1,3,1,0, // 3456 2,3,2,3,1,3,1,3,1,0, 2,3,2,3,2,3,1,3,1,0, 2,3,2,3,2,3,2,3,1,0, 2,3,2,3,2,3,2,3,2,0, // 7890 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0 }; // 6 morse symbols: 1=dot(.) 2=dash(-) 3=element space(^) 4=char space (~) 5=word space(W) 6=pause(P) static integer ielm = 1; static struct { char e_1[24]; integer e_2; } equiv_22 = { {'.', ' ', ' ', ' ', '-', ' ', ' ', ' ', '^', ' ', ' ', ' ', 'C', ' ', ' ', ' ', 'W', ' ', ' ', ' ', 'P', ' ', ' ', ' '}, 0 }; #define isymbl ((integer *)&equiv_22) /* Format strings */ static char fmt_90[] = "(1x,\002END OF RUN; INPUT DATA WAS:\002)"; static char fmt_105[] = "(/,1x,50a1)"; /* System generated locals */ integer i__1; /* Builtin functions */ integer s_wsfe(cilist *), e_wsfe(), do_fio(integer *, char *, ftnlen), s_rsfe(cilist *), e_rsfe(); /* Local variables */ static integer k, l; static real y; static integer k1, k2; static real xm, beta, wait; static integer iout[500]; static real xsigm; /* Fortran I/O blocks */ static cilist io___12 = { 0, 6, 0, fmt_90, 0 }; static cilist io___16 = { 0, 6, 0, fmt_105, 0 }; static cilist io___18 = { 0, 5, 0, fmt_105, 0 }; /* CHARACTER(500) IOUT */ /* CHARACTER*500 IOUT */ /* CHARACTER*6 ISYMBL */ /* CHARACTER(LEN=6), PARAMETER :: ISYMBL = '.-^CWP' */ /* REPLACE WITH THIS: CHARACTER(LEN=6), PARAMETER :: ISYMBL = '.-^CWP' */ beta = (float)1e3 * blk1_1.tau * *dur; if (beta < blk6_1.xdur) { goto L200; } ++nelm; ielm = morse[nelm + ltr * 10 - 11]; if (ielm != 0) { goto L100; } nelm = 0; /* Y=RAND(IK) */ ielm = 4; if (y > (float).9) { ielm = 5; } if (y <= (float).9 && y > (float).3) { ielm = 6; } /* Y=RAND(IK) */ /* Y=35*(Y-0.001)+1. */ /* IY=Y */ /* LTR=IY+1 */ ++ltr; if (ltr >= 38) { ltr = 1; } goto L100; ++nltr; ltr = blktxt_1.itext[nltr - 1]; if (ltr == 0) { ielm = 4; } if (ltr == 37) { ielm = 5; } if (ltr == 38) { ielm = 6; } ++nltr; ltr = blktxt_1.itext[nltr - 1]; L100: ++n; /* IOUTP(N:N+1) = ISYMBL(IELM:IELM+1) */ iout[n - 1] = isymbl[ielm - 1]; if (n < 300) { goto L110; } n = 0; nltr = 0; blkend_1.iend = 1; s_wsfe(&io___12); e_wsfe(); for (k = 1; k <= 10; ++k) { k1 = (k - 1) * 50 + 1; k2 = k * 50; s_wsfe(&io___16); i__1 = k2; for (l = k1; l <= i__1; ++l) { do_fio(&c__1, (char *)&iout[l - 1], (ftnlen)sizeof(integer)); } e_wsfe(); /* L10: */ } s_rsfe(&io___18); do_fio(&c__1, (char *)&wait, (ftnlen)sizeof(real)); e_rsfe(); L110: xm = blk6_1.esep[ielm - 1] * blk6_1.dmean; xsigm = blk6_1.edev[ielm - 1] * blk6_1.dmean; /* Y=RAND(IK) */ /* Y=2.*(Y-.5) */ /* XDUR=XM+Y+XSIGM */ blk6_1.xdur = xm + xsigm; if (blk6_1.xdur < (float)20.) { blk6_1.xdur = (float)20.; } /* MARK x=1 SPACE x=0 */ *x = (float)1.; if (ielm >= 3) { *x = (float)0.; } L200: /* PRINT 300, NELM, LTR, IELM, XM, BETA, XDUR */ /* 300 FORMAT('KEY: ',3(I3,2X),3(F8.2,2X)) */ return 0; } /* key_ */ #undef isymbl #ifdef __cplusplus } #endif