/*REXX*/
/*-- ANSI.REX -- MSDOS/PCDOS/DOSBOX/Unix/Linux - 1992 Mark McDonald--*/
/* Display Text on Screen using ANSI Codes - 1999 - Mark McDonald
Works in DOSBOX, DOSEMU, Putty, Linux Consoles, NOT WIN XP/7/8/10
as WIN does not provide ANSI support.
NOTE: ASCRN routine produces bulky ANSI code but is 100% reliable
ABOX BOXTYPE,SROW,SCOL,ROWS,COLS,ATTR
| | | | | +-- 0 to 255 - Colors
| | | | +------- 1 to 80 - Cols wide
| | | +------------ 1 to 24 - Rows High
| | +------------------ 1 to 80 - Start Col
| +----------------------- 1 to 24 - Start Row
+----------------------------- 0 - 17 - DOS
0 - 7 - Linux UTF-8/16
0 - 17 - Unicode
ACLS Reset/clears screen
ADISP "TEST.ANS" Display ANSI coded Screen
AMEM filespec Dislay mem saved screen
APOS ROW,COL Position cursor on Screen
ASAY row,col,attr,string Display string at row/col using attr
CSAY string Say string, no crlf
T = FIXS("\U\TEST.DAT") Make slashes work for DOS/Linux
T = GETFB(ATTR) Return PC FG/BG colors from attr (0-255)
T = RSAY(ROW,COL,ATTR,STRING) Returns ANSI String - No disp */
/*--------------------------------------------------------------------*/
/*--- Text positioning with attribute (color) on screen */
CALL ACLS
CALL ASAY 2,20,12,"Red on Black"
CALL ASAY 5,2,199,"White on Bright/Blinkg Red"
CALL ASAY 20,2,31,"Bright White on Blue"
CALL ASAY 15,15,78,"Bright Yellow on Red"
CALL ASAY 22,15,239,"Bright White on Bright/Blinking Brown"
CALL ASAY 24,20,9,"Looping/Displaying"
CALL ASAY 24,39,15,">>"
CALL ASAY 24,42,0,COPIES(" ",20) ;/*Supresses Cursor */
DO CNT = 1 TO 3000;CALL ASAY 24,42,14,CNT;END
PULL Z
/*--- Text Boxes DOS/LINUX ---*/
CALL ACLS
DO X = 0 TO 7
CALL ABOX X,10,10,10,40,31
PULL Z
END
/*--- MSDOS/DOSBOX Only ---*/
DO X = 8 TO 17
CALL ABOX X,10,10,10,40,31
END
PULL Z
/*--- Display Memory Saved Screen (char/attr) ---
FSPEC = "color2.mem"
CALL ACLS
CALL AMEM FSPEC
PULL Z */
/*--- Display Screen saved in ANSI Code
FSPEC = "COLOR6.ANS"
CALL ACLS
CALL ADISP FSPEC
PULL Z */
CALL ASAY 1,1,31,""
CALL CSAY "THIS IS ANOTHER TEST"
PULL Z
EXIT ;/* Exit program */
/*--- Fix path slahes for Linux --------------------------------------*/
FIXS: PROCEDURE
PARSE ARG FSPEC
T = ADDRESS()
IF T = "SYSTEM" THEN FSPEC = "/mnt/home"||TRANSLATE(FSPEC,"/","\")
RETURN FSPEC
/*--- Send Content of ANSI File to Screen ----------------------------*/
ADISP: PROCEDURE
PARSE ARG MAPNAME
T = CHAROUT('',LINEIN(MAPNAME)) ;/*Send file to screen */
T = LINEOUT(MAPNAME) ;/*Ensure file released */
RETURN
/*--- Draw Box --- PC=DOS - UC=Unicode (Not UTF-8/16) ----------------*/
ABOX: PROCEDURE
ARG BT,SROW,SCOL,ROWS,COLS,ATTR
PC.0 = " "
PC.1 = "+-+|+-+"
PC.2 = "*******"
PC.3 = "*** ***"
PC.4 = "+++++++"
PC.5 = "+++ +++"
PC.6 = "+-+ +-+"
PC.7 = "--- ---"
PC.8 = X2C(DA)||X2C(C4)||X2C(BF)||X2C(B3)||X2C(C0)||X2C(C4)||X2C(D9)
PC.9 = X2C(C9)||X2C(CD)||X2C(BB)||X2C(BA)||X2C(C8)||X2C(CD)||X2C(BC)
PC.10 = X2C(D6)||X2C(C4)||X2C(B7)||X2C(BA)||X2C(D3)||X2C(C4)||X2C(BD)
PC.11 = X2C(D5)||X2C(CD)||X2C(B8)||X2C(B3)||X2C(D4)||X2C(CD)||X2C(BE)
PC.12 = X2C(DB)||X2C(DF)||X2C(DB)||X2C(DB)||X2C(DB)||X2C(DC)||X2C(DB)
PC.13 = COPIES(X2C(B0),7)
PC.14 = COPIES(X2C(B1),7)
PC.15 = COPIES(X2C(B2),7)
PC.16 = COPIES(X2C(C4),3)||" "||COPIES(X2C(C4),3)
PC.17 = COPIES(X2C(CD),3)||" "||COPIES(X2C(CD),3)
UC.0 = PC.0
UC.1 = PC.1
UC.2 = PC.2
UC.3 = PC.3
UC.4 = PC.4
UC.5 = PC.5
UC.6 = PC.6
UC.7 = PC.7
UC.8 = X2C(250C)||X2C(2500)||X2C(2510)||X2C(2502)||X2C(2515)||X2C(2500)||X2C(2518)
UC.9 = X2C(2554)||X2C(2550)||X2C(2557)||X2C(2551)||X2C(255A)||X2C(2550)||X2C(255D)
UC.10 = X2C(2553)||X2C(2500)||X2C(2556)||X2C(2551)||X2C(2559)||X2C(2550)||X2C(255B)
UC.11 = X2C(2552)||X2C(2550)||X2C(2555)||X2C(2502)||X2C(2558)||X2C(2550)||X2C(255B)
UC.12 = " "
UC.13 = COPIES(X2C(2591),7)
UC.14 = COPIES(X2C(2592),7)
UC.15 = COPIES(X2C(2593),7)
UC.16 = COPIES(X2C(2500),3)||" "||COPIES(X2C(2500),3)
UC.17 = COPIES(X2C(2550),3)||" "||COPIES(X2C(2550),3)
DS = PC.BT
IF FUNICODE = 1 THEN DS = UC.BT
/* Build Lines */
TT = SUBSTR(DS,1,1)||COPIES(SUBSTR(DS,2,1),COLS-2)||SUBSTR(DS,3,1)
TL = SUBSTR(DS,5,1)||COPIES(SUBSTR(DS,6,1),COLS-2)||SUBSTR(DS,7,1)
TM = SUBSTR(DS,4,1)||COPIES(" ",COLS-2)||SUBSTR(DS,4,1)
/* Display Box */
DO CNT = 1 TO ROWS
IF CNT = 1 THEN CALL ASAY SROW,SCOL,ATTR,TT
IF (CNT <> 1 & CNT <> ROWS) THEN CALL ASAY SROW+CNT-1,SCOL,ATTR,TM
IF CNT = ROWS THEN CALL ASAY SROW+ROWS-1,SCOL,ATTR,TL
END
RETURN
/*--- Position Cursor on Screen Using ANSI Codes ---------------------*/
APOS: PROCEDURE
ARG ROW,COL
T = CHAROUT('','1b'x||"["||ROW||";"||COL||"H")
RETURN
/*--- Same as Say only w/o CRLF of SAY -------------------------------*/
CSAY: PROCEDURE
PARSE ARG TSTR
T = CHAROUT('',TSTR)
RETURN
/*--- 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
/*--- Reset/Clear Screen ---------------------------------------------*/
ACLS: PROCEDURE; T = CHAROUT('','1b'x||'[2J');RETURN
/*--- Write to Screen Using ANSI Codes -------------------------------*/
ASAY: PROCEDURE
PARSE ARG ROW,COL,ATTR,TSTR
/*--- Set ANSI Codes ---*/
AF = "30 34 32 36 31 35 33 37 1;30 1;34 1;32 1;36 1;31 1;35 1;33 1;37"
AB = "40m 44m 42m 46m 41m 45m 43m 47m 5;40m 5;44m 5;42m 5;46m 5;41m 5;45m 5;43m 5;47m"
ESC = "1b"x||"[" ;/*Set ESC Code */
CF = (ATTR // 16) ;/*Calc Fore Color */
CB = (((ATTR - CF) / 16) // 128) ;/*Calc Back Color */
FC = WORD(AF,(CF+1)); BC = WORD(AB,(CB+1)) ;/*Det ANSI Color Codes */
TC = ESC||FC||";"||BC ;/*Set ANSI Color Code */
SP = ESC||ROW||";"||COL||"H" ;/*Set Position Screen */
T = CHAROUT('',SP||TC||TSTR||ESC||"0m") ;/*Send to Screen */
RETURN
/*--- Return ANSI Coded String ---------------------------------------*/
RSAY: PROCEDURE
PARSE ARG ROW,COL,ATTR,TSTR ;/*Parse preserves case */
T = ASCRN(ROW,COL,ATTR,TSTR,1)
RETURN T
/*--- Write to Screen Using ANSI Codes -------------------------------*/
ASCRN: PROCEDURE
PARSE ARG ROW,COL,ATTR,TSTR,OPT ;/*Parse preserves case */
TANSI = " ";T = " " ;/*Init Vars */
/*--- Define ANSI Codes ---*/
AF = "30 34 32 36 31 35 33 37 1;30 1;34 1;32 1;36 1;31 1;35 1;33 1;37"
AB = "40m 44m 42m 46m 41m 45m 43m 47m 5;40m 5;44m 5;42m 5;46m 5;41m 5;45m 5;43m 5;47m"
T = GETFB(ATTR) ;/*Convert ATTR XXX */
CF = WORD(T,1); CB = WORD(T,2) ;/*Extract CF CB */
FC = WORD(AF,(CF+1));BC = WORD(AB,(CB+1)) ;/*Get Fore/Back Ansi */
TANSI = "1b"x||"["ROW||";"||COL||"H" ;/*Position Cursor */
TANSI = TANSI||"1b"x||"[" ;/*Prep for Colors */
TANSI = TANSI||FC";"||BC||TSTR||"1b"x||"[0m";/*Add Colors */
IF OPT = 1 THEN RETURN TANSI ;/*Just Build Str */
IF OPT = 0 THEN T = CHAROUT('',TANSI) ;/*Screen w/o CRLF */
/*SAY TANSI */ ;/*To Screen WITH CRLF */
RETURN
/*--- Cvrt MEM File to ANSI (Slow but Sure) --------------------------*/
/*--------------------------------------------------------------------*/
AMEM: PROCEDURE
PARSE ARG MAPNAME
CNT = 1 ;/*Init Var */
DO ROW = 1 TO 24
DO COL = 1 TO 80
ARRAY = CHARIN(MAPNAME,CNT,2) ;/*Char/Attribute Pair */
TC = SUBSTR(ARRAY,1,1) ;/*Extract Character */
TA = SUBSTR(ARRAY,2,1) ;/*Extract Color */
TR = RSAY(ROW,COL,C2D(TA),TC) ;/*Build Array */
CNT = CNT + 2 ;/*Next Character */
T = CHAROUT('',TR) ;/*Send to Screen */
END
END
T = LINEOUT(MAPNAME) ;/*Ensure File is Closed*/
RETURN