§ Программный код
Программа может загружать INES файл и редактировать его, но сохраняет в BIN-формат.
Команды управления редактором:
- TAB — Переключиться в режим выбора или редактирования тайлов
- F2 — Загрузить с диска .nes или .bin файл
- F3 — Сохранить на диск .bin файл с сохранением палитры
- F4 — Переключить палитру (4 цвета по 4 палитры)
- F5 — Копировать тайл в другой тайл (дважды нажать F5)
- F6 — Обмен тайла с другим тайлом (дважды нажать F6)
SCREEN 13 DIM SHARED T AS STRING * 4096 DIM SHARED PLT(0 TO 15) AS INTEGER DIM SHARED cpal AS INTEGER DIM SHARED cp AS INTEGER DIM SHARED mv AS INTEGER DIM SHARED EMode AS INTEGER DIM SHARED LFile AS STRING FOR i = 0 TO 15 IF i AND 3 THEN PLT(i) = i NEXT TitleName Controls cp = 0: mv = 0 xs = 0: ys = 0 xp = 0: yp = 0 DO SelectBox xs, ys, xp, yp DO: i$ = INKEY$: LOOP WHILE i$ = "" ' Clear OLD id = xs + ys * 16 DrawSP id, 0 ' Controls IF EMode THEN IF i$ = CHR$(0) + "H" THEN yp = yp - 1 IF i$ = CHR$(0) + "P" THEN yp = yp + 1 IF i$ = CHR$(0) + "K" THEN xp = xp - 1 IF i$ = CHR$(0) + "M" THEN xp = xp + 1 IF xp < 0 THEN xp = 7 IF yp < 0 THEN yp = 7 IF xp > 7 THEN xp = 0 IF yp > 7 THEN yp = 0 IF i$ >= "0" AND i$ <= "3" THEN lcl = VAL(i$): SetPix xs, ys, xp, yp, lcl IF i$ = " " THEN SetPix xs, ys, xp, yp, lcl ELSE IF i$ = CHR$(0) + "H" THEN ys = ys - 1 IF i$ = CHR$(0) + "P" THEN ys = ys + 1 IF i$ = CHR$(0) + "K" THEN xs = xs - 1 IF i$ = CHR$(0) + "M" THEN xs = xs + 1 IF xs < 0 THEN xs = 15 IF ys < 0 THEN ys = 15 IF xs > 15 THEN xs = 0 IF ys > 15 THEN ys = 0 IF i$ >= "0" AND i$ <= "3" THEN COLOR 15: PLT(cpal * 4 + VAL(i$)) = VAL(Inp$("ColorID")): Refresh END IF IF i$ = CHR$(0) + "<" THEN LoadData: EMode = 0: Refresh IF i$ = CHR$(0) + "=" THEN SaveData IF i$ = CHR$(0) + ">" THEN cpal = (cpal + 1) AND 3: Refresh IF i$ = CHR$(9) THEN EMode = 1 - EMode: Controls ' COPY IF i$ = CHR$(0) + "?" THEN cp = 1 - cp: IF cp THEN cpsrc = id ELSE DoCopy cpsrc, id Controls END IF ' SWAP IF i$ = CHR$(0) + "@" THEN mv = 1 - mv: IF mv THEN cpsrc = id ELSE DoMove cpsrc, id Controls END IF ' LOCATE 1, 1: PRINT i$ LOOP WHILE i$ <> CHR$(27) ' Show controls button SUB Controls LOCATE 25, 1 mc = 15: IF EMode THEN mc = 12 COLOR 11: PRINT "F1"; : COLOR mc: PRINT "ED "; COLOR 11: PRINT "F2"; : COLOR 15: PRINT "LD "; COLOR 11: PRINT "F3"; : COLOR 15: PRINT "SV "; COLOR 11: PRINT "F4"; : COLOR 15: PRINT "PL "; mc = 15: IF cp THEN mc = 12 COLOR 11: PRINT "F5"; : COLOR mc: PRINT "CP "; mc = 15: IF mv THEN mc = 12 COLOR 11: PRINT "F6"; : COLOR mc: PRINT "MV "; COLOR 11: PRINT "03"; : COLOR 15: PRINT "CL "; FOR i = 0 TO 15 x1 = i * 16 y1 = 140 x2 = x1 + 14 y2 = y1 + 14 LINE (x1, y1)-(x2, y2), 15, B LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), PLT(i), BF NEXT FOR i = 0 TO 3 x1 = i * 64 LINE (x1, 160)-(x1 + 62, 160), 7 LINE (x1, 160)-(x1, 156), 8 LINE (x1 + 62, 160)-(x1 + 62, 156), 8 IF cpal = i THEN COLOR 15 ELSE COLOR 8 LOCATE 21, 4 + i * 8 PRINT i; NEXT ' Tiles Box LINE (0, 8)-(129, 137), 7, B LINE (131, 8)-(197, 74), 7, B END SUB ' Copy tile from src to dst ID SUB DoCopy (src, dst) k$ = MID$(T, 1 + src * 16, 16) T = MID$(T, 1, dst * 16) + k$ + MID$(T, dst * 16 + 17, 4095 - dst * 16) END SUB ' Swap tiles SUB DoMove (src, dst) a$ = MID$(T, 1 + src * 16, 16) B$ = MID$(T, 1 + dst * 16, 16) T = MID$(T, 1, dst * 16) + a$ + MID$(T, dst * 16 + 17, 4096) T = MID$(T, 1, src * 16) + B$ + MID$(T, src * 16 + 17, 4096) DrawSP src, 0 END SUB ' Drawing ID sprite, if sel > 0 then also draw right box SUB DrawSP (id, sel) x = id AND 15 y = id \ 16 s = x + y * 16 FOR i = 0 TO 7 m0 = 1 + id * 16 + i b0 = ASC(MID$(T, m0, 1)) b1 = ASC(MID$(T, m0 + 8, 1)) ' Clear right lines IF EMode THEN LINE (132, 9 + i * 8)-(196, 9 + i * 8), 0 LINE (132 + 8 * i, 9)-(132 + 8 * i, 73), 0 END IF ' Down and right line clear LINE (132, 9 + 64)-(196, 9 + 64), 0 LINE (132 + 64, 9)-(132 + 64, 9 + 64), 0 FOR j = 0 TO 7 c = (b0 AND 1) + 2 * (b1 AND 1) + cpal * 4 PSET (8 + x * 8 - j, 9 + y * 8 + i), PLT(c) b0 = b0 \ 2 b1 = b1 \ 2 IF sel > 0 THEN xa = 132 + (7 - j) * 8 ya = 9 + i * 8 LINE (xa + 1, ya + 1)-(xa + 7, ya + 7), PLT(c), BF END IF NEXT NEXT END SUB ' Input data from keyboard FUNCTION Inp$ (msg$) LOCATE 23, 2: PRINT msg$; : INPUT ix$ LOCATE 23, 2: PRINT " "; Inp$ = ix$ END FUNCTION ' Load sprites (nes/bin) SUB LoadData DIM DT AS STRING * 16 COLOR 14 File$ = Inp$("Load File") IF File$ <> "" THEN Ext$ = MID$(File$, LEN(File$) - 2, 3) OPEN File$ FOR BINARY AS #1 IF Ext$ = "nes" THEN PGE = VAL(Inp$("Page")) GET #1, 5, DT prg = ASC(MID$(DT, 1, 1)) ofs = 16 + prg * 16384 IF prg THEN GET #1, ofs + 1 + PGE * 4096, T ELSE GET #1, 1, T GET #1, 4096, DT FOR i = 0 TO 15 x = ASC(MID$(DT, 1 + i, 1)) PLT(i) = x NEXT LFile = File$ END IF CLOSE #1 END IF END SUB ' Update all SUB Refresh Controls FOR i = 0 TO 255: DrawSP i, 0: NEXT END SUB ' Save to bin file SUB SaveData COLOR 14 IF LFile <> "" THEN File$ = LFile ELSE File$ = Inp$("Save File") OPEN File$ FOR BINARY AS #1 PUT #1, 1, T FOR i = 0 TO 15 M$ = CHR$(PLT(i)) PUT #1, 4096 + i, M$ NEXT CLOSE #1 LFile = File$ END SUB ' Show current sprite SUB SelectBox (x, y, xp, yp) xs = 1 + x * 8 ys = 9 + y * 8 DrawSP x + y * 16, 1 IF EMode = 0 THEN FOR j = 0 TO 7 STEP 2 PSET (xs + j, ys), 7 PSET (xs + j + 1, ys + 7), 7 PSET (xs, ys + j), 7 PSET (xs + 7, ys + j + 1), 7 NEXT ELSE xs = 132 + xp * 8 ys = 9 + yp * 8 LINE (xs, ys)-(xs + 8, ys + 8), 15, B END IF hx$ = "0123456789ABCDEF" LOCATE 12, 18: COLOR 14: PRINT "ID:"; MID$(hx$, y + 1, 1); MID$(hx$, x + 1, 1); END SUB ' Update files in tile SUB SetPix (xs, ys, xp, yp, cl) m1 = 2 ^ (7 - xp) m0 = 1 + yp + ys * 256 + xs * 16 b0 = ASC(MID$(T, m0, 1)) b1 = ASC(MID$(T, m0 + 8, 1)) k1 = cl AND 1 k2 = (cl \ 2) AND 1 b0 = b0 AND (255 - m1) b1 = b1 AND (255 - m1) IF k1 THEN b0 = b0 + m1 IF k2 THEN b1 = b1 + m1 T = MID$(T, 1, m0 - 1) + CHR$(b0) + MID$(T, m0 + 1, 4096 - m0) T = MID$(T, 1, m0 + 7) + CHR$(b1) + MID$(T, m0 + 9, 4096 - m0 - 8) END SUB ' Show tite SUB TitleName LOCATE 1, 22 COLOR 16 PRINT "TILES EDITOR 1" FOR y = 0 TO 7 FOR x = 0 TO 129 c = POINT(x + 160, y - 1) IF c > 0 THEN c = 0 ELSE c = 31 - y PSET (x, y), c NEXT NEXT FOR y = 0 TO 7: LINE (130, y)-(320, y), 31 - y: NEXT END SUB