IMG2ANS-50-RGB-OPT.BAS

''
' IMG2ANS-50-RGB-OPT
'
' Convert any QB64 supported image into ANSI block art
'
' This version exports RGB color codes. So it can take any image as input!
'
' @author Rick Christy (grymmjack@gmail.com)
' @link https://youtube.com/grymmjack
' @version 0.1.1
'

'$INCLUDE:'../../include/SAUCE/SAUCE.BI'

DIM AS LONG CANVAS, SRC_IMAGE
DIM AS INTEGER SRC_W, SRC_H, x, y, z
DIM AS STRING SRC_FILE, ans
CONST E  = 27  ' ESCAPE - The ANSI escape code
CONST B  = 219 '█ BLOCK CHARACTER - Full block foreground
CONST FT = 223 '▀ HALF BLOCK Top FG Bottom BG

' Choose an image file with dialog
SRC_FILE$ = _OPENFILEDIALOG$( _
	"Choose an image", _
	, _
	"*.jpg|*.jpeg|*.png|*.tga|*.bmp|*.psd|*.gif|*.pcx|*.svg|*.qoi", _
	"Image Files", _
	-1 _
)
IF SRC_FILE$ = "" THEN SYSTEM ' image is required...

SRC_FILE$ = SRC_FILE$ + "|"

DIM AS INTEGER i, l, ch
DIM AS STRING filename
l% = LEN(SRC_FILE$)

FOR i%=0 TO l%
	IF i%+1 <= l% THEN ' At end of file list, do nothing
		ch% = ASC(SRC_FILE$, i%+1)
		IF CHR$(ch%) = "|" THEN ' File found
			' Load the image into the canvas at the same size
			SRC_IMAGE& = _LOADIMAGE(filename$, 32) 
			SRC_W% = _WIDTH(SRC_IMAGE&) : SRC_H% = _HEIGHT(SRC_IMAGE&)
			CANVAS& = _NEWIMAGE(SRC_W%, SRC_H%, 32)
			SCREEN CANVAS&
			_SOURCE SRC_IMAGE& : _DEST CANVAS& : _PUTIMAGE

			' Parse the image into ansi color blocks
			ans$ = ""
			FOR y% = 0 TO SRC_H% - 1
				FOR x% = 0 TO SRC_W% - 1
					DIM AS _UNSIGNED LONG TopColor, BottomColor
					DIM AS STRING FG_CODE, BG_CODE
					DIM AS STRING bR, bG, bB, fR, fG, fB
                    DIM AS STRING cbR, cbG, cbB, cfR, cfG, cfB

					TopColor~& = POINT(x%, y%) ' top pixel

					' Extract RGB values from each color
					bR$ = _TRIM$(STR$(_RED32(BottomColor~&)))
					bG$ = _TRIM$(STR$(_GREEN32(BottomColor~&)))
					bB$ = _TRIM$(STR$(_BLUE32(BottomColor~&)))
					fR$ = _TRIM$(STR$(_RED32(TopColor~&)))
					fG$ = _TRIM$(STR$(_GREEN32(TopColor~&)))
					fB$ = _TRIM$(STR$(_BLUE32(TopColor~&)))

					' Create the code strings
					FG_CODE$ = "[1;" _
								+ fR$ + ";" _
								+ fG$ + ";" _
								+ fB$ + "t"

					BG_CODE$ = "[0;" _
								+ bR$ + ";" _
								+ bG$ + ";" _
								+ bB$ + "t"
					IF (cbR$ <> bR$ OR cbG$ <> bG$ OR cbB$ <> bB$) _
					AND (cfR$ <> fR$ OR cfG$ <> fG$ OR cfB$ <> fB$) THEN
						ans$ = ans$ _
							+ CHR$(E) _
							+ FG_CODE$ _
							+ CHR$(E) _
							+ BG_CODE$ _
							+ CHR$(B)
						cbR$ = bR$ : cbG$ = bG$ : cbB$ = bB$
						cfR$ = fR$ : cfG$ = fG$ : cfB$ = fB$
					ELSEIF cbR$ <> bR$ OR cbG$ <> bG$ OR cbB$ <> bB$ THEN
						ans$ = ans$ _
							+ CHR$(E) _
							+ BG_CODE$ _
							+ CHR$(B)
						cbR$ = bR$ : cbG$ = bG$ : cbB$ = bB$
					ELSEIF cfR$ <> fR$ OR cfG$ <> fG$ OR cfB$ <> fB$ THEN
						ans$ = ans$ _
							+ CHR$(E) _
							+ FG_CODE$ _
							+ CHR$(B)
						cfR$ = fR$ : cfG$ = fG$ : cfB$ = fB$
					ELSE
						ans$ = ans$ + CHR$(B)
					END IF
				NEXT x%
			NEXT y%

			SCREEN 0
			CLS

			' Write the output.ans file
			PRINT ans$
			OPEN filename$ + "-50-RGB-OPT.ans" FOR OUTPUT AS #1
			PRINT #1, CHR$(E) + "[0;30m" +  ans$
			CLOSE #1

			OPEN filename$ + "-50-RGB-OPT.ans" FOR APPEND AS #1
			PRINT #1, CHR$(&H1A) ' EOF
			CLOSE #1 

			OPEN filename$ + "-50-RGB-OPT.ans" FOR BINARY AS #1
			SEEK #1, LOF(1)
			SAUCE.InitPacket
			SauceRecord.ID$		 = "SAUCE"
			SauceRecord.Version$	= "00"
			DIM slash AS STRING
			slash$ = "/" : IF _OS$ = "WINDOWS" THEN slash$ = "\"			
			s$ = MID$(filename$, _INSTRREV(filename$, slash$) + 1)
			MID$(SauceRecord.Title$, 1, LEN(s$)) = s$
			s$ = "grymmjack"
			MID$(SauceRecord.Author$, 1, LEN(s$)) = s$
			s$ = "MiSTiGRiS"
			MID$(SauceRecord.Group$, 1, LEN(s$)) = s$
			s$ = "20231231"
			MID$(SauceRecord.Date$, 1, LEN(s$)) = s$
			SauceRecord.FileSize~&  = LOF(1)-1
			SauceRecord.DataType~%% = 1
			SauceRecord.FileType~%% = 1
			SauceRecord.TInfo1~%	= SRC_W%
			SauceRecord.TInfo2~%	= SRC_H%
			SauceRecord.TInfo3~%	= 0
			SauceRecord.TInfo4~%	= 0
			SauceRecord.Comments~%% = 0
			SauceRecord.TFlags~%%   = 3 '8px iCE Color
			s$ = "IBM VGA50"
			MID$(SauceRecord.TInfoS$, 1, LEN(s$)) = s$
			SAUCE.FillPacket
			PUT #1, LOF(1)-1, SauceRecord
			CLOSE #1

			filename$ = ""
		ELSE ' Not at end of filename yet concat...
			filename$ = filename$ + CHR$(ch%)
		END IF
	END IF
NEXT i%

' Clean up
_FREEIMAGE SRC_IMAGE&
_FREEIMAGE CANVAS&

'$INCLUDE:'../../include/SAUCE/SAUCE.BM'