2 ' made by Svjatoslav Agejenko
\r
5 DECLARE SUB box (x1%, y1%, x2%, y2%)
\r
6 DECLARE SUB ssort (s%, m%)
\r
7 DECLARE SUB sort (s%, w%)
\r
9 DECLARE SUB cmp (a$, b$, r%)
\r
11 DECLARE SUB std (a$)
\r
12 DECLARE FUNCTION cnum$ (a%)
\r
13 DECLARE SUB fload (a$, b%, c%, d%)
\r
14 DECLARE SUB putfs (f%, l%, s%, c$)
\r
15 DECLARE SUB gets (l%, s%, a$)
\r
16 DECLARE SUB puts (l%, s%, a$)
\r
17 DECLARE SUB runf (a$)
\r
18 DECLARE SUB getfil (a%)
\r
20 DECLARE SUB mkson (a$)
\r
21 DECLARE SUB title (a$)
\r
22 DECLARE SUB strip (a$, b$)
\r
23 DECLARE SUB cmd (a$)
\r
24 DECLARE SUB conkey (a$)
\r
25 DECLARE SUB conn (a$)
\r
27 DECLARE SUB chkey (a$)
\r
28 DECLARE SUB getkey (a$)
\r
29 DECLARE SUB conm (a$, c)
\r
30 DECLARE SUB start ()
\r
32 DIM SHARED con$(1 TO 50)
\r
33 DIM SHARED conc(1 TO 50)
\r
36 DIM SHARED sona$(1 TO 20)
\r
39 DIM SHARED buf$(1 TO 5000)
\r
40 DIM SHARED bufu(1 TO 5000)
\r
41 DIM SHARED bufl(1 TO 1000, 1 TO 30)
\r
42 DIM SHARED buflu(1 TO 1000)
\r
44 DIM SHARED opf(1 TO 30)
\r
45 DIM SHARED hist$(1 TO 20)
\r
46 DIM SHARED histp, histk
\r
47 DIM SHARED buff(1 TO 30, 1 TO 1000)
\r
48 DIM SHARED stack(1 TO 2000, 1 TO 10)
\r
49 DIM SHARED stackl(1 TO 10)
\r
75 IF a$ = CHR$(0) + "H" THEN yp1 = yp1 - 25
\r
76 IF a$ = CHR$(0) + "P" THEN yp1 = yp1 + 25
\r
77 IF a$ = CHR$(27) THEN GOTO 17
\r
79 LINE (10, y1 - 35)-(20, y1 + 35), 0, B
\r
80 LINE (11, y1 - 34)-(19, y1 + 34), 15, B
\r
82 LINE (310, y2 - 35)-(300, y2 + 35), 0, B
\r
83 LINE (309, y2 - 34)-(301, y2 + 34), 15, B
\r
85 LINE (lx - 10, ly - 10)-(lx + 10, ly + 10), 0, B
\r
86 LINE (lx - 9, ly - 9)-(lx + 9, ly + 9), 15, B
\r
90 IF ly < 20 THEN lyp = 1
\r
91 IF ly > 180 THEN lyp = -1
\r
94 IF ly < y1 - 35 OR ly > y1 + 35 THEN SOUND 1000, 1
\r
96 IF lx > 290 THEN lxp = -1: GOSUB 18
\r
99 IF yp1 > 0 THEN y1 = y1 + 1: yp1 = yp1 - 1
\r
100 IF yp1 < 0 THEN y1 = y1 - 1: yp1 = yp1 + 1
\r
101 IF yp2 > 0 THEN y2 = y2 + 1: yp2 = yp2 - 1
\r
102 IF yp2 < 0 THEN y2 = y2 - 1: yp2 = yp2 + 1
\r
116 IF ly < 20 THEN lyp = 1
\r
117 IF ly > 180 THEN lyp = -1
\r
118 IF lx < 30 THEN lxp = 1
\r
137 SUB box (x1, y1, x2, y2)
\r
145 b$ = "|" + b$ + "|"
\r
146 c$ = "|" + c$ + "|"
\r
153 FOR a = y1 + 1 TO y2 - 1
\r
163 IF a$ <> "" THEN conkey a$
\r
170 IF a$ = CHR$(0) + "M" THEN a$ = "pa"
\r
171 IF a$ = CHR$(0) + "K" THEN a$ = "va"
\r
172 IF a$ = CHR$(0) + "H" THEN a$ = "ul"
\r
173 IF a$ = CHR$(0) + "P" THEN a$ = "al"
\r
180 IF a$ = SPACE$(LEN(a$)) THEN GOTO 5
\r
184 IF mitus = 0 THEN GOTO 5
\r
186 SELECT CASE sona$(1)
\r
189 conm "help - for help", 7
\r
190 conm "quit - quit program", 7
\r
191 conm "b - boss screen", 7
\r
192 conm "memstat- show info about memory blocks", 7
\r
193 conm "memput <addr> <data> - put data to specified memoy block", 7
\r
194 conm "memlist <addr> <amount> - show memory blocks, starting from <addr>", 7
\r
195 conm "runf <file.ext> - run script file", 7
\r
196 conm "lnstat - show info about memory lines", 7
\r
197 conm "lnput <line> <word> <data> <data> ... put data in <line> starting from <word>", 7
\r
198 conm "lnlist <addr> <amount> - show contenc of memory lines", 7
\r
199 conm "fstat - show info about memory files", 7
\r
200 conm "fput <file> <line> <word> <data> <data> ... put data in memory file", 7
\r
201 conm "fload <filename.ext> <file> <line> <word>- load data file into memory file", 7
\r
202 conm "cls - clear screen", 7
\r
203 conm "stclear <stack> - clear stack", 7
\r
204 conm "chklin <page> <from line> <to line> - determine used line numbers to STDOUT", 7
\r
205 conm "stacksize <stack> - determine stack size to STDOUT", 7
\r
206 conm "filtand <stack> <word> <mask> <word> <mask> ... filters out lines to STDOUT", 7
\r
207 conm "filtor <stack> <word> <mask> <word> <mask> ... filters out lines to STDOUT", 7
\r
208 conm "disp <stack> <word> <word> ... display formatted selected cells to STDOUT", 7
\r
209 conm "sort <stack> <word> - sort elements by <word> value, lower first", 7
\r
210 conm "swap <stack> - swap stack elements (backwards)", 7
\r
211 conm "ssort <stack> <word> - sort stack in alphabetical order", 7
\r
212 conm "memget <pointer> - allocates memory block, and puts there -", 7
\r
213 conm "liststack <stack> <from line> <to line> - show stack values to STDOUT", 7
\r
214 conm "ask <question> <file> <line> <word> - asks question, and stores result", 7
\r
215 conm "flnget <file> <pointer> - get unused line in file", 7
\r
222 title "memory blocks summary"
\r
226 IF bufu(b) > 0 THEN c = c + 1
\r
227 lng = lng + LEN(buf$(b))
\r
229 d$ = "memory blocks used:" + STR$(c) + " total 5000"
\r
231 d$ = "data size:" + STR$(lng)
\r
250 IF b = 0 THEN b = 1
\r
251 IF c = 0 THEN c = 1
\r
254 IF c = 0 THEN GOTO 5
\r
255 IF bufu(d) > 0 THEN
\r
256 e$ = cnum(d) + ":" + SPACE$(5 - LEN(cnum(d)))
\r
269 title "memory lines summary"
\r
273 IF buflu(b) > 0 THEN c = c + 1: d = d + buflu(b)
\r
275 d$ = "memory lines used:" + STR$(c) + " total 1000"
\r
277 d$ = "total number of words in lines:" + STR$(d)
\r
285 IF e < 4 THEN e = 4
\r
287 puts b, c + d - 4, sona$(d)
\r
296 IF c = 0 THEN GOTO 5
\r
297 IF buflu(d) > 0 THEN
\r
299 e$ = e$ + SPACE$(5 - LEN(e$))
\r
300 e$ = e$ + cnum(buflu(d))
\r
301 e$ = e$ + SPACE$(8 - LEN(e$))
\r
305 e$ = e$ + " >" + f$
\r
314 title "Memory files summary"
\r
318 IF buff(b, c) > -1 THEN
\r
320 d$ = "File number:" + STR$(b)
\r
324 d$ = "on line:" + STR$(c) + " allocated memory line: " + STR$(buff(b, c))
\r
336 IF f < 5 THEN f = 5
\r
338 putfs b, c, d + e - 5, sona$(e)
\r
352 IF b = 0 THEN b = 1
\r
353 IF c = 0 THEN c = 1
\r
354 IF d = 0 THEN d = 1
\r
355 fload sona$(2), b, c, d
\r
360 IF b = 0 THEN b = 1
\r
368 IF b = 0 THEN b = 1
\r
369 IF c = 0 THEN c = 1
\r
370 IF d = 0 THEN d = 1000
\r
373 IF buff(b, e) > 0 THEN std cnum(buff(b, e))
\r
379 IF b = 0 THEN b = 1
\r
380 std cnum(stackl(b))
\r
385 conm "returning", 7
\r
390 FOR e = 1 TO stackl(b)
\r
391 FOR c = 3 TO mitus STEP 2
\r
392 gets stack(e, b), VAL(sona$(c)), f$
\r
393 cmp f$, sona$(c + 1), d
\r
395 std cnum(stack(e, b))
\r
415 tmp1(d) = VAL(sona$(e))
\r
418 FOR c = 1 TO stackl(b)
\r
420 gets stack(c, b), tmp1(e), f$
\r
421 IF tmp2(e) < LEN(f$) THEN tmp2(e) = LEN(f$)
\r
425 FOR c = 1 TO stackl(b)
\r
428 gets stack(c, b), tmp1(e), f$
\r
429 f$ = f$ + SPACE$(tmp2(e) - LEN(f$))
\r
430 g$ = g$ + f$ + " # "
\r
441 FOR e = 1 TO stackl(b)
\r
442 FOR c = 3 TO mitus STEP 2
\r
443 gets stack(e, b), VAL(sona$(c)), f$
\r
444 cmp f$, sona$(c + 1), d
\r
445 IF d = 0 THEN GOTO 21
\r
447 std cnum(stack(e, b))
\r
462 SWAP stack(d, b), stack(c - d + 1, b)
\r
469 IF b = 0 THEN b = 1
\r
470 IF c = 0 THEN c = 1
\r
476 IF b = 0 THEN b = 1
\r
478 IF bufu(c) = 0 THEN bufu(c) = 1: buf$(c) = "-": stack(b, 10) = c: GOTO 23
\r
481 IF stackl(10) < b THEN stackl(10) = b
\r
488 IF b = 0 THEN b = 1
\r
489 IF c = 0 THEN c = 1
\r
490 IF d = 0 THEN d = stackl(b)
\r
492 std cnum(stack(e, b))
\r
498 IF b$ = "" THEN b$ = "input"
\r
508 conm "'" + f$ + "' accepted", 7
\r
515 IF buff(b, d) = -1 THEN
\r
517 IF stackl(10) < c THEN stackl(10) = c
\r
528 conm "Invalid command", 12
\r
532 SUB cmp (a$, b$, r)
\r
533 IF a$ = b$ THEN r = 1 ELSE r = 0
\r
538 cnum$ = RIGHT$(b$, LEN(b$) - 1)
\r
542 b$ = concmd$ + SPACE$(85)
\r
545 IF a$ = "va" THEN conx = conx - 1
\r
546 IF a$ = "pa" THEN conx = conx + 1
\r
550 IF histk < 1 THEN histk = 20
\r
555 IF histk > 20 THEN histk = 1
\r
560 IF LEN(a$) = 1 THEN
\r
561 IF a$ = CHR$(13) THEN
\r
564 IF histp > 20 THEN histp = 1
\r
573 IF a$ = CHR$(8) THEN
\r
575 b$ = LEFT$(b$, conx - 2) + RIGHT$(b$, 81 - conx)
\r
581 b$ = LEFT$(b$, conx - 1) + a$ + RIGHT$(b$, 81 - conx)
\r
587 IF conx < 1 THEN conx = 1
\r
588 IF conx > 80 THEN conx = 80
\r
590 b$ = b$ + SPACE$(85)
\r
591 concmd$ = LEFT$(b$, 80)
\r
597 PRINT RIGHT$(LEFT$(concmd$, conx), 1);
\r
606 IF LEN(a$) > 78 THEN
\r
609 a$ = " >> " + RIGHT$(a$, LEN(a$) - 78)
\r
614 b$ = a$ + SPACE$(80 - LEN(a$))
\r
619 con$(a) = con$(a + 1)
\r
620 conc(a) = conc(a + 1)
\r
631 SUB fload (a$, b, c, d)
\r
637 OPEN a$ FOR INPUT AS #h
\r
639 IF EOF(h) <> 0 THEN GOTO 13
\r
642 IF LEFT$(e$, 3) = "// " THEN
\r
646 IF e$ = SPACE$(LEN(e$)) THEN GOTO 12
\r
652 FOR f = 1 TO LEN(e$)
\r
653 g$ = RIGHT$(LEFT$(e$, f), 1)
\r
660 IF g$ = CHR$(9) THEN g$ = ""
\r
672 k$ = "file: " + a$ + " loaded." + STR$(l) + " lines in file"
\r
678 IF opf(b) = 0 THEN opf(b) = 1: a = b: GOTO 7
\r
683 SUB gets (l, s, a$)
\r
699 FOR b = 1 TO LEN(a$)
\r
700 c$ = RIGHT$(LEFT$(a$, b), 1)
\r
709 sona$(mitus) = sona$(mitus) + c$
\r
713 'conm "sonad_______", 10
\r
714 'FOR b = 1 TO mitus
\r
719 IF LEFT$(sona$(a), 2) = "|>" THEN
\r
720 IF sona$(a + 1) = "c" THEN stdl = 1
\r
721 IF sona$(a + 1) = "s" THEN stdl = 10 + VAL(sona$(a + 2))
\r
725 IF LEFT$(sona$(a), 2) = "|@" THEN
\r
726 sona$(a) = cnum(stack(VAL(RIGHT$(sona$(a), LEN(sona$(a)) - 2)), 10))
\r
731 FOR a = mitus + 1 TO 20
\r
736 SUB putfs (f, l, s, c$)
\r
738 'DIM SHARED buff(1 TO 30, 1 TO 1000)
\r
744 IF buflu(a) = 0 THEN la = a: GOTO 10
\r
750 IF buflu(la) = 0 THEN buff(f, l) = -1 ELSE buff(f, l) = la
\r
753 SUB puts (l, s, a$)
\r
755 IF a$ = "|" THEN a$ = ""
\r
756 IF a$ = "||" THEN GOTO 11
\r
761 'DIM SHARED buf$(1 TO 10000)
\r
762 'DIM SHARED bufu(1 TO 10000)
\r
764 IF bufu(c) = 0 THEN GOTO 6
\r
769 buflu(l) = buflu(l) + 1
\r
778 buflu(l) = buflu(l) - 1
\r
789 OPEN a$ FOR INPUT AS #h
\r
791 IF EOF(h) <> 0 THEN GOTO 8
\r
802 DIM tmp1(1 TO 10000)
\r
803 DIM tmp2(1 TO 10000)
\r
808 gets stack(a, s), w, c$
\r
818 IF tmp1(c) < e THEN e = tmp1(c): f = c
\r
821 SWAP tmp1(a), tmp1(f)
\r
822 SWAP tmp2(a), tmp2(f)
\r
827 stack(a, s) = tmp2(a)
\r
833 DIM tbti(1 TO 2000)
\r
834 DIM tbtp(1 TO 2000)
\r
835 DIM tbt$(1 TO 2000)
\r
837 FOR a = 1 TO stackl(s)
\r
838 gets stack(a, s), m, b$
\r
844 FOR a = 1 TO stackl(s)
\r
847 f = ASC(LEFT$(d$, 1))
\r
849 IF ASC(LEFT$(tbt$(c), 1)) = f THEN
\r
850 IF d$ <> tbt$(c) THEN
\r
852 h$ = tbt$(c) + CHR$(0)
\r
854 IF LEN(h$) > i THEN i = LEN(h$)
\r
856 k = ASC(RIGHT$(LEFT$(g$, j), 1))
\r
857 l = ASC(RIGHT$(LEFT$(h$, j), 1))
\r
858 IF k < l THEN GOTO 22
\r
859 IF l < k THEN e = c: d$ = tbt$(c): f = ASC(LEFT$(d$, 1)): GOTO 22
\r
863 IF ASC(LEFT$(tbt$(c), 1)) < f THEN f = ASC(LEFT$(tbt$(c), 1)): e = c: d$ = tbt$(c)
\r
873 FOR a = 1 TO stackl(s)
\r
874 stack(a, s) = tbti(a)
\r
889 conm "DDBASE, (Dos Data BASE) 0.0", 7
\r
890 conm "Copyright Svjatoslav Agejenko. All Rights Reserved.", 7
\r
891 conm "starting...", 7
\r
914 a$ = "runf auto.scr"
\r
915 FOR b = 1 TO LEN(a$)
\r
916 c$ = RIGHT$(LEFT$(a$, b), 1)
\r
931 stackl(b) = stackl(b) + 1
\r
932 stack(stackl(b), b) = VAL(a$)
\r
934 c$ = a$ + " > " + cnum(stackl(b)) + " ! " + cnum(b)
\r
945 IF LEFT$(b$, 1) = " " THEN b$ = RIGHT$(b$, LEN(b$) - 1): GOTO 2
\r
947 IF RIGHT$(b$, 1) = " " THEN b$ = LEFT$(b$, LEN(b$) - 1): GOTO 3
\r
952 conm "================> " + a$ + " <===============", 7
\r