1 ' Disk file editor for FIFTH
\r
2 ' Svjatoslav Agejenko: n0@hot.ee
\r
5 DECLARE SUB fopen (a$)
\r
6 DECLARE SUB ask (a$, b$)
\r
7 DECLARE SUB addk (a$)
\r
8 DECLARE SUB llen (a%, l%)
\r
9 DECLARE SUB save (a%)
\r
13 DECLARE SUB load (a)
\r
14 DECLARE SUB start ()
\r
16 DIM SHARED buf(0 TO 31, 0 TO 31)
\r
17 DIM SHARED obuf(0 TO 31, 0 TO 31)
\r
18 DIM SHARED byte AS STRING * 1
\r
19 DIM SHARED font(0 TO 20, 0 TO 255)
\r
21 DIM SHARED keys(0 TO 10000)
\r
22 DIM SHARED keyl, keyc
\r
23 DIM SHARED curx, cury
\r
24 DIM SHARED fil$(0 TO 1000)
\r
25 DIM SHARED fline, froll
\r
26 DIM SHARED filename$
\r
30 OPEN "..\..\disk.raw" FOR BINARY AS #1
\r
38 keys(keyl) = ASC(a$)
\r
40 IF keyl > 10000 THEN keyl = 0
\r
50 LOCATE 16, 34 + LEN(a$)
\r
62 IF c <> obuf(x, y) THEN
\r
63 PUT (x * 8, y * 8), font(0, c), PSET
\r
71 FOR y = y1 TO y1 + 7
\r
72 FOR x = x1 TO x1 + 7
\r
74 IF c = 15 THEN c = 0 ELSE c = 10
\r
78 obuf(curx, cury) = -1
\r
83 PRINT buf(curx, cury)
\r
99 PRINT "page:"; eb; " "
\r
106 IF keyl = keyc THEN GOTO 2
\r
107 a$ = CHR$(keys(keyc))
\r
109 IF keyc > 10000 THEN keyc = 0
\r
113 IF a$ = CHR$(0) + CHR$(73) THEN eb = eb - 1
\r
114 IF a$ = CHR$(0) + CHR$(81) THEN eb = eb + 1
\r
115 IF a$ = CHR$(27) THEN GOTO 4
\r
116 IF a$ = CHR$(0) + "M" THEN curx = curx + 1
\r
117 IF a$ = CHR$(0) + "K" THEN curx = curx - 1
\r
118 IF a$ = CHR$(0) + "P" THEN cury = cury + 1
\r
119 IF a$ = CHR$(0) + "H" THEN cury = cury - 1
\r
120 IF a$ = CHR$(0) + "=" THEN ask "page: ", b$: eb = VAL(b$)
\r
121 IF a$ = CHR$(0) + "?" THEN ask "file: ", b$: fopen b$
\r
122 IF a$ = CHR$(0) + CHR$(132) THEN fline = fline - 1: fdisp
\r
123 IF a$ = CHR$(0) + CHR$(118) THEN fline = fline + 1: fdisp
\r
124 IF a$ = CHR$(0) + CHR$(64) THEN ' F6
\r
126 FOR b = 1 TO LEN(fil$(fline))
\r
127 c$ = RIGHT$(LEFT$(fil$(fline), b), 1)
\r
128 IF c$ = CHR$(9) THEN c$ = " "
\r
129 IF c$ = " " OR c$ = CHR$(255) THEN d = d + 1 ELSE d = 0
\r
130 IF d < 2 THEN addk c$
\r
134 IF a$ = CHR$(0) + ";" THEN
\r
143 IF a$ = CHR$(0) + CHR$(83) THEN
\r
145 buf(b, cury) = buf(b + 1, cury)
\r
147 buf(31, cury) = 255
\r
151 IF (a$ = CHR$(13)) AND (bk = 0) THEN
\r
154 FOR a = 31 TO cury + 2 STEP -1
\r
156 buf(b, a) = buf(b, a - 1)
\r
160 buf(a, cury + 1) = 255
\r
163 SWAP buf(a, cury), buf(a - curx, cury + 1)
\r
171 IF LEN(a$) = 1 THEN
\r
172 IF ASC(a$) = 32 THEN a$ = CHR$(255)
\r
173 IF (a$ = CHR$(8)) AND (bk = 0) THEN
\r
176 FOR b = curx - 1 TO 30
\r
177 buf(b, cury) = buf(b + 1, cury)
\r
179 buf(31, cury) = 255
\r
187 buf(b, cury - 1) = buf(b - a, cury)
\r
191 buf(b, a) = buf(b, a + 1)
\r
204 IF a$ = CHR$(0) + "<" THEN
\r
205 ask "decimal number:", b$
\r
207 FOR a = 1 TO LEN(b$)
\r
208 c = ASC(RIGHT$(LEFT$(b$, a), 1))
\r
209 IF (c <= 57) AND (c >= 48) THEN d$ = CHR$(c - 48): addk d$
\r
210 IF (c <= 70) AND (c >= 65) THEN d$ = CHR$(c - 55): addk d$
\r
214 IF a$ = CHR$(0) + CHR$(65) THEN
\r
215 FOR a = 999 TO fline STEP -1
\r
216 fil$(a + 1) = fil$(a)
\r
220 fil$(fline) = fil$(fline) + CHR$(buf(a, cury))
\r
225 IF a$ = CHR$(0) + ">" THEN
\r
226 ask "ascii code:", b$
\r
230 IF LEN(a$) = 1 THEN
\r
231 FOR b = 31 TO curx + 1 STEP -1
\r
232 buf(b, cury) = buf(b - 1, cury)
\r
234 buf(curx, cury) = ASC(a$)
\r
239 IF eb < 0 THEN eb = 0
\r
240 IF curx < 0 THEN curx = 0
\r
241 IF cury < 0 THEN cury = 0
\r
242 IF curx > 31 THEN curx = 31
\r
243 IF cury > 31 THEN cury = 31
\r
250 IF fline < 0 THEN fline = 0
\r
251 IF fline > 1000 THEN fline = 1000
\r
252 IF fline - froll > 10 THEN froll = fline - 10
\r
253 IF fline - froll < 0 THEN froll = fline
\r
254 IF froll < 0 THEN froll = 0
\r
259 PRINT "file: " + filename$
\r
262 PRINT "line:"; fline
\r
266 IF a + froll = fline THEN
\r
268 IF fil$(a + froll) = SPACE$(LEN(fil$(a + froll))) THEN
\r
277 PRINT fil$(a + froll) + SPACE$(80 - LEN(fil$(a + froll)));
\r
291 OPEN filename$ FOR INPUT AS #2
\r
293 IF EOF(2) <> 0 THEN GOTO 6
\r
297 IF b > 1000 THEN GOTO 6
\r
308 FOR b = 31 TO 0 STEP -1
\r
309 IF buf(b, a) <> 255 THEN l = b + 1: GOTO 3
\r
324 buf(x, y) = ASC(byte)
\r
337 byte = CHR$(buf(x, y))
\r
349 filename$ = "<noname>"
\r
355 OPEN "font.dat" FOR BINARY AS #1
\r
362 IF n >= b THEN n = n - b: c = 15 ELSE c = 0
\r
367 GET (0, 0)-(7, 7), font(0, f)
\r
378 PRINT "F1 - clear page"
\r
380 PRINT "F2 - enter decimal number"
\r
382 PRINT "F3 - goto page"
\r
384 PRINT "F4 - enter character code"
\r
386 PRINT "F5 - load source file"
\r
388 PRINT "F6 - insert line from source file"
\r
390 PRINT "F7 - copy line to source file"
\r