'$DYNAMIC

DEFINT A-Z

DECLARE SUB SetRgbMap (X%, Y%, R%, G%, B%)
DECLARE FUNCTION RgbMap% (X%, Y%, Clr%)

DECLARE SUB SetPal ()

'$INCLUDE: 'CosmoX.BI'

TYPE BmpHeader
 bType          AS INTEGER
 Size           AS LONG
 Dummy          AS LONG
 DataOffset     AS LONG
END TYPE

TYPE BmpInfo
 Size           AS LONG
 xSize          AS LONG
 ySize          AS LONG
 Planes         AS INTEGER
 ColourB        AS INTEGER
 Squish         AS LONG
 iSize          AS LONG
 xPPM           AS LONG
 yPPM           AS LONG
 clrUsed        AS LONG
 clrImportand   AS LONG
END TYPE

DIM Header AS BmpHeader, Info AS BmpInfo
DIM SHARED ClrType

CONST Red = 0
CONST Green = 1
CONST Blue = 2
CONST Grey = 3

REDIM SHARED ColMap(32001) AS INTEGER
  DIM OrigPal              AS STRING * 768

LINE INPUT "File name? (No extension):"; FileName$

FileName$ = "XGBMP\" + FileName$ + ".BMP"

LINE INPUT "Colour type? red = 0, green = 1, blue = 2, grey = 3"; ClrT$
ClrType = VAL(ClrT$)

R = CSLoadBMP(VARSEG(ColMap(0)), 0, 0, (FileName$), OrigPal)

Handle = FREEFILE
OPEN FileName$ FOR BINARY AS #Handle
 GET #Handle, , Header
 GET #Handle, , Info
CLOSE #Handle

CSInitVGA
CSSetClipBox 0, 0, 319, 199

CSPcopy VARSEG(ColMap(0)), VIDEO

CSSetPal OrigPal

FOR X = 0 TO Info.xSize - 1
 FOR Y = 0 TO Info.ySize - 1
  CSGetCol CSPoint(VIDEO, X, Y), R, G, B
  Alpha = (R + G + B) / 3
  IF ClrType = Red THEN NewClr = Alpha
  IF ClrType = Green THEN NewClr = 64 + Alpha * 3
  IF ClrType = Blue THEN NewClr = 128 + Alpha * 3
  IF ClrType = Grey THEN NewClr = 192 + Alpha
  IF Alpha < 10 THEN NewClr = 0
  CSPset VIDEO, X, Y, NewClr
 NEXT
NEXT

SetPal

G$ = INPUT$(1)

CSGet VIDEO, 0, 0, Info.xSize - 1, Info.ySize - 1, VARSEG(ColMap(0)), VARPTR(ColMap(0))

DEF SEG = VARSEG(ColMap(0))
BSAVE MID$(FileName$, 1, LEN(FileName$) - 3) + "BSV", VARPTR(ColMap(0)), (Info.xSize * Info.ySize) + 4

CSClose

SCREEN 0: WIDTH 80, 25

CLS

REDIM SHARED ColMap(0) AS INTEGER

REM $STATIC
FUNCTION RgbMap (X, Y, Clr)
 DEF SEG = VARSEG(ColMap(0))
 RgbMap = PEEK(((Y * 160& + X) * 3&) + Clr)
END FUNCTION

SUB SetPal
 FOR I = 0 TO 255
  CSSetCol I, 0, 0, 0
 NEXT
 FOR I = 1 TO 63
  IF ClrType = Green THEN CSSetCol I + 64, 0, I, 0
  IF ClrType = Blue THEN CSSetCol I + 128, 0, 0, I
  IF ClrType = Grey OR ClrType = Red THEN CSSetCol I + 192, I, I, I
 NEXT I
 FOR I = 1 TO 32
  R = I * 2
  IF R > 63 THEN R = 63
  IF ClrType = Red THEN CSSetCol I, R, 0, 0
 NEXT I
 FOR I = 1 TO 16
  IF ClrType = Red THEN
   CSSetCol I + 32, 63, (I * 4), 0
   CSSetCol I + 32 + 16, 63, 63, (I * 4)
  END IF
 NEXT I
END SUB

SUB SetRgbMap (X, Y, R, G, B)
 DEF SEG = VARSEG(ColMap(0))
 POKE ((Y * 160& + X) * 3&), R
 POKE ((Y * 160& + X) * 3&) + 1&, G
 POKE ((Y * 160& + X) * 3&) + 2&, B
END SUB

