Редактор спрайтов для PPU NES

Редактор спрайтов для PPU NES — Лисья нора

Главная

Лента

Блог

Сервисы

Проекты

Главная » Проекты » Программы Quick Basic 4.5 » Редактор спрайтов для PPU NES

§ Программный код

Программа может загружать INES файл и редактировать его, но сохраняет в BIN-формат.

Команды управления редактором:

TAB — Переключиться в режим выбора или редактирования тайлов
F2 — Загрузить с диска .nes или .bin файл
F3 — Сохранить на диск .bin файл с сохранением палитры
F4 — Переключить палитру (4 цвета по 4 палитры)
F5 — Копировать тайл в другой тайл (дважды нажать F5)
F6 — Обмен тайла с другим тайлом (дважды нажать F6)

При активном окне выбора тайла нажатие на 0-3 выбирает цвет в текущей палитре, надо ввести номер цвета от 0 до 255. При активном окне редактора тайлов выбирает цвет, которым будет происходить рисование и тут же рисует этим цветом. Нажимая на пробел, рисуется последним использованным цветом.

#CONTROLSDOCOPYDOMOVEDRAWSPINPLOADDATAREFRESHSAVEDATASELECTBOXSETPIXTITLENAME
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