10 ' Programm: MATEDIT.BAS 20 ' 30 ' -------------------------------------------------------------------- 40 ' 50 ' Simpler Editor f}r Zeichen Matrix Dateien 60 ' Programm ben|tigt ASCII hex kodierte Datei 70 ' 80 ' Copyright (C) W.Cirsovius 90 ' Hohe Weide 44 100 ' D-2000 Hamburg ZO 110 ' Tel.:040/4223247 120 ' Version 1.2, Juli 1987 130 ' 131 ' -------------------------------------------------------------------- 132 ' B U G & M O D R E P O R T 133 ' -------------------------------------------------------------------- 134 ' 1) 24.11.86 Fehlerroutine gibt jetzt Meldungen richtig aus 135 ' 2) 22.12.86 Optionale akustische Anzeige 136 ' 3) 24.04.87 Copyright Anzeige 137 ' 4) 31.07.87 Erweiterte Ausgabedateim|glichkeit 140 ' 150 ' +++++ Initialisierung +++++ 160 ' 170 DEFINT a-z 180 ' Einlesen von Fehler Nummern 190 DATA 8,50,61,63,64,67,70,71,72 200 READ x:DIM erpos(x) 210 FOR i=1 TO x:READ patt:erpos(i)=patt:NEXT 220 false=0:true=-1:done=false:break=false:single=false 230 left=2:right=16:top=2:bottom=16 240 DIM matrix(8,8) 250 esc$=CHR$(27):bel$=CHR$(7) 260 def$="0123456789ABCDEF" 270 com$=CHR$(31)+CHR$(30)+CHR$(1)+CHR$(6)+CHR$(8)+CHR$(27)+CHR$(13)+CHR$(22) 280 rev.on$=esc$+"p":rev.off$=esc$+"q" 290 curs.on$=esc$+"e":curs.off$=esc$+"f" 300 und.on$=esc$+"r":und.off$=esc$+"u" 310 cl$=esc$+"H"+esc$+"E":del.eol$=esc$+"K" 320 DEF FN cursor$(y,x)=esc$+"Y"+CHR$(y+32)+CHR$(x+32) 330 ON ERROR GOTO 750 331 PRINT cl$;"Mit akustischer Anzeige, wenn Operation beendet (j/n) :"; 332 x$=INKEY$:IF x$="" GOTO 332 333 PRINT:IF UPPER$(x$)="J" THEN bel=true ELSE bel=false 340 PRINT cl$;SPC(25);und.on$;"M A T R I X E D I T 0 R";und.off$ 350 PRINT: PRINT 360 INPUT "File-Name: ";fil$:fil$=UPPER$(fil$) 370 infil$=fil$:IF INSTR(fil$,".")=0 THEN infil$=infil$+".ALT" 380 fil$=MID$(infil$,1,INSTR(infil$,".")) 390 IF FIND$(infil$)="" THEN PRINT bel$;"File ist unbekannt":GOTO 360 400 GOSUB 2970 410 OPEN "R",1,infil$,16:OPEN "R",2,fil$,16 420 FIELD 1,16 AS work$:FIELD 2,16 AS record$ 430 PRINT "Datensatz wird eingelesen. Bitte warten ..." 440 FOR record=1 TO 256 450 : GET 1,record 460 : LSET record$=work$ 470 : PUT 2,record 480 NEXT record 490 CLOSE 1 500 PRINT cl$;curs.off$ 510 GOSUB 1050 520 ' 530 ' +++++ Hauptschleife +++++ 540 ' 550 FOR char=0 TO 255 560 : GET 2,char+1:char$=record$ 570 : GOSUB 1600 580 : IF break=true GOTO 660 590 : LSET record$=char$:PUT 2,char+1 600 : IF done=true GOTO 660 610 NEXT char 620 PRINT cl$ 630 CLOSE 2:PRINT "Neue Datei : ";fil$;" geschlossen" 640 IF break=false THEN PRINT "Definition beendet":END 650 PRINT "Definition abgebrochen":END 660 PRINT cl$;curs.on$:IF break=true GOTO 700 670 PRINT "EXIT bet{tigt. Datei retten (j/n) "; 680 hx$=INKEY$:IF hx$="" GOTO 680 690 PRINT:IF UPPER$(hx$)="J" GOTO 630 700 KILL fil$ 710 GOTO 640 720 ' 730 ' +++++ Fehlerroutine +++++ 740 ' 750 PRINT bel$;rev.off$;curs.on$;cl$;"!!! Fehler !!!":PRINT 760 RESTORE 180:READ xx 770 FOR i=1 TO xx:IF ERR=erpos(i) THEN GOTO 780 ELSE NEXT 775 PRINT "Fehler : ";ERR;", in Zeile . ";ERL:END 780 ON i GOTO 790,800,790,810,800,820,820,830 790 PRINT "Datens{tze in Datei sind falsch":END 800 PRINT "Diskette oder Inhaltsverzeichnis voll":END 810 PRINT "Der File-Name ist falsch":END 820 PRINT "Diskette oder File schreibgesch}tzt":END 830 PRINT "Laufwerk ist falsch angegeben":END 850 ' 860 ' =============== Unterprogramme ============== 870 ' 880 ' >>>>> Oberen oder unteren Rand setzen <<<<< 890 ' 900 PRINT FN cursor$(cy,1);CHR$(patt); 910 FOR i=1 TO 7:PRINT CHR$(138);CHR$(Patt+8);:NEXT 920 PRINT CHR$(138);CHR$(patt+6); 930 RETURN 940 ' 950 ' >>>>> Mittelteil setzen <<<<< 960 ' 970 FOR i=s TO e STEP 2 980 PRINT FN cursor$(i,1);CHR$(p1); 990 FOR j=1 TO 7:PRINT CHR$(p2);CHR$(p3);:NEXT 1000 PRINT CHR$(p2);CHR$(p4):NEXT 1010 RETURN 1020 ' 1030 ' >>>>> Generierung des Bildschirms <<<<< 1040 ' 1050 cy=1:patt=134:GOSUB 900 1060 s=2:e=16:p1=133:p2=32:p3=133:p4=133:GOSUB 970 1070 s=3:e=15:p1=135:p2=138:p3=143:p4=141:GOSUB 970 1080 cy=17:patt=131:GOSUB 900 1090 PRINT rev.on$; 1100 PRINT FN cursor$(2,30);"Hexwert : .." 1110 PRINT FN cursor$(13,30);" Cursor setzen mit Pfeilen" 1120 PRINT FN cursor$(14,30);" ENTER {ndert Bit " 1130 PRINT FN cursor$(15,30);" CAN beendet Eingabe " 1140 PRINT FN cursor$(24,20);"> M A T R I X E D I T O R <" 1141 PRINT FN cursor$(25,20);"> Copyright (C) Werner Cirsovius - 1987 <" 1150 PRINT rev.off$ 1151 PRINT FN cursor$(20,1);"Originaldatei : ";und.on$;infil$;und.off$ 1152 PRINT FN cursor$(22,1);" Neue Datei : ";und.on$;fil$;und.off$ 1160 GOSUB 2330 1170 RETURN 1180 ' 1190 ' >>>>> Numerische Matrix aus Zeichen berechnen <<<<< 1200 ' 1210 FOR zeile=1 TO 8 1220 : h$=MID$(char$,2*zeile-1,1) 1230 : l$=MID$(char$,2*zeile,1) 1240 : h=INSTR(def$,h$)-1 1250 : l=INSTR(def$,l$)-1 1260 : IF l<0 OR h<0 THEN break=true:RETURN 1270 : inmat=h*16+l 1280 : div=128 1290 : FOR reihe=1 TO 8 1300 :: IF (inmat AND div)=0 THEN bit=false ELSE bit=true 1310 :: matrix(zeile,reihe)=bit 1320 :: div=div\2 1330 : NEXT reihe 1335 NEXT zeile 1340 RETURN 1350 ' 1360 ' >>>>> Zeichen aus numerischer Matrix berechnen <<<<< 1370 ' 1380 char$="":FOR zeile=1 TO 8 1390 : inmat=0:div=128 1400 : FOR reihe=1 TO 8 1410 :: bit=matrix(zeile,reihe) 1420 :: IF bit=true THEN inmat=inmat+div 1430 :: div=div\2 1440 : NEXT reihe 1450 : hx$="0"+HEX$(inmat) 1460 : char$=char$+RIGHT$(hx$,2) 1470 NEXT zeile 1480 RETURN 1490 ' 1500 ' >>>>> Initialisierung der Matrix auf Bildschirm <<<<< 1510 ' 1520 FOR zeile=1 TO 8:FOR reihe=1 TO 8 1530 :: GOSUB 2000:bit=matrix(zeile,reihe):IF bit=true THEN GOSUB 1930 1540 NEXT reihe:NEXT zeile 1550 cursx=2:cursy=2:GOSUB 2090 1560 RETURN 1570 ' 1580 ' >>>>> Editieren der Matrix <<<<< 1590 ' 1600 GOSUB 2850:GOSUB 1780 1610 IF break=true THEN RETURN 1620 IF single=false THEN GOSUB 1380:RETURN 1630 PRINT FN cursor$(7,30);"Welcher Hex Matrixwert (00..FF) :"; 1635 IF bel=true THEN PRINT bel$; 1640 INPUT hx$:PRINT FN cursor$(7,30);del.eol$:GOSUB 2330 1650 GOSUB 2740 1660 IF hexflag=true THEN GOTO 1630 1670 SWAP oldchar,char:SWAP oldchar$,char$ 1680 GET 2,char+1:char$=record$ 1690 GOSUB 2910:GOSUB 1780:IF break=true THEN RETURN 1700 GOSUB 1380 1710 LSET record$=char$ 1720 PUT 2,char+1 1730 SWAP oldchar,char:SWAP oldchar$,char$ 1740 single=false:GOTO 1600 1750 ' 1760 ' >>>>> Gemeinsame Editor-Routine <<<<< 1770 ' 1780 hx$="0"+HEX$(char) 1790 PRINT FN cursor$(2,40);rev.on$;RIGHT$(hx$,2);rev.off$ 1800 GOSUB 1210:IF break=true THEN RETURN 1810 GOSUB 1520 1820 GOSUB 2160 1830 RETURN 1840 ' 1850 ' >>>>> Setzen eines Bits in der Matrix <<<<< 1860 ' 1870 ' Berechnung der Cursor Positionen 1880 ' 1890 cursx=2*reihe:cursy=2*zeile 1900 ' 1910 ' Cursor Position schon berechnet 1920 ' 1930 PRINT FN cursor$(cursy,cursx);rev.on$;" ";rev.off$ 1940 RETURN 1950 ' 1960 ' >>>>> R}cksetzen eines Bits in der Matrix <<<<< 1970 ' 1980 ' Berechnung der Cursor Positionen 1990 ' 2000 cursx=2*reihe:cursy=2*zeile 2010 ' 2020 ' Cursor Position schon berechnet 2030 ' 2040 PRINT FN cursor$(cursy,cursx);" " 2050 RETURN 2060 ' 2070 ' >>>>> Setzen des Editiermarkers <<<<< 2080 ' 2090 bit=matrix(cursy\2,cursx\2) 2100 IF bit=true THEN ma$=rev.on$+"X"+rev.off$ ELSE ma$="_" 2110 PRINT FN cursor$(cursy,cursx);ma$ 2120 RETURN 2130 ' 2140 ' >>>>> Editieren der Pixels <<<<< 2150 ' 2160 PRINT FN cursor$(7,30);rev.on$;"!! Eingabe !!";rev.off$;:IF bel=true THEN PRINT bel$ 2170 key$=INKEY$:IF key$="" GOTO 2170 2180 key=INSTR(com$,key$) 2190 IF key=0 GOTO 2170 2200 ON key GOTO 2370,2420,2470,2520,2330,2290,2570,2250 2210 ERROR 255 2220 ' 2230 ' -> [+] 2240 ' 2250 IF single=true THEN GOTO 2170 ELSE single=true:RETURN 2260 ' 2270 ' -> EXIT 2280 ' 2290 IF single=true THEN GOTO 2170 ELSE done=true 2300 ' 2310 ' -> CAN 2320 ' 2330 PRINT FN cursor$(7,30);und.on$;"Bitte warten";und.off$;" ":RETURN 2340 ' 2350 -> Cursor up 2360 ' 2370 IF cursy-2 Cursor down 2410 ' 2420 IF cursy+2>bottom GOTO 2170 2430 dx=O:dy=2:GOSUB 2660:GOTO 2170 2440 ' 2450 ' -> Cursor left 2460 ' 2470 IF cursx-2 Cursor right 2510 ' 2520 IF cursx+2>right GOTO 2170 2530 dx=2:dy=O:GOSUB 2660:GOTO 2170 2540 ' 2550 ' -> ENTER 2560 ' 2570 reihe=cursx\2:zeile=cursy\2 2580 bit=matrix(zeile,reihe) 2590 IF bit=false THEN bit=true ELSE bit=false 2600 matrix(zeile,reihe)=bit 2610 GOSUB 2090 2620 GOTO 2170 2630 ' 2640 ' >>>>> Alten Marker l|schen, neuen setzen <<<<< 2650 ' 2660 reihe=cursx\2:zeile=cursy\2:cx=cursx:cy=cursy:GOSUB 2040 2670 cursx=cursx+dx:cursy=cursy+dy:GOSUB 2090 2680 IF matrix(zeile,reihe)=false THEN RETURN 2690 SWAP cx,cursx:SWAP cy,cursy:GOSUB 1930:SWAP cx,cursx:SWAP cy,cursy 2700 RETURN 2710 ' 2720 ' >>>>> Umwandlung ASCII Hex Digit in Zahl <<<<< 2730 ' 2740 hexflag=false:hx$=UPPER$(hx$):hexlen=LEN(hx$) 2750 IF hexlen>2 OR hexlen<1 THEN hexflag=true:RETURN 2760 oldchar=0:FOR i=1 TO hexlen 2770 : x$=MID$(hx$,i,1):x=INSTR(def$,x$)-1 2780 : IF x<0 THEN hexflag=true:RETURN 2790 : oldchar=oldchar*16+x 2800 NEXT i 2810 RETURN 2820 ' 2830 ' >>>>> Alle Optionen einschalten <<<<< 2840 ' 2850 PRINT rev.on$;FN cursor$(16,30);"EXIT bricht Bearbeitung ab" 2860 PRINT FN cursor$(17,30);" Einzelpixel mit [+] ";rev.off$ 2870 RETURN 2880 ' 2890 ' >>>>> Einige Optionen abschalten <<<<< 2900 ' 2910 PRINT FN cursor$(16,30);del.eol$ 2920 PRINT FN cursor$(17,30);del.eol$ 2930 RETURN 2940 ' 2950 '>>>>> Ausgabedatei bestimmen <<<<< 2960 ' 2970 FOR i=0 TO 999 2980 : ext$=MID$(STR$(i),2) 2990 : WHILE LEN(ext$)<3 3000 :: ext$="0"+ext$ 3010 : WEND 3020 : IF FIND$(fil$+ext$)="" THEN fil$=fil$+ext$:RETURN 3030 NEXT i 3031 PRINT cl$;"Keine freie Standard Datei gefunden" 3032 INPUT "Ausgabe Datei : ";fil$ 3033 IF FIND$(fil$)="" THEN RETURN 3040 PRINT cl$;"Ausgabedatei existiert bereits, l|schen (j/n) :"; 3050 x$=INKEY$:IF x$="" GOTO 3050 3060 PRINT:IF UPPERS(x$)<>"J" GOTO 3032 3070 KILL fil$ 3080 RETURN