fixed file permissions
[qbasicapps.git] / math / logic.bas
1 ' Logical equation solver\r
2 ' made by Svjatoslav Agejenko\r
3 ' in 2002\r
4 ' homepage: svjatoslav.eu\r
5 ' email:    svjatoslav@svjatoslav.eu\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