Karoshi MSX Community

10 '--------------------

20 '

30 ' Editor Grafico

40 ' NONAME 0.02

50 '

60 ' 26/08/13

70 '

80 '--------------------

90 SCREEN0,,0:KEYOFF:WIDTH40:COLOR2,1,1

100 '

110 ' define variables

120 '

130 AS=0:'CODICO ASCII

140 CL=2:'COLOR ACTUAL

150 XT=0:YT=0:'COORDENADAS TABLA PATRONES

160 XR=12:YR=82:'COORDENAS REJILLA

170 O=0: ' AREA DE TRABAJO 0=TABLA PATRONES 1=REJILLA

180 DIM P(8,8): ' MATRIZ DE APOYO

190 DIM U(8,8): ' SOLO PARA RESTABLECER, OPCION N

200 '

210 ' lanza programa

220 '

230 SCREEN 5,,0

240 OPEN "GRP:" FOR OUTPUT AS #1

250 LINE (0,70)-(255,211),13,B

260 COLOR 13:PRESET (10,67):PRINT #1, "EDITOR GRAFICO NONAME v0.02"

270 '

280 'dibuja rejilla

290 '

300 FOR I=0 TO 8:LINE (10,80+I*10)-(90,80+I*10),2:NEXT I

310 FOR I=0 TO 8:LINE (10+I*10,80)-(10+I*10,160),2:NEXT I

320 GOSUB 1190

330 '

340 'dibuja informacion sobre caracter

350 '

360 PRESET(10,166): PRINT #1, "ASCII"

370 COLOR 15:PRESET(64,166): PRINT #1, AS

380 '

390 'dibuja paleta colores

400 '

410 LINE (8,176)-(92,198),2,B

420 FOR I=0 TO 15: LINE (10+I*5,178)-(15+I*5,187),I,BF:NEXT I

430 LINE (10,188)-(90,196),CL,BF

440 '

450 'define SPRITE

460 SPRITE$(0)=CHR$(254)+CHR$(130)+CHR$(130)+CHR$(130)+CHR$(130)+CHR$(130)+CHR$(254)+CHR$(0)

470 '

480 ' imprime opciones del programa

490 '

500 COLOR 15:PRESET(95, 80):PRINT#1,"CUR y Z=QUITA X=PONE"

510 COLOR 14:PRESET(95, 88):PRINT#1,"<1,2> COLOR"

520 COLOR 15:PRESET(95, 96):PRINT#1,"Ir a set grafico   T"

530 COLOR 14:PRESET(95,104):PRINT#1,"Ir a rejilla trabj R"

540 COLOR 15:PRESET(95,112):PRINT#1,"Giro antihorario   G"

550 COLOR 14:PRESET(95,120):PRINT#1,"Invierte Hor-Ver H,V"

560 COLOR 15:PRESET(95,128):PRINT#1,"Desplaza Izquierda D"

570 COLOR 14:PRESET(95,136):PRINT#1,"Desplaza Arriba    U"

580 COLOR 15:PRESET(95,144):PRINT#1,"Llena Obj,Linea  F,I"

590 COLOR 14:PRESET(95,152):PRINT#1,"ReSet Caracter     N"

600 COLOR 15:PRESET(95,160):PRINT#1,"Copia-Pega       C,P"

610 COLOR 14:PRESET(95,168):PRINT#1,"Borra rejilla      E"

620 COLOR 15:PRESET(95,176):PRINT#1,"Save-Load        S,L"

630 COLOR 14:PRESET(95,184):PRINT#1,"to C,Asm,Basic B,J,Y"

640 COLOR 15:PRESET(95,192):PRINT#1,"SALIR=K"

650 '

660 'menu principal

670 '

680 A$=INKEY$:D=STICK(0)

690 IF O=1 THEN GOTO 750

700 IF D=1 AND YT>0 THEN YT=YT-8:AS=AS-32

