-' Disk file editor for FIFTH\r
-' Svjatoslav Agejenko: n0@hot.ee\r
-\r
-DECLARE SUB fdisp ()\r
-DECLARE SUB fopen (a$)\r
-DECLARE SUB ask (a$, b$)\r
-DECLARE SUB addk (a$)\r
-DECLARE SUB llen (a%, l%)\r
-DECLARE SUB save (a%)\r
-DECLARE SUB disp ()\r
-DEFINT A-Z\r
-\r
-DECLARE SUB load (a)\r
-DECLARE SUB start ()\r
-DECLARE SUB edit ()\r
-DIM SHARED buf(0 TO 31, 0 TO 31)\r
-DIM SHARED obuf(0 TO 31, 0 TO 31)\r
-DIM SHARED byte AS STRING * 1\r
-DIM SHARED font(0 TO 20, 0 TO 255)\r
-DIM SHARED eb\r
-DIM SHARED keys(0 TO 10000)\r
-DIM SHARED keyl, keyc\r
-DIM SHARED curx, cury\r
-DIM SHARED fil$(0 TO 1000)\r
-DIM SHARED fline, froll\r
-DIM SHARED filename$\r
-\r
-start\r
-\r
-OPEN "..\..\disk.raw" FOR BINARY AS #1\r
-\r
-edit\r
-\r
-CLOSE #1\r
-SYSTEM\r
-\r
-SUB addk (a$)\r
-keys(keyl) = ASC(a$)\r
-keyl = keyl + 1\r
-IF keyl > 10000 THEN keyl = 0\r
-END SUB\r
-\r
-SUB ask (a$, b$)\r
-LOCATE 16, 34\r
-PRINT SPACE$(46)\r
-LOCATE 16, 34\r
-COLOR 15\r
-PRINT a$\r
-COLOR 10\r
-LOCATE 16, 34 + LEN(a$)\r
-INPUT "", b$\r
-LOCATE 16, 34\r
-PRINT SPACE$(46)\r
-COLOR 15\r
-END SUB\r
-\r
-SUB disp\r
-\r
-FOR y = 0 TO 31\r
-FOR x = 0 TO 31\r
-c = buf(x, y)\r
-IF c <> obuf(x, y) THEN\r
- PUT (x * 8, y * 8), font(0, c), PSET\r
- obuf(x, y) = c\r
-END IF\r
-NEXT x\r
-NEXT y\r
-\r
-x1 = curx * 8\r
-y1 = cury * 8\r
-FOR y = y1 TO y1 + 7\r
-FOR x = x1 TO x1 + 7\r
-c = POINT(x, y)\r
-IF c = 15 THEN c = 0 ELSE c = 10\r
-PSET (x, y), c\r
-NEXT x\r
-NEXT y\r
-obuf(curx, cury) = -1\r
-\r
-LOCATE 1, 77\r
-PRINT " "\r
-LOCATE 1, 76\r
-PRINT buf(curx, cury)\r
-END SUB\r
-\r
-SUB edit\r
-fdisp\r
-leb = -1\r
-m = 0\r
-1\r
-IF eb <> leb THEN\r
- IF m = 1 THEN\r
- save leb\r
- m = 0\r
- END IF\r
- load eb\r
- leb = eb\r
- LOCATE 1, 60\r
- PRINT "page:"; eb; " "\r
-END IF\r
-disp\r
-2\r
-a$ = INKEY$\r
-bk = 0\r
-IF a$ = "" THEN\r
- IF keyl = keyc THEN GOTO 2\r
- a$ = CHR$(keys(keyc))\r
- keyc = keyc + 1\r
- IF keyc > 10000 THEN keyc = 0\r
- bk = 1\r
-END IF\r
-\r
-IF a$ = CHR$(0) + CHR$(73) THEN eb = eb - 1\r
-IF a$ = CHR$(0) + CHR$(81) THEN eb = eb + 1\r
-IF a$ = CHR$(27) THEN GOTO 4\r
-IF a$ = CHR$(0) + "M" THEN curx = curx + 1\r
-IF a$ = CHR$(0) + "K" THEN curx = curx - 1\r
-IF a$ = CHR$(0) + "P" THEN cury = cury + 1\r
-IF a$ = CHR$(0) + "H" THEN cury = cury - 1\r
-IF a$ = CHR$(0) + "=" THEN ask "page: ", b$: eb = VAL(b$)\r
-IF a$ = CHR$(0) + "?" THEN ask "file: ", b$: fopen b$\r
-IF a$ = CHR$(0) + CHR$(132) THEN fline = fline - 1: fdisp\r
-IF a$ = CHR$(0) + CHR$(118) THEN fline = fline + 1: fdisp\r
-IF a$ = CHR$(0) + CHR$(64) THEN ' F6\r
- d = 0\r
- FOR b = 1 TO LEN(fil$(fline))\r
- c$ = RIGHT$(LEFT$(fil$(fline), b), 1)\r
- IF c$ = CHR$(9) THEN c$ = " "\r
- IF c$ = " " OR c$ = CHR$(255) THEN d = d + 1 ELSE d = 0\r
- IF d < 2 THEN addk c$\r
- NEXT b\r
-END IF\r
-\r
-IF a$ = CHR$(0) + ";" THEN\r
- FOR y = 0 TO 31\r
- FOR x = 0 TO 31\r
- buf(x, y) = 255\r
- NEXT x\r
- NEXT y\r
- m = 1\r
-END IF\r
-\r
-IF a$ = CHR$(0) + CHR$(83) THEN\r
- FOR b = curx TO 30\r
- buf(b, cury) = buf(b + 1, cury)\r
- NEXT b\r
- buf(31, cury) = 255\r
- m = 1\r
-END IF\r
-\r
-IF (a$ = CHR$(13)) AND (bk = 0) THEN\r
-a$ = ""\r
-IF cury < 31 THEN\r
- FOR a = 31 TO cury + 2 STEP -1\r
- FOR b = 0 TO 31\r
- buf(b, a) = buf(b, a - 1)\r
- NEXT b\r
- NEXT a\r
- FOR a = 0 TO 31\r
- buf(a, cury + 1) = 255\r
- NEXT a\r
- FOR a = curx TO 31\r
- SWAP buf(a, cury), buf(a - curx, cury + 1)\r
- NEXT a\r
- m = 1\r
- cury = cury + 1\r
- curx = 0\r
-END IF\r
-END IF\r
-\r
-IF LEN(a$) = 1 THEN\r
- IF ASC(a$) = 32 THEN a$ = CHR$(255)\r
- IF (a$ = CHR$(8)) AND (bk = 0) THEN\r
- a$ = ""\r
- IF curx > 0 THEN\r
- FOR b = curx - 1 TO 30\r
- buf(b, cury) = buf(b + 1, cury)\r
- NEXT b\r
- buf(31, cury) = 255\r
- curx = curx - 1\r
- m = 1\r
- ELSE\r
- IF cury > 0 THEN\r
- llen cury - 1, a\r
- curx = a\r
- FOR b = a TO 31\r
- buf(b, cury - 1) = buf(b - a, cury)\r
- NEXT b\r
- FOR a = cury TO 30\r
- FOR b = 0 TO 31\r
- buf(b, a) = buf(b, a + 1)\r
- NEXT b\r
- NEXT a\r
- FOR b = 0 TO 31\r
- buf(b, 31) = 255\r
- NEXT b\r
- m = 1\r
- cury = cury - 1\r
- END IF\r
- END IF\r
- END IF\r
-END IF\r
-\r
-IF a$ = CHR$(0) + "<" THEN\r
-ask "decimal number:", b$\r
-b$ = HEX$(VAL(b$))\r
-FOR a = 1 TO LEN(b$)\r
- c = ASC(RIGHT$(LEFT$(b$, a), 1))\r
- IF (c <= 57) AND (c >= 48) THEN d$ = CHR$(c - 48): addk d$\r
- IF (c <= 70) AND (c >= 65) THEN d$ = CHR$(c - 55): addk d$\r
-NEXT a\r
-END IF\r
-\r
-IF a$ = CHR$(0) + CHR$(65) THEN\r
-FOR a = 999 TO fline STEP -1\r
- fil$(a + 1) = fil$(a)\r
-NEXT a\r
-fil$(fline) = ""\r
-FOR a = curx TO 31\r
- fil$(fline) = fil$(fline) + CHR$(buf(a, cury))\r
-NEXT a\r
-fdisp\r
-END IF\r
-\r
-IF a$ = CHR$(0) + ">" THEN\r
-ask "ascii code:", b$\r
-a$ = CHR$(VAL(b$))\r
-END IF\r
-\r
-IF LEN(a$) = 1 THEN\r
- FOR b = 31 TO curx + 1 STEP -1\r
- buf(b, cury) = buf(b - 1, cury)\r
- NEXT b\r
- buf(curx, cury) = ASC(a$)\r
- curx = curx + 1\r
- m = 1\r
-END IF\r
-\r
-IF eb < 0 THEN eb = 0\r
-IF curx < 0 THEN curx = 0\r
-IF cury < 0 THEN cury = 0\r
-IF curx > 31 THEN curx = 31\r
-IF cury > 31 THEN cury = 31\r
-GOTO 1\r
-4\r
-\r
-END SUB\r
-\r
-SUB fdisp\r
-IF fline < 0 THEN fline = 0\r
-IF fline > 1000 THEN fline = 1000\r
-IF fline - froll > 10 THEN froll = fline - 10\r
-IF fline - froll < 0 THEN froll = fline\r
-IF froll < 0 THEN froll = 0\r
-\r
-LOCATE 17, 1\r
-PRINT SPACE$(80)\r
-LOCATE 17, 1\r
-PRINT "file: " + filename$\r
-\r
-LOCATE 17, 20\r
-PRINT "line:"; fline\r
-\r
-FOR a = 0 TO 10\r
- LOCATE a + 18, 1\r
- IF a + froll = fline THEN\r
- COLOR 10\r
- IF fil$(a + froll) = SPACE$(LEN(fil$(a + froll))) THEN\r
- FOR b = 1 TO 80\r
- PRINT CHR$(219);\r
- NEXT b\r
- GOTO 7\r
- END IF\r
- ELSE\r
- COLOR 12\r
- END IF\r
- PRINT fil$(a + froll) + SPACE$(80 - LEN(fil$(a + froll)));\r
-7\r
-NEXT a\r
-\r
-COLOR 15\r
-END SUB\r
-\r
-SUB fopen (a$)\r
-filename$ = a$\r
-FOR b = 0 TO 1000\r
- fil$(b) = ""\r
-NEXT b\r
-\r
-b = 0\r
-OPEN filename$ FOR INPUT AS #2\r
-5\r
-IF EOF(2) <> 0 THEN GOTO 6\r
-LINE INPUT #2, c$\r
-fil$(b) = c$\r
-b = b + 1\r
-IF b > 1000 THEN GOTO 6\r
-GOTO 5\r
-6\r
-CLOSE #2\r
-\r
-fline = 0\r
-froll = 0\r
-fdisp\r
-END SUB\r
-\r
-SUB llen (a, l)\r
-FOR b = 31 TO 0 STEP -1\r
-IF buf(b, a) <> 255 THEN l = b + 1: GOTO 3\r
-NEXT b\r
-l = 0\r
-3\r
-END SUB\r
-\r
-SUB load (a)\r
-DIM c AS LONG\r
-DIM a1 AS LONG\r
-a1 = a\r
-c = a1 * 1024\r
-SEEK #1, c + 1\r
-FOR y = 0 TO 31\r
- FOR x = 0 TO 31\r
- GET #1, , byte\r
- buf(x, y) = ASC(byte)\r
- NEXT x\r
-NEXT y\r
-END SUB\r
-\r
-SUB save (a)\r
-DIM c AS LONG\r
-DIM a1 AS LONG\r
-a1 = a\r
-c = a1 * 1024\r
-SEEK #1, c + 1\r
-FOR y = 0 TO 31\r
- FOR x = 0 TO 31\r
- byte = CHR$(buf(x, y))\r
- PUT #1, , byte\r
- NEXT x\r
-NEXT y\r
-SOUND 5000, .1\r
-END SUB\r
-\r
-SUB start\r
-SCREEN 12\r
-COLOR 15\r
-eb = 7\r
-\r
-filename$ = "<noname>"\r
-fline = 0\r
-froll = 0\r
-keyl = 0\r
-keyc = 0\r
-\r
-OPEN "font.dat" FOR BINARY AS #1\r
-FOR f = 0 TO 255\r
-FOR y = 0 TO 7\r
-GET #1, , byte\r
-n = ASC(byte)\r
-b = 128\r
-FOR a = 0 TO 7\r
-IF n >= b THEN n = n - b: c = 15 ELSE c = 0\r
-b = b / 2\r
-PSET (a, y), c\r
-NEXT a\r
-NEXT y\r
-GET (0, 0)-(7, 7), font(0, f)\r
-NEXT f\r
-CLOSE #1\r
-\r
-FOR y = 0 TO 31\r
-FOR x = 0 TO 31\r
-obuf(x, y) = -1\r
-NEXT x\r
-NEXT y\r
-\r
-LOCATE 1, 34\r
-PRINT "F1 - clear page"\r
-LOCATE 2, 34\r
-PRINT "F2 - enter decimal number"\r
-LOCATE 3, 34\r
-PRINT "F3 - goto page"\r
-LOCATE 4, 34\r
-PRINT "F4 - enter character code"\r
-LOCATE 5, 34\r
-PRINT "F5 - load source file"\r
-LOCATE 6, 34\r
-PRINT "F6 - insert line from source file"\r
-LOCATE 7, 34\r
-PRINT "F7 - copy line to source file"\r
-\r
-LOCATE 1, 71\r
-PRINT "code:"\r
-END SUB\r
-\r
projects / fifth.git / blobdiff