X-Git-Url: http://www2.svjatoslav.eu/gitweb/?p=fifth.git;a=blobdiff_plain;f=tools%2Feditor.bas;fp=tools%2Feditor.bas;h=3e64fa1f7b79b2348eaf9e6af9f7df6721a2172c;hp=0000000000000000000000000000000000000000;hb=7ad7475c2abf891a92b457339aaa0c20c40634d1;hpb=791dce846c524feca7b344307597c1d1224ba1de

diff --git a/tools/editor.bas b/tools/editor.bas
new file mode 100755
index 0000000..3e64fa1
--- /dev/null
+++ b/tools/editor.bas
@@ -0,0 +1,395 @@
+' 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$ = "<noname>"
+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
+