710 IF D=3 AND XT<247 THEN XT=XT+8:AS=AS+1

720 IF D=5 AND YT<56 THEN YT=YT+8:AS=AS+32

730 IF D=7 AND XT>0 THEN XT=XT-8:AS=AS-1

740 GOTO 790

750 IF D=1 AND YR>82 THEN YR=YR-10

760 IF D=3 AND XR<82 THEN XR=XR+10

770 IF D=5 AND YR<152 THEN YR=YR+10

780 IF D=7 AND XR>12 THEN XR=XR-10

790 IF A$<>"" AND D=0 THEN GOSUB 850

800 IF O=1 THEN X=XR:Y=YR

810 IF O=0 AND D>0 THEN X=XT:Y=YT:LINE(54,166)-(94,165),1,BF:COLOR 15:PRESET(54,166): PRINT #1, AS

820 PUT SPRITE 0,(X,Y),CL,0

830 GOTO 680

840 '

850 'gestion opciones

860 '

870 GOSUB 1130

880 IF A$="x" OR A$="X" AND O=1 THEN LINE (XR,YR)-(XR+6,YR+6),CL,BF:GOTO 1190

890 IF A$="z" OR A$="Z" AND O=1 THEN LINE (XR,YR)-(XR+6,YR+6),0,BF:GOTO 1190

900 IF A$="r" OR A$="R" THEN O=1:GOTO 1260

910 IF A$="t" OR A$="T" THEN O=0:GOTO 1340

920 IF A$="1" THEN CL=CL-1: IF CL=-1 THEN CL=15

930 IF A$="2" THEN CL=CL+1: IF CL=16 THEN CL=0

940 IF A$="1" OR A$="2" THEN LINE (10,188)-(90,196),CL,BF:GOTO 1190

950 IF A$="c" OR A$="C" THEN GOTO 1410

960 IF A$="p" OR A$="P" THEN GOTO 1480

970 IF A$="g" OR A$="G" THEN GOTO 1550

980 IF A$="e" OR A$="E" THEN GOTO 1620

990 IF A$="h" OR A$="H" THEN GOTO 1690

1000 IF A$="v" OR A$="V" THEN GOTO 1760

1010 IF A$="u" OR A$="U" THEN GOTO 1830

1020 IF A$="d" OR A$="D" THEN GOTO 1910

1030 IF A$="f" OR A$="F" THEN GOTO 1990

1040 IF A$="i" OR A$="I" THEN GOTO 2070

1050 IF A$="n" OR A$="N" THEN GOTO 2150

1060 IF A$="b" OR A$="B" THEN GOTO 2220

1070 IF A$="j" OR A$="J" THEN GOTO 2690

1080 IF A$="y" OR A$="Y" THEN GOTO 3160

1090 IF A$="s" OR A$="S" THEN BSAVE "GRAFICO",&H0,&H2000,S:GOTO 1190

1100 IF A$="l" OR A$="L" THEN BLOAD "GRAFICO",S:GOTO 1190

1110 IF A$="k" OR A$="K" THEN END

1120 GOTO 1190

1130 '

1140 ' activa luz de trabajo en proceso

1150 '

1160 LINE (2,80)-(8,90),6,B

1170 LINE (3,81)-(7,89),9,BF

1180 RETURN

1190 '

1200 ' des-activa luz de trabajo en proceso (BLACKHOLE)

1210 ' (All GOSUBs must re-send to here)

1220 '

1230 LINE (2,80)-(8,90),2,B

1240 LINE (3,81)-(7,89),3,BF

1250 RETURN

1260 '

1270 ' actualiza datos rejilla

1280 '

1290 FOR J=0 TO 7:FOR I=0 TO 7

1300 H=POINT(XT+I,YT+J):LINE (12+I*10,82+J*10)-(18+I*10,88+J*10),H,BF

1310 U(I,J)=H

1320 NEXT I,J

1330 GOTO 1190

1340 '

