initial cammit
[qbasicapps.git] / math / logic.bas
1 ' Logical equation solver\r
2 ' made by Svjatoslav Agejenko\r
3 ' in 2002\r
4 ' H-Page: svjatoslav.eu\r
5 ' E-Mail: svjatoslavagejenko@gmail.com\r
6  \r
7 ' Solves logical equations.\r
8 ' AND OR XOR etc...\r
9 \r
10 DECLARE SUB rmslg (x1!, x3!, l!)\r
11 DECLARE SUB getp (a!, b!)\r
12 DECLARE SUB movm (x1!, n!)\r
13 DECLARE SUB lihts (x1, x2, l)\r
14 DECLARE SUB klea ()\r
15 DECLARE SUB lendm (x1!, m!)\r
16 DECLARE SUB mov (x1!, n!)\r
17 DECLARE SUB lendp (x1!, m!)\r
18 DECLARE SUB teeslg (x1!, x2!, l!)\r
19 DECLARE SUB prepare ()\r
20 DECLARE SUB tee (x1!, x2!)\r
21 DECLARE SUB lahend (x1, x2)\r
22 DECLARE SUB prn (x!, y!, c!, c1!, a$)\r
23 DECLARE SUB sist ()\r
24 DECLARE SUB start ()\r
25 DIM SHARED font(0 TO 7, 0 TO 7, 0 TO 122)\r
26 DIM SHARED tehe(0 TO 79)\r
27 DIM SHARED muut(1 TO 8, 1 TO 100)\r
28 DIM SHARED muun(1 TO 8)\r
29 DIM SHARED vast(1 TO 100)\r
30 DIM SHARED xloc(0 TO 79)\r
31 DIM SHARED xlah(0 TO 79, 0 TO 100)\r
32 DIM SHARED xlahn\r
33 DIM SHARED tehl\r
34 DIM SHARED nm\r
35 DIM SHARED prnp\r
36 \r
37 start\r
38 \r
39 13\r
40 sist\r
41 prepare\r
42 GOTO 13\r
43 \r
44 SUB getp (a, b)\r
45 SELECT CASE a\r
46 CASE 5\r
47 b = 1\r
48 CASE 3, 4\r
49 b = 2\r
50 CASE 2\r
51 b = 3\r
52 CASE 1\r
53 b = 4\r
54 CASE 40, 41\r
55 b = 100\r
56 END SELECT\r
57 END SUB\r
58 \r
59 SUB klea\r
60 FOR a = 1 TO 50\r
61 a$ = INKEY$\r
62 NEXT a\r
63 END SUB\r
64 \r
65 SUB lahend (x1, x2)\r
66 \r
67 DIM muu(65 TO 122)\r
68 FOR a = 65 TO 122\r
69 muu(a) = 0\r
70 NEXT a\r
71 \r
72 muu(116) = 1\r
73 muu(118) = 1\r
74 \r
75 nm = 0\r
76 FOR a = x1 TO x2\r
77 b = tehe(a)\r
78 IF ((b >= 65) AND (b <= 90)) OR ((b >= 97) AND (b <= 122)) THEN\r
79 IF muu(b) = 0 THEN\r
80 nm = nm + 1\r
81 muun(nm) = b\r
82 muu(b) = 1\r
83 END IF\r
84 END IF\r
85 NEXT a\r
86 \r
87 muun(nm + 1) = 116\r
88 muun(nm + 2) = 118\r
89 \r
90 f = 2 ^ nm\r
91 tehl = f\r
92 FOR a = 1 TO nm\r
93 d = 1\r
94 e = 1\r
95 f = f / 2\r
96 FOR b = 1 TO 2 ^ nm\r
97 IF e > f THEN d = -d: e = 1\r
98 IF d = 1 THEN c = ASC("t") ELSE c = ASC("v")\r
99 muut(a, b) = c\r
100 e = e + 1\r
101 NEXT b\r
102 NEXT a\r
103 \r
104 FOR a = 1 TO tehl\r
105 muut(nm + 1, a) = 116\r
106 muut(nm + 2, a) = 118\r
107 NEXT a\r
108 \r
109 nm = nm + 2\r
110 \r
111 DIM bck(0 TO 79)\r
112 FOR a = 0 TO 79\r
113 bck(a) = tehe(a)\r
114 xloc(a) = a\r
115 NEXT a\r
116 \r
117 LOCATE 5, 1\r
118 teeslg x1, x2, a\r
119 \r
120 'FOR b = x1 TO x2 + a\r
121 'prn b, 20, 14, 1, CHR$(tehe(b))\r
122 'NEXT b\r
123 \r
124 tee x1, x2 + a\r
125 \r
126 FOR a = 0 TO 79\r
127 tehe(a) = bck(a)\r
128 NEXT a\r
129 \r
130 FOR a = 1 TO tehl\r
131 prn x2 + 1, a, 14, 0, CHR$(vast(a))\r
132 NEXT a\r
133 \r
134 \r
135 END SUB\r
136 \r
137 SUB lendm (x1, m)\r
138 IF tehe(x1) <> 41 THEN m = 1: GOTO 19\r
139 c = x1\r
140 d = 1\r
141 20\r
142 c = c - 1\r
143 IF tehe(c) = 40 THEN d = d - 1\r
144 IF tehe(c) = 41 THEN d = d + 1\r
145 IF d > 0 THEN GOTO 20\r
146 m = x1 - c\r
147 19\r
148 END SUB\r
149 \r
150 SUB lendp (x1, m)\r
151 IF tehe(x1) <> 40 THEN m = 1: GOTO 17\r
152 c = x1\r
153 d = 1\r
154 18\r
155 c = c + 1\r
156 IF tehe(c) = 40 THEN d = d + 1\r
157 IF tehe(c) = 41 THEN d = d - 1\r
158 IF d > 0 THEN GOTO 18\r
159 m = c - x1 + 1\r
160 17\r
161 END SUB\r
162 \r
163 SUB lihts (x1, x2, l)\r
164 rmslg x1, x2, l1\r
165 l = l1\r
166 'BEEP\r
167 prnp = prnp + 1\r
168 FOR a = x1 TO x2 - l\r
169 prn a, 0, 13, 1, CHR$(tehe(a))\r
170 NEXT a\r
171 END SUB\r
172 \r
173 SUB mov (x1, n)\r
174 FOR a = 79 - n TO x1 STEP -1\r
175 tehe(a + n) = tehe(a)\r
176 xloc(a + n) = xloc(a)\r
177 NEXT a\r
178 END SUB\r
179 \r
180 SUB movm (x1, n)\r
181 FOR a = x1 TO 79 - n\r
182 tehe(a) = tehe(a + n)\r
183 xloc(a) = xloc(a + n)\r
184 NEXT a\r
185 END SUB\r
186 \r
187 SUB prepare\r
188 CLS\r
189 \r
190 ln = 79\r
191 FOR a = 0 TO 79\r
192 5\r
193 IF tehe(a) = 32 OR tehe(a) = 0 THEN\r
194 FOR b = a TO 78\r
195 tehe(b) = tehe(b + 1)\r
196 NEXT b\r
197 ln = ln - 1\r
198 IF ln <= a - 1 THEN GOTO 6\r
199 GOTO 5\r
200 END IF\r
201 NEXT a\r
202 6\r
203 \r
204 CLS\r
205 \r
206 FOR a = 0 TO ln\r
207 prn a, 0, 13, 1, CHR$(tehe(a))\r
208 NEXT a\r
209 \r
210 prn 0, 1, 7, 0, "Do you want to simplyfy it (unfinished so press N)"\r
211 a = 0\r
212 23\r
213 klea\r
214 a$ = INPUT$(1)\r
215 IF a$ = "n" OR a$ = "N" THEN GOTO 24\r
216 IF a$ = "y" OR a$ = "Y" THEN  ELSE GOTO 23\r
217 a = 1\r
218 24\r
219 prn 0, 1, 7, 0, SPACE$(79)\r
220 \r
221 l = 0\r
222 IF a = 1 THEN lihts 0, ln, l\r
223 lahend 0, ln - l\r
224 \r
225 a$ = INPUT$(1)\r
226 \r
227 END SUB\r
228 \r
229 SUB prn (x, y, c, c1, a$)\r
230 x1 = x * 8\r
231 y1 = (y + prnp) * 8\r
232 \r
233 FOR b = 1 TO LEN(a$)\r
234 LINE (x1, y1)-(x1 + 7, y1 + 7), c1, BF\r
235 d = ASC(RIGHT$(LEFT$(a$, b), 1))\r
236 IF d > 122 THEN GOTO 22\r
237 FOR y2 = 0 TO 7\r
238 FOR x2 = 0 TO 7\r
239 c2 = font(x2, y2, d)\r
240 IF c2 > 0 THEN PSET (x1 + x2, y1 + y2), c\r
241 NEXT x2\r
242 NEXT y2\r
243 22\r
244 x1 = x1 + 8\r
245 NEXT b\r
246 \r
247 END SUB\r
248 \r
249 SUB rmslg (x1, x3, l)\r
250 x2 = x3\r
251 l2 = 0\r
252 \r
253 'FOR a = x1 TO x2\r
254 a = x1\r
255 26\r
256 IF tehe(a) = 40 THEN\r
257 IF a = x1 THEN p1 = 100 ELSE getp tehe(a - 1), p1\r
258 c = a\r
259 d = 1\r
260 p2 = 0\r
261 25\r
262 c = c + 1\r
263 IF tehe(c) = 40 THEN d = d + 1\r
264 IF tehe(c) = 41 THEN d = d - 1\r
265 IF d = 1 THEN\r
266 IF (tehe(c) > 0) AND (tehe(c) <= 5) THEN\r
267 getp tehe(c), b\r
268 IF b > p2 THEN p2 = b\r
269 END IF\r
270 END IF\r
271 IF d > 0 THEN GOTO 25\r
272 IF c + 1 > x2 THEN p3 = 100 ELSE getp tehe(c + 1), p3\r
273 \r
274 IF (p1 > p2) AND (p3 >= p2) THEN\r
275 movm c, 1\r
276 movm a, 1\r
277 l2 = l2 + 2\r
278 x2 = x2 - 2\r
279 a = a - 1\r
280 END IF\r
281 END IF\r
282 'NEXT a\r
283 a = a + 1\r
284 IF a <= x2 THEN GOTO 26\r
285 l = l2\r
286 END SUB\r
287 \r
288 SUB sist\r
289 CLS\r
290 prn 0, 0, 3, 0, "enter equation (ESC to quit) keys: 1 - " + CHR$(1) + "   2 - " + CHR$(2) + "   3 - " + CHR$(3) + "   4 - " + CHR$(4) + "   5 - " + CHR$(5)\r
291 prn 0, 1, 3, 0, "example: a" + CHR$(1) + "b" + CHR$(2) + "(g" + CHR$(3) + "b)"\r
292 \r
293 FOR a = 0 TO 79\r
294 tehe(a) = 0\r
295 NEXT a\r
296 \r
297 x = 0\r
298 1\r
299 FOR a = 0 TO 79\r
300 IF a = x THEN prn a, 2, 14, 1, CHR$(tehe(a)) ELSE prn a, 2, 3, 0, CHR$(tehe(a))\r
301 NEXT a\r
302 2\r
303 a$ = INKEY$\r
304 IF a$ = "" THEN GOTO 2\r
305 \r
306 IF a$ = CHR$(27) THEN SYSTEM\r
307 IF a$ = CHR$(0) + "M" THEN x = x + 1\r
308 IF a$ = CHR$(0) + "K" THEN x = x - 1\r
309 IF x < 0 THEN x = 0\r
310 IF x > 79 THEN x = 79\r
311 \r
312 IF LEN(a$) = 1 THEN\r
313 SELECT CASE ASC(a$)\r
314 CASE 32, 40, 41, 65 TO 90, 97 TO 122\r
315 3\r
316 FOR a = 78 TO x STEP -1\r
317 tehe(a + 1) = tehe(a)\r
318 NEXT a\r
319 tehe(x) = ASC(a$)\r
320 x = x + 1\r
321 CASE 8\r
322 IF x > 0 THEN\r
323 FOR a = x - 1 TO 78\r
324 tehe(a) = tehe(a + 1)\r
325 NEXT a\r
326 x = x - 1\r
327 END IF\r
328 CASE 49 TO 53\r
329 a$ = CHR$(ASC(a$) - 48)\r
330 GOTO 3\r
331 CASE 13\r
332 GOTO 4\r
333 END SELECT\r
334 END IF\r
335 \r
336 GOTO 1\r
337 4\r
338 \r
339 \r
340 END SUB\r
341 \r
342 SUB start\r
343 prnp = 0\r
344 \r
345 SCREEN 7\r
346 \r
347 FOR a = 0 TO 122\r
348 LOCATE 1, 1\r
349 SELECT CASE a\r
350 CASE 7\r
351 CASE 1\r
352 LINE (0, 0)-(7, 7), 0, BF\r
353 LINE (2, 1)-(0, 3), 15\r
354 LINE (1, 4)-(2, 5), 15\r
355 LINE (5, 1)-(7, 3), 15\r
356 LINE (6, 4)-(5, 5), 15\r
357 LINE (1, 2)-(5, 2), 15\r
358 LINE (1, 4)-(5, 4), 15\r
359 \r
360 CASE 2\r
361 LINE (0, 0)-(7, 7), 0, BF\r
362 LINE (5, 1)-(7, 3), 15\r
363 LINE (6, 4)-(5, 5), 15\r
364 LINE (1, 2)-(5, 2), 15\r
365 LINE (1, 4)-(5, 4), 15\r
366 \r
367 CASE 3\r
368 LINE (0, 0)-(7, 7), 0, BF\r
369 LINE (0, 0)-(3, 7), 15\r
370 LINE (6, 0)-(3, 7), 15\r
371 \r
372 CASE 4\r
373 LINE (0, 0)-(7, 7), 0, BF\r
374 LINE (0, 7)-(3, 0), 15\r
375 LINE (6, 7)-(3, 0), 15\r
376 \r
377 CASE 5\r
378 LINE (0, 0)-(7, 7), 0, BF\r
379 LINE (0, 0)-(4, 0), 15\r
380 LINE (4, 1)-(4, 7), 15\r
381 \r
382 CASE ELSE\r
383 PRINT CHR$(a)\r
384 END SELECT\r
385 \r
386 FOR y = 0 TO 7\r
387 FOR x = 0 TO 7\r
388 font(x, y, a) = POINT(x, y)\r
389 NEXT x\r
390 NEXT y\r
391 NEXT a\r
392 \r
393 SCREEN 12\r
394 \r
395 \r
396 END SUB\r
397 \r
398 SUB tee (x1, x2)\r
399 DIM opr(1 TO 2, 1 TO tehl)\r
400 ng = 0\r
401 ngx = 0\r
402 oprm = 1\r
403 oe = 0\r
404 oex = 0\r
405 \r
406 \r
407 FOR a = x1 TO x2\r
408 b = tehe(a)\r
409 SELECT CASE b\r
410 CASE 40\r
411 c = a\r
412 d = 1\r
413 10\r
414 c = c + 1\r
415 IF tehe(c) = ASC("(") THEN d = d + 1\r
416 IF tehe(c) = ASC(")") THEN d = d - 1\r
417 IF d = 0 THEN GOTO 11\r
418 GOTO 10\r
419 11\r
420 tee a + 1, c - 1\r
421 a = c\r
422 FOR c = 1 TO tehl\r
423 opr(oprm, c) = vast(c)\r
424 NEXT c\r
425 GOTO 12\r
426 CASE 5\r
427 ng = 1\r
428 ngx = a\r
429 CASE 1 TO 4\r
430 oe = b\r
431 oex = a\r
432 CASE 65 TO 90, 97 TO 122\r
433 FOR c = 1 TO nm\r
434 IF muun(c) = b THEN d = c: GOTO 8\r
435 NEXT c\r
436 8\r
437 FOR c = 1 TO tehl\r
438 opr(oprm, c) = muut(d, c)\r
439 prn xloc(a), c, 3, 0, CHR$(muut(d, c))\r
440 NEXT c\r
441 12\r
442 IF ng = 1 THEN GOSUB mkneg\r
443 IF oprm = 2 THEN\r
444 SELECT CASE oe\r
445 CASE 1\r
446 FOR c = 1 TO tehl\r
447 d = opr(1, c)\r
448 e = opr(2, c)\r
449 IF d = e THEN f = ASC("t") ELSE f = ASC("v")\r
450 opr(1, c) = f\r
451 prn xloc(oex), c, 12, 0, CHR$(f)\r
452 NEXT c\r
453 CASE 2\r
454 FOR c = 1 TO tehl\r
455 d = opr(1, c)\r
456 e = opr(2, c)\r
457 f = ASC("t")\r
458 IF (d = ASC("t")) AND (e = ASC("v")) THEN f = ASC("v")\r
459 opr(1, c) = f\r
460 prn xloc(oex), c, 12, 0, CHR$(f)\r
461 NEXT c\r
462 CASE 3\r
463 FOR c = 1 TO tehl\r
464 d = opr(1, c)\r
465 e = opr(2, c)\r
466 f = ASC("t")\r
467 IF (d = ASC("v")) AND (e = ASC("v")) THEN f = ASC("v")\r
468 opr(1, c) = f\r
469 prn xloc(oex), c, 12, 0, CHR$(f)\r
470 NEXT c\r
471 CASE 4\r
472 FOR c = 1 TO tehl\r
473 d = opr(1, c)\r
474 e = opr(2, c)\r
475 f = ASC("v")\r
476 IF (d = ASC("t")) AND (e = ASC("t")) THEN f = ASC("t")\r
477 opr(1, c) = f\r
478 prn xloc(oex), c, 12, 0, CHR$(f)\r
479 NEXT c\r
480 END SELECT\r
481 ELSE\r
482 oprm = oprm + 1\r
483 END IF\r
484 END SELECT\r
485 NEXT a\r
486 \r
487 GOTO 9\r
488 mkneg:\r
489 FOR c = 1 TO tehl\r
490 d = opr(oprm, c)\r
491 IF d = ASC("t") THEN d = ASC("v") ELSE d = ASC("t")\r
492 prn xloc(ngx), c, 4, 0, CHR$(d)\r
493 opr(oprm, c) = d\r
494 NEXT c\r
495 ng = 0\r
496 RETURN\r
497 9\r
498 \r
499 FOR c = 1 TO tehl\r
500 vast(c) = opr(1, c)\r
501 NEXT c\r
502 END SUB\r
503 \r
504 SUB teeslg (x1, x4, l)\r
505 x2 = x4\r
506 h = 0\r
507 FOR e = 1 TO 4\r
508 g = 1\r
509 'FOR a = x1 TO x2\r
510 a = x1\r
511 21\r
512 b = tehe(a)\r
513 IF b = 40 THEN\r
514 c = a\r
515 d = 1\r
516 14\r
517 c = c + 1\r
518 IF tehe(c) = 40 THEN d = d + 1\r
519 IF tehe(c) = 41 THEN d = d - 1\r
520 IF d = 0 THEN GOTO 15\r
521 GOTO 14\r
522 15\r
523 IF e = 1 THEN teeslg a + 1, c - 1, l ELSE l = 0\r
524 a = c + l\r
525 x2 = x2 + l\r
526 h = h + l\r
527 GOTO 16\r
528 END IF\r
529 \r
530 IF (b = 5) AND (e = 1) AND (g > 1) THEN\r
531 mov a, 1\r
532 tehe(a) = 40\r
533 lendp a + 2, f\r
534 mov a + 2 + f, 1\r
535 tehe(a + 2 + f) = 41\r
536 h = h + 2\r
537 x2 = x2 + 2\r
538 a = a + 2 + f\r
539 GOTO 16\r
540 END IF\r
541 \r
542 IF (b = 3 OR b = 4) AND (e = 2) AND (g > 2) THEN\r
543 lendm a - 1, f\r
544 mov a - f, 1\r
545 tehe(a - f) = 40\r
546 lendp a + 2, f\r
547 mov a + 2 + f, 1\r
548 tehe(a + 2 + f) = 41\r
549 h = h + 2\r
550 x2 = x2 + 2\r
551 a = a + 2 + f\r
552 GOTO 16\r
553 END IF\r
554 \r
555 IF (b = 2) AND (e = 3) AND (g > 3) THEN\r
556 lendm a - 1, f\r
557 mov a - f, 1\r
558 tehe(a - f) = 40\r
559 lendp a + 2, f\r
560 mov a + 2 + f, 1\r
561 tehe(a + 2 + f) = 41\r
562 h = h + 2\r
563 x2 = x2 + 2\r
564 a = a + 2 + f\r
565 GOTO 16\r
566 END IF\r
567 \r
568 \r
569 SELECT CASE b\r
570 CASE 5\r
571 g = 1\r
572 CASE 3, 4\r
573 g = 2\r
574 CASE 2\r
575 g = 3\r
576 CASE 1\r
577 g = 4\r
578 END SELECT\r
579 16\r
580 a = a + 1\r
581 IF a <= x2 THEN GOTO 21\r
582 NEXT e\r
583 l = h\r
584 END SUB\r
585 \r