Las novedades son:
- pregunta el nombre del dispositivo de almacenamiento (flp1, mdv1, ram1,...) en lugar de disquetera, microdrive, número, etc. para que sea más cómodo trabajar con emuladores, y
- al moverse por las fuentes o por los caracteres se pueden utilizar, además de las flechas de cursor, las teclas O P Q y A.
Además el editor de caracteres tiene nuevas funciones para el diseño gráfico,
- Desplazar todo el diseño a la derecha (Ctrl+Right)
- Desplazar todo el diseño hacia abajo (Ctrl+Down)
- Desplazar todo el diseño a la izquierda (Ctrl+Left)
- Desplazar todo el diseño hacia arriba (Ctrl+Up)
- Invertir horizontalmente el diseño (Flip) (F ó Ctrl+F)
- Invertir verticalmente el diseño (Mirror) (M ó Ctrl+M)
- Copiar el diseño en la memoria intermedia (clipboard/buffer) (C ó Ctrl+C)
- Pegar el diseño desde la memoria intermedia (clipboard/buffer) (V ó Ctrl+V)
- Limpiar el tablero de diseño (X ó Ctrl-X)
- Grabar el carácter que está siendo editado como líneas DATA (*)
(*) Los datos se añaden al final del fichero fuente.data o fuente_data (si no existe, se crea uno vacío), donde fuente es el nombre del fichero de caracteres cargado (si no se ha cargado antes nada, pregunta el nombre).
DefCarac 1.00
Código: Seleccionar todo
100 :
110 REMark Gestor de errores
120 :
130 WHEN ERRor
140 IF ERR_NF: errorES = 1: REMark Not Found
150 END WHEN
160 :
170 REMark programa principal
180 :
190 trap3 = RESPR(8)
200 r = RESPR(2306)
210 drv$ = "": fich$ = "": DIM buffer(8)
220 abc$ = "": FOR n = 0 TO 9, 13, 11 TO 255: abc$ = abc$&CHR$(n)&" "
230 POKE_W trap3, 8196
240 POKE_W trap3+2, 20035
250 POKE_W trap3+4, 28672
260 POKE_W trap3+6, 20085
270 MODE 512
280 WINDOW 512, 256, 0, 0: PAPER 0: CLS
290 WINDOW 448, 202, 32, 14: BORDER 1, 7
300 WINDOW#0, 448, 40, 32, 216: INK#0, 7: REMark CSIZE#0, 1, 0
310 PAPER 0: INK 7: RESTORE : t = 0
320 FOR k = 1 TO 10
330 READ c: c$ = DB$(c)
340 FOR l = 1 TO 8
350 BLOCK 11, 9, 10+12*(l+24), 10*k, 6-4*c$(l)
360 NEXT l: NEXT k
370 DATA 0, 56, 100, 100, 100, 124, 100, 100, 100, 0
380 POKE r, 0: POKE r+1, 255
390 CSIZE 1, 0: AT 19, 1: PRINT"F1.SALVAR F2.CARGAR F3.FUENTE F4.COPIAR F5.MONTAR";
400 BLOCK 444, 1, 0, 188, 7: FOR i = 1 TO 4: BLOCK 2, 12, 88*i-1, 188, 7
410 p = 32
420 OVER 0: CSIZE 1, 0
430 WINDOW 256, 160, 50, 31: PRINT abc$: WINDOW 444, 200, 34, 15
440 :
450 REMark editor de fuentes
460 :
470 OVER -1
480 BLOCK 8, 10, 16+16*(p MOD 16), 16+10*(p DIV 16), 6
490 OVER 0: CSIZE 1, 0: AT 17, 36: PRINT "Codigo ASCII: "!FILL$(" ", 3-LEN(p));p;" "
500 IF p = 10: GO TO 550
510 CURSOR 330, 122: CSIZE 1, 0: PRINT CHR$(p)
520 CURSOR 360, 122: CSIZE 3, 0: PRINT CHR$(p)
530 CURSOR 330, 138: CSIZE 1, 1: PRINT CHR$(p)
540 CURSOR 360, 138: CSIZE 3, 1: PRINT CHR$(p)
550 OVER -1
560 a = CODE(INKEY$(-1)): IF a > 96 AND a < 123: a = a && 223
570 BLOCK 8, 10, 16+16*(p MOD 16), 16+10*(p DIV 16), 6
580 IF a == 10: GO TO 760 : REMark ENTER
590 IF a == 27: STOP : REMark ESC
600 IF a == 192 OR a == 79: p = p-1 : REMark left / O
610 IF a == 200 OR a == 80: p = p+1 : REMark right / P
620 IF a == 208 OR a == 81: p = p-16 : REMark up / Q
630 IF a == 216 OR a == 65: p = p+16 : REMark down / A
640 IF a == 232: SALVACARGA 1 : REMark F1 / Save
650 IF a == 234: SALVACARGA 2 : REMark shift+F1
660 IF a == 236: SALVACARGA 0 : REMark F2 / Load
670 IF a == 240: t = 1-t: JUEGO t: GO TO 420 : REMark F3
680 IF a == 244: COPIAR : REMark F4
690 IF a == 248: MONTAR : REMark F5
700 IF p > 255: p = 255
710 IF p < 0: p = 0
720 GO TO 440
730 :
740 REMark editor de caracteres
750 :
760 OVER 0
770 FOR l = 1 TO 8: BLOCK 11, 9, 10+12*(l+24), 10, 6
780 FOR k = 0 TO 8
790 c$ = DB$(PEEK(r+p*9+k+2))
800 FOR l = 1 TO 8
810 BLOCK 11, 9, 10+12*(l+24), 10*(k+2), 6-4*c$(l)
820 NEXT l
830 NEXT k
840 OVER -1
850 y = 0: x = 0
860 BLOCK 6, 5, 310+12*x, 20+10*y, 7
870 a = CODE(INKEY$(-1)): IF a > 96 AND a < 123: a = a && 223
880 BLOCK 6, 5, 310+12*x, 20+10*y, 7
890 IF a == 3 OR a == 67 : copydata: GO TO 730 : REMark ctrl+c / C
900 IF a == 6 OR a == 70 : flipHdata: GO TO 730 : REMark ctrl+f / F
910 IF a == 10 : GO TO 480 : REMark enter
920 IF a == 13 OR a == 77 : flipVdata: GO TO 730 : REMark ctrl+m / M
930 IF a == 22 OR a = 86 : pastedata: GO TO 730 : REMark ctrl+v / V
940 IF a == 24 OR a = 88 : cleardata: GO TO 730 : REMark ctrl+x / X
950 IF a == 192 OR a == 79: x = x-1: IF x < 0: x = 7 : REMark left / O
960 IF a == 194: shiftLdata: GO TO 730 : REMark ctrl+left
970 IF a == 200 OR a == 80: x = x+1: IF x > 7: x = 0 : REMark right / P
980 IF a == 202: shiftRdata: GO TO 730 : REMark ctrl+right
990 IF a == 208 OR a == 81: y = y-1: IF y < 0: y = 8 : REMark up / Q
1000 IF a == 210: shiftUdata: GO TO 730 : REMark ctrl+up
1010 IF a == 216 OR a == 65: y = y+1: IF y > 8: y = 0 : REMark down / A
1020 IF a == 218: shiftDdata: GO TO 730 : REMark ctrl+down
1030 IF a == 252 OR a = 83: savedata : REMark shift+space / S
1040 SELect ON a = 48 TO 57: FILAS : REMark 0-9
1050 IF a == 27: CSIZE#0, 0, 0: STOP : REMark ESC
1060 IF a == 32: TOGGLE x, y : REMark space
1070 GO TO 860
1080 :
1090 DEFine PROCedure cleardata
1100 REMark borra el tablero de dibujo
1110 LOCal adrb, i
1120 adrb = r + 9*p + 2
1130 FOR i = 0 TO 8: POKE adrb, 0: adrb = adrb + 1
1140 updateChar p
1150 END DEFine cleardata
1160 :
1170 DEFine PROCedure copydata
1180 REMark copia un caracter al buffer
1190 LOCal adrb, i
1200 adrb = r + 9*p + 2
1210 FOR i = 0 TO 8: buffer(i) = PEEK(adrb): adrb = adrb + 1
1220 END DEFine copydata
1230 :
1240 DEFine PROCedure flipHdata
1250 REMark volteo horizontal
1260 LOCal a, adrb, b, i, j, p1, p2
1270 adrb = r + 9*p + 2
1280 FOR i = 0 TO 8
1290 b = PEEK(adrb)
1300 p1 = 1: p2 = 128: a = 0
1310 FOR j = 0 TO 7
1320 a = a + p1*((b && p2) <> 0)
1330 p1 = 2*p1: p2 = p2 DIV 2
1340 NEXT j
1350 POKE adrb, a: adrb = adrb + 1
1360 NEXT i
1370 updateChar p
1380 END DEFine flipHdata
1390 :
1400 DEFine PROCedure flipVdata
1410 REMark volteo vertical
1420 LOCal adr1, adr2, adrb, b, i
1430 adrb = r + 9*p + 2
1440 adr1 = adrb
1450 adr2 = adrb + 8
1460 FOR i = 0 TO 3
1470 b = PEEK(adr1)
1480 POKE adr1, PEEK(adr2): adr1 = adr1 + 1
1490 POKE adr2, b: adr2 = adr2 - 1
1500 NEXT i
1510 updateChar p
1520 END DEFine flipVdata
1530 :
1540 DEFine PROCedure pastedata
1550 REMark pega un caracter desde el buffer
1560 LOCal adrb, i
1570 adrb = r + 9*p + 2
1580 FOR i = 0 TO 8: POKE adrb, buffer(i): adrb = adrb + 1
1590 updateChar p
1600 END DEFine pastedata
1610 :
1620 DEFine PROCedure shiftDdata
1630 REMark desplazamiento hacia abajo
1640 LOCal a, adrb, b, i
1650 adrb = r + 9*p + 10
1660 a = PEEK(adrb)
1670 FOR i = 0 TO 7
1680 adrb = adrb - 1
1690 b = PEEK(adrb)
1700 POKE adrb+1, b
1710 NEXT i
1720 POKE adrb, a
1730 updateChar p
1740 END DEFine shiftDdata
1750 :
1760 DEFine PROCedure shiftLdata
1770 REMark desplazamiento a la izquierda
1780 LOCal a, adrb, b, i, j, p1, p2
1790 adrb = r + 9*p + 2
1800 FOR i = 0 TO 8
1810 b = PEEK(adrb):
1820 a = 2*b + ((b && 128) <> 0)
1830 POKE adrb, a: adrb = adrb + 1
1840 NEXT i
1850 updateChar p
1860 END DEFine shiftLdata
1870 :
1880 DEFine PROCedure shiftRdata
1890 REMark desplazamiento a la derecha
1900 LOCal a, adrb, b, i, j, p1, p2
1910 adrb = r + 9*p + 2
1920 FOR i = 0 TO 8
1930 b = PEEK(adrb):
1940 a = b DIV 2 + 128*((b && 1) <> 0)
1950 POKE adrb, a: adrb = adrb + 1
1960 NEXT i
1970 updateChar p
1980 END DEFine shiftRdata
1990 :
2000 DEFine PROCedure shiftUdata
2010 REMark desplazamiento hacia arriba
2020 LOCal a, adrb, b, i
2030 adrb = r + 9*p + 2
2040 a = PEEK(adrb)
2050 FOR i = 0 TO 7
2060 adrb = adrb + 1
2070 b = PEEK(adrb)
2080 POKE adrb-1, b
2090 NEXT i
2100 POKE adrb, a
2110 updateChar p
2120 END DEFine shiftUdata
2130 :
2140 DEFine PROCedure savedata
2150 REMark anade al final del fichero output los datos BASIC del caracter editado
2160 LOCal b, i, j, s$, savedataLoop
2170 ficheroDispositivoPorDefecto
2180 IF drv$ == "" THEN RETurn
2190 errorES = 0: s$ = drv$&fich$&"_data"
2200 OPEN #9, s$
2210 IF errorES: errorES = 0: OPEN_NEW #9, s$
2220 REPeat savedataLoop
2230 IF EOF(#9) THEN EXIT savedataLoop
2240 INPUT #9, s$
2250 END REPeat savedataLoop
2260 s$ = " DATA "
2270 FOR i = 0 TO 8: d = PEEK(r + 9*p + i + 2): s$ = s$ & d: IF i <> 8 THEN s$ = s$ & ", "
2280 s$ = s$ & ": REMark"
2290 PRINT #9, s$
2300 CLOSE #9
2310 CLS #0
2320 END DEFine savedata
2330 :
2340 DEFine PROCedure updateChar(p)
2350 REMark actualiza el diseno del caracter p en la pantalla
2360 OVER 0: CSIZE 1, 0: CURSOR 16+(p MOD 16)*16, 16+(p DIV 16)*10: PRINT CHR$(p)
2370 END DEFine updateChar
2380 :
2390 DEFine PROCedure TOGGLE(x, y)
2400 OVER 0: CSIZE 3, 0
2410 d = r+9*p+y+2
2420 POKE d, PEEK(d)^^(2^(7-x))
2430 c$ = DB$(PEEK(d))
2440 BLOCK 11, 9, 10+12*(25+x), 10*(2+y), 6-4*c$(x+1)
2450 updateChar p
2460 IF p = 10: GO TO 2510
2470 CURSOR 330, 122: CSIZE 1, 0: PRINT CHR$(p)
2480 CURSOR 360, 122: CSIZE 3, 0: PRINT CHR$(p)
2490 CURSOR 330, 138: CSIZE 1, 1: PRINT CHR$(p)
2500 CURSOR 360, 138: CSIZE 3, 1: PRINT CHR$(p)
2510 OVER -1
2520 END DEFine TOGGLE
2530 :
2540 DEFine PROCedure FILAS
2550 OVER 0
2560 CLS#0: PRINT#0, "Decimal >>>"!CHR$(a);"_": s$ = CHR$(a)
2570 REPeat GET
2580 a = CODE(INKEY$(-1))
2590 SELect ON a = 48 TO 57: s$ = s$&CHR$(a): AT #0, 0, 12: PRINT #0, s$;"_" : REMark 0-9
2600 IF a = 10: AT #0, 0, 12: PRINT #0, s$;" ": de = s$: EXIT GET : REMark enter
2610 IF a = 27: RETurn : REMark ESC
2620 IF a = 194: s$ = s$(1 TO LEN(s$)-1): AT#0, 0, 12: PRINT#0, s$;"_ " : REMark ctrl+left
2630 END REPeat GET
2640 d = r+2+9*p+y: POKE d, de
2650 c$ = DB$(PEEK(d))
2660 FOR x = 0 TO 7: BLOCK 11, 9, 10+12*(25+x), 10*y+20, 6-4*c$(x+1)
2670 y = y+(y < 8): CLS#0
2680 GO TO 2450
2690 END DEFine FILAS
2700 :
2710 DEFine PROCedure COPIAR
2720 p1 = p: AT#0, 0, 0: PRINT#0, "Lleva el cursor al carŒcter donde lo quieres COPIAR."
2730 CURS
2740 IF a$ == CHR$(27): a$ = "": CLS#0: RETurn
2750 FOR k = 0 TO 8: POKE r+p*9+k+2, PEEK(r+p1*9+k+2)
2760 OVER 0: CSIZE 1, 0: CURSOR 16+(p MOD 16)*16, 16+(p DIV 16)*10: PRINT CHR$(p): OVER -1
2770 CLS#0
2780 END DEFine COPIAR
2790 :
2800 DEFine PROCedure MONTAR
2810 p1 = p: AT#0, 0, 0: PRINT#0, "Lleva el cursor al carŒcter donde lo quieres MONTAR."
2820 CURS
2830 IF a$ == CHR$(27): a$ = "": CLS#0: RETurn
2840 FOR k = 0 TO 8: POKE r+p*9+k+2, PEEK(r+p1*9+k+2)||PEEK(r+p*9+k+2)
2850 OVER 0: CSIZE 1, 0: CURSOR 16+(p MOD 16)*16, 16+(p DIV 16)*10: PRINT CHR$(p): OVER -1
2860 CLS#0
2870 END DEFine MONTAR
2880 :
2890 DEFine PROCedure CURS
2900 OVER -1
2910 BLOCK 8, 10, 16+16*(p MOD 16), 16+10*(p DIV 16), 6
2920 OVER 0: CSIZE 1, 0: AT 17, 36: PRINT "Codigo ASCII: "!FILL$(" ", 3-LEN(p));p;" "
2930 IF p = 10: GO TO 3000
2940 OVER 0
2950 CURSOR 330, 122: CSIZE 1, 0: PRINT CHR$(p)
2960 CURSOR 360, 122: CSIZE 3, 0: PRINT CHR$(p)
2970 CURSOR 330, 138: CSIZE 1, 1: PRINT CHR$(p)
2980 CURSOR 360, 138: CSIZE 3, 1: PRINT CHR$(p)
2990 OVER -1
3000 a = CODE(INKEY$(-1)): IF a > 96 AND a < 123: a = a && 223
3010 BLOCK 8, 10, 16+16*(p MOD 16), 16+10*(p DIV 16), 6
3020 IF a == 10 OR a == 27: RETurn : REMark enter / ESC
3030 IF a == 192 OR a == 79: p = p-1 : REMark left / O
3040 IF a == 200 OR a == 80: p = p+1 : REMark right / P
3050 IF a == 208 OR a == 81: p = p-16 : REMark up / Q
3060 IF a == 216 OR a == 65: p = p+16 : REMark down / A
3070 IF a == 240: t = 1-t: JUEGO t: OVER 0: CSIZE 1, 0: WINDOW 256, 160, 50, 31: PRINT abc$: WINDOW 444, 200, 34, 15: GO TO 2900 : REMark F3
3080 IF p > 255: p = 255
3090 IF p < 0: p = 0
3100 GO TO 2900
3110 END DEFine CURS
3120 :
3130 DEFine PROCedure ficheroDispositivoPorDefecto
3140 REMark pregunta el nombre del fichero o dispositivo a usar por defecto
3150 IF fich$ = "": INPUT#0, "Nombre del fichero?"!fich$: ELSE PRINT#0, "Fichero actual: "!fich$
3160 IF drv$ == "" THEN
3170 INPUT #0, "Dispositivo? (p.e.mvd1)"!u$
3180 IF u$ == "" THEN RETurn
3190 i = u$ INSTR "_": IF NOT i THEN u$ = u$ & "_"
3200 drv$ = u$
3210 ELSE
3220 PRINT #0, "Dispositivo actual: "!drv$
3230 END IF
3240 END DEFine ficheroDispositivoPorDefecto
3250 :
3260 DEFine PROCedure SALVACARGA(o)
3270 LOCal u$, d$, i, n
3280 CLS#0
3290 IF NOT o: PRINT#0, "CARGAR": ELSE PRINT#0, "SALVAR"
3300 ficheroDispositivoPorDefecto
3310 IF NOT o:LBYTES drv$&fich$&"_car", r:ELSE DELETE drv$&fich$&"_car":SBYTES drv$&fich$&"_car", r, 2306
3320 CLS#0
3330 END DEFine SALVACARGA
3340 :
3350 DEFine PROCedure JUEGO(t)
3360 CALL trap3, 0, 0, 0, 37, 0, 0, 0, 65537, r*t, r*t
3370 END DEFine JUEGO
3380 :
3390 DEFine FuNction DB$(d)
3400 LOCal a, b$, i, r
3410 a = d: b$ = ""
3420 FOR i = 1 TO 8
3430 r = a-INT(a/2)*2: a = INT(a/2)
3440 b$ = r&b$
3450 END FOR i
3460 RETurn b$
3470 END DEFine DB$