1350 ' actualiza area tabla patrones y colores

1360 '

1370 FOR J=0 TO 7:FOR I=0 TO 7

1380 H=POINT(12+I*10,82+J*10):PSET (XT+I,YT+J),H:'LINE (XT+I,YT+J)-(XT+I,YT+J),H

1390 NEXT I,J

1400 GOTO 1190

1410 '

1420 ' copia contenido rejilla al portapapeles

1430 '

1440 FOR J=0 TO 7:FOR I=0 TO 7

1450 H=POINT(12+I*10,82+J*10):P(I,J)=H

1460 NEXT I,J

1470 GOTO 1190

1480 '

1490 ' pega contenido portapapeles a rejilla

1500 '

1510 FOR J=0 TO 7:FOR I=0 TO 7

1520 H=P(I,J):LINE (12+I*10,82+J*10)-(18+I*10,88+J*10),H,BF

1530 NEXT I,J

1540 GOTO 1190

1550 '

1560 ' gira 90 grados en sentido antihorario

1570 '

1580 FOR J=0 TO 7:FOR I=0 TO 7

1590 H=POINT(12+I*10,82+J*10):P(J,7-I)=H

1600 NEXT I,J

1610 GOTO 1480

1620 '

1630 ' borrar rejilla

1640 '

1650 FOR J=0 TO 7:FOR I=0 TO 7

1660 LINE (12+I*10,82+J*10)-(18+I*10,88+J*10),0,BF

1670 NEXT I,J

1680 GOTO 1190

1690 '

1700 ' voltea horizontalmente

1710 '

1720 FOR J=0 TO 7:FOR I=0 TO 7

1730 H=POINT(12+I*10,82+J*10):P(7-I,J)=H

1740 NEXT I,J

1750 GOTO 1480

1760 '

1770 ' voltea verticalmente

1780 '

1790 FOR J=0 TO 7:FOR I=0 TO 7

1800 H=POINT(12+I*10,82+J*10):P(I,7-J)=H

1810 NEXT I,J

1820 GOTO 1480

1830 '

1840 ' desplaza verticalmente

1850 '

1860 FOR J=1 TO 7:FOR I=0 TO 7

1870 H=POINT(12+I*10,82+J*10):P(I,J-1)=H

1880 NEXT I,J

1890 FOR I=0 TO 7:H=POINT(12+I*10,84):P(I,7)=H:NEXT I

1900 GOTO 1480

1910 '

1920 ' desplaza horizontalmente

1930 '

1940 FOR J=0 TO 7:FOR I=1 TO 7

1950 H=POINT(12+I*10,82+J*10):P(I-1,J)=H

1960 NEXT I,J

1970 FOR J=0 TO 7:H=POINT(14,82+J*10):P(7,J)=H:NEXT J

1980 GOTO 1480

1990 '

2000 ' rellena con color activo el objeto

2010 '

2020 H=POINT(XR+2,YR+2):

2030 FOR J=0 TO 7:FOR I=0 TO 7

2040 IF POINT(12+I*10,82+J*10)=H THEN LINE (12+I*10,82+J*10)-(18+I*10,88+J*10),CL,BF

2050 NEXT I,J

2060 GOTO 1190

2070 '

2080 ' rellena linea con color activo

2090 '

2100 H=POINT(XR+2,YR+2):

2110 FOR I=0 TO 7

2120 IF POINT(12+I*10,YR)=H THEN LINE (12+I*10,YR)-(18+I*10,YR+6),CL,BF

2130 NEXT I

2140 GOTO 1190

2150 '

2160 ' RESET CHAR (recupera char original)

2170 '

2180 FOR J=0 TO 7:FOR I=0 TO 7

2190 H=U(I,J):LINE (12+I*10,82+J*10)-(18+I*10,88+J*10),H,BF

2200 NEXT I,J

2210 GOTO 1190

2220 '

2230 ' graba dos ficheros .c para patrones y colores

