/*REXX*/
/*-- M2A.REX - Runs in MSDOS/WIN/UNIX/LINUX/DOSBOX -------------------*/
/* Convert MEMory saved screen to ANSI - 1999 - Mark McDonald */
/* Writes efficient ANSI Code */
/* Set TFOUT = '' send conversion to screen */
/*--------------------------------------------------------------------*/
TFIN = "color2.mem" ;/*MEM File to Convert */
TFOUT = "" ;/*Fileout ''=screen */
/* TFOUT = "test.ans" */ ;/*Create File test.ans */
CALL M2A TFIN,TFOUT
PULL Z
EXIT
/*--- Calc PC Colors from ATTR ---------------------------------------*/
GETFB: PROCEDURE
ARG ATTR
CF = 0; CB = 0 ;/*Init Vars */
CF = (ATTR // 16) ;/*Calc Foreground Color*/
CB = (((ATTR - CF) / 16) // 128) ;/*Calc Background Color*/
RETURN CF" "CB
/*--- Convert MEM Saved Screen to ANSI Screen ------------------------*/
M2A: PROCEDURE
PARSE ARG TFIN,TFOUT
/*--- Define ANSI Codes ---*/
AF = "30 34 32 36 31 35 33 37 30 34 32 36 31 35 33 37"
AB = "40 44 42 46 41 45 43 47 40 44 42 46 41 45 43 47 "
ESC = "1b"x||"["
CNT = 1 ;/*3840 Positions */
T = CHAROUT(TFOUT,ESC||"2J") ;/*Reset Screen */
DO ROW = 1 TO 24
T = CHAROUT(TFOUT,ESC||ROW||";1H"||ESC||"40;37m")
HA = 0; CFH = 0; CBH = 0; ;/*Hold Color */
DO COL = 1 TO 80
TC = CHARIN(TFIN,CNT,1) ;/*Get Character */
TA = C2D(CHARIN(TFIN,CNT+1,1)) ;/*Get Attribute 0-255*/
CNT = CNT + 2 ;/*Next Char Position */
/*--- Attribute Change? ---*/
IF HA <> TA THEN DO
HA = TA ;/*Update Hold Attr */
T = GETFB(TA) ;/*Convert ATTR ff bb*/
CF = WORD(T,1); CB = WORD(T,2) ;/*Extract CF CB */
FC = WORD(AF,(CF+1)) ;/*Cvrt PC FG to ANSI */
BC = WORD(AB,(CB+1)) ;/*Cvrt PC BG to ANSI */
/*--- Reset Attributes Needed? ---*/
RESET = 0
IF ((CB < 8) & (CBH > 7)) THEN RESET = 1
IF ((CF < 8) & (CFH > 7)) THEN RESET = 1
IF RESET = 1 THEN DO
T = CHAROUT(TFOUT,ESC||"0m")
BOLD = 0
/*--- Turn Bold/Blink Back On? ---*/
T = CHAROUT(TFOUT,ESC)
IF (CF > 7) THEN T = CHAROUT(TFOUT,"1;")
IF (CB > 7) THEN T = CHAROUT(TFOUT,"5;")
/*--- Set Background/Foreground Colors ---*/
T = CHAROUT(TFOUT,BC||";"||FC||"m")
END
IF RESET = 0 THEN DO
T = CHAROUT(TFOUT,ESC)
IF ((CF > 7) & (CFH < 8)) THEN T = CHAROUT(TFOUT,"1;")
IF ((CB > 7) & (CBH < 8)) THEN T = CHAROUT(TFOUT,"5;")
IF ((CB <> CBH) & (CF <> CFH)) THEN T = CHAROUT(TFOUT,BC||";"||FC||"m")
IF ((CB <> CBH) & (CF = CFH)) THEN T = CHAROUT(TFOUT,BC||"m")
IF ((CB = CBH) & (CF <> CFH)) THEN T = CHAROUT(TFOUT,FC||"m")
END
END
CFH = CF; CBH = CB; RESET = 0
T = CHAROUT(TFOUT,TC) ;/*Add Char to Var */
END
END
T = CHAROUT(TFOUT,ESC||"25;1H")
T = LINEOUT(TFIN)
T = LINEOUT(TFOUT)
RETURN