DEFINT A-Z

'*** Variable declarations *************************
DIM BitMask(0 TO 7) AS INTEGER
DIM CmdLine AS STRING
DIM bmpfile AS STRING
DIM chrfile AS STRING
DIM CurChr AS INTEGER
DIM FileNum AS INTEGER
DIM XSIZE AS LONG
DIM YSIZE AS LONG
DIM Bitsperpixel AS INTEGER
DIM XTILES AS INTEGER
DIM YTILES AS INTEGER
DIM Index AS INTEGER
DIM R AS INTEGER
DIM G AS INTEGER
DIM B AS INTEGER
DIM BUFFER AS STRING
DIM XX AS INTEGER
DIM YY AS INTEGER
DIM X AS INTEGER
DIM Y AS INTEGER
DIM LX AS INTEGER
DIM LY AS INTEGER
DIM Tile AS INTEGER
DIM B1 AS INTEGER
DIM B2 AS INTEGER
DIM PX AS INTEGER
DIM PX1 AS INTEGER
DIM PX2 AS INTEGER

'*** Set bit mask **********************************
BitMask(0) = &H80
BitMask(1) = &H40
BitMask(2) = &H20
BitMask(3) = &H10
BitMask(4) = &H8
BitMask(5) = &H4
BitMask(6) = &H2
BitMask(7) = &H1

'*** Interpret command line ************************
bmpfile = ""
chrfile = ""
CurChr = 0
CmdLine = COMMAND$

IF CmdLine = "" THEN GOTO BadCommand

DO
  CurChr = CurChr + 1
  C$ = MID$(CmdLine, CurChr, 1)
  IF C$ <> " " THEN bmpfile = bmpfile + C$
LOOP UNTIL ((LEN(bmpfile) <> 0) AND (C$ = " ")) OR (CurChr = LEN(CmdLine))

IF CurChr = LEN(CmdLine) THEN GOTO BadCommand

DO
  CurChr = CurChr + 1
  C$ = MID$(CmdLine, CurChr, 1)
  IF C$ <> " " THEN chrfile = chrfile + C$
LOOP UNTIL ((LEN(chrfile) <> 0) AND (C$ = " ")) OR (CurChr = LEN(CmdLine))

IF bmpfile = "" OR chrfile = "" THEN GOTO BadCommand

'*** Check if BMP has the needed specs *************
FileNum = FREEFILE
OPEN bmpfile FOR BINARY AS FileNum
IF LOF(FileNum) = 0 THEN
  CLOSE FileNum
  KILL bmpfile
  PRINT
  PRINT " Cannot find BMP file"
  END
END IF
CLOSE FileNum

OPEN bmpfile FOR BINARY AS FileNum

GET FileNum, 19, XSIZE
GET FileNum, 23, YSIZE

IF (XSIZE > 320) OR (YSIZE > 200) THEN
  CLOSE FileNum
  PRINT
  PRINT " Image is larger than 320x200"
  END
END IF

XTILES = XSIZE \ 8
YTILES = YSIZE \ 8

GET FileNum, 29, Bitsperpixel

IF Bitsperpixel <> 8 THEN
  CLOSE FileNum
  PRINT
  PRINT " Not a 256 colors BMP"
  END
END IF

SCREEN 13 'VGA 320x200x256

CLS

'*** Set the first 4 colors of the palette *********
SEEK FileNum, 55

FOR Index = 0 TO 3
  A$ = " ": GET FileNum, , A$: B = ASC(A$): B = B \ 4
  A$ = " ": GET FileNum, , A$: G = ASC(A$): G = G \ 4
  A$ = " ": GET FileNum, , A$: R = ASC(A$): R = R \ 4
  A$ = " ": GET FileNum, , A$

  OUT &H3C8, Index
  OUT &H3C9, R
  OUT &H3C9, G
  OUT &H3C9, B
NEXT Index

'*** Decode BMP data to the screen *****************
SEEK FileNum, 1079

FOR YY = (YSIZE - 1) TO 0 STEP -1
  BUFFER = SPACE$(XSIZE): GET FileNum, , BUFFER
  FOR XX = 1 TO XSIZE
    PSET (XX - 1, YY), ASC(MID$(BUFFER, XX, 1))
  NEXT XX
NEXT YY

CLOSE FileNum

'*** Save CHR file *********************************
Y = 0
X = 0
B1 = 0
B2 = 0

OPEN chrfile FOR BINARY AS FileNum

Reg& = 1
FOR Tile = 1 TO (XTILES * YTILES)
  FOR LY = 0 TO 7
    FOR LX = 0 TO 7
      XX = X + LX
      YY = Y + LY
      PX = POINT(XX, YY)
      IF PX > 3 THEN PX = 0
      PX2 = (PX AND 2) \ 2
      PX1 = PX AND 1
      B1 = B1 OR (PX1 * BitMask(LX))
      B2 = B2 OR (PX2 * BitMask(LX))
    NEXT LX
    A$ = CHR$(B1)
    PUT FileNum, Reg&, A$
    A$ = CHR$(B2)
    PUT FileNum, Reg& + 8, A$
    Reg& = Reg& + 1
    B1 = 0
    B2 = 0
  NEXT LY
  X = X + 8
  IF X > (XTILES * 8) - 1 THEN
    X = 0
    Y = Y + 8
  END IF
  Reg& = Reg& + 8
NEXT Tile

CLOSE FileNum

COLOR 15
LOCATE 25, 1: PRINT "DONE - Press any key . . ."; : SLEEP

CLS

SCREEN 0: WIDTH 80 'Text mode

END 'End of program

'*** If command line is wrong... *******************
BadCommand:

PRINT
PRINT " Syntax: bmp2nes.exe bmpfile.bmp chrfile.chr"

END