2240 ' (set_pt.c y set_cl.c)

2250 '

2260 XS=X:YS=Y:CO=0:CLOSE#1:OPEN "set_pt.c" FOR OUTPUT AS #1

2270 PRINT #1, "/*-------------------------------------*/"

2280 PRINT #1, "/* ONLY PATTERN TABLE                  */"

2290 PRINT #1, "/*-------------------------------------*/"

2300 PRINT #1, "const char PATTERN[] = {"

2310 FOR Y=0 TO 63 STEP 8

2320 FOR X=0 TO 255 STEP 8

2330 PRINT #1,"          ";

2340 FOR K=0 TO 7 STEP 1

2350 B=0

2360 H=POINT(X,K+Y)

2370 FOR L=0 TO 7

2380 A=POINT(X+L,K+Y): IF A<>H THEN B=B+2^(7-L)

2390 NEXT L

2400 IF B>15 THEN PRINT #1, "0x"+HEX$(B)+","; ELSE PRINT #1,"0x0"+HEX$(B)+",";

2410 NEXT K

2420 PRINT #1,"   /* ASCII CODE "+STR$(CO)+"*/"

2430 CO=CO+1

2440 NEXT X,Y

2450 PRINT #1,"};"

2460 CO=0:CLOSE#1:OPEN "set_cl.c" FOR OUTPUT AS #1

2470 PRINT #1, "/*-------------------------------------*/"

2480 PRINT #1, "/* ONLY COLOUR TABLE                   */"

2490 PRINT #1, "/*-------------------------------------*/"

2500 PRINT #1, "const char COLOUR[] = {"

2510 FOR Y=0 TO 63 STEP 8

2520 FOR X=0 TO 255 STEP 8

2530 PRINT #1,"          ";

2540 FOR K=0 TO 7 STEP 1

2550 B=0

2560 H1=POINT(X,K+Y):H2=0

2570 L=0:'FOR L=0 TO 7

2580 H2=POINT(X+L,K+Y): IF H2<>H1 THEN GOTO 2610 ELSE L=L+1

2590 IF L=8 THEN GOTO 2610:'SALE DEL BUCLE

2600 GOTO 2580

2610 PRINT #1, "0x"+HEX$(H2)+HEX$(H1)+",";

2620 NEXT K

2630 PRINT #1,"   /* ASCII CODE "+STR$(CO)+"*/"

2640 CO=CO+1

2650 NEXT X,Y

2660 PRINT #1,"};"

2670 CLOSE #1:OPEN "GRP:" FOR OUTPUT AS #1

2680 X=XS:Y=YS:GOTO 1190

2690 '

2700 ' graba dos ficheros .asm para patrones y colores

2710 ' (set_pt.asm y set_cl.asm)

2720 '

2730 XS=X:YS=Y:CO=0:CLOSE#1:OPEN "set_pt.asm" FOR OUTPUT AS #1

2740 PRINT #1, ";-------------------------------------"

2750 PRINT #1, "; ONLY PATTERN TABLE                  "

2760 PRINT #1, ";-------------------------------------"

2770 PRINT #1, "PATTERN:"

2780 FOR Y=0 TO 63 STEP 8

2790 FOR X=0 TO 255 STEP 8

2800 PRINT #1,"db ";

2810 FOR K=0 TO 7 STEP 1

2820 B=0

2830 H=POINT(X,K+Y)

2840 FOR L=0 TO 7

2850 A=POINT(X+L,K+Y): IF A<>H THEN B=B+2^(7-L)

2860 NEXT L

2870 IF B>15 THEN PRINT #1, HEX$(B)+"h"; ELSE PRINT #1,"0"+HEX$(B)+"h";

2880 IF K<>7 THEN PRINT #1,",";

2890 NEXT K

2900 PRINT #1,"   ; ASCII CODE "+STR$(CO)

2910 CO=CO+1

