util/editor.bas

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