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