2920 NEXT X,Y

2930 CO=0:CLOSE#1:OPEN "set_cl.asm" FOR OUTPUT AS #1

2940 PRINT #1, ";-------------------------------------"

2950 PRINT #1, "; ONLY COLOUR TABLE                   "

2960 PRINT #1, ";-------------------------------------"

2970 PRINT #1, "COLLOUR:"

2980 FOR Y=0 TO 63 STEP 8

2990 FOR X=0 TO 255 STEP 8

3000 PRINT #1,"db ";

3010 FOR K=0 TO 7 STEP 1

3020 B=0

3030 H1=POINT(X,K+Y):H2=0

3040 L=0:'FOR L=0 TO 7

3050 H2=POINT(X+L,K+Y): IF H2<>H1 THEN GOTO 3080 ELSE L=L+1

3060 IF L=8 THEN GOTO 3080:'SALE DEL BUCLE

3070 GOTO 3050

3080 PRINT #1, HEX$(H2)+HEX$(H1)+"h";

3090 IF K<>7 THEN PRINT #1,",";

3100 NEXT K

3110 PRINT #1,"   ; ASCII CODE "+STR$(CO)

3120 CO=CO+1

3130 NEXT X,Y

3140 CLOSE #1:OPEN "GRP:" FOR OUTPUT AS #1

3150 X=XS:Y=YS:GOTO 1190

3160 '

3170 ' graba un solo fichero .asc para patrones y colores

3180 ' (set.asc) para BASIC

3190 '

3200 XS=X:YS=Y:LN=10000:CO=0:CLOSE#1:OPEN "set.asc" FOR OUTPUT AS #1

3210 PRINT #1,LN ; "'------------------------------":LN=LN+10

3220 PRINT #1,LN ; "' ONLY PATTERN TABLE           ":LN=LN+10

3230 PRINT #1,LN ; "'------------------------------":LN=LN+10

3240 FOR Y=0 TO 63 STEP 8

3250 FOR X=0 TO 255 STEP 8

3260 PRINT #1,LN ; "DATA ";

3270 FOR K=0 TO 7 STEP 1

3280 B=0

3290 H=POINT(X,K+Y)

3300 FOR L=0 TO 7

3310 A=POINT(X+L,K+Y): IF A<>H THEN B=B+2^(7-L)

3320 NEXT L

3330 IF B>15 THEN PRINT #1, "&h"+HEX$(B); ELSE PRINT #1,"&h" + "0"+HEX$(B);

3340 IF K<>7 THEN PRINT #1,",";

3350 NEXT K

3360 PRINT#1,"":CO=CO+1:LN=LN+10

3370 NEXT X,Y

3380 CO=0

3390 PRINT #1,LN ; "'------------------------------":LN=LN+10

3400 PRINT #1,LN ; "' ONLY COLOUR TABLE            ":LN=LN+10

3410 PRINT #1,LN ; "'------------------------------":LN=LN+10

3420 FOR Y=0 TO 63 STEP 8

3430 FOR X=0 TO 255 STEP 8

3440 PRINT #1,LN ; "DATA ";

3450 FOR K=0 TO 7 STEP 1

3460 B=0

3470 H1=POINT(X,K+Y):H2=0

3480 L=0:'FOR L=0 TO 7

3490 H2=POINT(X+L,K+Y): IF H2<>H1 THEN GOTO 3520 ELSE L=L+1

3500 IF L=8 THEN GOTO 3520:'SALE DEL BUCLE

3510 GOTO 3490

3520 PRINT #1, "&h"+HEX$(H2)+HEX$(H1);

3530 IF K<>7 THEN PRINT #1,",";

3540 NEXT K

3550 PRINT#1,"":LN=LN+10

3560 CO=CO+1

3570 NEXT X,Y

3580 CLOSE #1:OPEN "GRP:" FOR OUTPUT AS #1

3590 X=XS:Y=YS:GOTO 1190