initial cammit
[qbasicapps.git] / networking / digital data over analog audio channel / xi2msg.bas
1 ' Svjatoslav Agejenko year: 2001\r
2 ' decades binary data from 8 bit wave sound file.\r
3 \r
4 DEFINT A-Y\r
5 DECLARE SUB bysf (a$, d)\r
6 DECLARE SUB messa (a$)\r
7 DECLARE SUB pfo (f, t, it)\r
8 DECLARE SUB anal ()\r
9 DECLARE SUB start ()\r
10 DECLARE SUB iadd ()\r
11 DECLARE SUB oadd ()\r
12 DECLARE SUB byt (a)\r
13 \r
14 DIM SHARED file1$\r
15 DIM SHARED file2$\r
16 DIM SHARED buf(-100 TO 10000)\r
17 DIM SHARED bus AS STRING * 1000\r
18 DIM SHARED bufi\r
19 DIM SHARED bg\r
20 DIM SHARED sm\r
21 DIM SHARED beg\r
22 DIM SHARED wai\r
23 DIM SHARED old2\r
24 DIM SHARED stat(1 TO 10)\r
25 DIM SHARED statl\r
26 DIM SHARED aver\r
27 DIM SHARED byte AS STRING * 1\r
28 DIM SHARED avv\r
29 \r
30 DIM SHARED li\r
31 DIM SHARED oc\r
32 DIM SHARED px\r
33 \r
34 start\r
35 messa "searching for beginning..."\r
36 \r
37 OPEN file1$ FOR BINARY AS #1\r
38 OPEN file2$ FOR BINARY AS #2\r
39 SEEK #2, 360\r
40 \r
41 2\r
42 GET #2, , bus\r
43 FOR a = 1 TO 1000\r
44 b$ = RIGHT$(LEFT$(bus, a), 1)\r
45 bufi = bufi + 1\r
46 c = ASC(b$)\r
47 IF c > 127 THEN c = c - 255\r
48 buf(bufi) = c\r
49 NEXT a\r
50 IF (EOF(2) = 0) AND (bufi < 8000) THEN GOTO 2\r
51 anal\r
52 IF EOF(2) = 0 THEN GOTO 2\r
53 \r
54 CLOSE #2\r
55 CLOSE #1\r
56 \r
57 SYSTEM\r
58 \r
59 SUB anal\r
60 LINE (1, 170)-(200, 430), 0, BF\r
61 FOR a = 1 TO bufi - (avv - 1)\r
62 \r
63 LINE (100, 170)-(100, 430), 13\r
64 LINE (old2 - a + 100, 170)-(old2 - a + 100, 430), 11\r
65 LINE (0, 300)-(200, 300), 13\r
66 FOR b = 0 TO 200\r
67 PSET (b, buf(b + a - 101) + 300), 0\r
68 PSET (b, buf(b + a - 100) + 300), 14\r
69 NEXT b\r
70 LINE (old2 - a + 100, 170)-(old2 - a + 100, 430), 0\r
71 \r
72 c = 0\r
73 FOR b = a TO a + (avv - 1)\r
74 c = c + buf(b)\r
75 NEXT b\r
76 c = c / (avv / 2)\r
77 IF c > oc THEN\r
78 IF li = -1 THEN\r
79 li = 1\r
80 pfo a + ((avv - 1) / 2 - 1), 1, oc\r
81 GOTO 3\r
82 END IF\r
83 END IF\r
84 IF c < oc THEN\r
85 IF li = 1 THEN\r
86 li = -1\r
87 pfo a + ((avv - 1) / 2 - 1), 2, oc\r
88 GOTO 3\r
89 END IF\r
90 END IF\r
91 3\r
92 oc = c\r
93 NEXT a\r
94 \r
95 FOR a = bufi - (avv - 2) TO bufi\r
96 buf(a - (bufi - (avv - 2)) + 1) = buf(a)\r
97 NEXT a\r
98 old2 = old2 - (bufi - (avv - 2)) + 1\r
99 bufi = avv - 1\r
100 \r
101 END SUB\r
102 \r
103 SUB bysf (a$, d)\r
104 'LINE (201, 170)-(639, 430), 1, B\r
105 IF d = 10 THEN px = 0: a$ = "": GOTO 5\r
106  \r
107 px = px + 1\r
108 IF px > 53 THEN\r
109 px = 1\r
110 5\r
111 DIM tempr(1 TO 32000)\r
112 GET (201, 186)-(639, 430), tempr(1)\r
113 PUT (201, 170), tempr(1), PSET\r
114 LINE (201, 414)-(639, 430), 0, BF\r
115 END IF\r
116 \r
117 LOCATE 26, 26 + px\r
118 PRINT a$\r
119 byte = CHR$(d)\r
120 PUT #1, , byte\r
121 \r
122 END SUB\r
123 \r
124 SUB byt (a)\r
125  \r
126 'LINE (410, 0)-(639, 169), 1, B\r
127 \r
128 statl = statl + 1\r
129 IF statl > 8 THEN\r
130 statl = 1\r
131 b = 0\r
132 IF stat(1) = 1 THEN b = b + 128\r
133 IF stat(2) = 1 THEN b = b + 64\r
134 IF stat(3) = 1 THEN b = b + 32\r
135 IF stat(4) = 1 THEN b = b + 16\r
136 IF stat(5) = 1 THEN b = b + 8\r
137 IF stat(6) = 1 THEN b = b + 4\r
138 IF stat(7) = 1 THEN b = b + 2\r
139 IF stat(8) = 1 THEN b = b + 1\r
140 LOCATE 10, 69\r
141 PRINT b\r
142 LOCATE 10, 75\r
143 PRINT HEX$(b)\r
144 LOCATE 10, 79\r
145 c$ = CHR$(b)\r
146 IF b = 7 OR b = 8 OR b = 10 OR b = 12 OR b = 13 THEN c$ = " "\r
147 PRINT c$\r
148 bysf c$, b\r
149 \r
150 DIM tempr(1 TO 10000)\r
151 GET (410, 16)-(639, 169), tempr(1)\r
152 PUT (410, 0), tempr(1), PSET\r
153 LINE (410, 153)-(639, 169), 0, BF\r
154 END IF\r
155 LOCATE 10, 50 + (statl * 2)\r
156 stat(statl) = a\r
157 PRINT a\r
158 \r
159 \r
160 'IF a > 128 THEN a = a - 128: iadd ELSE oadd\r
161 'IF a > 64 THEN a = a - 64: iadd ELSE oadd\r
162 'IF a > 32 THEN a = a - 32: iadd ELSE oadd\r
163 'IF a > 16 THEN a = a - 16: iadd ELSE oadd\r
164 'IF a > 8 THEN a = a - 8: iadd ELSE oadd\r
165 'IF a > 4 THEN a = a - 4: iadd ELSE oadd\r
166 'IF a > 2 THEN a = a - 2: iadd ELSE oadd\r
167 'IF a > 1 THEN iadd ELSE oadd\r
168 END SUB\r
169 \r
170 SUB messa (a$)\r
171 'LINE (0, 0)-(409, 169), 1, B\r
172 DIM tempr(1 TO 20000)\r
173 GET (0, 16)-(409, 169), tempr(1)\r
174 PUT (0, 0), tempr(1), PSET\r
175 LINE (0, 153)-(409, 169), 0, BF\r
176 LOCATE 10, 1\r
177 PRINT a$\r
178 END SUB\r
179 \r
180 SUB pfo (f, t, it)\r
181 IF t = 2 THEN\r
182 bg = it\r
183 IF wai > 0 THEN wai = wai - 1\r
184 \r
185 IF (bg - sm > 6) AND (beg = 0) THEN beg = 1: wai = 10: messa "Beginning point found!"\r
186 \r
187 IF (wai = 0) AND (beg = 1) THEN\r
188 IF statl = 0 THEN messa "Beginning statistical analyze"\r
189 statl = statl + 1\r
190 IF statl > 10 THEN\r
191 FOR a = 1 TO 10\r
192 aver = aver + stat(a)\r
193 NEXT a\r
194 aver = aver * 1.5 / 10\r
195 beg = 2\r
196 statl = 1\r
197 messa "Statistical analyze completed!"\r
198 END IF\r
199 stat(statl) = f - old2\r
200 END IF\r
201 \r
202 IF beg = 2 THEN\r
203 IF f - old2 >= aver THEN\r
204 beg = 3\r
205 statl = 0\r
206 FOR a = 1 TO 8\r
207 stat(a) = 0\r
208 NEXT a\r
209 GOTO 4\r
210 END IF\r
211 END IF\r
212 \r
213 IF beg = 3 THEN\r
214 IF f - old2 >= aver THEN\r
215 byt 0\r
216 ELSE\r
217 byt 1\r
218 END IF\r
219 END IF\r
220 4\r
221 \r
222 old2 = f\r
223 ELSE\r
224 sm = it\r
225 END IF\r
226 END SUB\r
227 \r
228 SUB start\r
229 IF COMMAND$ = "" THEN END\r
230 \r
231 SCREEN 12\r
232 \r
233 b$ = COMMAND$\r
234 file2$ = b$\r
235 file1$ = ""\r
236 FOR a = 1 TO LEN(b$)\r
237 c$ = RIGHT$(LEFT$(b$, a), 1)\r
238 IF c$ = "." OR c$ = " " THEN GOTO 1\r
239 file1$ = file1$ + c$\r
240 NEXT a\r
241 1\r
242 file1$ = file1$ + ".msg"\r
243 \r
244 bufi = 0\r
245 beg = 0\r
246 statl = 0\r
247 aver = 0\r
248 px = 0\r
249 avv = 7\r
250 \r
251 li = 1\r
252 oc = -9999\r
253 END SUB\r
254 \r