tools/editor.bas

   1 ' Disk file editor for FIFTH
   2 ' Svjatoslav Agejenko: n0@hot.ee
   3
   4 DECLARE SUB fdisp ()
   5 DECLARE SUB fopen (a$)
   6 DECLARE SUB ask (a$, b$)
   7 DECLARE SUB addk (a$)
   8 DECLARE SUB llen (a%, l%)
   9 DECLARE SUB save (a%)
  10 DECLARE SUB disp ()
  11 DEFINT A-Z
  12
  13 DECLARE SUB load (a)
  14 DECLARE SUB start ()
  15 DECLARE SUB edit ()
  16 DIM SHARED buf(0 TO 31, 0 TO 31)
  17 DIM SHARED obuf(0 TO 31, 0 TO 31)
  18 DIM SHARED byte AS STRING * 1
  19 DIM SHARED font(0 TO 20, 0 TO 255)
  20 DIM SHARED eb
  21 DIM SHARED keys(0 TO 10000)
  22 DIM SHARED keyl, keyc
  23 DIM SHARED curx, cury
  24 DIM SHARED fil$(0 TO 1000)
  25 DIM SHARED fline, froll
  26 DIM SHARED filename$
  27
  28 start
  29
  30 OPEN "..\..\disk.raw" FOR BINARY AS #1
  31
  32 edit
  33
  34 CLOSE #1
  35 SYSTEM
  36
  37 SUB addk (a$)
  38 keys(keyl) = ASC(a$)
  39 keyl = keyl + 1
  40 IF keyl > 10000 THEN keyl = 0
  41 END SUB
  42
  43 SUB ask (a$, b$)
  44 LOCATE 16, 34
  45 PRINT SPACE$(46)
  46 LOCATE 16, 34
  47 COLOR 15
  48 PRINT a$
  49 COLOR 10
  50 LOCATE 16, 34 + LEN(a$)
  51 INPUT "", b$
  52 LOCATE 16, 34
  53 PRINT SPACE$(46)
  54 COLOR 15
  55 END SUB
  56
  57 SUB disp
  58
  59 FOR y = 0 TO 31
  60 FOR x = 0 TO 31
  61 c = buf(x, y)
  62 IF c <> obuf(x, y) THEN
  63   PUT (x * 8, y * 8), font(0, c), PSET
  64   obuf(x, y) = c
  65 END IF
  66 NEXT x
  67 NEXT y
  68
  69 x1 = curx * 8
  70 y1 = cury * 8
  71 FOR y = y1 TO y1 + 7
  72 FOR x = x1 TO x1 + 7
  73 c = POINT(x, y)
  74 IF c = 15 THEN c = 0 ELSE c = 10
  75 PSET (x, y), c
  76 NEXT x
  77 NEXT y
  78 obuf(curx, cury) = -1
  79
  80 LOCATE 1, 77
  81 PRINT "   "
  82 LOCATE 1, 76
  83 PRINT buf(curx, cury)
  84 END SUB
  85
  86 SUB edit
  87 fdisp
  88 leb = -1
  89 m = 0
  90 1
  91 IF eb <> leb THEN
  92   IF m = 1 THEN
  93     save leb
  94     m = 0
  95   END IF
  96   load eb
  97   leb = eb
  98   LOCATE 1, 60
  99   PRINT "page:"; eb; " "
 100 END IF
 101 disp
 102 2
 103 a$ = INKEY$
 104 bk = 0
 105 IF a$ = "" THEN
 106   IF keyl = keyc THEN GOTO 2
 107   a$ = CHR$(keys(keyc))
 108   keyc = keyc + 1
 109   IF keyc > 10000 THEN keyc = 0
 110   bk = 1
 111 END IF
 112
 113 IF a$ = CHR$(0) + CHR$(73) THEN eb = eb - 1
 114 IF a$ = CHR$(0) + CHR$(81) THEN eb = eb + 1
 115 IF a$ = CHR$(27) THEN GOTO 4
 116 IF a$ = CHR$(0) + "M" THEN curx = curx + 1
 117 IF a$ = CHR$(0) + "K" THEN curx = curx - 1
 118 IF a$ = CHR$(0) + "P" THEN cury = cury + 1
 119 IF a$ = CHR$(0) + "H" THEN cury = cury - 1
 120 IF a$ = CHR$(0) + "=" THEN ask "page: ", b$: eb = VAL(b$)
 121 IF a$ = CHR$(0) + "?" THEN ask "file: ", b$: fopen b$
 122 IF a$ = CHR$(0) + CHR$(132) THEN fline = fline - 1: fdisp
 123 IF a$ = CHR$(0) + CHR$(118) THEN fline = fline + 1: fdisp
 124 IF a$ = CHR$(0) + CHR$(64) THEN         ' F6
 125   d = 0
 126   FOR b = 1 TO LEN(fil$(fline))
 127     c$ = RIGHT$(LEFT$(fil$(fline), b), 1)
 128     IF c$ = CHR$(9) THEN c$ = " "
 129     IF c$ = " " OR c$ = CHR$(255) THEN d = d + 1 ELSE d = 0
 130     IF d < 2 THEN addk c$
 131   NEXT b
 132 END IF
 133
 134 IF a$ = CHR$(0) + ";" THEN
 135   FOR y = 0 TO 31
 136     FOR x = 0 TO 31
 137       buf(x, y) = 255
 138     NEXT x
 139   NEXT y
 140   m = 1
 141 END IF
 142
 143 IF a$ = CHR$(0) + CHR$(83) THEN
 144   FOR b = curx TO 30
 145     buf(b, cury) = buf(b + 1, cury)
 146   NEXT b
 147   buf(31, cury) = 255
 148   m = 1
 149 END IF
 150
 151 IF (a$ = CHR$(13)) AND (bk = 0) THEN
 152 a$ = ""
 153 IF cury < 31 THEN
 154   FOR a = 31 TO cury + 2 STEP -1
 155     FOR b = 0 TO 31
 156       buf(b, a) = buf(b, a - 1)
 157     NEXT b
 158   NEXT a
 159   FOR a = 0 TO 31
 160     buf(a, cury + 1) = 255
 161   NEXT a
 162   FOR a = curx TO 31
 163     SWAP buf(a, cury), buf(a - curx, cury + 1)
 164   NEXT a
 165   m = 1
 166   cury = cury + 1
 167   curx = 0
 168 END IF
 169 END IF
 170
 171 IF LEN(a$) = 1 THEN
 172   IF ASC(a$) = 32 THEN a$ = CHR$(255)
 173   IF (a$ = CHR$(8)) AND (bk = 0) THEN
 174     a$ = ""
 175     IF curx > 0 THEN
 176       FOR b = curx - 1 TO 30
 177         buf(b, cury) = buf(b + 1, cury)
 178       NEXT b
 179       buf(31, cury) = 255
 180       curx = curx - 1
 181       m = 1
 182     ELSE
 183       IF cury > 0 THEN
 184         llen cury - 1, a
 185         curx = a
 186         FOR b = a TO 31
 187           buf(b, cury - 1) = buf(b - a, cury)
 188         NEXT b
 189         FOR a = cury TO 30
 190           FOR b = 0 TO 31
 191             buf(b, a) = buf(b, a + 1)
 192           NEXT b
 193         NEXT a
 194         FOR b = 0 TO 31
 195           buf(b, 31) = 255
 196         NEXT b
 197         m = 1
 198         cury = cury - 1
 199       END IF
 200     END IF
 201   END IF
 202 END IF
 203
 204 IF a$ = CHR$(0) + "<" THEN
 205 ask "decimal number:", b$
 206 b$ = HEX$(VAL(b$))
 207 FOR a = 1 TO LEN(b$)
 208   c = ASC(RIGHT$(LEFT$(b$, a), 1))
 209   IF (c <= 57) AND (c >= 48) THEN d$ = CHR$(c - 48): addk d$
 210   IF (c <= 70) AND (c >= 65) THEN d$ = CHR$(c - 55): addk d$
 211 NEXT a
 212 END IF
 213
 214 IF a$ = CHR$(0) + CHR$(65) THEN
 215 FOR a = 999 TO fline STEP -1
 216   fil$(a + 1) = fil$(a)
 217 NEXT a
 218 fil$(fline) = ""
 219 FOR a = curx TO 31
 220   fil$(fline) = fil$(fline) + CHR$(buf(a, cury))
 221 NEXT a
 222 fdisp
 223 END IF
 224
 225 IF a$ = CHR$(0) + ">" THEN
 226 ask "ascii code:", b$
 227 a$ = CHR$(VAL(b$))
 228 END IF
 229
 230 IF LEN(a$) = 1 THEN
 231     FOR b = 31 TO curx + 1 STEP -1
 232       buf(b, cury) = buf(b - 1, cury)
 233     NEXT b
 234     buf(curx, cury) = ASC(a$)
 235     curx = curx + 1
 236     m = 1
 237 END IF
 238
 239 IF eb < 0 THEN eb = 0
 240 IF curx < 0 THEN curx = 0
 241 IF cury < 0 THEN cury = 0
 242 IF curx > 31 THEN curx = 31
 243 IF cury > 31 THEN cury = 31
 244 GOTO 1
 245 4
 246
 247 END SUB
 248
 249 SUB fdisp
 250 IF fline < 0 THEN fline = 0
 251 IF fline > 1000 THEN fline = 1000
 252 IF fline - froll > 10 THEN froll = fline - 10
 253 IF fline - froll < 0 THEN froll = fline
 254 IF froll < 0 THEN froll = 0
 255
 256 LOCATE 17, 1
 257 PRINT SPACE$(80)
 258 LOCATE 17, 1
 259 PRINT "file: " + filename$
 260
 261 LOCATE 17, 20
 262 PRINT "line:"; fline
 263
 264 FOR a = 0 TO 10
 265   LOCATE a + 18, 1
 266   IF a + froll = fline THEN
 267     COLOR 10
 268     IF fil$(a + froll) = SPACE$(LEN(fil$(a + froll))) THEN
 269       FOR b = 1 TO 80
 270         PRINT CHR$(219);
 271       NEXT b
 272       GOTO 7
 273     END IF
 274   ELSE
 275     COLOR 12
 276   END IF
 277   PRINT fil$(a + froll) + SPACE$(80 - LEN(fil$(a + froll)));
 278 7
 279 NEXT a
 280
 281 COLOR 15
 282 END SUB
 283
 284 SUB fopen (a$)
 285 filename$ = a$
 286 FOR b = 0 TO 1000
 287   fil$(b) = ""
 288 NEXT b
 289
 290 b = 0
 291 OPEN filename$ FOR INPUT AS #2
 292 5
 293 IF EOF(2) <> 0 THEN GOTO 6
 294 LINE INPUT #2, c$
 295 fil$(b) = c$
 296 b = b + 1
 297 IF b > 1000 THEN GOTO 6
 298 GOTO 5
 299 6
 300 CLOSE #2
 301
 302 fline = 0
 303 froll = 0
 304 fdisp
 305 END SUB
 306
 307 SUB llen (a, l)
 308 FOR b = 31 TO 0 STEP -1
 309 IF buf(b, a) <> 255 THEN l = b + 1: GOTO 3
 310 NEXT b
 311 l = 0
 312 3
 313 END SUB
 314
 315 SUB load (a)
 316 DIM c AS LONG
 317 DIM a1 AS LONG
 318 a1 = a
 319 c = a1 * 1024
 320 SEEK #1, c + 1
 321 FOR y = 0 TO 31
 322   FOR x = 0 TO 31
 323     GET #1, , byte
 324     buf(x, y) = ASC(byte)
 325   NEXT x
 326 NEXT y
 327 END SUB
 328
 329 SUB save (a)
 330 DIM c AS LONG
 331 DIM a1 AS LONG
 332 a1 = a
 333 c = a1 * 1024
 334 SEEK #1, c + 1
 335 FOR y = 0 TO 31
 336   FOR x = 0 TO 31
 337     byte = CHR$(buf(x, y))
 338     PUT #1, , byte
 339   NEXT x
 340 NEXT y
 341 SOUND 5000, .1
 342 END SUB
 343
 344 SUB start
 345 SCREEN 12
 346 COLOR 15
 347 eb = 7
 348
 349 filename$ = "<noname>"
 350 fline = 0
 351 froll = 0
 352 keyl = 0
 353 keyc = 0
 354
 355 OPEN "font.dat" FOR BINARY AS #1
 356 FOR f = 0 TO 255
 357 FOR y = 0 TO 7
 358 GET #1, , byte
 359 n = ASC(byte)
 360 b = 128
 361 FOR a = 0 TO 7
 362 IF n >= b THEN n = n - b: c = 15 ELSE c = 0
 363 b = b / 2
 364 PSET (a, y), c
 365 NEXT a
 366 NEXT y
 367 GET (0, 0)-(7, 7), font(0, f)
 368 NEXT f
 369 CLOSE #1
 370
 371 FOR y = 0 TO 31
 372 FOR x = 0 TO 31
 373 obuf(x, y) = -1
 374 NEXT x
 375 NEXT y
 376
 377 LOCATE 1, 34
 378 PRINT "F1 - clear page"
 379 LOCATE 2, 34
 380 PRINT "F2 - enter decimal number"
 381 LOCATE 3, 34
 382 PRINT "F3 - goto page"
 383 LOCATE 4, 34
 384 PRINT "F4 - enter character code"
 385 LOCATE 5, 34
 386 PRINT "F5 - load source file"
 387 LOCATE 6, 34
 388 PRINT "F6 - insert line from source file"
 389 LOCATE 7, 34
 390 PRINT "F7 - copy line to source file"
 391
 392 LOCATE 1, 71
 393 PRINT "code:"
 394 END SUB
 395