SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00032 ANSI CONTROL & OUTPUT 1 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Character Driver IMPORT 66 .g┴ Unit Ansi; (* Ho ho ho -Santa Clause) *)ππInterfaceππUses Crt;ππProcedure Display_ANSI(ch:Char);π{ Displays ch following ANSI Graphics protocol }ππ{---------------------------------------------------------------------- -----}π{ Useful information For porting this thing over to other computers:ππ Change background Text color Change foreground Text colorπ TextBackground(0) = black TextColor(0) = blackπ TextBackground(1) = blue TextColor(1) = blueπ TextBackground(2) = green TextColor(2) = greenπ TextBackground(3) = cyan TextColor(3) = cyanπ TextBackground(4) = red TextColor(4) = redπ TextBackground(5) = Magenta TextColor(5) = magentaπ TextBackground(6) = brown TextColor(6) = brownπ TextBackground(7) = light grey TextColor(7) = whiteπ TextColor(8) = greyπ Delete(s,i,c); TextColor(9) = bright blueπ Delete c Characters from TextColor(10)= bright greenπ String s starting at i TextColor(11)= bright cyanπ Val(s,v,c); TextColor(12)= bright redπ convert String s to numeric TextColor(13)= bright magentaπ value v. code=0 if ok. TextColor(14)= bright yellowπ Length(s) TextColor(15)= bright whiteπ length of String sπ}ππImplementationππVarπ ANSI_St :String ; {stores ANSI escape sequence if receiving ANSI}π ANSI_SCPL :Integer; {stores the saved cursor position line}π ANSI_SCPC :Integer; { " " " " " column}π ANSI_FG :Integer; {stores current foreground}π ANSI_BG :Integer; {stores current background}π ANSI_C,ANSI_I,ANSI_B,ANSI_R:Boolean ; {stores current attribute options}ππp,x,y : Integer;ππProcedure Display_ANSI(ch:Char);π{ Displays ch following ANSI Graphics protocal }ππ Procedure TABULATE;π Var x:Integer;π beginπ x:=WhereX;π if x<80 thenπ Repeatπ Inc(x);π Until (x MOD 8)=0;π if x=80 then x:=1;π GotoXY(x,WhereY);π if x=1 then WriteLN;π end;ππ Procedure BACKSPACE;π Var x:Integer;π beginπ if WhereX>1 thenπ Write(^H,' ',^H)π elseπ if WhereY>1 then beginπ GotoXY(80,WhereY-1);π Write(' ');π GotoXY(80,WhereY-1);π end;π end;ππ Procedure TTY(ch:Char);π Var x:Integer;π beginπ if ANSI_C then beginπ if ANSI_I then ANSI_FG:=ANSI_FG or 8;π if ANSI_B then ANSI_FG:=ANSI_FG or 16;π if ANSI_R then beginπ x:=ANSI_FG;π ANSI_FG:=ANSI_BG;π ANSI_BG:=x;π end;π ANSI_C:=False;π end;π TextColor(ANSI_FG);π TextBackground(ANSI_BG);π Case Ch ofπ ^G: beginπ Sound(2000);π Delay(75);π NoSound;π end;π ^H: Backspace;π ^I: Tabulate;π ^J: beginπ TextBackground(0);π Write(^J);π end;π ^K: GotoXY(1,1);π ^L: beginπ TextBackground(0);π ClrScr;π end;π ^M: beginπ TextBackground(0);π Write(^M);π end;π else Write(Ch);π end;π end;ππ Procedure ANSIWrite(S:String);π Var x:Integer;π beginπ For x:=1 to Length(S) doπ TTY(S[x]);π end;ππ Function Param:Integer; {returns -1 if no more parameters}π Var S:String;π x,XX:Integer;π B:Boolean;π beginπ B:=False;π For x:=3 to Length(ANSI_St) DOπ if ANSI_St[x] in ['0'..'9'] then B:=True;π if not B thenπ Param:=-1π else beginπ S:='';π x:=3;π if ANSI_St[3]=';' then beginπ Param:=0;π Delete(ANSI_St,3,1);π Exit;π end;π Repeatπ S:=S+ANSI_St[x];π x:=x+1;π Until (NOT (ANSI_St[x] in ['0'..'9'])) or (Length(S)>2) or (x>Length(ANSI_St));π if Length(S)>2 then beginπ ANSIWrite(ANSI_St+Ch);π ANSI_St:='';π Param:=-1;π Exit;π end;π Delete(ANSI_St,3,Length(S));π if ANSI_St[3]=';' then Delete(ANSI_St,3,1);π Val(S,x,XX);π Param:=x;π end;π end;ππbeginπ if (Ch<>#27) and (ANSI_St='') then beginπ TTY(Ch);π Exit;π end;π if Ch=#27 then beginπ if ANSI_St<>'' then beginπ ANSIWrite(ANSI_St+#27);π ANSI_St:='';π end else ANSI_St:=#27;π Exit;π end;π if ANSI_St=#27 then beginπ if Ch='[' thenπ ANSI_St:=#27+'['π else beginπ ANSIWrite(ANSI_St+Ch);π ANSI_St:='';π end;π Exit;π end;π if (Ch='[') and (ANSI_St<>'') then beginπ ANSIWrite(ANSI_St+'[');π ANSI_St:='';π Exit;π end;π if not (Ch in ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) then beginπ ANSIWrite(ANSI_St+Ch);π ANSI_St:='';π Exit;π end;π if Ch in ['A'..'D','f','H','J','K','m','s','u'] then beginπ Case Ch ofπ 'A': beginπ p:=Param;π if p=-1 then p:=1;π if WhereY-p<1 thenπ GotoXY(WhereX,1)π else GotoXY(WhereX,WhereY-p);π end;π 'B': beginπ p:=Param;π if p=-1 then p:=1;π if WhereY+p>25 thenπ GotoXY(WhereX,25)π else GotoXY(WhereX,WhereY+p);π end;π 'C': beginπ p:=Param;π if p=-1 then p:=1;π if WhereX+p>80 thenπ GotoXY(80,WhereY)π else GotoXY(WhereX+p,WhereY);π end;π 'D': beginπ p:=Param;π if p=-1 then p:=1;π if WhereX-p<1 thenπ GotoXY(1,WhereY)π else GotoXY(WhereX-p,WhereY);π end;π'H','f': beginπ Y:=Param;π x:=Param;π if Y<1 then Y:=1;π if x<1 then x:=1;π if (x>80) or (x<1) or (Y>25) or (Y<1) then beginπ ANSI_St:='';π Exit;π end;π GotoXY(x,Y);π end;π 'J': beginπ p:=Param;π if p=2 then beginπ TextBackground(0);π ClrScr;π end;π if p=0 then beginπ x:=WhereX;π Y:=WhereY;π Window(1,y,80,25);π TextBackground(0);π ClrScr;π Window(1,1,80,25);π GotoXY(x,Y);π end;π if p=1 then beginπ x:=WhereX;π Y:=WhereY;π Window(1,1,80,WhereY);π TextBackground(0);π ClrScr;π Window(1,1,80,25);π GotoXY(x,Y);π end;π end;π 'K': beginπ TextBackground(0);π ClrEol;π end;π 'm': beginπ if ANSI_St=#27+'[' then beginπ ANSI_FG:=7;π ANSI_BG:=0;π ANSI_I:=False;π ANSI_B:=False;π ANSI_R:=False;π end;π Repeatπ p:=Param;π Case p ofπ -1:;π 0:beginπ ANSI_FG:=7;π ANSI_BG:=0;π ANSI_I:=False;π ANSI_R:=False;π ANSI_B:=False;π end;π 1:ANSI_I:=True;π 5:ANSI_B:=True;π 7:ANSI_R:=True;π 30:ANSI_FG:=0;π 31:ANSI_FG:=4;π 32:ANSI_FG:=2;π 33:ANSI_FG:=6;π 34:ANSI_FG:=1;π 35:ANSI_FG:=5;π 36:ANSI_FG:=3;π 37:ANSI_FG:=7;π 40:ANSI_BG:=0;π 41:ANSI_BG:=4;π 42:ANSI_BG:=2;π 43:ANSI_BG:=6;π 44:ANSI_BG:=1;π 45:ANSI_BG:=5;π 46:ANSI_BG:=3;π 47:ANSI_BG:=7;π end;π if ((p>=30) and (p<=47)) or (p=1) or (p=5) or (p=7) thenπANSI_C:=True;π Until p=-1;π end;π 's': beginπ ANSI_SCPL:=WhereY;π ANSI_SCPC:=WhereX;π end;π 'u': beginπ if ANSI_SCPL>-1 then GotoXY(ANSI_SCPC,ANSI_SCPL);π ANSI_SCPL:=-1;π ANSI_SCPC:=-1;π end;π end;π ANSI_St:='';π Exit;π end;π if Ch in ['0'..'9',';'] thenπ ANSI_St:=ANSI_St+Ch;π if Length(ANSI_St)>50 then beginπ ANSIWrite(ANSI_St);π ANSI_St:='';π Exit;π end;πend;πππbeginπ ANSI_St:='';π ANSI_SCPL:=-1;π ANSI_SCPC:=-1;π ANSI_FG:=7;π ANSI_BG:=0;π ANSI_C:=False;π ANSI_I:=False;π ANSI_B:=False;π ANSI_R:=False;πEND. 2 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Character Driver #2 IMPORT 61 .gw∙ UNIT Ansi;ππINTERFACEπππUSES Crt, Dos;ππCONSTπ RecANSI : BOOLEAN = FALSE;ππPROCEDURE AnsiWrite (ch : CHAR);πPROCEDURE AnsiWriteLn (S : STRING);ππIMPLEMENTATIONπππVARπ Escape, Saved_X,π Saved_Y : BYTE;π Control_Code : STRING;ππFUNCTION GetNumber (VAR LINE : STRING) : INTEGER;ππ VARπ i, j, k : INTEGER;π temp0, temp1 : STRING;ππ BEGINπ temp0 := LINE;π VAL (temp0, i, j);π IF j = 0 THEN temp0 := ''π ELSEπ BEGINπ temp1 := COPY (temp0, 1, j - 1);π DELETE (temp0, 1, j);π VAL (temp1, i, j);π END;π LINE := temp0;π GetNumber := i;π END;ππ PROCEDURE loseit;π BEGINπ escape := 0;π control_code := '';π RecANSI := FALSE;π END;ππ PROCEDURE Ansi_Cursor_move;ππ VARπ x, y : INTEGER;ππ BEGINπ y := GetNumber (control_code);π IF y = 0 THEN y := 1;π x := GetNumber (control_code);π IF x = 0 THEN x := 1;π IF y > 25 THEN y := 25;π IF x > 80 THEN x := 80;π GOTOXY (x, y);π loseit;π END;ππPROCEDURE Ansi_Cursor_up;ππ VARπ y, new_y, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π y := WHEREY;π IF (y - Offset) < 1 THENπ New_y := 1π ELSEπ New_y := y - offset;π GOTOXY (WHEREX, new_y);π loseit;π END;ππPROCEDURE Ansi_Cursor_Down;ππ VARπ y, new_y, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π y := WHEREY;π IF (y + Offset) > 25 THENπ New_y := 25π ELSEπ New_y := y + offset;π GOTOXY (WHEREX, new_y);π loseit;π END;ππPROCEDURE Ansi_Cursor_Left;ππ VARπ x, new_x, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π x := WHEREX;π IF (x - Offset) < 1 THENπ New_x := 1π ELSEπ New_x := x - offset;π GOTOXY (new_x, WHEREY);π loseit;π END;ππPROCEDURE Ansi_Cursor_Right;ππ VARπ x, new_x, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π x := WHEREX;π IF (x + Offset) > 80 THENπ New_x := 1π ELSEπ New_x := x + offset;π GOTOXY (New_x, WHEREY);π loseit;π END;ππ PROCEDURE Ansi_Clear_Screen;ππ BEGIN { 0J = cusor to Eos }π CLRSCR; { 1j start to cursor }π loseit; { 2j entie screen/cursor no-move}π END;ππ PROCEDURE Ansi_Clear_EoLine;ππ BEGINπ CLREOL;π loseit;π END;πππ PROCEDURE Reverse_Video;ππ VARπ tempAttr, tblink, tempAttrlo, tempAttrhi : BYTE;ππ BEGINπ LOWVIDEO;π TempAttrlo := (TextAttr AND $7);π tempAttrHi := (textAttr AND $70);π tblink := (textattr AND $80);π tempattrlo := tempattrlo * 16;π tempattrhi := tempattrhi DIV 16;π TextAttr := TempAttrhi + TempAttrLo + TBlink;π END;πππ PROCEDURE Ansi_Set_Colors;ππ VARπ temp0, Color_Code : INTEGER;ππ BEGINπ IF LENGTH (control_code) = 0 THEN control_code := '0';π WHILE (LENGTH (control_code) > 0) DOπ BEGINπ Color_code := getNumber (control_code);π CASE Color_code OFπ 0 : BEGINπ LOWVIDEO;π TEXTCOLOR (LightGray);π TEXTBACKGROUND (Black);π END;π 1 : HIGHVIDEO;π 5 : TextAttr := (TextAttr OR $80);π 7 : Reverse_Video;π 30 : textAttr := (TextAttr AND $F8) + black;π 31 : textattr := (TextAttr AND $f8) + red;π 32 : textattr := (TextAttr AND $f8) + green;π 33 : textattr := (TextAttr AND $f8) + brown;π 34 : textattr := (TextAttr AND $f8) + blue;π 35 : textattr := (TextAttr AND $f8) + magenta;π 36 : textattr := (TextAttr AND $f8) + cyan;π 37 : textattr := (TextAttr AND $f8) + Lightgray;π 40 : TEXTBACKGROUND (black);π 41 : TEXTBACKGROUND (red);π 42 : TEXTBACKGROUND (green);π 43 : TEXTBACKGROUND (yellow);π 44 : TEXTBACKGROUND (blue);π 45 : TEXTBACKGROUND (magenta);π 46 : TEXTBACKGROUND (cyan);π 47 : TEXTBACKGROUND (white);π END;π END;π loseit;π END;πππ PROCEDURE Ansi_Save_Cur_pos;ππ BEGINπ Saved_X := WHEREX;π Saved_Y := WHEREY;π loseit;π END;πππ PROCEDURE Ansi_Restore_cur_pos;ππ BEGINπ GOTOXY (Saved_X, Saved_Y);π loseit;π END;πππ PROCEDURE Ansi_check_code ( ch : CHAR);ππ BEGINπ CASE ch OFπ '0'..'9', ';' : control_code := control_code + ch;π 'H', 'f' : Ansi_Cursor_Move;π 'A' : Ansi_Cursor_up;π 'B' : Ansi_Cursor_Down;π 'C' : Ansi_Cursor_Right;π 'D' : Ansi_Cursor_Left;π 'J' : Ansi_Clear_Screen;π 'K' : Ansi_Clear_EoLine;π 'm' : Ansi_Set_Colors;π 's' : Ansi_Save_Cur_Pos;π 'u' : Ansi_Restore_Cur_pos;π ELSEπ loseit;π END;π END;πππPROCEDURE AnsiWrite (ch : CHAR);ππVARπ temp0 : INTEGER;ππBEGINπ IF escape > 0 THENπ BEGINπ CASE Escape OFπ 1 : BEGINπ IF ch = '[' THENπ BEGINπ escape := 2;π Control_Code := '';π ENDπ ELSEπ escape := 0;π END;π 2 : Ansi_Check_code (ch);π ELSEπ BEGINπ escape := 0;π control_code := '';π RecANSI := FALSE;π END;π END;π ENDπ ELSEπ BEGINπ CASE Ch OFπ #27 : Escape := 1;π #9 : BEGINπ temp0 := WHEREX;π temp0 := temp0 DIV 8;π temp0 := temp0 + 1;π temp0 := temp0 * 8;π GOTOXY (temp0, WHEREY);π END;π #12 : CLRSCR;π ELSEπ BEGINπ IF ( (WHEREX = 80) AND (WHEREY = 25) ) THENπ BEGINπ windmax := (80 + (24 * 256) );π WRITE (ch);π windmax := (79 + (24 * 256) );π ENDπ ELSEπ WRITE (ch);π escape := 0;π END;π END;π END;π RecANSI := (Escape <> 0);π END;ππPROCEDURE AnsiWriteLn (S : STRING);πVAR I : BYTE;πBEGINπFOR I := 1 TO LENGTH (S) DO Ansiwrite (S [i]);πEND;ππEND.π 3 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Display Unit IMPORT 17 .g?╥ {π>How do I make an ansi and put it in my Pascal File? I know there is anπ>option to save as pascal, but it does not look like anything to me!π>Any help is appreciated!ππHere is a Program that will read an ANSI File into a buffer in 2k chunksπthen Write it (to screen) Character by Character. BUT - it will Writeπall ANSI-escape-sequences as StringS.ππ Two reasons For this:ππ 1) I just 'feel happier' if each ANSI escape sequence is written toπ screen as a String instead of as individual Characters. (Its just anπ irrational 'thing' I have)ππ 2) By assembling all the Characters in the escape sequence together,π it make its _easy_ to FILTER OUT all ANSI sequences if you want to justπ output plain black-and-white Text. This is For those people who forπ some strange reason would rather not have ANSI.SYS installed, butπ complain about getting 'garbage' Characters on the screen.ππAll you have to do to filter out the escape sequences is toπun-bracket the 'if AnsiDetected then' part.ππif you want me to post 'Function AnsiDetected: Boolean' just let meπknow.π}ππProgram ansiWrite;ππConst esc = chr(27);π termnChar: SET of Char =π ['f','A'..'D','H','s','u','J','K','l'..'n','h'];ππVar f: File;π buf:Array[1..2048] of Char;π Numread: Word;π num: Integer;π escString: String;π escseq: Boolean;ππbeginπ Assign(f,'FRINGE3.ANS');π Reset(f,1);π escseq := False;π escString:='';π Repeatπ BlockRead(f,buf,Sizeof(Buf),Numread);π { Write Block to Screen }π For NUM := 1 to Numread DOπ beginπ if Buf[Num] = esc then escseq := True;π if escseq=True thenπ beginπ escString:= escString+buf[num];π if Buf[num] in termnChar thenπ beginπ escseq:=False;π {if AnsiDetected then} Write(escString);π escString:=''π endπ endπ else Write(Buf[num])π end; { For }π Until NumRead < SizeOf(Buf);π close(f)πend.π 4 05-28-9313:33ALL DUSTIN NULF Direct ANSI Display IMPORT 8 .gÇü {πDUSTIN NULFππI've run into that familiar problem in trying to view Ansi colored pictures andπusing the Crt Unit at the same time. The Crt Unitπdoesn't translate the Ansi codes and displays them literally. Now,πI've created an Ansi interpreter Procedure that reads each line inπan ansi File and calls the appropriate TextColor/TextBackground Procedures,πaccording to what ansi escape String was found. Thisπis groovy and all, but I just found out something new today With:π}πAssign(Output,'');πReWrite(Output);π{π...and that it translates all the ansi codes For me already! Now,πthe big question is, what are the advantages and disadvantagesπof using this Assign method vs. the Ansi interpreter method? Isπthis Assign method slower/faster, take up more memory, more diskπspace, etc. Any information would be highly appreciated! :)π}π 5 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Output IMPORT 34 .g∞ {π> Now that I need to make a .ANS bulletin Type File, I was wonderingπ> how to Write from a Pascal Program, ANSI control Characters to aπ> File and produce nice color bulletin screen to be displayed by RA.ππThe following Unit will enable you to Write Ansi sequences to a TextπFile Without having to look them up yourself. It enables you to do thisπusing the (easier) Crt Unit style of commands, and provides the optimumπAnsi sequence to do the job.π}ππUnit AnsiOut;π{1. Contains reduced set of Procedures from AnsiCrt Unit by I.Hinson.}π{2. Modified to provide output to a Text File.}ππInterfaceππConst Black = 0; Blue = 1; Green = 2; Cyan = 3;π Red = 4; Magenta = 5; Brown = 6; LightGray = 7;π DarkGray = 8; LightBlue = 9; LightGreen = 10; LightCyan = 11;π LightRed = 12; LightMagenta = 13; Yellow = 14; White = 15;π Blink = 128;ππVar AnsiFile: Text;ππProcedure TextColor(fore : Byte);πProcedure TextBackGround(back : Byte);πProcedure NormVideo;πProcedure LowVideo;πProcedure HighVideo;πProcedure ClrEol;πProcedure ClrScr;ππImplementationππConst forestr: Array[Black..LightGray] of String[2]π = ('30','34','32','36','31','35','33','37');π backstr: Array[Black..LightGray] of String[2]π = ('40','44','42','46','41','45','43','47');π decisiontree: Array[Boolean, Boolean, Boolean, Boolean] of Integer =π ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));ππVar forecolour, backcolour: Byte; { stores last colours set }π boldstate, blinkstate: Boolean;ππProcedure TextColor(fore : Byte);π Varπ blinknow, boldnow: Boolean;π outstr: String;π beginπ blinknow := (fore and $80) = $80;π boldnow := (fore and $08) = $08;π fore := fore and $07; { mask out intensity and blink attributes }π forecolour := fore;π Case decisiontree[blinknow, blinkstate, boldnow, boldstate] OFπ 0: outstr := Concat(#27,'[',forestr[fore],'m');π 1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');π 2: outstr := Concat(#27,'[1;',forestr[fore],'m');π 3: outstr :=π Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');π 4: outstr := Concat(#27,'[5;',forestr[fore],'m');π 5: outstr :=π Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');π 6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');π end; { Case }π Write(AnsiFile,outstr);π blinkstate := blinknow;π boldstate := boldnow;π end;ππProcedure TextBackGround(back: Byte);π Var outString: String;π beginπ if Back > 7 then Exit; { No such thing as bright or blinking backgrounds }π BackColour := Back;π outString := Concat(#27,'[',backstr[back],'m');π Write(AnsiFile,outString)π end;ππProcedure NormVideo;π beginπ Write(AnsiFile,#27'[0m');π forecolour := LightGray;π backcolour := Black;π boldstate := False;π blinkstate := Falseπ end;ππProcedure LowVideo;π beginπ if blinkstate then forecolour := forecolour or $80; { retain blinking }π TextColor(forecolour); { stored forecolour never contains bold attr }π end;ππProcedure HighVideo;π beginπ if not boldstate thenπ beginπ boldstate := True;π Write(AnsiFile,#27,'[1m')π end;π end;ππProcedure ClrEol;π beginπ Write(AnsiFile,#27'[K')π end;ππProcedure ClrScr;π beginπ Write(AnsiFile,#27'[2J');π end;ππbeginπ forecolour := LightGray;π backcolour := Black;π boldstate := False;π blinkstate := Falseπend.ππ___------------------------------------------------------------------πProgram Demo;πUses AnsiOut;πbeginπ Assign(AnsiFile,'CON'); { or a File - e.g. 'MYSCREEN.ANS' }π ReWrite(AnsiFile);π ClrScr;π TextColor(Blue); TextBackGround(LightGray);π Writeln(AnsiFile,' Blue Text on LightGray ');π HighVideo; Write(AnsiFile,' Now the Text is LightBlue ');π TextBackground(Red); Writeln(AnsiFile,' on a Red background');π TextColor(Black+Blink); TextBackground(Cyan);π Writeln(AnsiFile,' Blinking Black ');π TextBackGround(Green); ClrEol; { a blank Green line }π(53 min left), (H)elp, More? Writeln(AnsiFile);π NormVideo;π Close(AnsiFile);πend.π 6 05-28-9313:33ALL ROBERT ROTHENBURG ANSI Ouput w/ INT29 IMPORT 6 .g╬: {πROBERT ROTHENBURGππFor those interested in using ANSI in Turbo Pascal (at least Dos v2-5π...I don't know if Dos 6 Uses this routine--Interrupt $29--or not)πhere's a tip: The "undocumented" Fast PutChar interrupt is used byπANSI.SYS, and thus anything you send to that interrupt will beπANSI-interpreted (provided ANSI.SYS is loaded :).ππUse this routine to output a Character to ANSI:π(you'll have to modify it to output Strings, of course).π}ππUsesπ Dos;ππProcedure FastPutChar(C : Char);π{ Outputs only to "display", not stdout! Uses Dos v2-5. }πVarπ Reg : Registers;πbeginπ Reg.AL := Ord(C);π Intr($29, Reg)πend;ππ 7 05-28-9313:33ALL SWAG SUPPORT TEAM CRT Clone with ANSI IMPORT 62 .g⌐} {π Well here it is again, its a little rough and some of the Crt.tpu Functionsπare left out. This Unit will generate Ansi TextColor and TextBackGrounds.πBecuase of the Ansi screen Writes you can send the Program to the com portπjust by using CTTY or GateWay in a bat File before you start your Program.π}ππUnit Crtclone;ππInterfaceππConstπ{ Foreground and background color Constants }ππ Black = 0;π Blue = 1;π Green = 2;π Cyan = 3;π Red = 4;π Magenta = 5;π Brown = 6;π LightGray = 7;ππ{ Foreground color Constants }ππ DarkGray = 8;π LightBlue = 9;π LightGreen = 10;π LightCyan = 11;π LightRed = 12;π LightMagenta = 13;π Yellow = 14;π White = 15;ππ{ Add-in For blinking }ππ Blink = 128;ππVarππ{ Interface Variables }ππ CheckBreak: Boolean; { Enable Ctrl-Break }π CheckEOF: Boolean; { Enable Ctrl-Z }π Procedure TextColor(Color: Byte);π Procedure TextBackground(Color: Byte);π Function KeyPressed : Boolean;π Function GetKey : Char;π Function ReadKey : Char;π Function WhereX : Byte;π Function WhereY : Byte;π Procedure NormVideo;π Procedure ClrEol;π Procedure ClrScr;π Procedure GotoXY(X, Y : Byte);πππ Implementationππ Function KeyPressed : Boolean; { Replacement For Crt.KeyPressed }π { ;Detects whether a key is pressed}π { ;Does nothing With the key}π { ;Returns True if key is pressed}π { ;Otherwise, False}π { ;Key remains in kbd buffer}π Var IsThere : Byte;π beginπ Inline(π $B4/$0B/ { MOV AH,+$0B ;Get input status}π $CD/$21/ { INT $21 ;Call Dos}π $88/$86/>ISTHERE); { MOV >IsThere[BP],AL ;Move into Variable}π if IsThere = $FF then KeyPressed := True else KeyPressed := False;π end;ππ Procedure ClrEol; { ANSI replacement For Crt.ClrEol }π beginπ Write(#27'[K');π end;ππ Procedure ClrScr; { ANSI replacement For Crt.ClrScr }π beginπ Write(#27'[2J');π end;ππ Function GetKey : Char; { Additional Function. Not in Crt Unit }π Var CH : Char;π beginπ Inline(π {; Function GetKey : Char}π {; Clears the keyboard buffer then waits Until}π {; a key is struck. if the key is a special, e.g.}π {; Function key, goes back and reads the next}π {; Byte in the keyboard buffer. Thus does}π {; nothing special With Function keys.}π $B4/$0C { MOV AH,$0C ;Set up to clear buffer}π /$B0/$08 { MOV AL,8 ;then to get a Char}π /$CD/$21 {SPCL: INT $21 ;Call Dos}π /$3C/$00 { CMP AL,0 ;if it's a 0 Byte}π /$75/$04 { JNZ CHRDY ;is spec., get second Byte}π /$B4/$08 { MOV AH,8 ;else set up For another}π /$EB/$F6 { JMP SHORT SPCL ;and get it}π /$88/$46/>CH {CHRDY: MOV >CH[BP],AL ;else put into Function return}π );π if CheckBreak and (Ch = #3) thenπ begin {if CheckBreak is True and it's a ^C}π Inline( {then execute Ctrl_Brk}π $CD/$23);π end;π GetKey := Ch;π end; {Inline Function GetKey}πππ Function ReadKey : Char; { Replacement For Crt.ReadKey }π Var chrout : Char;π beginπ { ;Just like ReadKey in Crt Unit}π Inline(π $B4/$07/ { MOV AH,$07 ;Char input w/o echo}π $CD/$21/ { INT $21 ;Call Dos}π $88/$86/>CHROUT); { MOV >chrout[bp],AL ;Put into Variable}π if CheckBreak and (chrout = #3) then {if it's a ^C and CheckBreak True}π begin {then execute Ctrl_Brk}π Inline(π $CD/$23); { INT $23}π end;π ReadKey := chrout; {else return Character}π end;ππ Function WhereX : Byte; { ANSI replacement For Crt.WhereX }π Var { Cursor position report. This is column or }π ch : Char; { X axis report.}π st : String;π st1 : String[2];π x : Byte;π i : Integer;ππ beginπ Write(#27'[6n'); { Ansi String to get X-Y position }π st := ''; { We will only use X here }π ch := #0; { Make sure Character is not 'R' }π While ch <> 'R' do { Return will be }π begin { Esc - [ - Ypos - ; - Xpos - R }π ch := #0;π ch := ReadKey; { Get one }π st := st + ch; { Build String }π end;π St1 := copy(St,6,2); { Pick off subString having number in ASCII}π Val(St1,x,i); { Make it numeric }π WhereX := x; { Return the number }π end;ππ Function WhereY : Byte; { ANSI replacement For Crt.WhereY }π Var { Cursor position report. This is row or }π ch : Char; { Y axis report.}π st : String;π st1 : String[2];π y : Byte;π i : Integer;ππ beginπ Write(#27'[6n'); { Ansi String to get X-Y position }π st := ''; { We will only use Y here }π ch := #0; { Make sure Character is not 'R' }π While ch <> 'R' do { Return will be }π begin { Esc - [ - Ypos - ; - Xpos - R }π ch := #0;π ch := ReadKey; { Get one }π st := st + ch; { Build String }π end;π St1 := copy(St,3,2); { Pick off subString having number in ASCII}π Val(St1,y,i); { Make it numeric }π WhereY := y; { Return the number }π end;πππ Procedure GotoXY(x : Byte ; y : Byte); { ANSI replacement For Crt.GoToXY}π beginπ if (x < 1) or (y < 1) then Exit;π if (x > 80) or (y > 25) then Exit;π Write(#27'[',y,';',x,'H');π end;ππ Procedure TextBackGround(Color:Byte);π beginπ Case color ofπ 0: begin Write(#27#91#52#48#109); end;π 1: begin Write(#27#91#52#52#109); end;π 2: begin Write(#27#91#52#50#109); end;π 3: begin Write(#27#91#52#54#109); end;π 4: begin Write(#27#91#52#49#109); end;π 5: begin Write(#27#91#52#53#109); end;π 6: begin Write(#27#91#52#51#109); end;π 6: begin Write(#27#91#52#55#109); end;π end;π end;ππ Procedure TextColor(Color:Byte);π beginπ Case color ofπ 0: begin Write(#27#91#51#48#109); end;π 1: begin Write(#27#91#51#52#109); end;π 2: begin Write(#27#91#51#50#109); end;π 3: begin Write(#27#91#51#54#109); end;π 4: begin Write(#27#91#51#49#109); end;π 5: begin Write(#27#91#51#53#109); end;π 6: begin Write(#27#91#51#51#109); end;π 7: begin Write(#27#91#51#55#109); end;π 8: begin Write(#27#91#49#59#51#48#109); end;π 9: begin Write(#27#91#49#59#51#52#109); end;π 10: begin Write(#27#91#49#59#51#50#109); end;π 11: begin Write(#27#91#49#59#51#54#109); end;π 12: begin Write(#27#91#49#59#51#49#109); end;π 13: begin Write(#27#91#49#59#51#53#109); end;π 14: begin Write(#27#91#49#59#51#51#109); end;π 15: begin Write(#27#91#49#59#51#55#109); end;π 128: begin Write(#27#91#53#109); end;π end;π end;ππ Procedure NormVideo;π beginπ Write(#27#91#48#109);π end;ππend.π 8 05-28-9313:33ALL SWAG SUPPORT TEAM Detect ANSI.SYS InstalledIMPORT 12 .g"π {πThe following Functions provide a way to determine if the machineπthe your application is running on has ANSI installed.ππif your Program is written using the Crt Unit the Function may returnπthe result as False even if ANSI is present, unless you successfullyπuse a 'work around' method to ensure all Writes go through Dos.ππI find it's easier just to not use Crt if my Program is working WithπANSI - since there is not much that you use the Crt Unit For that can'tπbe done in some other way.ππThe Dos-based alternatives to ReadKey and KeyPressed are included sinceπthey are needed For the AnsiDetect Function.π}ππUsesπ Dos;ππFunction KeyPressed : Boolean;π { Detects whether a key is pressed. Key remains in kbd buffer}πVarπ r: Registers;πbeginπ r.AH := $0B;π MsDos(r);π KeyPressed := (r.AL = $FF)πend;ππFunction ReadKey : Char;πVarπ r: Registers;πbeginπ r.AH := $08;π MsDos(r);π ReadKey := Chr(r.AL)πend;ππFunction AnsiDetected: Boolean;π{ Detects whether ANSI is installed }πVarπ dummy: Char;πbeginπ Write(#27'[6n'); { Ask For cursor position report via }π if not KeyPressed { the ANSI driver. }π thenπ AnsiDetected := Falseπ elseπ beginπ AnsiDetected := True;π { empty the keyboard buffer }π Repeat Dummy := ReadKey Until not KeyPressedπ endπend;ππbeginπend.ππ 9 05-28-9313:33ALL SWAG SUPPORT TEAM THEDRAW UNCRUNCH Image IMPORT 32 .gPç {Reading in a thedraw image :)π}πProcedure UNCRUNCH (Var Addr1,Addr2; BlkLen:Integer);ππbeginπ Inline (π $1E/ { PUSH DS ;Save data segment.}π $C5/$B6/ADDR1/ { LDS SI,[BP+Addr1] ;Source Address}π $C4/$BE/ADDR2/ { LES DI,[BP+Addr2] ;Destination Addr}π $8B/$8E/BLKLEN/ { MOV CX,[BP+BlkLen] ;Length of block}π $E3/$5B/ { JCXZ Done}π $8B/$D7/ { MOV DX,DI ;Save X coordinate Forπlater.}π $33/$C0/ { xor AX,AX ;Set Current attributes.}π $FC/ { CLD}π $AC/ {LOOPA: LODSB ;Get next Character.}π $3C/$20/ { CMP AL,32 ;if a control Character,πjump.}π $72/$05/ { JC ForeGround}π $AB/ { StoSW ;Save letter on screen.}π $E2/$F8/ {Next: LOOP LOOPA}π $EB/$4C/ { JMP Short Done}π {ForeGround:}π $3C/$10/ { CMP AL,16 ;if less than 16, thenπchange the}π $73/$07/ { JNC BackGround ;Foreground color.πotherwise jump.}π $80/$E4/$F0/ { and AH,0F0H ;Strip off oldπForeground.}π $0A/$E0/ { or AH,AL}π $EB/$F1/ { JMP Next}π {BackGround:}π $3C/$18/ { CMP AL,24 ;if less than 24, thenπchange the}π $74/$13/ { JZ NextLine ;background color. ifπexactly 24,}π $73/$19/ { JNC FlashBittoggle ;then jump down to nextπline.}π $2C/$10/ { SUB AL,16 ;otherwise jump toπmultiple output}π $02/$C0/ { ADD AL,AL ;routines.}π $02/$C0/ { ADD AL,AL}π $02/$C0/ { ADD AL,AL}π $02/$C0/ { ADD AL,AL}π $80/$E4/$8F/ { and AH,8FH ;Strip off oldπbackground.}π $0A/$E0/ { or AH,AL}π $EB/$DA/ { JMP Next}π {NextLine:}π $81/$C2/$A0/$00/ { ADD DX,160 ;if equal to 24,}π $8B/$FA/ { MOV DI,DX ;then jump down to}π $EB/$D2/ { JMP Next ;the next line.}π {FlashBittoggle:}π $3C/$1B/ { CMP AL,27 ;Does user want to toggleπthe blink}π $72/$07/ { JC MultiOutput ;attribute?}π $75/$CC/ { JNZ Next}π $80/$F4/$80/ { xor AH,128 ;Done.}π $EB/$C7/ { JMP Next}π {MultiOutput:}π $3C/$19/ { CMP AL,25 ;Set Z flag ifπmulti-space output.}π $8B/$D9/ { MOV BX,CX ;Save main counter.}π $AC/ { LODSB ;Get count of number ofπtimes}π $8A/$C8/ { MOV CL,AL ;to display Character.}π $B0/$20/ { MOV AL,32}π $74/$02/ { JZ StartOutput ;Jump here if displayingπspaces.}π $AC/ { LODSB ;otherwise get Characterπto use.}π $4B/ { DEC BX ;Adjust main counter.}π {StartOutput:}π $32/$ED/ { xor CH,CH}π $41/ { inC CX}π $F3/$AB/ { REP StoSW}π $8B/$CB/ { MOV CX,BX}π $49/ { DEC CX ;Adjust main counter.}π $E0/$AA/ { LOOPNZ LOOPA ;Loop if anything else toπdo...}π $1F); {Done: POP DS ;Restore data segment.}πend; {UNCRUNCH}π 10 05-28-9313:33ALL SWAG SUPPORT TEAM Display THEDRAW Images IMPORT 8 .g∞: {π> if you save as Pascal, and follow the instructions in the manual Forπ> TheDraw everything will work fine. It is also much more efficient thenπ> using normal ANSI-Files, since TheDraw-Pascal Files can be Compressed...π}πVarπ VideoSeg : Word;ππProcedure VisTheDrawImage(x, y, Depth, Width: Byte; Var Picture);πVarπ c : Byte;π scrpos : Word;πbeginπ Dec(y);π Dec(x);π ScrPos := y * (ScrCol Shl 1) + x * 2;π For c := 0 to Depth-1 Doπ Move(Mem[Seg(Picture) : ofs(Picture) + c * (Width Shl 1)],π Mem[VideoSeg : c * (ScrCol Shl 1) + ScrPos], Width Shl 1);πend;ππ{πif you picture is not crunched you can use this routine to show them WithπVideoSeg has to be $B000 or $B800, then use the Vars from the generatedπpicture and insert when you call that procedure.π} 11 05-28-9313:33ALL SWAG SUPPORT TEAM How To Use THEDRAW IMPORT 6 .g≡ > Also does anyone know how to import TheDraw Files into a prg and getπ> them to show properly. Thanks.ππSave the Files into Bin Format, then run BinOBJ on them. When you select aπpublic name, remember that this will be the Procedure's name.ππAfter that Write:ππProcedure <public name>; External; {$L <objname>}ππWalkthrough example:πππSaved File: Welcom.BinππBinOBJ WELCOME WELCOME WELCOMESCREENππIn pascal:ππProcedure WelcomeScreen; External; {$L WELCOME.OBJ}ππIn order to display, dump the Procedure to b800:0 -ππMove(@WelcomeScreen,Mem[$B800:0],4000];ππ4000 is the size For 80x25. The size is x*y*2.ππ 12 05-28-9313:33ALL SWAG SUPPORT TEAM How To Use THEDRAW #2 IMPORT 19 .g Well, everyone is asking how to integrate a picture from The Draw into yourπPascal Program, so here is how to do it.ππFirst start up The Draw, and either Draw, or load your picture(prettyπsimple).ππthen select Save.πWhen asked For a save Format, select (ObJect).πFor Save Mode, select (Normal).πFor Memory Model, select (Turbo Pascal v4+).πFor Reference identifier to use, Type in the name that you wish to have theπpicture Procedure named, this will be explained later.πthen, For the Filename, of course enter the Filename you wish to save itπunder.ππNext, is the method to place The .OBJ image into your Program.πSomewhere up in the declairations area (after the Var statements, andπbeFore your begin) place the following:ππ{$L C:\PATH\PICTURE.OBJ}πProcedure ProcName; external; {Change ProcName to the Reference Identifierπ That you used when saving the picture}ππthen, to call that picture, there is 1 of 2 ways. First of all, you canπmake another Procedure immediatly after this one that goes as such:ππProcedure DrawANSIScreen;πbeginπ Move(Pointer(@ProcName)^,prt($B800,0)^,4000);πend;ππthen all you have to do is call the Procedure DrawANSIScreen to draw yourπpicture. or you can copy that line beginning With Move into your sourceπcode directly. Make sure to again replace the ProcName With your specifiedπReferecne Identifier. Make sure to give each picture a differentπIdentifier, I do not know what the outcome would be if you used the sameπone. Probally wouldn't even Compile. Also, I have not tried this WithπAnimation. Considering that this Writes directly to screen, it proballyπwon't work, or will be too fast For the human eye to follow. On top ofπthis, I migh point out that since this IS a direct video access, the cursorπWILL not move For it's last position when the screen is printed, so you canπfill the Complete screen, and it will not scroll.ππHope that this has been helpful. It's very easy, and I pulled it directπfrom The Draw docs. This is supposed to work With Pascal 6.0 and up only.πto work With earlier Pascal versions, please read the docs. They entail theπprocess Completely (but not very understandibly <G>).ππ 13 05-28-9313:33ALL SWAG SUPPORT TEAM Displaying THEDRAW ImagesIMPORT 7 .g: {▐ Oh, about the thedraw screens, here'sπ▐ a bit of code in which you can load up a File saved as O)bject, P)ascal.π▐ Oh this is saved as Uncrunched not Crunched.π▐π▐ {$L,TESTFile.OBJ} {This is the File you saved in thedraw as a Object}π {It is linked directly into the code at Compile time}ππ Procedure ImageData; external; {The imagedata Procedure you can}π {define the name of this Procedure}π {when you save the File in TheDraw}π beginπ Move (Pointer(@ImageData)^,ptr($B800,0)^,5000);π Readln;π end.ππ{By using the Move instruction, the placement of the imageπis restricted to full screens or essentially 80 Character lines.π}π 14 05-28-9313:33ALL SWAG SUPPORT TEAM Display THEDRAW BIN File IMPORT 17 .g`É {πHere are the relevant pieces from a Program I wrote to convert TheDrawπ.Bin Files to .ANS Files. Why? TheDraw's .ANSI Files are incrediblyπwasteful! The display speed of the menus of the BBS I wrote this Forπnow redraw at 300% the speed they used to!ππif you (or anyone) wants the full Program, give me a yell.π}ππProgram Bin2Ansi;ππUsesπ Crt,Dos;ππVarπ Filenum :Byte; {Points to the command line parameter now being looked at}π fName :String; {File from cmd line - possibly With wildcards}π Filesdone :Word;ππ Procedure ParseFile (Var cmdFName:String);ππ Varπ Details:SearchRec;π fDir, fName, fExt:String;π Dummy:String;π {The parts of the name of the source .Bin File}ππ beginπ {Default extension}π if pos ('.',cmdFName) = 0 then cmdFName := cmdFName + '.Bin';π FSplit(cmdFName, fDir, dummy, dummy); {Get the directory name}π {Check to see if we have any matches For this Filespec}π FindFirst (cmdFName,AnyFile,Details);π if DosError <> 0 then beginπ Writeln ('Filespec: ',cmdfname);π error (7,warning);π end else beginπ While DosError = 0 do beginπ FSplit(fdir+details.name, dummy, fName, fExt); {Get the directory name}π assign (BinFile,fdir+details.name);π Write ('Opening File: ',details.name,#13);π {$i-}π reset (BinFile);π {$i+}π end else beginπ Writeln (details.name,' --> ',fname,'.ANS ');π process (BinFile,fdir+fname+'.ANS');π close (BinFile);π end;π FindNext (Details);π end;π end;π end;ππbeginπ directvideo := False;π Filesdone := 0;π header;π if paramcount < 1 then error (1,fatal);π FileNum := 0;π Repeatπ fname := paramstr (Filenum + 1);π ParseFile (fname);π inc (FileNum);π Until paramstr (FileNum + 1) = '';π Writeln; Write (' ■ Done, With ',Filesdone,' File');π if Filesdone <> 1 then Write ('s');π Writeln (' processed.');πend.π 15 08-27-9320:01ALL JAMES FIELDEN Ansi Screens IMPORT 16 .gLα {πJAMES FIELDENππ> Ok, but how would you get the actual ANSI screens into one file,π> (TheDraw for example makes them individually), and then knowπ> their starting and ending positions?πHere's part of a routine I used back in 1988 When I was a WWIV Junky When itπwas in Turbo Pascal. I used this to combine all my ansi screens intoπone file and just pick the one out I needed.π}ππusesπ Dos,π Crt;πVarπ infil : Text;π nilfil : Text;π Star : String;π Enn : String;π Cup : String[5];ππProcedure PrintScr(Tfil, Loca, ELoca : String);πBeginπ assign(infil,Tfil);π {$I-}π reset(infil);π {$I+}π if IOResult <> 0 thenπ beginπ Writeln(Tfil, ' Not Found');π Exit;π end;π assign(nilfil,'');π rewrite(nilfil);π repeatπ readln(infil, Star);π Cup := Copy(Star,1,5);π until (Cup = Loca) or EOF(infil);π repeatπ readln(infil, Enn);π Cup := Copy(Enn, 1, 5);π if Cup = ELoca thenπ writelnπ elseπ Writeln(nilfil,Enn);π until (Cup = ELoca) or EOF(infil);π close(infil);π close(nilfil);πend;πbeginπ PrintScr('Bulk.Ans','@2---','@3---');πend.ππ'Bulk.ans' would be in this format :π@1-------------------------------------------------------------------πEsc[2J This is your first ansi screen;;;π@2-------------------------------------------------------------------πEsc[K This would be your second ansi screen and so on and on Iπhad about 6 or 7 ANSI screens in One fileπ@3-------------------------------------------------------------------πI used ANSIDraw to make my screens and then used Turbo3 to add themπall into one file with the Ctrl-K,R Command. (TheDraw and Qedit) wouldπbe much better To use now thought.πI tested this Program on a few ANSI Screens I thur together into oneπand it worked ok here using Turbo Pascal 7.0πI'm sure this could be done better as well but if it helps good!π 16 08-27-9320:37ALL STEVE CONNET Detect ANSI.SYS Present IMPORT 4 .gY⌡ {πSTEVE CONNETππdetermine whether ansi.sys is installedπ}ππFunction LocalAnsiDetected : Boolean;πVarπ Dummy : Byte;πbeginπ Asmπ mov ah,1ah { detect ANSI.SYS device driver }π mov al,00hπ int 2fhπ mov dummy,alπ end;π LocalAnsiDetected := Dummy = $FF;πend;π 17 10-28-9311:38ALL GUY MCLOUGHLIN SHOWANSI.PAS IMPORT 27 .g h {===========================================================================πDate: 10-10-93 (13:21)πFrom: GUY MCLOUGHLINπSubj: Ansi in TP 6.0π---------------------------------------------------------------------------}ππ(* Program to demonstrate how to do display ANSI files *)π program ShowANSI;π usesπ crt; (* Required for "ClrScr" and "Delay" routines. *)ππ const (* ANSI display delay factor in 1/1000th's of a second *)π co_DelayFactor = 40;ππ type (* Type definition. *)π st_80 = string[80];ππ (***** Check for I/O errors. *)π (* *)π procedure CheckErrors(st_Msg : st_80);π var by_Temp : byte;π beginπ by_Temp := ioresult;π if (by_Temp <> 0) thenπ beginπ writeln('Error = ', by_Temp, ' ', st_Msg); haltπ endπ end; (* CheckErrors. *)ππ var (* Temporary string varialble. *)π st_Temp : string;ππ (* Temporary text file variable. *)π fite_Temp,π (* Text "device-driver". *)π fite_ANSI : text;ππ (* Main program execution block. *)π BEGINπ (* Assign "text-device" driver to standard output. *)π assign(fite_ANSI, '');ππ (* Attempt to open the ANSI "text-device" driver. *)π {$I-}π rewrite(fite_ANSI);π {$I+}π (* Check for I/O errors. *)π CheckErrors('Opening ANSI device driver');ππ (* Assign ANSI ART file to display. *)π assign(fite_Temp, 'TEST.ANS');π {$I-}π reset(fite_Temp);π {$I+}π (* Check for I/O errors. *)π CheckErrors('Opening TEST.ANS file');ππ (* Clear the screen. *)π clrscr;ππ (* Diplay the ANSI ART file. While the end of the *)π (* ANSI ART file has not been reached, do... *)π while not eof(fite_Temp) doπ beginπ (* Read line of text from the ANSI ART file. *)π readln(fite_Temp, st_Temp);ππ (* Check for I/O errors. *)π CheckErrors('Reading from TEST.ANS file');ππ (* Delay for co_DelayFactor milli-seconds. *)π delay(co_DelayFactor);ππ (* Write the line of ANSI text to the "text-device *)π (* driver". *)π writeln(fite_ANSI, st_Temp);ππ (* Check for I/O errors. *)π CheckErrors('Writing to ANSI "text-device driver"')π end;ππ (* Close the ANSI ART text file. *)π close(fite_Temp);ππ (* Check for I/O errors. *)π CheckErrors('Closing TEST.ANS');ππ (* Close the ANSI "text device driver". *)π close(fite_ANSI);ππ (* Check for I/O errors. *)π CheckErrors('Closing ANSI "text-device driver"')π END.π 18 11-02-9304:47ALL JAMES FIELDEN Combine Ansi Screens IMPORT 16 .gLα {πJAMES FIELDENππ> Ok, but how would you get the actual ANSI screens into one file,π> (TheDraw for example makes them individually), and then knowπ> their starting and ending positions?πHere's part of a routine I used back in 1988 When I was a WWIV Junky When itπwas in Turbo Pascal. I used this to combine all my ansi screens intoπone file and just pick the one out I needed.π}ππusesπ Dos, Crt;ππVarπ infil : Text;π nilfil : Text;π Star : String;π Enn : String;π Cup : String[5];ππProcedure PrintScr(Tfil, Loca, ELoca : String);πBeginπ assign(infil, Tfil);π {$I-}π reset(infil);π {$I+}π if IOResult <> 0 thenπ beginπ Writeln(Tfil, ' Not Found');π Exit;π end;π assign(nilfil,'');π rewrite(nilfil);π repeatπ readln(infil, Star);π Cup := Copy(Star,1,5);π until (Cup = Loca) or EOF(infil);π repeatπ readln(infil, Enn);π Cup := Copy(Enn, 1, 5);π if Cup = ELoca thenπ writelnπ elseπ Writeln(nilfil,Enn);π until (Cup = ELoca) or EOF(infil);π close(infil);π close(nilfil);πend;πbeginπ PrintScr('Bulk.Ans','@2---','@3---');πend.ππ'Bulk.ans' would be in this format :π@1-------------------------------------------------------------------πEsc[2J This is your first ansi screen;;;π@2-------------------------------------------------------------------πEsc[K This would be your second ansi screen and so on and on Iπhad about 6 or 7 ANSI screens in One fileπ@3-------------------------------------------------------------------πI used ANSIDraw to make my screens and then used Turbo3 to add themπall into one file with the Ctrl-K,R Command. (TheDraw and Qedit) wouldπbe much better To use now thought.πI tested this Program on a few ANSI Screens I thur together into oneπand it worked ok here using Turbo Pascal 7.0πI'm sure this could be done better as well but if it helps good!π 19 11-02-9304:47ALL JACK DYBCZAK ANSI Music IMPORT 35 .gQσ {πJACK DYBCZAKπ ANSI MUSICππIt's Really simple to create this music. Hopefully many more will startπusing those codes inside online games etc.ππSmall examples:ππ O3 Sets octave 3π T120 Sets tempo to 120 (default)ππYou can use several statements on each line. Could it be more simple.πIt's exactly the same command as the BASIC command called PLAY fromπIBM BASIC or GW-BASIC and all those.ππ MUSIC:ππ Syntax: ESC[MF T120 O2C8D8E8F8G8 (All lines must end With ASCII 14)ππ Music Strings in the BASIC Play format are supported.π Multiple Strings per line may be entered.ππ Music Strings should begin With the Characters "<esc>[M"π where <esc> is a True ESC Character (DEC 27, Hex 1B).π Please refer to your BASIC manual For information on theπ BASIC Play commands. The following are all valid forπ beginning a Music String in SMILE: MF, MB, MN, ML, MS, M .π Although MB (Music Background) is valid, True backgroudπ music is not supported.ππ Music Strings should end With the musical note Characterπ (DEC 14, Hex 0E, CTRL-N). if this Character is missing,π SMILE will look For the next ESC Character or theπ end-of-line marker to terminate the music String. Thisπ option was added to try and catch as many incorrectlyπ formated music Strings as possible. However, forπ compatiblity With other viewers, I suggest you always endπ your music Strings With CTRL-N (DEC 14)ππ Sound:π ( Thanks to Julie Ibarra, author of ANSIPLAY For this idea )ππ Syntax:π ESC[MF Freq; Duration; Cycles; CycleDelay;Variation (DEC14)ππ Custom Sounds are supported in SMILE by using a Sound CODEπ similar to that found in BASIC and the Program ANSIPLAY.π However, the Sound generator in SMILE differs from theπ Sound command in BASIC. Therefore, different frequencyπ values must be used to produce the musical notes. Theseπ are listed somewhere down the page.ππ The Sound statement must begin and end in the same mannerπ discussed above For a normal music String. The Sound CODEπ consists of the following parameters serparated by aπ semicolon (;) :ππ FREQ : Frequency of note to be played. The affectiveπ range of frequencies is 0 to 7904.π (0..65535)ππ DURATION : Time, in milliseconds, the note should be played.π (0..65535)ππ CYCLES : Number of times to Repeat Frequency/Duration.π (0..65535)ππ Delay : Time, in milliseconds, between cycles.π (0..65535)ππ VarIATION: Frequency value is changed by this number forπ each CYCLE the note is played.π (-65535..65535)ππ (NOTE: 1 second = 1000 milliseconds)ππ Press ESC to Exit a DURATION or Delay action. You mayπ have to press ESC a couple of times to completely Exitπ a Sound sequence.ππ Sound CODE Musical Note Frequency Values (7 Octives):ππ C C# D D# E F F# G G# A A# Bππ 65 69 73 78 82 87 92 98 104 110 116 123π 131 139 147 156 165 175 185 196 208 220 233 247π 262 278 294 312 330 350 370 392 416 440 466 494π 524 556 588 624 660 700 740 784 832 880 932 988π 1048 1112 1176 1248 1320 1400 1480 1568 1664 1760 1864 1976π 2096 2224 2352 2496 2640 2800 2960 3136 3328 3520 3728 3952π 4192 4448 4704 4992 5280 5600 5920 6272 6656 7040 7456 7904ππ One advantage of the Sound CODE is the ability to place aπ PAUSE in your ANSI screens Without having to use aπ multitude of ESC[s codes. Just use a Sound CODE With theπ Delay set very high to get a pause. For example,ππ ESC[MF ;;;60000ππ would pause your ANSI Screen For 60 seconds, or Until a keyπ is pressed when viewing it With SMILE. Remember, theseπ Sound CODES are not supported by bulletin boards...(yet)!π 20 11-02-9304:48ALL SWAG SUPPORT TEAM ANSI Bulletin files IMPORT 33 .g∞ {π> Now that I need to make a .ANS bulletin Type File, I was wonderingπ> how to Write from a Pascal Program, ANSI control Characters to aπ> File and produce nice color bulletin screen to be displayed by RA.ππThe following Unit will enable you to Write Ansi sequences to a TextπFile Without having to look them up yourself. It enables you to do thisπusing the (easier) Crt Unit style of commands, and provides the optimumπAnsi sequence to do the job.π}ππUnit AnsiOut;π{1. Contains reduced set of Procedures from AnsiCrt Unit by I.Hinson.}π{2. Modified to provide output to a Text File.}ππInterfaceππConst Black = 0; Blue = 1; Green = 2; Cyan = 3;π Red = 4; Magenta = 5; Brown = 6; LightGray = 7;π DarkGray = 8; LightBlue = 9; LightGreen = 10; LightCyan = 11;π LightRed = 12; LightMagenta = 13; Yellow = 14; White = 15;π Blink = 128;ππVar AnsiFile: Text;ππProcedure TextColor(fore : Byte);πProcedure TextBackGround(back : Byte);πProcedure NormVideo;πProcedure LowVideo;πProcedure HighVideo;πProcedure ClrEol;πProcedure ClrScr;ππImplementationππConstπ forestr : Array [Black..LightGray] of String[2] =π ('30','34','32','36','31','35','33','37');π backstr : Array [Black..LightGray] of String[2] =π ('40','44','42','46','41','45','43','47');π decisiontree : Array [Boolean, Boolean, Boolean, Boolean] of Integer =π ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));ππVar forecolour, backcolour: Byte; { stores last colours set }π boldstate, blinkstate: Boolean;ππProcedure TextColor(fore : Byte);π Varπ blinknow, boldnow: Boolean;π outstr: String;π beginπ blinknow := (fore and $80) = $80;π boldnow := (fore and $08) = $08;π fore := fore and $07; { mask out intensity and blink attributes }π forecolour := fore;π Case decisiontree[blinknow, blinkstate, boldnow, boldstate] OFπ 0: outstr := Concat(#27,'[',forestr[fore],'m');π 1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');π 2: outstr := Concat(#27,'[1;',forestr[fore],'m');π 3: outstr :=π Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');π 4: outstr := Concat(#27,'[5;',forestr[fore],'m');π 5: outstr :=π Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');π 6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');π end; { Case }π Write(AnsiFile,outstr);π blinkstate := blinknow;π boldstate := boldnow;π end;ππProcedure TextBackGround(back: Byte);π Var outString: String;π beginπ if Back > 7 then Exit; { No such thing as bright or blinking backgrounds }π BackColour := Back;π outString := Concat(#27,'[',backstr[back],'m');π Write(AnsiFile,outString)π end;ππProcedure NormVideo;π beginπ Write(AnsiFile,#27'[0m');π forecolour := LightGray;π backcolour := Black;π boldstate := False;π blinkstate := Falseπ end;ππProcedure LowVideo;π beginπ if blinkstate then forecolour := forecolour or $80; { retain blinking }π TextColor(forecolour); { stored forecolour never contains bold attr }π end;ππProcedure HighVideo;π beginπ if not boldstate thenπ beginπ boldstate := True;π Write(AnsiFile,#27,'[1m')π end;π end;ππProcedure ClrEol;π beginπ Write(AnsiFile,#27'[K')π end;ππProcedure ClrScr;π beginπ Write(AnsiFile,#27'[2J');π end;ππbeginπ forecolour := LightGray;π backcolour := Black;π boldstate := False;π blinkstate := Falseπend.πππProgram Demo;πUsesπ AnsiOut;πbeginπ Assign(AnsiFile,'CON'); { or a File - e.g. 'MYSCREEN.ANS' }π ReWrite(AnsiFile);π ClrScr;π TextColor(Blue);π TextBackGround(LightGray);π Writeln(AnsiFile,' Blue Text on LightGray ');π HighVideo;π Write(AnsiFile,' Now the Text is LightBlue ');π TextBackground(Red);π Writeln(AnsiFile,' on a Red background');π TextColor(Black+Blink);π TextBackground(Cyan);π Writeln(AnsiFile,' Blinking Black ');π TextBackGround(Green);π ClrEol; { a blank Green line }π Writeln(AnsiFile);π NormVideo;π Close(AnsiFile);πend.π 21 11-02-9304:48ALL MAYNARD PHILBROOK ANSI in a window IMPORT 10 .g,å {πMAYNARD PHILBROOKππ> I am having troubles displaying an ANSI codes from a Text File. I can do itπ> fine With the full screen, but I have trouble trying to do it Within aπ> Window. if I use the usual ASSIGN (Con, ''); WriteLn (Con, AnsiText);π> IT works fine, but not Within a Window. The Con TextFile seems to ignoreπ> Window limitations, and I can understand that. My question is how to getπ> around it? Do I have to use an ANSI Unit which converts ANSI codes toπ> TP color codes? I am looking For such a Unit, but is that the onlyππ TP Windows is Directly Writeln to the Screen memory, You can how everπ Redirect Dos to a TP Window.π}ππ{$M 1024, 0, 1000}ππUsesπ Dos, Crt;ππVarπ Old_Vect : Pointer;ππProcedure Redirect_OutPut(Character : Char); Interrupt;πbeginπ Write(Character);πend;ππbeginπ GetIntVec($29, Old_Vect); { Save Old Vector }π SetIntVec($29, @Redirect_OutPut);π Window(10, 3, 70, 20);π Exec(' MainProgram ',''); { all output using WriteLn(Con,'????') }π SetIntVec($29, Old_Vect); { to this Window }π Halt(DosError);πend;ππ 22 11-02-9305:43ALL SWAG SUPPORT TEAM Another DETECT ANSI.SYS IMPORT 12 .g"π {πThe following Functions provide a way to determine if the machineπthe your application is running on has ANSI installed.ππif your Program is written using the Crt Unit the Function may returnπthe result as False even if ANSI is present, unless you successfullyπuse a 'work around' method to ensure all Writes go through Dos.ππI find it's easier just to not use Crt if my Program is working WithπANSI - since there is not much that you use the Crt Unit For that can'tπbe done in some other way.ππThe Dos-based alternatives to ReadKey and KeyPressed are included sinceπthey are needed For the AnsiDetect Function.π}ππUsesπ Dos;ππFunction KeyPressed : Boolean;π { Detects whether a key is pressed. Key remains in kbd buffer}πVarπ r: Registers;πbeginπ r.AH := $0B;π MsDos(r);π KeyPressed := (r.AL = $FF);πend;ππFunction ReadKey : Char;πVarπ r: Registers;πbeginπ r.AH := $08;π MsDos(r);π ReadKey := Chr(r.AL);πend;ππFunction AnsiDetected : Boolean;π{ Detects whether ANSI is installed }πVarπ dummy: Char;πbeginπ Write(#27'[6n'); { Ask For cursor position report via }π if not KeyPressed { the ANSI driver. }π thenπ AnsiDetected := Falseπ elseπ beginπ AnsiDetected := True;π { empty the keyboard buffer }π Repeatπ Dummy := ReadKey;π Until not KeyPressed;π end;πend;ππbeginπend.ππ 23 11-02-9315:10ALL DAVE LOWE ANSI String Thing IMPORT 9 .gu▓ {Here's a neat ANSI effect that scrolls a string in... quite neat i think.}ππ procedure Thingy;π constπ len = 45;π IL : string[len] = 'Cool String Thingy! by The MAN';π chardelay = 10;π enddelay = 1000;π varπ loop: byte;π beginπ TextColor(white);π GotoXY(1,1);π write(IL);π Delay(chardelay);π TextColor(Random(15)+1);π GotoXY(1,1);π write(IL[1]);π Delay(chardelay);π GotoXY(2,1);π TextColor(Random(15)+1);π write(IL[2]);π Delay(chardelay);π for loop:=3 to len doπ beginπ GotoXY(loop-2,1);π TextColor(Random(15)+1);π {TextColor(white);}π write(IL[loop-2]);π Delay(chardelay);π GotoXY(loop-1,1);π TextColor(Random(15)+1);π write(IL[loop-1]);π Delay(chardelay);π GotoXY(loop,1);π TextColor(Random(15)+1);π write(IL[loop]);π Delay(chardelay);π end;π Delay(enddelay);π end;ππBEGINπThingy;πEND.ππ 24 11-21-9309:24ALL STEFAN XENOS Another ANSI Driver IMPORT 55 .g╚ {πFrom: STEFAN XENOSπSubj: ANSI.PASππThose routines have been posted several times, so here's some different codeπwhich serves a similar purpose. I got it from the 1992 ZipNav CD, andπhave done some slight debugging. Here it is: }ππUSES crt;πCONSTπ FF = #12;π ESC = #27;πVAR Ch : CHAR;π C : CHAR;π i , FGcolor, BGcolor, CursorX, CursorY : INTEGER;π escape_mode, lightcolor : BOOLEAN;π escape_number : BYTE;π escape_register : ARRAY [1..50] OF BYTE;π escape_str : STRING [80];ππAnsiFile : TEXT;ππ(****************************************************************************)π(* PROCESS ESCAPE *)π(****************************************************************************)πPROCEDUREπ wrt ( c : CHAR );π BEGINππ CASE c OFπ FF : CLRSCR;π ELSE WRITE (c);π END;π END;ππ PROCEDUREπ set_graphics;π VARπ i : INTEGER;π FG, BG : INTEGER;π BEGINπ FG := FGcolor;π BG := BGcolor;π FOR i := 1 TO escape_number DO BEGINπ CASE escape_register [i] OFπ 0 : lightcolor := FALSE;π 1 : lightcolor := TRUE;π 5 : FG := FG + blink;π 7 : BEGINπ FG := BG;π BG := FG;π END;π 30 : FG := black;π 31 : FG := red;π 32 : FG := green;π 33 : FG := brown;π 34 : FG := blue;π 35 : FG := magenta;π 36 : FG := cyan;π 37 : FG := white;π 40 : BG := black;π 41 : BG := red;π 42 : BG := green;π 43 : BG := yellow;π 44 : BG := blue;π 45 : BG := magenta;π 46 : BG := cyan;π 47 : BG := white;π ELSEπ ;π END;π END;π IF (lightcolor) AND (fg < 8) THENπ fg := fg + 8;π IF (lightcolor = FALSE) AND (fg > 7) THENπ fg := fg - 8;π TEXTCOLOR ( FG );π TEXTBACKGROUND ( BG );π escape_mode := FALSE;π END;ππ PROCEDURE MoveUp;π BEGINπ IF escape_register [1] < 1 THENπ escape_register [1] := 1;π GOTOXY (WHEREX, WHEREY - (Escape_Register [1]) );π END;ππ PROCEDURE MoveDown;π BEGINπ IF escape_register [1] < 1 THENπ escape_register [1] := 1;π GOTOXY (WHEREX, WHEREY + (Escape_Register [1]) );π END;ππ PROCEDURE MoveForeward;π BEGINπ IF escape_register [1] < 1 THENπ escape_register [1] := 1;π GOTOXY (WHEREX + (Escape_Register [1]), WHEREY);π END;ππ PROCEDURE MoveBackward;π BEGINπ IF escape_register [1] < 1 THENπ escape_register [1] := 1;π GOTOXY (WHEREX - (Escape_Register [1]), WHEREY);π END;ππ PROCEDURE SaveCursorPos;π BEGINπ CursorX := WHEREX;π CursorY := WHEREY;π END;ππ PROCEDURE RestoreCursorPos;π BEGINπ GOTOXY (CursorX, CursorY);π END;ππ PROCEDURE addr_cursor;π BEGINπ CASE escape_number OFπ 0 : BEGINπ escape_register [1] := 1;π escape_register [2] := 1;π END;π 1 : escape_register [2] := 1;π ELSEπ ;π END;π IF escape_register [1] = 25 THENπ GOTOXY (escape_register [2], 24)π ELSEπ GOTOXY (escape_register [2], escape_register [1]);π escape_mode := FALSE;π END;ππ PROCEDURE clear_scr;π BEGINπ IF ( escape_number = 1 ) AND ( escape_register [1] = 2 ) THENπ CLRSCR;π escape_mode := FALSE;π END;ππ PROCEDURE clear_line;π BEGINπ IF ( escape_number = 1 ) AND ( escape_register [1] = 0 ) THENπ CLREOL;π escape_mode := FALSE;π END;ππ PROCEDURE process_escape ( c : CHAR );π VARπ i : INTEGER;π ch : CHAR;π BEGINπ c := UPCASE (c);π CASE c OFπ '['π : EXIT;π 'F', 'H'π : BEGINπ addr_cursor;π Escape_mode := FALSE;π EXIT;π END;π 'J' : BEGINπ clear_scr;π Escape_mode := FALSE;π EXIT;π END;ππ 'K' : BEGINπ clear_line;π Escape_mode := FALSE;π EXIT;π END;π 'M' : BEGINπ set_graphics;π Escape_mode := FALSE;π EXIT;ππ END;π 'S' : BEGINπ SaveCursorPos;π Escape_mode := FALSE;π EXIT;π END;π 'U' : BEGINπ RestoreCursorPos;π Escape_Mode := FALSE;π EXIT;π END;π 'A' : BEGINπ MoveUp;π Escape_mode := FALSE;π EXIT;π END;π 'B' : BEGINπ MoveDown;π Escape_mode := FALSE;π EXIT;π END;π 'C' : BEGINπ MoveForeward;π Escape_mode := FALSE;π EXIT;π END;π 'D' : BEGINπ MoveBackward;π Escape_mode := FALSE;π EXIT;π END;π END;π ch := UPCASE ( c );π escape_str := escape_str + ch;π IF ch IN [ 'A'..'G', 'L'..'P' ] THEN EXIT;π IF ch IN [ '0'..'9' ] THEN BEGINπ escape_register [escape_number] := (escape_register [escape_number] * 10) + ORD ( ch ) - ORD ( '0' );π EXIT;π END;π CASE ch OFπ ';', ',' : BEGINπ escape_number := escape_number + 1;π escape_register [escape_number] := 0;π END;π 'T', '#', '+', '-', '>', '<', '.'π : ;π ELSEπ escape_mode := FALSE;π FOR i := 1 TO LENGTH ( escape_str ) DOπ wrt ( escape_str [i] );π END;π END;π(**************************************************************************)π(* SCREEN HANDLER *)π(**************************************************************************)π PROCEDURE scrwrite ( c : CHAR );π VARπ i : INTEGER;π BEGINπ IF c = ESC THEN BEGINπ IF escape_mode THEN BEGINπ FOR i := 1 TO LENGTH ( escape_str ) DOπ wrt ( escape_str [i] );π END;π escape_str := '';π escape_number := 1;π escape_register [escape_number] := 0;π escape_mode := TRUE;π ENDπ ELSEπ IF escape_mode THENπ process_escape (c)π ELSEπ wrt ( c );π END;πBEGINπEscape_Str := '';πFGColor := White;BGColor := BLACK;πEscape_Mode := TRUE;πCLRSCR;πASSIGN (AnsiFile, '\modem\host.ans');πRESET (AnsiFile);πWHILE NOT EOF (AnsiFile) DO BEGINπ READ (AnsiFile, ch);π DELAY (1);π ScrWrite (Ch);πEND;ππEND.π 25 01-27-9411:52ALL ERIC MILLER ANSI Save Screen IMPORT 31 .g╕ {π> 2: Writing ansi screens to directly to a file.ππ 2. What exactly do you mean by writing ANSI screens to a file?π Do you mean a text mode screen to the ANSI file format,π or interpreting an ANSI file to a text mode screen?ππ I have code that will save a textmode screen to an ANSI formatπ text file by reading the text mode screen directly. The code cameπ from another discussion on saving text screens to ANSI files;π the code is not mine.π}ππPROGRAM Ansi_Save_Screen;π{*π * Save a color-screen in Ansi-format. Simple way, char by char: blanksπ * not skipped.π *}πUsesπ Dos;ππPROCEDURE SaveANSI(Filename : PathStr);πCONSTπ Esc = #27;π MaxCol = 70;π AnsiCols : array [0..7] of char = '04261537';ππTYPEπ TCell = RECORDπ C : Char;π A : byte;π END;π TScreen = array [1..25, 1..80] of TCell;ππ ANSIATTR = recordπ Bright : boolean;π Blink : boolean;π FG : byte;π BG : byte;π end;ππVARπ Screen : TSCreen ABSOLUTE $B800:$0000;π F : text;π X, Y : byte;π s, s1 : String;π AnsiLast,π AnsiTmp : ANSIATTR;ππfunction WriteAttr(var Old, New : ANSIATTR) : string;π{ Write Attributes (ESC[..m) into a string }πvarπ s : string;πbeginπ WriteAttr := '';π s := ESC + '[';π if (not(New.Bright = Old.Bright)) or (not(New.Blink = Old.Blink)) thenπ beginπ if (Not (New.Bright and New.Blink)) thenπ s := s + '0;'π elseπ if (not New.Bright) and (New.Blink) thenπ beginπ if Old.Bright thenπ s := s + '0;5;'π elseπ s := s + '5;';π endπ elseπ if (New.Bright) and (not New.Blink) thenπ beginπ if Old.Blink thenπ s := s + '0;1;'π elseπ s := s + '1;';π endπ elseπ beginπ if not Old.Bright thenπ s := s + '1;';π if not Old.Blink thenπ s := s + '5;';π end;π end;ππ if (Old.FG <> New.FG) or ((not New.Bright) and Old.Bright) orπ ((not New.Blink) and Old.Blink) thenπ beginπ {* I don't have no info why, but obviously backswitching to darkπ * colorset, what has to be done via ^[0m, must turn fg/bg colors toπ * 37/40. However, we can optimize still then a bit !-. *}π if not ( (New.FG=7) and ((not New.Bright) and Old.Bright) )π then s:=s+'3'+AnsiCols[New.FG]+';';π end;ππ if (Old.BG<>New.BG) or ((not New.Bright) and Old.Bright) orπ ((not New.Blink) and Old.Blink) thenπ beginπ if not ( (New.BG=0) and ((not New.Bright) and Old.Bright) )π then s:=s+'4'+AnsiCols[New.BG]+';';π end;ππ if s[length(s)]=';' then s[length(s)]:='m' else s:=s+'m';ππ if length(s)>length(ESC+'[m') then WriteAttr:=s;πend;ππBEGINπ Assign(F, filename);π Rewrite(F);ππ AnsiTmp.FG := Screen[1, 1].A and 15;π AnsiTmp.BG := Screen[1, 1].A SHR 4;π AnsiTmp.Blink := (AnsiTmp.BG AND 8) = 8;π AnsiTmp.Bright := (AnsiTmp.FG AND 8) = 8;π AnsiTmp.FG:=AnsiTmp.FG and 7;π AnsiTmp.BG:=AnsiTmp.BG and 7;ππ s:=Esc+'[2J'+Esc+'[0m'+ESC+'[';π if AnsiTmp.Bright then s:=s+'1;';π if AnsiTmp.Blink then s:=s+'5;';π s:=s+'3'+ansicols[AnsiTmp.FG]+';';π s:=s+'4'+ansicols[AnsiTmp.BG]+'m';ππ FOR Y := 1 TO 25 DOπ BEGINπ FOR X := 1 TO 80 DOπ BEGINπ AnsiLast:=AnsiTmp;ππ AnsiTmp.FG := Screen[Y, X].A AND 15;π AnsiTmp.BG := Screen[Y, X].A SHR 4;π AnsiTmp.Bright := (AnsiTmp.FG AND 8)<>0;π AnsiTmp.Blink := (AnsiTmp.BG AND 8)<>0;π AnsiTmp.FG:=AnsiTmp.FG and 7;π AnsiTmp.BG:=AnsiTmp.BG and 7;ππ s1:=WriteAttr(AnsiLast, AnsiTmp);π s1:=s1+Screen[Y, X].C;ππ IF (length(s+s1+ESC+'[s')) <= MaxCol then s:=s+s1 elseπ beginπ Write(F,s+ESC+'[s'+#13#10);π s:=ESC+'[u'+s1;π end;ππ END;π END;π Write(F, Esc+'[0;37;40m');π Close(F);πEND;πBEGINπ SaveANSI('test3.ans');πEND.π 26 01-27-9417:29ALL ROBERT LONG Direct ANSI write IMPORT 7 .g═W {πFrom: ROBERT LONGπSubj: Ansi Graphics - TP 6.0π---------------------------------------------------------------------------πJP>If anyone knows how to do Ansi Graphics in Turbo Pascal 6.0 any help would bπJP>appreciated. I'm writing a BBS Door a lot like Dungeons & Dragons and wantπJP>add some Ansi Graphics to it. Please HelpππI assume you mean you want to send ansi graphics to the local screen. Ifπso this routine works very well.ππYou can use this routine with or without the CRT unit. All output willπbe routed through the BIOS. You must have the ANSI.SYS driver loaded inπyour config.sys file.ππ}πprocedure awrite(c : byte);ππ beginπ asmπ mov ah,2;π mov dl,c;π int $21;π end;π end;ππ 27 01-27-9417:29ALL GREG ESTABROOKS ANSI Screen Dump IMPORT 20 .g└╩ {πFrom: GREG ESTABROOKSπSubj: ANS->BINπ---------------------------------------------------------------------------πDT> I'm looking for some kinda code which will convert an ANSI fileπDT> to a raw binary file (<-Or Something that can be directly written toπDT> the screen, without decoding). Something which converts an ansi file, sayπDT>24-255 lines to an array which holds <CHAR>,<ATTRIBUTE>,<CHAR>,ect..justπDT>like video memory. Can anybody help me out here?ππ Just feed the ansi into the CON and then dump the contents ofπ video memory to a file. Heres a demo of how to do it.ππ NOTE: this does not check file IO so if the file doesn't existπ it'll cause a runtime error.ππ Call it like this:π ANSDUMP AnsiFile DumpFileπ}π{***********************************************************************}πPROGRAM AnsiDump; { Dec 09/93, Greg Estabrooks. }πUSES CRT; { IMPORT Clrscr,Writeln }πVARπ Con, { File handle to the Console. }π InFile :TEXT; { File that contains ANSI info. }π OutFile:FILE; { File to send new info to. }π BuffStr:STRING; { Holds string read from Ansi File. }ππBEGINπ Clrscr; { Clear any screen clutter. }π Assign(InFile,ParamStr(1)); { Open Ansi File. }π Reset(InFile);π Assign(Con,''); { Assign Con to the Console. }π ReWrite(Con); { Set it for writing to. }π Assign(OutFile,ParamStr(2)); { Open file to send dump to. }π ReWrite(OutFile);π WHILE NOT Eof(InFile) DO { Loop through entire ansi file. }π BEGINπ Readln(InFile,BuffStr); { Read line from file. }π Writeln(Con,BuffStr); { Write line to console. }π END;π { Now block write entire contents of text}π { video memory to file. }π BlockWrite(OutFile,MEM[$B800:0000],4000);π Close(OutFile); { Close dump file. }π Close(Con);π Close(InFile); { Close ansi file. }π Readln;πEND.π 28 02-03-9409:14ALL BETATECH COMPUTING ANSI Color Strings IMPORT 376 .goº {*********************************************************}π{* ANSICOLR.PAS 1.0 *}π{* Copyright (c) φ ßETATech φ 1991. *}π{* All rights reserved. *}π{*********************************************************}π{ Wed 12-18-1991 v1.0 }π{ This unit is patterned after the TurboPower OPCOLOR }π{ unit. OPCOLOR allows the programmer to specify screen }π{ colors with easily rememberable names like "RedOnBlue". }π{ I wanted a way to specify the same type of color }π{ definitions, but have the ANSI escape sequence for that }π{ combination to be the output. Hopfully this unit will }π{ accomplish this task making ANSI colors easier for the }π{ programmer. }π{ }π{ The naming conventions of ANSICOLR are similar to that }π{ of OPCOLOR except that all names begin with a lower }π{ case "a" (ie. aRedOnBlack). This will return the ANSI }π{ escape code that will enable this color combination. }π{ All low intensity forground combinations start by }π{ setting the previous colors off, then define the new }π{ color set. To get a color set with the foreground set }π{ to blink, just preface the color combination with "ab" }π{ (ie. abRedOnBlue). Each low intensity color combination}π{ is 10 char., each high intensity color set is 12 char. }π{ and each blinking color set is 14 char. long. }π{ }π{ I retain the copyright for this unit, but release it for}π{ public use with no royalties required. You may use it }π{ in any program that it would be of assistance to you. }π{ In the same regard, I offer NO WARANTEE what so ever }π{ either express or implied. }π{ }π{ If you come up with enhancements or changes to this unit}π{ I would appreciate knowing about them as I would like to}π{ keep the unit up to date. I can be reached at the }π{ places listed below: }π{ }π{ ßETATech Computer Consulting The Paradigm BBS }π{ P. O. Box 566742 404/671-1581 }π{ Atlanta, GA 30356-6013 1200-19200 HST }π{*********************************************************}ππππUNIT AnsiColr;ππINTERFACEππCONSTππ aBlink : BYTE = 16;π π aSt : STRING [2] = #27'[';π aEnd : STRING [1] = 'm';π aDef : STRING [4] = #27'[0m';π π fgCol : ARRAY [0..31] OF STRING [8] =π ('0;30', '0;34', '0;32', '0;36',π '0;31', '0;35', '0;33', '0;37',π '0;1;30', '0;1;34', '0;1;32', '0;1;36', π '0;1;31', '0;1;35', '0;1;33', '0;1;37',π '0;5;30', '0;5;34', '0;5;32', '0;5;36',π '0;5;31', '0;5;35', '0;5;33', '0;5;37',π '0;1;5;30', '0;1;5;34', '0;1;5;32', '0;1;5;36', π '0;1;5;31', '0;1;5;35', '0;1;5;33', '0;1;5;37');ππ bgCol : ARRAY [0..7] OF STRING [4] =π (';40', ';44', ';42', ';46', ';41', ';45', ';43', ';47');ππTYPEπ Str14 = STRING [14];π ππππ {Black background}π FUNCTION aBlackOnBlack : Str14;π FUNCTION abBlackOnBlack : Str14;π FUNCTION aBlueOnBlack : Str14;π FUNCTION abBlueOnBlack : Str14;π FUNCTION aGreenOnBlack : Str14; π FUNCTION abGreenOnBlack : Str14; π FUNCTION aCyanOnBlack : Str14;π FUNCTION abCyanOnBlack : Str14;π FUNCTION aRedOnBlack : Str14; π FUNCTION abRedOnBlack : Str14; π FUNCTION aMagentaOnBlack : Str14; π FUNCTION abMagentaOnBlack : Str14; π FUNCTION aBrownOnBlack : Str14; π FUNCTION abBrownOnBlack : Str14; π FUNCTION aLtGrayOnBlack : Str14; π FUNCTION abLtGrayOnBlack : Str14; π FUNCTION aDkGrayOnBlack : Str14; π FUNCTION abDkGrayOnBlack : Str14; π FUNCTION aLtBlueOnBlack : Str14;π FUNCTION abLtBlueOnBlack : Str14;π FUNCTION aLtGreenOnBlack : Str14;π FUNCTION abLtGreenOnBlack : Str14;π FUNCTION aLtCyanOnBlack : Str14;π FUNCTION abLtCyanOnBlack : Str14;π FUNCTION aLtRedOnBlack : Str14; π FUNCTION abLtRedOnBlack : Str14; π FUNCTION aLtMagentaOnBlack : Str14; π FUNCTION abLtMagentaOnBlack : Str14; π FUNCTION aYellowOnBlack : Str14; π FUNCTION abYellowOnBlack : Str14; π FUNCTION aWhiteOnBlack : Str14; π FUNCTION abWhiteOnBlack : Str14; ππ {Blue background}π FUNCTION aBlackOnBlue : Str14; π FUNCTION abBlackOnBlue : Str14; π FUNCTION aBlueOnBlue : Str14; π FUNCTION abBlueOnBlue : Str14; π FUNCTION aGreenOnBlue : Str14; π FUNCTION abGreenOnBlue : Str14; π FUNCTION aCyanOnBlue : Str14; π FUNCTION abCyanOnBlue : Str14; π FUNCTION aRedOnBlue : Str14; π FUNCTION abRedOnBlue : Str14; π FUNCTION aMagentaOnBlue : Str14; π FUNCTION abMagentaOnBlue : Str14; π FUNCTION aBrownOnBlue : Str14; π FUNCTION abBrownOnBlue : Str14; π FUNCTION aLtGrayOnBlue : Str14; π FUNCTION abLtGrayOnBlue : Str14; π FUNCTION aDkGrayOnBlue : Str14; π FUNCTION abDkGrayOnBlue : Str14; π FUNCTION aLtBlueOnBlue : Str14; π FUNCTION abLtBlueOnBlue : Str14; π FUNCTION aLtGreenOnBlue : Str14; π FUNCTION abLtGreenOnBlue : Str14; π FUNCTION aLtCyanOnBlue : Str14; π FUNCTION abLtCyanOnBlue : Str14; π FUNCTION aLtRedOnBlue : Str14; π FUNCTION abLtRedOnBlue : Str14; π FUNCTION aLtMagentaOnBlue : Str14; π FUNCTION abLtMagentaOnBlue : Str14; π FUNCTION aYellowOnBlue : Str14; π FUNCTION abYellowOnBlue : Str14; π FUNCTION aWhiteOnBlue : Str14; π FUNCTION abWhiteOnBlue : Str14; ππ {Green background}π FUNCTION aBlackOnGreen : Str14; π FUNCTION abBlackOnGreen : Str14; π FUNCTION aBlueOnGreen : Str14; π FUNCTION abBlueOnGreen : Str14; π FUNCTION aGreenOnGreen : Str14; π FUNCTION abGreenOnGreen : Str14; π FUNCTION aCyanOnGreen : Str14; π FUNCTION abCyanOnGreen : Str14; π FUNCTION aRedOnGreen : Str14; π FUNCTION abRedOnGreen : Str14; π FUNCTION aMagentaOnGreen : Str14; π FUNCTION abMagentaOnGreen : Str14; π FUNCTION aBrownOnGreen : Str14; π FUNCTION abBrownOnGreen : Str14; π FUNCTION aLtGrayOnGreen : Str14; π FUNCTION abLtGrayOnGreen : Str14; π FUNCTION aDkGrayOnGreen : Str14; π FUNCTION abDkGrayOnGreen : Str14; π FUNCTION aLtBlueOnGreen : Str14; π FUNCTION abLtBlueOnGreen : Str14; π FUNCTION aLtGreenOnGreen : Str14; π FUNCTION abLtGreenOnGreen : Str14; π FUNCTION aLtCyanOnGreen : Str14; π FUNCTION abLtCyanOnGreen : Str14; π FUNCTION aLtRedOnGreen : Str14; π FUNCTION abLtRedOnGreen : Str14; π FUNCTION aLtMagentaOnGreen : Str14; π FUNCTION abLtMagentaOnGreen : Str14; π FUNCTION aYellowOnGreen : Str14; π FUNCTION abYellowOnGreen : Str14; π FUNCTION aWhiteOnGreen : Str14; π FUNCTION abWhiteOnGreen : Str14; ππ {Cyan background}π FUNCTION aBlackOnCyan : Str14; π FUNCTION abBlackOnCyan : Str14; π FUNCTION aBlueOnCyan : Str14; π FUNCTION abBlueOnCyan : Str14; π FUNCTION aGreenOnCyan : Str14; π FUNCTION abGreenOnCyan : Str14; π FUNCTION aCyanOnCyan : Str14; π FUNCTION abCyanOnCyan : Str14; π FUNCTION aRedOnCyan : Str14; π FUNCTION abRedOnCyan : Str14; π FUNCTION aMagentaOnCyan : Str14; π FUNCTION abMagentaOnCyan : Str14; π FUNCTION aBrownOnCyan : Str14; π FUNCTION abBrownOnCyan : Str14; π FUNCTION aLtGrayOnCyan : Str14; π FUNCTION abLtGrayOnCyan : Str14; π FUNCTION aDkGrayOnCyan : Str14; π FUNCTION abDkGrayOnCyan : Str14; π FUNCTION aLtBlueOnCyan : Str14; π FUNCTION abLtBlueOnCyan : Str14; π FUNCTION aLtGreenOnCyan : Str14; π FUNCTION abLtGreenOnCyan : Str14; π FUNCTION aLtCyanOnCyan : Str14; π FUNCTION abLtCyanOnCyan : Str14; π FUNCTION aLtRedOnCyan : Str14; π FUNCTION abLtRedOnCyan : Str14; π FUNCTION aLtMagentaOnCyan : Str14; π FUNCTION abLtMagentaOnCyan : Str14; π FUNCTION aYellowOnCyan : Str14; π FUNCTION abYellowOnCyan : Str14; π FUNCTION aWhiteOnCyan : Str14; π FUNCTION abWhiteOnCyan : Str14; ππ {Red background}π FUNCTION aBlackOnRed : Str14; π FUNCTION abBlackOnRed : Str14; π FUNCTION aBlueOnRed : Str14; π FUNCTION abBlueOnRed : Str14; π FUNCTION aGreenOnRed : Str14; π FUNCTION abGreenOnRed : Str14; π FUNCTION aCyanOnRed : Str14; π FUNCTION abCyanOnRed : Str14; π FUNCTION aRedOnRed : Str14; π FUNCTION abRedOnRed : Str14; π FUNCTION aMagentaOnRed : Str14; π FUNCTION abMagentaOnRed : Str14; π FUNCTION aBrownOnRed : Str14; π FUNCTION abBrownOnRed : Str14; π FUNCTION aLtGrayOnRed : Str14; π FUNCTION abLtGrayOnRed : Str14; π FUNCTION aDkGrayOnRed : Str14; π FUNCTION abDkGrayOnRed : Str14; π FUNCTION aLtBlueOnRed : Str14; π FUNCTION abLtBlueOnRed : Str14; π FUNCTION aLtGreenOnRed : Str14; π FUNCTION abLtGreenOnRed : Str14; π FUNCTION aLtCyanOnRed : Str14; π FUNCTION abLtCyanOnRed : Str14; π FUNCTION aLtRedOnRed : Str14; π FUNCTION abLtRedOnRed : Str14; π FUNCTION aLtMagentaOnRed : Str14; π FUNCTION abLtMagentaOnRed : Str14; π FUNCTION aYellowOnRed : Str14; π FUNCTION abYellowOnRed : Str14; π FUNCTION aWhiteOnRed : Str14; π FUNCTION abWhiteOnRed : Str14; ππ {Magenta background}π FUNCTION aBlackOnMagenta : Str14; π FUNCTION abBlackOnMagenta : Str14; π FUNCTION aBlueOnMagenta : Str14; π FUNCTION abBlueOnMagenta : Str14; π FUNCTION aGreenOnMagenta : Str14; π FUNCTION abGreenOnMagenta : Str14; π FUNCTION aCyanOnMagenta : Str14; π FUNCTION abCyanOnMagenta : Str14; π FUNCTION aRedOnMagenta : Str14; π FUNCTION abRedOnMagenta : Str14; π FUNCTION aMagentaOnMagenta : Str14; π FUNCTION abMagentaOnMagenta : Str14; π FUNCTION aBrownOnMagenta : Str14; π FUNCTION abBrownOnMagenta : Str14; π FUNCTION aLtGrayOnMagenta : Str14; π FUNCTION abLtGrayOnMagenta : Str14; π FUNCTION aDkGrayOnMagenta : Str14; π FUNCTION abDkGrayOnMagenta : Str14; π FUNCTION aLtBlueOnMagenta : Str14; π FUNCTION abLtBlueOnMagenta : Str14; π FUNCTION aLtGreenOnMagenta : Str14; π FUNCTION abLtGreenOnMagenta : Str14; π FUNCTION aLtCyanOnMagenta : Str14; π FUNCTION abLtCyanOnMagenta : Str14; π FUNCTION aLtRedOnMagenta : Str14; π FUNCTION abLtRedOnMagenta : Str14; π FUNCTION aLtMagentaOnMagenta : Str14; π FUNCTION abLtMagentaOnMagenta : Str14; π FUNCTION aYellowOnMagenta : Str14; π FUNCTION abYellowOnMagenta : Str14; π FUNCTION aWhiteOnMagenta : Str14; π FUNCTION abWhiteOnMagenta : Str14; ππ {Brown background}π FUNCTION aBlackOnBrown : Str14; π FUNCTION abBlackOnBrown : Str14; π FUNCTION aBlueOnBrown : Str14; π FUNCTION abBlueOnBrown : Str14; π FUNCTION aGreenOnBrown : Str14; π FUNCTION abGreenOnBrown : Str14; π FUNCTION aCyanOnBrown : Str14; π FUNCTION abCyanOnBrown : Str14; π FUNCTION aRedOnBrown : Str14; π FUNCTION abRedOnBrown : Str14; π FUNCTION aMagentaOnBrown : Str14; π FUNCTION abMagentaOnBrown : Str14; π FUNCTION aBrownOnBrown : Str14; π FUNCTION abBrownOnBrown : Str14; π FUNCTION aLtGrayOnBrown : Str14; π FUNCTION abLtGrayOnBrown : Str14; π FUNCTION aDkGrayOnBrown : Str14; π FUNCTION abDkGrayOnBrown : Str14; π FUNCTION aLtBlueOnBrown : Str14; π FUNCTION abLtBlueOnBrown : Str14; π FUNCTION aLtGreenOnBrown : Str14; π FUNCTION abLtGreenOnBrown : Str14; π FUNCTION aLtCyanOnBrown : Str14; π FUNCTION abLtCyanOnBrown : Str14; π FUNCTION aLtRedOnBrown : Str14; π FUNCTION abLtRedOnBrown : Str14; π FUNCTION aLtMagentaOnBrown : Str14; π FUNCTION abLtMagentaOnBrown : Str14; π FUNCTION aYellowOnBrown : Str14; π FUNCTION abYellowOnBrown : Str14; π FUNCTION aWhiteOnBrown : Str14; π FUNCTION abWhiteOnBrown : Str14; ππ {Light gray backgrouund}π FUNCTION aBlackOnLtGray : Str14; π FUNCTION abBlackOnLtGray : Str14; π FUNCTION aBlueOnLtGray : Str14; π FUNCTION abBlueOnLtGray : Str14; π FUNCTION aGreenOnLtGray : Str14; π FUNCTION abGreenOnLtGray : Str14; π FUNCTION aCyanOnLtGray : Str14; π FUNCTION abCyanOnLtGray : Str14; π FUNCTION aRedOnLtGray : Str14; π FUNCTION abRedOnLtGray : Str14; π FUNCTION aMagentaOnLtGray : Str14; π FUNCTION abMagentaOnLtGray : Str14; π FUNCTION aBrownOnLtGray : Str14; π FUNCTION abBrownOnLtGray : Str14; π FUNCTION aLtGrayOnLtGray : Str14; π FUNCTION abLtGrayOnLtGray : Str14; π FUNCTION aDkGrayOnLtGray : Str14; π FUNCTION abDkGrayOnLtGray : Str14; π FUNCTION aLtBlueOnLtGray : Str14; π FUNCTION abLtBlueOnLtGray : Str14; π FUNCTION aLtGreenOnLtGray : Str14; π FUNCTION abLtGreenOnLtGray : Str14; π FUNCTION aLtCyanOnLtGray : Str14; π FUNCTION abLtCyanOnLtGray : Str14; π FUNCTION aLtRedOnLtGray : Str14; π FUNCTION abLtRedOnLtGray : Str14; π FUNCTION aLtMagentaOnLtGray : Str14; π FUNCTION abLtMagentaOnLtGray : Str14; π FUNCTION aYellowOnLtGray : Str14; π FUNCTION abYellowOnLtGray : Str14; π FUNCTION aWhiteOnLtGray : Str14; π FUNCTION abWhiteOnLtGray : Str14; ππ {==========================================================================}ππIMPLEMENTATIONππCONSTππ{ Foreground and background color constants }ππ Black : BYTE = 0;π Blue : BYTE = 1;π Green : BYTE = 2;π Cyan : BYTE = 3;π Red : BYTE = 4;π Magenta : BYTE = 5;π Brown : BYTE = 6;π LightGray : BYTE = 7;ππ{ Foreground color constants }ππ DarkGray : BYTE = 8;π LightBlue : BYTE = 9;π LightGreen : BYTE = 10;π LightCyan : BYTE = 11;π LightRed : BYTE = 12;π LightMagenta : BYTE = 13;π Yellow : BYTE = 14;π White : BYTE = 15;ππππ FUNCTION MakeAnsiString (ForeG, BackG : BYTE) : Str14;π BEGINπ MakeAnsiString := aSt + fgCol [ForeG] + bgCol [BackG] + aEnd;π END;π πππ {Black background}π FUNCTION aBlackOnBlack : Str14;π BEGINπ aBlackOnBlack := MakeAnsiString (Black, Black);π END;π ππ FUNCTION abBlackOnBlack : Str14;π BEGINπ abBlackOnBlack := MakeAnsiString (Black + aBlink, Black);π END;π ππ FUNCTION aBlueOnBlack : Str14;π BEGINπ aBlueOnBlack := MakeAnsiString (Blue, Black);π END;π ππ FUNCTION abBlueOnBlack : Str14;π BEGINπ abBlueOnBlack := MakeAnsiString (Blue + aBlink, Black);π END;π ππ FUNCTION aGreenOnBlack : Str14; π BEGINπ aGreenOnBlack := MakeAnsiString (Green, Black);π END;π ππ FUNCTION abGreenOnBlack : Str14; π BEGINπ abGreenOnBlack := MakeAnsiString (Green + aBlink, Black);π END;π ππ FUNCTION aCyanOnBlack : Str14;π BEGINπ aCyanOnBlack := MakeAnsiString (Cyan, Black);π END;π ππ FUNCTION abCyanOnBlack : Str14;π BEGINπ abCyanOnBlack := MakeAnsiString (Cyan + aBlink, Black);π END;π ππ FUNCTION aRedOnBlack : Str14; π BEGINπ aRedOnBlack := MakeAnsiString (Red, Black);π END;π ππ FUNCTION abRedOnBlack : Str14; π BEGINπ abRedOnBlack := MakeAnsiString (Red + aBlink, Black);π END;π ππ FUNCTION aMagentaOnBlack : Str14; π BEGINπ aMagentaOnBlack := MakeAnsiString (Magenta, Black);π END;π ππ FUNCTION abMagentaOnBlack : Str14; π BEGINπ abMagentaOnBlack := MakeAnsiString (Magenta + aBlink, Black);π END;π ππ FUNCTION aBrownOnBlack : Str14;π BEGINπ aBrownOnBlack := MakeAnsiString (Brown, Black);π END;π ππ FUNCTION abBrownOnBlack : Str14; π BEGINπ abBrownOnBlack := MakeAnsiString (Brown + aBlink, Black);π END;π ππ FUNCTION aLtGrayOnBlack : Str14; π BEGINπ aLtGrayOnBlack := MakeAnsiString (LightGray, Black);π END;π ππ FUNCTION abLtGrayOnBlack : Str14; π BEGINπ abLtGrayOnBlack := MakeAnsiString (LightGray + aBlink, Black);π END;π ππ FUNCTION aDkGrayOnBlack : Str14; π BEGINπ aDkGrayOnBlack := MakeAnsiString (DarkGray, Black);π END;π ππ FUNCTION abDkGrayOnBlack : Str14; π BEGINπ abDkGrayOnBlack := MakeAnsiString (DarkGray + aBlink, Black);π END;π ππ FUNCTION aLtBlueOnBlack : Str14;π BEGINπ aLtBlueOnBlack := MakeAnsiString (LightBlue, Black);π END;π ππ FUNCTION abLtBlueOnBlack : Str14;π BEGINπ abLtBlueOnBlack := MakeAnsiString (LightBlue + aBlink, Black);π END;π ππ FUNCTION aLtGreenOnBlack : Str14;π BEGINπ aLtGreenOnBlack := MakeAnsiString (LightGreen, Black);π END;π ππ FUNCTION abLtGreenOnBlack : Str14;π BEGINπ abLtGreenOnBlack := MakeAnsiString (LightGreen + aBlink, Black);π END;π ππ FUNCTION aLtCyanOnBlack : Str14;π BEGINπ aLtCyanOnBlack := MakeAnsiString (LightCyan, Black);π END;π ππ FUNCTION abLtCyanOnBlack : Str14;π BEGINπ abLtCyanOnBlack := MakeAnsiString (LightCyan + aBlink, Black);π END;π ππ FUNCTION aLtRedOnBlack : Str14; π BEGINπ aLtRedOnBlack := MakeAnsiString (LightRed, Black);π END;π ππ FUNCTION abLtRedOnBlack : Str14; π BEGINπ abLtRedOnBlack := MakeAnsiString (LightRed + aBlink, Black);π END;π ππ FUNCTION aLtMagentaOnBlack : Str14; π BEGINπ aLtMagentaOnBlack := MakeAnsiString (LightMagenta, Black);π END;π ππ FUNCTION abLtMagentaOnBlack : Str14; π BEGINπ abLtMagentaOnBlack := MakeAnsiString (LightMagenta + aBlink, Black);π END;π ππ FUNCTION aYellowOnBlack : Str14; π BEGINπ aYellowOnBlack := MakeAnsiString (Yellow, Black);π END;π ππ FUNCTION abYellowOnBlack : Str14; π BEGINπ abYellowOnBlack := MakeAnsiString (Yellow + aBlink, Black);π END;π ππ FUNCTION aWhiteOnBlack : Str14; π BEGINπ aWhiteOnBlack := MakeAnsiString (White, Black);π END;π ππ FUNCTION abWhiteOnBlack : Str14; π BEGINπ abWhiteOnBlack := MakeAnsiString (White + aBlink, Black);π END;π πππ {Blue background}π FUNCTION aBlackOnBlue : Str14; π BEGINπ aBlackOnBlue := MakeAnsiString (Black, Blue);π END;π ππ FUNCTION abBlackOnBlue : Str14; π BEGINπ abBlackOnBlue := MakeAnsiString (Black + aBlink, Blue);π END;π ππ FUNCTION aBlueOnBlue : Str14; π BEGINπ aBlueOnBlue := MakeAnsiString (Blue, Blue);π END;π ππ FUNCTION abBlueOnBlue : Str14; π BEGINπ abBlueOnBlue := MakeAnsiString (Blue + aBlink, Blue);π END;π ππ FUNCTION aGreenOnBlue : Str14; π BEGINπ aGreenOnBlue := MakeAnsiString (Green, Blue);π END;π ππ FUNCTION abGreenOnBlue : Str14; π BEGINπ abGreenOnBlue := MakeAnsiString (Green + aBlink, Blue);π END;π ππ FUNCTION aCyanOnBlue : Str14; π BEGINπ aCyanOnBlue := MakeAnsiString (Cyan, Blue);π END;π ππ FUNCTION abCyanOnBlue : Str14; π BEGINπ abCyanOnBlue := MakeAnsiString (Cyan + aBlink, Blue);π END;π ππ FUNCTION aRedOnBlue : Str14; π BEGINπ aRedOnBlue := MakeAnsiString (Red, Blue);π END;π ππ FUNCTION abRedOnBlue : Str14; π BEGINπ abRedOnBlue := MakeAnsiString (Red + aBlink, Blue);π END;π ππ FUNCTION aMagentaOnBlue : Str14; π BEGINπ aMagentaOnBlue := MakeAnsiString (Magenta, Blue);π END;π ππ FUNCTION abMagentaOnBlue : Str14; π BEGINπ abMagentaOnBlue := MakeAnsiString (Magenta + aBlink, Blue);π END;π ππ FUNCTION aBrownOnBlue : Str14; π BEGINπ aBrownOnBlue := MakeAnsiString (Brown, Blue);π END;π ππ FUNCTION abBrownOnBlue : Str14; π BEGINπ abBrownOnBlue := MakeAnsiString (Brown + aBlink, Blue);π END;π ππ FUNCTION aLtGrayOnBlue : Str14; π BEGINπ aLtGrayOnBlue := MakeAnsiString (LightGray, Blue);π END;π ππ FUNCTION abLtGrayOnBlue : Str14; π BEGINπ abLtGrayOnBlue := MakeAnsiString (LightGray + aBlink, Blue);π END;π ππ FUNCTION aDkGrayOnBlue : Str14; π BEGINπ aDkGrayOnBlue := MakeAnsiString (DarkGray, Blue);π END;π ππ FUNCTION abDkGrayOnBlue : Str14; π BEGINπ abDkGrayOnBlue := MakeAnsiString (DarkGray + aBlink, Blue);π END;π ππ FUNCTION aLtBlueOnBlue : Str14; π BEGINπ aLtBlueOnBlue := MakeAnsiString (LightBlue, Blue);π END;π ππ FUNCTION abLtBlueOnBlue : Str14; π BEGINπ abLtBlueOnBlue := MakeAnsiString (LightBlue + aBlink, Blue);π END;π ππ FUNCTION aLtGreenOnBlue : Str14; π BEGINπ aLtGreenOnBlue := MakeAnsiString (LightGreen, Blue);π END;π ππ FUNCTION abLtGreenOnBlue : Str14; π BEGINπ abLtGreenOnBlue := MakeAnsiString (LightGreen + aBlink, Blue);π END;π ππ FUNCTION aLtCyanOnBlue : Str14; π BEGINπ aLtCyanOnBlue := MakeAnsiString (LightCyan, Blue);π END;π ππ FUNCTION abLtCyanOnBlue : Str14; π BEGINπ abLtCyanOnBlue := MakeAnsiString (LightCyan + aBlink, Blue);π END;π ππ FUNCTION aLtRedOnBlue : Str14; π BEGINπ aLtRedOnBlue := MakeAnsiString (LightRed, Blue);π END;π ππ FUNCTION abLtRedOnBlue : Str14; π BEGINπ abLtRedOnBlue := MakeAnsiString (LightRed + aBlink, Blue);π END;π ππ FUNCTION aLtMagentaOnBlue : Str14; π BEGINπ aLtMagentaOnBlue := MakeAnsiString (LightMagenta, Blue);π END;π ππ FUNCTION abLtMagentaOnBlue : Str14; π BEGINπ abLtMagentaOnBlue := MakeAnsiString (LightMagenta + aBlink, Blue);π END;π ππ FUNCTION aYellowOnBlue : Str14; π BEGINπ aYellowOnBlue := MakeAnsiString (Yellow, Blue);π END;π ππ FUNCTION abYellowOnBlue : Str14; π BEGINπ abYellowOnBlue := MakeAnsiString (Yellow + aBlink, Blue);π END;π ππ FUNCTION aWhiteOnBlue : Str14; π BEGINπ aWhiteOnBlue := MakeAnsiString (White, Blue);π END;π ππ FUNCTION abWhiteOnBlue : Str14; π BEGINπ abWhiteOnBlue := MakeAnsiString (White + aBlink, Blue);π END;π πππ {Green background}π FUNCTION aBlackOnGreen : Str14; π BEGINπ aBlackOnGreen := MakeAnsiString (Black, Green);π END;π ππ FUNCTION abBlackOnGreen : Str14; π BEGINπ abBlackOnGreen := MakeAnsiString (Black + aBlink, Green);π END;π ππ FUNCTION aBlueOnGreen : Str14; π BEGINπ aBlueOnGreen := MakeAnsiString (Blue, Green);π END;π ππ FUNCTION abBlueOnGreen : Str14; π BEGINπ abBlueOnGreen := MakeAnsiString (Blue + aBlink, Green);π END;π ππ FUNCTION aGreenOnGreen : Str14; π BEGINπ aGreenOnGreen := MakeAnsiString (Green, Green);π END;π ππ FUNCTION abGreenOnGreen : Str14; π BEGINπ abGreenOnGreen := MakeAnsiString (Green + aBlink, Green);π END;π ππ FUNCTION aCyanOnGreen : Str14; π BEGINπ aCyanOnGreen := MakeAnsiString (Cyan, Green);π END;π ππ FUNCTION abCyanOnGreen : Str14; π BEGINπ abCyanOnGreen := MakeAnsiString (Cyan + aBlink, Green);π END;π ππ FUNCTION aRedOnGreen : Str14; π BEGINπ aRedOnGreen := MakeAnsiString (Red, Green);π END;π ππ FUNCTION abRedOnGreen : Str14; π BEGINπ abRedOnGreen := MakeAnsiString (Red + aBlink, Green);π END;π ππ FUNCTION aMagentaOnGreen : Str14; π BEGINπ aMagentaOnGreen := MakeAnsiString (Magenta, Green);π END;π ππ FUNCTION abMagentaOnGreen : Str14; π BEGINπ abMagentaOnGreen := MakeAnsiString (Magenta + aBlink, Green);π END;π ππ FUNCTION aBrownOnGreen : Str14; π BEGINπ aBrownOnGreen := MakeAnsiString (Brown, Green);π END;π ππ FUNCTION abBrownOnGreen : Str14; π BEGINπ abBrownOnGreen := MakeAnsiString (Brown + aBlink, Green);π END;π ππ FUNCTION aLtGrayOnGreen : Str14; π BEGINπ aLtGrayOnGreen := MakeAnsiString (LightGray, Green);π END;π ππ FUNCTION abLtGrayOnGreen : Str14; π BEGINπ abLtGrayOnGreen := MakeAnsiString (LightGray + aBlink, Green);π END;π ππ FUNCTION aDkGrayOnGreen : Str14; π BEGINπ aDkGrayOnGreen := MakeAnsiString (DarkGray, Green);π END;π ππ FUNCTION abDkGrayOnGreen : Str14; π BEGINπ abDkGrayOnGreen := MakeAnsiString (DarkGray + aBlink, Green);π END;π ππ FUNCTION aLtBlueOnGreen : Str14; π BEGINπ aLtBlueOnGreen := MakeAnsiString (LightBlue, Green);π END;π ππ FUNCTION abLtBlueOnGreen : Str14; π BEGINπ abLtBlueOnGreen := MakeAnsiString (LightBlue + aBlink, Green);π END;π ππ FUNCTION aLtGreenOnGreen : Str14; π BEGINπ aLtGreenOnGreen := MakeAnsiString (LightGreen, Green);π END;π ππ FUNCTION abLtGreenOnGreen : Str14; π BEGINπ abLtGreenOnGreen := MakeAnsiString (LightGreen + aBlink, Green);π END;π ππ FUNCTION aLtCyanOnGreen : Str14; π BEGINπ aLtCyanOnGreen := MakeAnsiString (LightCyan, Green);π END;π ππ FUNCTION abLtCyanOnGreen : Str14; π BEGINπ abLtCyanOnGreen := MakeAnsiString (LightCyan + aBlink, Green);π END;π ππ FUNCTION aLtRedOnGreen : Str14; π BEGINπ aLtRedOnGreen := MakeAnsiString (LightRed, Green);π END;π ππ FUNCTION abLtRedOnGreen : Str14; π BEGINπ abLtRedOnGreen := MakeAnsiString (LightRed + aBlink, Green);π END;π ππ FUNCTION aLtMagentaOnGreen : Str14; π BEGINπ aLtMagentaOnGreen := MakeAnsiString (LightMagenta, Green);π END;π ππ FUNCTION abLtMagentaOnGreen : Str14; π BEGINπ abLtMagentaOnGreen := MakeAnsiString (LightMagenta + aBlink, Green);π END;π ππ FUNCTION aYellowOnGreen : Str14; π BEGINπ aYellowOnGreen := MakeAnsiString (Yellow, Green);π END;π ππ FUNCTION abYellowOnGreen : Str14; π BEGINπ abYellowOnGreen := MakeAnsiString (Yellow + aBlink, Green);π END;π ππ FUNCTION aWhiteOnGreen : Str14; π BEGINπ aWhiteOnGreen := MakeAnsiString (White, Green);π END;π ππ FUNCTION abWhiteOnGreen : Str14; π BEGINπ abWhiteOnGreen := MakeAnsiString (White + aBlink, Green);π END;π πππ {Cyan background}π FUNCTION aBlackOnCyan : Str14; π BEGINπ aBlackOnCyan := MakeAnsiString (Black, Cyan);π END;π ππ FUNCTION abBlackOnCyan : Str14; π BEGINπ abBlackOnCyan := MakeAnsiString (Black + aBlink, Cyan);π END;π ππ FUNCTION aBlueOnCyan : Str14; π BEGINπ aBlueOnCyan := MakeAnsiString (Blue, Cyan);π END;π ππ FUNCTION abBlueOnCyan : Str14; π BEGINπ abBlueOnCyan := MakeAnsiString (Blue + aBlink, Cyan);π END;π ππ FUNCTION aGreenOnCyan : Str14; π BEGINπ aGreenOnCyan := MakeAnsiString (Green, Cyan);π END;π ππ FUNCTION abGreenOnCyan : Str14; π BEGINπ abGreenOnCyan := MakeAnsiString (Green + aBlink, Cyan);π END;π ππ FUNCTION aCyanOnCyan : Str14; π BEGINπ aCyanOnCyan := MakeAnsiString (Cyan, Cyan);π END;π ππ FUNCTION abCyanOnCyan : Str14; π BEGINπ abCyanOnCyan := MakeAnsiString (Cyan + aBlink, Cyan);π END;π ππ FUNCTION aRedOnCyan : Str14; π BEGINπ aRedOnCyan := MakeAnsiString (Red, Cyan);π END;π ππ FUNCTION abRedOnCyan : Str14; π BEGINπ abRedOnCyan := MakeAnsiString (Red + aBlink, Cyan);π END;π ππ FUNCTION aMagentaOnCyan : Str14; π BEGINπ aMagentaOnCyan := MakeAnsiString (Magenta, Cyan);π END;π ππ FUNCTION abMagentaOnCyan : Str14; π BEGINπ abMagentaOnCyan := MakeAnsiString (Magenta + aBlink, Cyan);π END;π ππ FUNCTION aBrownOnCyan : Str14; π BEGINπ aBrownOnCyan := MakeAnsiString (Brown, Cyan);π END;π ππ FUNCTION abBrownOnCyan : Str14; π BEGINπ abBrownOnCyan := MakeAnsiString (Brown + aBlink, Cyan);π END;π ππ FUNCTION aLtGrayOnCyan : Str14; π BEGINπ aLtGrayOnCyan := MakeAnsiString (LightGray, Cyan);π END;π ππ FUNCTION abLtGrayOnCyan : Str14; π BEGINπ abLtGrayOnCyan := MakeAnsiString (LightGray + aBlink, Cyan);π END;π ππ FUNCTION aDkGrayOnCyan : Str14; π BEGINπ aDkGrayOnCyan := MakeAnsiString (DarkGray, Cyan);π END;π ππ FUNCTION abDkGrayOnCyan : Str14; π BEGINπ abDkGrayOnCyan := MakeAnsiString (DarkGray + aBlink, Cyan);π END;π ππ FUNCTION aLtBlueOnCyan : Str14; π BEGINπ aLtBlueOnCyan := MakeAnsiString (LightBlue, Cyan);π END;π ππ FUNCTION abLtBlueOnCyan : Str14; π BEGINπ abLtBlueOnCyan := MakeAnsiString (LightBlue + aBlink, Cyan);π END;π ππ FUNCTION aLtGreenOnCyan : Str14; π BEGINπ aLtGreenOnCyan := MakeAnsiString (LightGreen, Cyan);π END;π ππ FUNCTION abLtGreenOnCyan : Str14; π BEGINπ abLtGreenOnCyan := MakeAnsiString (LightGreen + aBlink, Cyan);π END;π ππ FUNCTION aLtCyanOnCyan : Str14; π BEGINπ aLtCyanOnCyan := MakeAnsiString (LightCyan, Cyan);π END;π ππ FUNCTION abLtCyanOnCyan : Str14; π BEGINπ abLtCyanOnCyan := MakeAnsiString (LightCyan + aBlink, Cyan);π END;π ππ FUNCTION aLtRedOnCyan : Str14; π BEGINπ aLtRedOnCyan := MakeAnsiString (LightRed, Cyan);π END;π ππ FUNCTION abLtRedOnCyan : Str14; π BEGINπ abLtRedOnCyan := MakeAnsiString (LightRed + aBlink, Cyan);π END;π ππ FUNCTION aLtMagentaOnCyan : Str14; π BEGINπ aLtMagentaOnCyan := MakeAnsiString (LightMagenta, Cyan);π END;π ππ FUNCTION abLtMagentaOnCyan : Str14; π BEGINπ abLtMagentaOnCyan := MakeAnsiString (LightMagenta + aBlink, Cyan);π END;π ππ FUNCTION aYellowOnCyan : Str14; π BEGINπ aYellowOnCyan := MakeAnsiString (Yellow, Cyan);π END;π ππ FUNCTION abYellowOnCyan : Str14; π BEGINπ abYellowOnCyan := MakeAnsiString (Yellow + aBlink, Cyan);π END;π ππ FUNCTION aWhiteOnCyan : Str14; π BEGINπ aWhiteOnCyan := MakeAnsiString (White, Cyan);π END;π ππ FUNCTION abWhiteOnCyan : Str14; π BEGINπ abWhiteOnCyan := MakeAnsiString (White + aBlink, Cyan);π END;π πππ {Red background}π FUNCTION aBlackOnRed : Str14; π BEGINπ aBlackOnRed := MakeAnsiString (Black, Red);π END;π ππ FUNCTION abBlackOnRed : Str14; π BEGINπ abBlackOnRed := MakeAnsiString (Black + aBlink, Red);π END;π ππ FUNCTION aBlueOnRed : Str14; π BEGINπ aBlueOnRed := MakeAnsiString (Blue, Red);π END;π ππ FUNCTION abBlueOnRed : Str14; π BEGINπ abBlueOnRed := MakeAnsiString (Blue + aBlink, Red);π END;π ππ FUNCTION aGreenOnRed : Str14; π BEGINπ aGreenOnRed := MakeAnsiString (Green, Red);π END;π ππ FUNCTION abGreenOnRed : Str14; π BEGINπ abGreenOnRed := MakeAnsiString (Green + aBlink, Red);π END;π ππ FUNCTION aCyanOnRed : Str14; π BEGINπ aCyanOnRed := MakeAnsiString (Cyan, Red);π END;π ππ FUNCTION abCyanOnRed : Str14; π BEGINπ abCyanOnRed := MakeAnsiString (Cyan + aBlink, Red);π END;π ππ FUNCTION aRedOnRed : Str14; π BEGINπ aRedOnRed := MakeAnsiString (Red, Red);π END;π ππ FUNCTION abRedOnRed : Str14; π BEGINπ abRedOnRed := MakeAnsiString (Red + aBlink, Red);π END;π ππ FUNCTION aMagentaOnRed : Str14; π BEGINπ aMagentaOnRed := MakeAnsiString (Magenta, Red);π END;π ππ FUNCTION abMagentaOnRed : Str14; π BEGINπ abMagentaOnRed := MakeAnsiString (Magenta + aBlink, Red);π END;π ππ FUNCTION aBrownOnRed : Str14; π BEGINπ aBrownOnRed := MakeAnsiString (Brown, Red);π END;π ππ FUNCTION abBrownOnRed : Str14; π BEGINπ abBrownOnRed := MakeAnsiString (Brown + aBlink, Red);π END;π ππ FUNCTION aLtGrayOnRed : Str14; π BEGINπ aLtGrayOnRed := MakeAnsiString (LightGray, Red);π END;π ππ FUNCTION abLtGrayOnRed : Str14; π BEGINπ abLtGrayOnRed := MakeAnsiString (LightGray + aBlink, Red);π END;π ππ FUNCTION aDkGrayOnRed : Str14; π BEGINπ aDkGrayOnRed := MakeAnsiString (DarkGray, Red);π END;π ππ FUNCTION abDkGrayOnRed : Str14; π BEGINπ abDkGrayOnRed := MakeAnsiString (DarkGray + aBlink, Red);π END;π ππ FUNCTION aLtBlueOnRed : Str14; π BEGINπ aLtBlueOnRed := MakeAnsiString (LightBlue, Red);π END;π ππ FUNCTION abLtBlueOnRed : Str14; π BEGINπ abLtBlueOnRed := MakeAnsiString (LightBlue + aBlink, Red);π END;π ππ FUNCTION aLtGreenOnRed : Str14; π BEGINπ aLtGreenOnRed := MakeAnsiString (LightGreen, Red);π END;π ππ FUNCTION abLtGreenOnRed : Str14; π BEGINπ abLtGreenOnRed := MakeAnsiString (LightGreen + aBlink, Red);π END;π ππ FUNCTION aLtCyanOnRed : Str14; π BEGINπ aLtCyanOnRed := MakeAnsiString (LightCyan, Red);π END;π ππ FUNCTION abLtCyanOnRed : Str14; π BEGINπ abLtCyanOnRed := MakeAnsiString (LightCyan + aBlink, Red);π END;π ππ FUNCTION aLtRedOnRed : Str14; π BEGINπ aLtRedOnRed := MakeAnsiString (LightRed, Red);π END;π ππ FUNCTION abLtRedOnRed : Str14; π BEGINπ abLtRedOnRed := MakeAnsiString (LightRed + aBlink, Red);π END;π ππ FUNCTION aLtMagentaOnRed : Str14; π BEGINπ aLtMagentaOnRed := MakeAnsiString (LightMagenta, Red);π END;π ππ FUNCTION abLtMagentaOnRed : Str14; π BEGINπ abLtMagentaOnRed := MakeAnsiString (LightMagenta + aBlink, Red);π END;π ππ FUNCTION aYellowOnRed : Str14; π BEGINπ aYellowOnRed := MakeAnsiString (Yellow, Red);π END;π ππ FUNCTION abYellowOnRed : Str14; π BEGINπ abYellowOnRed := MakeAnsiString (Yellow + aBlink, Red);π END;π ππ FUNCTION aWhiteOnRed : Str14; π BEGINπ aWhiteOnRed := MakeAnsiString (White, Red);π END;π ππ FUNCTION abWhiteOnRed : Str14; π BEGINπ abWhiteOnRed := MakeAnsiString (White + aBlink, Red);π END;π πππ {Magenta background}π FUNCTION aBlackOnMagenta : Str14; π BEGINπ aBlackOnMagenta := MakeAnsiString (Black, Magenta);π END;π ππ FUNCTION abBlackOnMagenta : Str14; π BEGINπ abBlackOnMagenta := MakeAnsiString (Black + aBlink, Magenta);π END;π ππ FUNCTION aBlueOnMagenta : Str14; π BEGINπ aBlueOnMagenta := MakeAnsiString (Blue, Magenta);π END;π ππ FUNCTION abBlueOnMagenta : Str14; π BEGINπ abBlueOnMagenta := MakeAnsiString (Blue + aBlink, Magenta);π END;π ππ FUNCTION aGreenOnMagenta : Str14; π BEGINπ aGreenOnMagenta := MakeAnsiString (Green, Magenta);π END;π ππ FUNCTION abGreenOnMagenta : Str14; π BEGINπ abGreenOnMagenta := MakeAnsiString (Green + aBlink, Magenta);π END;π ππ FUNCTION aCyanOnMagenta : Str14; π BEGINπ aCyanOnMagenta := MakeAnsiString (Cyan, Magenta);π END;π ππ FUNCTION abCyanOnMagenta : Str14; π BEGINπ abCyanOnMagenta := MakeAnsiString (Cyan + aBlink, Magenta);π END;π ππ FUNCTION aRedOnMagenta : Str14; π BEGINπ aRedOnMagenta := MakeAnsiString (Red, Magenta);π END;π ππ FUNCTION abRedOnMagenta : Str14; π BEGINπ abRedOnMagenta := MakeAnsiString (Red + aBlink, Magenta);π END;π ππ FUNCTION aMagentaOnMagenta : Str14; π BEGINπ aMagentaOnMagenta := MakeAnsiString (Magenta, Magenta);π END;π ππ FUNCTION abMagentaOnMagenta : Str14; π BEGINπ abMagentaOnMagenta := MakeAnsiString (Magenta + aBlink, Magenta);π END;π ππ FUNCTION aBrownOnMagenta : Str14; π BEGINπ aBrownOnMagenta := MakeAnsiString (Brown, Magenta);π END;π ππ FUNCTION abBrownOnMagenta : Str14; π BEGINπ abBrownOnMagenta := MakeAnsiString (Brown + aBlink, Magenta);π END;π ππ FUNCTION aLtGrayOnMagenta : Str14; π BEGINπ aLtGrayOnMagenta := MakeAnsiString (LightGray, Magenta);π END;π ππ FUNCTION abLtGrayOnMagenta : Str14; π BEGINπ abLtGrayOnMagenta := MakeAnsiString (LightGray + aBlink, Magenta);π END;π ππ FUNCTION aDkGrayOnMagenta : Str14; π BEGINπ aDkGrayOnMagenta := MakeAnsiString (DarkGray, Magenta);π END;π ππ FUNCTION abDkGrayOnMagenta : Str14; π BEGINπ abDkGrayOnMagenta := MakeAnsiString (DarkGray + aBlink, Magenta);π END;π ππ FUNCTION aLtBlueOnMagenta : Str14; π BEGINπ aLtBlueOnMagenta := MakeAnsiString (LightBlue, Magenta);π END;π ππ FUNCTION abLtBlueOnMagenta : Str14; π BEGINπ abLtBlueOnMagenta := MakeAnsiString (LightBlue + aBlink, Magenta);π END;π ππ FUNCTION aLtGreenOnMagenta : Str14; π BEGINπ aLtGreenOnMagenta := MakeAnsiString (LightGreen, Magenta);π END;π ππ FUNCTION abLtGreenOnMagenta : Str14; π BEGINπ abLtGreenOnMagenta := MakeAnsiString (LightGreen + aBlink, Magenta);π END;π ππ FUNCTION aLtCyanOnMagenta : Str14; π BEGINπ aLtCyanOnMagenta := MakeAnsiString (LightCyan, Magenta);π END;π ππ FUNCTION abLtCyanOnMagenta : Str14; π BEGINπ abLtCyanOnMagenta := MakeAnsiString (Lightcyan + aBlink, Magenta);π END;π ππ FUNCTION aLtRedOnMagenta : Str14; π BEGINπ aLtRedOnMagenta := MakeAnsiString (LightRed, Magenta);π END;π ππ FUNCTION abLtRedOnMagenta : Str14; π BEGINπ abLtRedOnMagenta := MakeAnsiString (LightRed + aBlink, Magenta);π END;π ππ FUNCTION aLtMagentaOnMagenta : Str14; π BEGINπ aLtMagentaOnMagenta := MakeAnsiString (LightMagenta, Magenta);π END;π ππ FUNCTION abLtMagentaOnMagenta : Str14; π BEGINπ abLtMagentaOnMagenta := MakeAnsiString (LightMagenta + aBlink, Magenta);π END;π ππ FUNCTION aYellowOnMagenta : Str14; π BEGINπ aYellowOnMagenta := MakeAnsiString (Yellow, Magenta);π END;π ππ FUNCTION abYellowOnMagenta : Str14; π BEGINπ abYellowOnMagenta := MakeAnsiString (Yellow + aBlink, Magenta);π END;π ππ FUNCTION aWhiteOnMagenta : Str14; π BEGINπ aWhiteOnMagenta := MakeAnsiString (White, Magenta);π END;π ππ FUNCTION abWhiteOnMagenta : Str14; π BEGINπ abWhiteOnMagenta := MakeAnsiString (White + aBlink, Magenta);π END;π πππ {Brown background}π FUNCTION aBlackOnBrown : Str14; π BEGINπ aBlackOnBrown := MakeAnsiString (Black, Brown);π END;π ππ FUNCTION abBlackOnBrown : Str14; π BEGINπ abBlackOnBrown := MakeAnsiString (Black + aBlink, Brown);π END;π ππ FUNCTION aBlueOnBrown : Str14; π BEGINπ aBlueOnBrown := MakeAnsiString (Blue, Brown);π END;π ππ FUNCTION abBlueOnBrown : Str14; π BEGINπ abBlueOnBrown := MakeAnsiString (Blue + aBlink, Brown);π END;π ππ FUNCTION aGreenOnBrown : Str14; π BEGINπ aGreenOnBrown := MakeAnsiString (Green, Brown);π END;π ππ FUNCTION abGreenOnBrown : Str14; π BEGINπ abGreenOnBrown := MakeAnsiString (Green + aBlink, Brown);π END;π ππ FUNCTION aCyanOnBrown : Str14; π BEGINπ aCyanOnBrown := MakeAnsiString (Cyan, Brown);π END;π ππ FUNCTION abCyanOnBrown : Str14; π BEGINπ abCyanOnBrown := MakeAnsiString (Cyan + aBlink, Brown);π END;π ππ FUNCTION aRedOnBrown : Str14; π BEGINπ aRedOnBrown := MakeAnsiString (Red, Brown);π END;π ππ FUNCTION abRedOnBrown : Str14; π BEGINπ abRedOnBrown := MakeAnsiString (Red + aBlink, Brown);π END;π ππ FUNCTION aMagentaOnBrown : Str14; π BEGINπ aMagentaOnBrown := MakeAnsiString (Magenta, Brown);π END;π ππ FUNCTION abMagentaOnBrown : Str14; π BEGINπ abMagentaOnBrown := MakeAnsiString (Magenta + aBlink, Brown);π END;π ππ FUNCTION aBrownOnBrown : Str14; π BEGINπ aBrownOnBrown := MakeAnsiString (Brown, Brown);π END;π ππ FUNCTION abBrownOnBrown : Str14; π BEGINπ abBrownOnBrown := MakeAnsiString (Brown + aBlink, Brown);π END;π ππ FUNCTION aLtGrayOnBrown : Str14; π BEGINπ aLtGrayOnBrown := MakeAnsiString (LightGray, Brown);π END;π ππ FUNCTION abLtGrayOnBrown : Str14; π BEGINπ abLtGrayOnBrown := MakeAnsiString (LightGray + aBlink, Brown);π END;π ππ FUNCTION aDkGrayOnBrown : Str14; π BEGINπ aDkGrayOnBrown := MakeAnsiString (DarkGray, Brown);π END;π ππ FUNCTION abDkGrayOnBrown : Str14; π BEGINπ abDkGrayOnBrown := MakeAnsiString (DarkGray + aBlink, Brown);π END;π ππ FUNCTION aLtBlueOnBrown : Str14; π BEGINπ aLtBlueOnBrown := MakeAnsiString (LightBlue, Brown);π END;π ππ FUNCTION abLtBlueOnBrown : Str14; π BEGINπ abLtBlueOnBrown := MakeAnsiString (LightBlue + aBlink, Brown);π END;π ππ FUNCTION aLtGreenOnBrown : Str14; π BEGINπ aLtGreenOnBrown := MakeAnsiString (LightGreen, Brown);π END;π ππ FUNCTION abLtGreenOnBrown : Str14; π BEGINπ abLtGreenOnBrown := MakeAnsiString (LightGreen + aBlink, Brown);π END;π ππ FUNCTION aLtCyanOnBrown : Str14; π BEGINπ aLtCyanOnBrown := MakeAnsiString (LightCyan, Brown);π END;π ππ FUNCTION abLtCyanOnBrown : Str14; π BEGINπ abLtCyanOnBrown := MakeAnsiString (LightCyan + aBlink, Brown);π END;π ππ FUNCTION aLtRedOnBrown : Str14; π BEGINπ aLtRedOnBrown := MakeAnsiString (LightRed, Brown);π END;π ππ FUNCTION abLtRedOnBrown : Str14; π BEGINπ abLtRedOnBrown := MakeAnsiString (LightRed + aBlink, Brown);π END;π ππ FUNCTION aLtMagentaOnBrown : Str14; π BEGINπ aLtMagentaOnBrown := MakeAnsiString (LightMagenta, Brown);π END;π ππ FUNCTION abLtMagentaOnBrown : Str14; π BEGINπ abLtMagentaOnBrown := MakeAnsiString (LightMagenta + aBlink, Brown);π END;π ππ FUNCTION aYellowOnBrown : Str14; π BEGINπ aYellowOnBrown := MakeAnsiString (Yellow, Brown);π END;π ππ FUNCTION abYellowOnBrown : Str14; π BEGINπ abYellowOnBrown := MakeAnsiString (Yellow + aBlink, Brown);π END;π ππ FUNCTION aWhiteOnBrown : Str14; π BEGINπ aWhiteOnBrown := MakeAnsiString (White, Brown);π END;π ππ FUNCTION abWhiteOnBrown : Str14; π BEGINπ abWhiteOnBrown := MakeAnsiString (White + aBlink, Brown);π END;π πππ {Light gray backgrouund}π FUNCTION aBlackOnLtGray : Str14; π BEGINπ aBlackOnLtGray := MakeAnsiString (Black, LightGray);π END;π ππ FUNCTION abBlackOnLtGray : Str14; π BEGINπ abBlackOnLtGray := MakeAnsiString (Black + aBlink, LightGray);π END;π ππ FUNCTION aBlueOnLtGray : Str14; π BEGINπ aBlueOnLtGray := MakeAnsiString (Blue, LightGray);π END;π ππ FUNCTION abBlueOnLtGray : Str14; π BEGINπ abBlueOnLtGray := MakeAnsiString (Blue + aBlink, LightGray);π END;π ππ FUNCTION aGreenOnLtGray : Str14; π BEGINπ aGreenOnLtGray := MakeAnsiString (Green, LightGray);π END;π ππ FUNCTION abGreenOnLtGray : Str14; π BEGINπ abGreenOnLtGray := MakeAnsiString (Green + aBlink, LightGray);π END;π ππ FUNCTION aCyanOnLtGray : Str14; π BEGINπ aCyanOnLtGray := MakeAnsiString (Cyan, LightGray);π END;π ππ FUNCTION abCyanOnLtGray : Str14; π BEGINπ abCyanOnLtGray := MakeAnsiString (Cyan + aBlink, LightGray);π END;π ππ FUNCTION aRedOnLtGray : Str14; π BEGINπ aRedOnLtGray := MakeAnsiString (Red, LightGray);π END;π ππ FUNCTION abRedOnLtGray : Str14; π BEGINπ abRedOnLtGray := MakeAnsiString (Red + aBlink, LightGray);π END;π ππ FUNCTION aMagentaOnLtGray : Str14; π BEGINπ aMagentaOnLtGray := MakeAnsiString (Magenta, LightGray);π END;π ππ FUNCTION abMagentaOnLtGray : Str14; π BEGINπ abMagentaOnLtGray := MakeAnsiString (Magenta + aBlink, LightGray);π END;π ππ FUNCTION aBrownOnLtGray : Str14; π BEGINπ aBrownOnLtGray := MakeAnsiString (Brown, LightGray);π END;π ππ FUNCTION abBrownOnLtGray : Str14; π BEGINπ abBrownOnLtGray := MakeAnsiString (Brown + aBlink, LightGray);π END;π ππ FUNCTION aLtGrayOnLtGray : Str14; π BEGINπ aLtGrayOnLtGray := MakeAnsiString (LightGray, LightGray);π END;π ππ FUNCTION abLtGrayOnLtGray : Str14; π BEGINπ abLtGrayOnLtGray := MakeAnsiString (LightGray + aBlink, LightGray);π END;π ππ FUNCTION aDkGrayOnLtGray : Str14; π BEGINπ aDkGrayOnLtGray := MakeAnsiString (DarkGray, LightGray);π END;π ππ FUNCTION abDkGrayOnLtGray : Str14; π BEGINπ abDkGrayOnLtGray := MakeAnsiString (DarkGray + aBlink, LightGray);π END;π ππ FUNCTION aLtBlueOnLtGray : Str14; π BEGINπ aLtBlueOnLtGray := MakeAnsiString (LightBlue, LightGray);π END;π ππ FUNCTION abLtBlueOnLtGray : Str14; π BEGINπ abLtBlueOnLtGray := MakeAnsiString (LightBlue + aBlink, LightGray);π END;π ππ FUNCTION aLtGreenOnLtGray : Str14; π BEGINπ aLtGreenOnLtGray := MakeAnsiString (LightGreen, LightGray);π END;π ππ FUNCTION abLtGreenOnLtGray : Str14; π BEGINπ abLtGreenOnLtGray := MakeAnsiString (LightGreen + aBlink, LightGray);π END;π ππ FUNCTION aLtCyanOnLtGray : Str14; π BEGINπ aLtCyanOnLtGray := MakeAnsiString (LightCyan, LightGray);π END;π ππ FUNCTION abLtCyanOnLtGray : Str14; π BEGINπ abLtCyanOnLtGray := MakeAnsiString (LightCyan + aBlink, LightGray);π END;π ππ FUNCTION aLtRedOnLtGray : Str14; π BEGINπ aLtRedOnLtGray := MakeAnsiString (LightRed, LightGray);π END;π ππ FUNCTION abLtRedOnLtGray : Str14; π BEGINπ abLtRedOnLtGray := MakeAnsiString (LightRed + aBlink, LightGray);π END;π ππ FUNCTION aLtMagentaOnLtGray : Str14; π BEGINπ aLtMagentaOnLtGray := MakeAnsiString (LightMagenta, LightGray);π END;π ππ FUNCTION abLtMagentaOnLtGray : Str14; π BEGINπ abLtMagentaOnLtGray := MakeAnsiString (LightMagenta + aBlink, LightGray);π END;π ππ FUNCTION aYellowOnLtGray : Str14; π BEGINπ aYellowOnLtGray := MakeAnsiString (Yellow, LightGray);π END;π ππ FUNCTION abYellowOnLtGray : Str14; π BEGINπ abYellowOnLtGray := MakeAnsiString (Yellow + aBlink, LightGray);π END;π ππ FUNCTION aWhiteOnLtGray : Str14; π BEGINπ aWhiteOnLtGray := MakeAnsiString (White, LightGray);π END;π ππ FUNCTION abWhiteOnLtGray : Str14; π BEGINπ abWhiteOnLtGray := MakeAnsiString (White + aBlink, LightGray);π END;π ππππBEGINπEND.π 29 02-03-9409:15ALL GAYLE DAVIS Full ANSI Output unit IMPORT 189 .g─╔ π{ A unit to implement FULL ANSI output. Useful for a BBS or DOOR programπ where you would want to send string out over the modem. Simply callπ your modem routine to :ππ SENDSTRING(port,ANSIGoToXY(1,1))ππ Would reposition the cursor on the remote terminal. Get the idea ??ππ The thing will EVEN play ANSI music !!ππ Gayle Davis 1/24/94ππππ}ππUNIT AnsiIO;ππINTERFACEππ USESπ CRT,π Graph3;ππ FUNCTION ANSIClrScr : string;π FUNCTION ANSIClrEol : string;π FUNCTION ANSIGotoXY(X, Y : word) : string;π FUNCTION ANSIUp(Lines : word) : string;π FUNCTION ANSIDown(Lines : word) : string;π FUNCTION ANSIRight(Cols : word) : string;π FUNCTION ANSILeft(Cols : word) : string;π FUNCTION ANSIColor(Fg, Bg : integer) : string;π FUNCTION ANSIMusic(s : string) : string;π PROCEDURE ANSIWrite(s : string);π PROCEDURE ANSIWriteLn(s : string);ππIMPLEMENTATIONππ CONSTπ ColorArray : array[0..7] of integer = (0,4,2,6,1,5,3,7);ππ VARπ Bold, TruncateLines : boolean;π Vari, Octave, Numb : integer;π Test, Dly, Intern, DlyKeep : longInt;π Flager, ChartoPlay : char;π Typom, Min1, Adder : real;ππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code for a Clear Screen. ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIClrScr : string;π BEGINπ ANSIClrScr := #27+'[2J';π END;ππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code for a Clear to End of Line. ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIClrEol : string;π BEGINπ ANSIClrEol := #27+'[K';π END;ππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code to move the cursor to (X,Y). ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIGotoXY(X, Y : word) : string;π VARπ XStr, YStr : string;ππ BEGINπ str(X,XStr);π str(Y,YStr);π ANSIGotoXY := #27+'['+YStr+';'+XStr+'H';π END;ππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code to move the cursor up "Lines" ***}π{*** number of lines. ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIUp(Lines : word) : string;π VARπ LinesStr : string;ππ BEGINπ str(Lines,LinesStr);π ANSIUp := #27+'['+LinesStr+'A';π END;ππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code to move the cursor down "Lines" ***}π{*** number of lines. ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIDown(Lines : word) : string;π VARπ LinesStr : string;ππ BEGINπ str(Lines,LinesStr);π ANSIDown := #27+'['+LinesStr+'B';π END;ππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code to move the cursor "Cols" ***}π{*** positions forward. ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIRight(Cols : word) : string;π VARπ ColsStr : string;ππ BEGINπ str(Cols,ColsStr);π ANSIRight := #27+'['+ColsStr+'C';π END;ππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code to move the cursor "Cols" ***}π{*** positions backward. ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSILeft(Cols : word) : string;π VARπ ColsStr : string;ππ BEGINπ str(Cols,ColsStr);π ANSILeft := #27+'['+ColsStr+'D';π END;πππ{****************************************************************************}π{*** ***}π{*** Function that returns the ANSI code to change the screen color ***}π{*** to an "Fg" foreground and a "Bg" background. ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIColor(Fg, Bg : integer) : string;π VARπ FgStr, BgStr, Temp : string;ππ BEGINπ str(ColorArray[Fg mod 8] + 30, FgStr);π str(ColorArray[Bg mod 8] + 40, BgStr);π Temp := #27+'[';π if Bg > 7 thenπ Temp := Temp+'5;'π elseπ Temp := Temp+'0;';π if Fg > 7 thenπ Temp := Temp+'1;'π elseπ Temp := Temp+'2;';π ANSIColor := Temp+FgStr+';'+BgStr+'m';π END;ππ{****************************************************************************}π{*** ***}π{*** Function that returns an ANSI code representing a music string ("s") ***}π{*** ***}π{****************************************************************************}π FUNCTION ANSIMusic(s : string) : string;ππ BEGINπ ANSIMusic := #27+'[MF'+s+#14;π END;ππ{****************************************************************************}π{*** ***}π{*** Procedure that simulates BASIC's "PLAY" procedure. Will also work ***}π{*** with ANSI codes. Taken from PC Magazine Volume 9 Number 3 ***}π{*** ***}π{****************************************************************************}π PROCEDURE Play(SoundC : string);π FUNCTION IsNumber(ch : char) : boolean;π BEGINπ IsNumber := (CH >= '0') AND (CH <= '9');π END;ππ {Converts a string to an integer}π FUNCTION value(s : string) : integer;π VARπ ss, sss : integer;π BEGINπ Val(s, ss, sss);π value := ss;π END;ππ {Plays the selected note}π PROCEDURE sounder(key : char; flag : char);π VARπ old, New, new2 : Real;π BEGINπ adder := 1;π old := dly;π New := dly;π intern := Pos(key, 'C D EF G A B')-1;π IF (flag = '+') AND (key <> 'E') AND (key <> 'B') {See if note}π THEN Inc(intern); {is sharped }π IF (flag = '-') AND (key <> 'F') AND (key <> 'C')π THEN Dec(intern); {or a flat. }π WHILE SoundC[vari+1] = '.' DOπ BEGINπ Inc(vari);π adder := adder/2;π New := New+(old*adder);π END;π new2 := (New/typom)*(1-typom);π sound(Round(Exp((octave+intern/12)*Ln(2)))); {Play the note}π Delay(Trunc(New));π Nosound;π Delay(Trunc(new2));π END;ππ {Calculate delay for a specified note length}π FUNCTION delayer1 : integer;π BEGINπ numb := value(SoundC[vari+1]);π delayer1 := Trunc((60000/(numb*min1))*typom);π END;ππ {Used as above, except reads a number >10}ππ FUNCTION delayer2 : Integer;π BEGINπ numb := value(SoundC[vari+1]+SoundC[vari+2]);π delayer2 := Trunc((60000/(numb*min1))*typom);π END;ππ BEGIN {Play}π SoundC := SoundC+' ';π FOR vari := 1 TO Length(SoundC) DOπ BEGIN {Go through entire string}π SoundC[vari] := Upcase(SoundC[vari]);π CASE SoundC[vari] OFπ{Check to see} 'C','D','E',π{if char is a} 'F','G','A',π{note} 'B' : BEGINπ flager := ' ';π dlykeep := dly;π chartoplay := SoundC[vari];π IF (SoundC[vari+1] = '-') ORπ (SoundC[vari+1] = '+') THENπ{Check for flats & sharps} BEGINπ flager := SoundC[vari+1];π Inc(vari);π END;π IF IsNumber(SoundC[vari+1]) THENπ BEGINπ IF IsNumber(SoundC[vari+2]) THENπ BEGINπ test := delayer2;π{Make sure # is legal} IF numb < 65 THENπ dly := test;π Inc(vari, 2);π ENDπ ELSEπ BEGINπ test := delayer1;π{Make sure # is legal} IF numb > 0 THENπ dly := test;π Inc(vari);π END;π END;π sounder(chartoplay, flager);π dly := dlykeep;π END;π{Check for} 'O' : BEGINπ{octave change} Inc(vari);π CASE SoundC[vari] OFπ '-' : IF octave > 1 THEN Dec(octave);π '+' : IF octave < 7 THEN Inc(octave);π '1','2','3',π '4','5','6',π '7' : octave := value(SoundC[vari])+4;π ELSE Dec(vari);π END;π END;π{Check for a} 'L' : IF IsNumber(SoundC[vari+1]) THENπ{change in length} BEGINπ{for notes} IF IsNumber(SoundC[vari+2]) THENπ BEGINπ test := delayer2;π IF numb < 65 THENπ{Make sure # is legal} dly := test;π Inc(vari, 2);π ENDπ ELSEπ BEGINπ test := delayer1;π IF numb > 0 THENπ{Make sure # is legal} dly := test;π Inc(vari);π END;π END;π{Check for pause} 'P' : IF IsNumber(SoundC[vari+1]) THENπ{and it's length} BEGINπ IF IsNumber(SoundC[vari+2]) THENπ BEGINπ test := delayer2;π IF numb < 65 THENπ{Make sure # is legal} Delay(test);π Inc(vari, 2);π ENDπ ELSEπ BEGINπ test := delayer1;π IF numb > 0 THENπ{Make sure # is legal} Delay(test);π Inc(vari);π END;π END;π{Check for} 'T' : IF IsNumber(SoundC[vari+1]) ANDπ{tempo change} IsNumber(SoundC[vari+2]) THENπ BEGINπ IF IsNumber(SoundC[vari+3]) THENπ BEGINπ min1 := value(SoundC[vari+1]+π SoundC[vari+2]+SoundC[vari+3]);π Inc(vari, 3);π IF min1 > 255 THENπ{Make sure # isn't too big} min1 := 255;π ENDπ ELSEπ BEGINπ min1 := value(SoundC[vari+1]+π SoundC[vari+2]);π IF min1 < 32 THENπ{Make sure # isn't too small} min1 := 32;π END;π min1 := min1/4;π END;π{Check for music} 'M' : BEGINπ{type} Inc(vari);π CASE Upcase(SoundC[vari]) OFπ{Normal} 'N' : typom := 7/8;π{Legato} 'L' : typom := 1;π{Staccato} 'S' : typom := 3/4;π END;π END;π END;π END;π END;ππ{****************************************************************************}π{*** ***}π{*** Procedure to process string "s" and write its contents to the ***}π{*** screen, interpreting ANSI codes as it goes along. ***}π{*** ***}π{****************************************************************************}π PROCEDURE ANSIWrite(s : string);π VARπ SaveX, SaveY : byte;π MusicStr : string;π MusicPos : integer;ππ {*** Procedure to process the actual ANSI sequence ***}π PROCEDURE ProcessEsc;π VARπ DeleteNum : integer;π ts : string[5];π Num : array[0..10] of shortint;π Color : integer;ππ LABELπ loop;ππ {*** Procedure to extract a parameter from the ANSI sequence and ***}π {*** place it in "Num" ***}π PROCEDURE GetNum(cx : byte);π VARπ code : integer;π BEGINπ ts := '';π WHILE (s[1] in ['0'..'9']) and (length(s) > 0) DOπ BEGINπ ts := ts + s[1];π Delete(s,1,1);π END;π val(ts,Num[cx],code)π END;ππ BEGINπ IF s[2] <> '[' THEN exit;π Delete(s,1,2);π IF (UpCase(s[1]) = 'M') and (UpCase(s[2]) in ['F','B']) THENπ{play music} BEGINπ Delete(s,1,2);π MusicPos := pos(#14,s);π Play(copy(s,1,MusicPos-1));π DeleteNum := MusicPos;π Goto Loop;π END;π fillchar(Num,sizeof(Num),#0);π GetNum(0);π DeleteNum := 1;π WHILE (s[1] = ';') and (DeleteNum < 11) DOπ BEGINπ Delete(s,1,1);π GetNum(DeleteNum);π DeleteNum := DeleteNum + 1;π END;π CASE UpCase(s[1]) ofπ{move up} 'A' : BEGINπ if Num[0] = 0 THENπ Num[0] := 1;π WHILE Num[0] > 0 DOπ BEGINπ GotoXY(wherex,wherey - 1);π Num[0] := Num[0] - 1;π END;π DeleteNum := 1;π END;π{move down} 'B' : BEGINπ if Num[0] = 0 THENπ Num[0] := 1;π WHILE Num[0] > 0 DOπ BEGINπ GotoXY(wherex,wherey + 1);π Num[0] := Num[0] - 1;π END;π DeleteNum := 1;π END;π{move right} 'C' : BEGINπ if Num[0] = 0 THENπ Num[0] := 1;π WHILE Num[0] > 0 DOπ BEGINπ GotoXY(wherex + 1,wherey);π Num[0] := Num[0] - 1;π END;π DeleteNum := 1;π END;π{move left} 'D' : BEGINπ if Num[0] = 0 THENπ Num[0] := 1;π WHILE Num[0] > 0 DOπ BEGINπ GotoXY(wherex - 1,wherey);π Num[0] := Num[0] - 1;π END;π DeleteNum := 1;π END;π{goto x,y} 'H',π 'F' : BEGINπ if (Num[0] = 0) THENπ Num[0] := 1;π if (Num[1] = 0) THENπ Num[1] := 1;π GotoXY(Num[1],Num[0]);π DeleteNum := 1;π END;π{save current} 'S' : BEGINπ{position} SaveX := wherex;π SaveY := wherey;π DeleteNum := 1;π END;π{restore} 'U' : BEGINπ{saved position} GotoXY(SaveX,SaveY);π DeleteNum := 1;π END;π{clear screen} 'J' : BEGINπ if Num[0] = 2 THENπ ClrScr;π DeleteNum := 1;π END;π{clear from} 'K' : BEGINπ{cursor position} ClrEOL;π{to end of line} DeleteNum := 1;π END;π{change} 'M' : BEGINπ{colors and} DeleteNum := 0;π{attributes} WHILE (Num[DeleteNum] <> 0) or (DeleteNum = 0) DOπ BEGINπ CASE Num[DeleteNum] ofπ{all attributes off} 0 : BEGINπ NormVideo;π Bold := false;π END;π{bold on} 1 : Bold := true;π{blink on} 5 : textattr := textattr + blink;π{reverse on} 7 : textattr := ((textattr and $07) shl 4) +π ((textattr and $70) shr 4);π{invisible on} 8 : textattr := 0;π{general foregrounds} 30..π 37 : BEGINπ color := ColorArray[Num[DeleteNum]π - 30];π IF Bold THENπ color := color + 8;π textcolor(color);π END;π{general backgrounds} 40..π 47 : textbackground(π ColorArray[Num[DeleteNum] - 40]);π END;π DeleteNum := DeleteNum + 1;π END;π DeleteNum := 1;π END;π{change text} '=',π{modes} '?' : BEGINπ Delete(s,1,1);π GetNum(0);π if UpCase(s[1]) = 'H' THENπ BEGINπ CASE Num[0] ofπ 0 : TextMode(bw40);π 1 : TextMode(co40);π 2 : TextMode(bw80);π 3 : TextMode(co80);π 4 : GraphColorMode;π 5 : GraphMode;π 6 : HiRes;π 7 : TruncateLines := false;π END;π END;π if UpCase(s[1]) = 'L' THENπ if Num[0] = 7 THENπ TruncateLines := true;π DeleteNum := 1;π END;π END;πloop: Delete(s,1,DeleteNum);π END;ππ BEGINπ WHILE length(s) > 0 DOπ BEGINπ if s[1] = #27 THENπ ProcessEscπ elseπ BEGINπ Write(s[1]);π Delete(s,1,1);π END;π END;π END;ππ{****************************************************************************}π{*** ***}π{*** Procedure that calls ANSIWrite, then line feeds. ***}π{*** ***}π{****************************************************************************}π PROCEDURE ANSIWriteLn(s : string);π BEGINπ ANSIWrite(s);π WriteLn;π END;ππ BEGINπ Octave := 4;π ChartoPlay := 'N';π Typom := 7/8;π Min1 := 120;π TruncateLines := false;π END.ππ{---------------------------- DEMO PROGRAM ------------------ }ππPROGRAM Atype;ππ USESπ ANSIIO,π DOS,π CRT;ππ VARπ F : text;π S, L : string;π Ch : char;π i : integer;π Rec : searchrec;ππ FUNCTION PathOnly(p1 : string) : string;π VARπ s, p : string;π i, t : integer;π BEGINπ p := p1;π i := 0;π REPEATπ t := i;π i := pos('\',p);π IF i > 0 THENπ p[i] := '|';π UNTIL i = 0;π IF t = 0 THENπ t := pos(':',p);π p1 := copy(p1,1,t);π IF length(p1) > 2 THENπ IF p1[length(p1)] <> '\' THENπ p1 := p1+'\';π PathOnly := p1;π END;ππ BEGINπ IF ParamCount < 1 thenπ BEGINπ writeln;π writeln('Usage : ATYPE file1 file2 file3 ...',π ' (Wildcards are OK)');π EXIT;π END;π{$I-} FOR i := 1 to ParamCount DOπ BEGINπ s := PathOnly(ParamStr(i));π FindFirst(ParamStr(i),AnyFile,Rec);π WHILE DosError = 0 doπ BEGINπ assign(f,s+Rec.name);π reset(f);π WHILE (not eof(f)) and (IOResult = 0) doπ BEGINπ readln(f,l);π ANSIWriteln(l);π END;π close(f);π While KeyPressed doπ ch := readkey;π Repeat until KeyPressed;π FindNext(Rec);π END;π END;π{$I+}π END.π 30 02-03-9410:58ALL GREG SMITH Complete ANSI Output UnitIMPORT 45 .gà {--------------------------------------------------------------------}π(* *)π(* Gansi.Pas -- A Pascal unit containing all of *)π(* ANSI graphics, cursor, keyboard, and screen *)π(* mode manipulation strings. *)π(* *)π(* Version 2.21 April 26th, 1991 *)π(* *)π(* Greg Smith *)π(* Boulder, Co. USA *)π(* *)π{--------------------------------------------------------------------}ππunit gansi;ππinterfaceππusesπ Dos;ππtypeπ ansicode = string[12]; { Maximum size for most ANSI strings }ππconstπ hdr = #27+'['; { ansi control sequence }π clsd = hdr+'0J'; { Clear Everything below cursor }π clsu = hdr+'1J'; { Clear Everything above cursor }π cls = hdr+'2J'; { Clear Screen }π requestpos = hdr+'6n'; { request Cursor pos. StdIn rets Esc[y;xR }π delline = hdr+'K'; { delete from cursor to EOL }π savepos = hdr+'s'; { save cursor position }π restpos = hdr+'u'; { restore cursor position }π cursorhome = hdr+'H'; { Home cursor }π normcolor = hdr+'0m'; { Normal white on black }π highlight = hdr+'1m'; { Highlight. (Bold) }π RevVideo = hdr+'7m'; { Reverse the FG and BG }πππfunction SetPos(x,y:integer): ansicode;πfunction CursorUp(n:integer): ansicode;πfunction CursorDown(n:integer): ansicode;πfunction CursorRight(n:integer): ansicode;πfunction CursorLeft(n:integer): ansicode;ππfunction InsertChar(n:integer): ansicode;πfunction DeleteChar(n:integer): ansicode;πfunction InsertLine(n:integer): ansicode;πfunction DeleteLine(n:integer): ansicode;ππfunction SetAttr(C:integer): ansicode;πfunction SetColor(f,b:integer): ansicode;ππfunction SetMode(mode:integer): ansicode;πfunction Resetmode(mode:integer): ansicode;ππfunction SetChar(ch:char;st:string): string;πfunction SetExtendedKey(key:integer;st:string): string;πππimplementationππtype intstring = string[6];ππ{ Misc support functions }ππfunction bts(x:integer): intstring;πvarπ z : intstring;πbeginπ Str(x,z);π bts := z;πend;ππfunction HNum(n:integer): ansicode;πvarπ z : intstring;πbeginπ Str(n,z);π HNum := hdr+z;πend;ππ{ Cursor Control functions }ππfunction SetPos(x,y:integer): ansicode;πbeginπ SetPos := hnum(y)+';'+bts(x)+'H';πend;ππfunction CursorUp(n:integer): ansicode;πbeginπ CursorUp := hnum(n)+'A';πend;ππfunction CursorDown(n:integer): ansicode;πbeginπ CursorDown := hnum(n)+'B';πend;ππfunction CursorRight(n:integer): ansicode;πbeginπ CursorRight := hnum(n)+'C';πend;ππfunction CursorLeft(n:integer): ansicode;πbeginπ CursorLeft := hnum(n)+'D';πend;πππ{ Editing Functions }ππfunction InsertChar(n:integer): ansicode;πbeginπ InsertChar := hnum(n)+'@';πend;ππfunction DeleteChar(n:integer): ansicode;πbeginπ DeleteChar := hnum(n)+'P';πend;ππfunction InsertLine(n:integer): ansicode;πbeginπ InsertLine := hnum(n)+'L';πend;ππfunction DeleteLine(n:integer): ansicode;πbeginπ DeleteLine := hnum(n)+'M';πend;πππ{ Color functions }ππfunction SetAttr(C:integer): ansicode;πvarπ x : integer;π tmp : ansicode;ππ procedure ColorIdentify;π beginπ case x ofπ 0 : tmp := tmp+'0'; { Black }π 1 : tmp := tmp+'4'; { Blue }π 2 : tmp := tmp+'2'; { Green }π 3 : tmp := tmp+'6'; { Cyan }π 4 : tmp := tmp+'1'; { Red }π 5 : tmp := tmp+'5'; { Magenta }π 6 : tmp := tmp+'3'; { Brown/Yellow }π 7 : tmp := tmp+'7'; { White }π end; { case }π end; { ColorIdentify }ππbeginπ tmp := hdr;π if (c and $08)=1 then tmp := tmp+'1' else tmp := tmp+'0';π tmp := tmp+';3'; { common to all fgnds. }π x := c and $07; { first three bits. }π ColorIdentify; { Add Color Value digit }π tmp := tmp+';4'; { common to all bkgnds. }π x := (c and $70) shr 4;π ColorIdentify; { Add color value digit }π if (c and $80)=$80 then tmp := tmp+';5';π SetAttr := tmp+'m'; { complete ANSI code! }πend; { setattr }ππfunction SetColor(f,b:integer): ansicode;πbeginπ b := (b shl 4); { move to high bits. }π f := (f and $0f); { zero all high bits. }π SetColor := SetAttr((b OR f)); {Create Attribute byte from values.}πend; { SetColor }πππ{ Mode Setting Functions }ππfunction SetMode(mode:integer): ansicode;πbeginπ SetMode := hdr+'='+bts(mode)+'h';π { Modes:π 0 40x25 Black and Whiteπ 1 40x25 Colorπ 2 80x25 Black and Whiteπ 3 80x25 Colorπ 4 320x200 color (CGA)π 5 320x200 Black and White (CGA)π 6 640x200 Black and White (CGA)π 7 Wrap at end of line.π }πend;ππfunction Resetmode(mode:integer): ansicode;πbeginπ Resetmode := hdr+'='+bts(mode)+'l'; { Same modes as above }πend; { Wrap at EOL will turn off }ππ{ Keyboard Re-Defining functions }ππfunction SetChar(ch:char;st:string): string;πbeginπ SetChar := hdr+bts(ord(ch))+';"'+st+'"p'; { when ch is pressed st is }πend; { sent instead of ch }ππfunction SetExtendedKey(key:integer;st:string): string;πbeginπ SetExtendedKey := hdr+'0;'+bts(key)+';"'+st+'"p'; { Same as above. but the }πend; { Key is an extended code }πππend.π 31 02-03-9411:01ALL LARRY HADLEY FAST ANSI Display Unit IMPORT 109 .gJ· π{πJW>I would be interested in such code - and a BP7 version is hardly needed,πJW>since I am happily working with TP4.0.ππ Well the problem is mainly keeping my code confidential, and Iπ don't have a TP4 compiler, I no longer have a TP5.x compiler,π either.ππ Fortunately, the "top secret" stuff is all in .asm, and I can sendπ you the .obj file without any complications. The .pas "wrapper"π for the .TPU is very simple.ππ A couple of caveats:ππ - there are a couple of minor bugs in the implementation, itπ works fine, but occasionally the output will get *slightly*π mangled.ππ - This code writes *directly* to the video buffer, bypassing allπ CRT or SYSTEM unit calls. This makes it generally incompatibleπ with windowing routines. (This is one reason I want badly toπ upgrade it to BP7 - I pretty much have to support TurboVision toπ be of any future use) The plus side: all CRT variables areπ updated, and so calls to HANSI can be intermixed with calls toπ normal CRT unit functions.ππ - *Only* ANSI codes relating to the CRT are translated, keyboardπ redefinition, etc, is ignored. (ie, eaten by the emulator)ππ - ALWAYS USE THE CALLS THE WAY I SET THEM UP! The functionsπ internal to the .obj file are NEAR calls, and will not workπ correctly when called externally to the .TPU.ππ - Use care to make sure you do not pass strings longer than 256π characters to the HANSI unit - longer strings will be truncated,π and do strange things to your output.ππ{------------------------ snip, snip ----------------------------}ππUnit HANSI;ππ{$F+,A+}πINTERFACEππUsesπ CRT;ππTYPEπ CURS_COORD = RECORDπ x, y : byte;π END;ππ BUF_STRUCT = array[0..127] of byte;ππVARπ temp : byte;π loop : word;π cpr_buf : array[0..8] of char; { 8 dup (0), '[' }ππ input_buf : string; { input buffer for ansi proc }π str_ofs, str_seg : word; { seg and offset parts to point to input_buf }π attr_parm : integer;ππ cur : CURS_COORD;π ansi_params : BUF_STRUCT;π saved_coords : word;ππ brkkeybuf, { db 3 control C }π fnkeybuf, { db 0 holds second byte of fn key codes }π driver_init,π max_x, max_y, ega_rows,π wrap_flag, attrib,π string_term, recurse, cur_page : byte;ππ crt_cols, crt_len, columns, lines,π buf_size, cur_parm_ptr, video_mode, escvector : word;ππ crt_disp_mode : byte ABSOLUTE $0040:$0049;π crt_page : byte ABSOLUTE $0040:$0062;π crt_curs_mode : word ABSOLUTE $0040:$0060;π crt_curs_pos : array[0..8] of word ABSOLUTE $0040:$0050;π crt_EGA_rows : byte ABSOLUTE $0040:$0084;ππProcedure Bip;ππProcedure A_Write(buf:string);ππProcedure A_WriteLn(buf:string);ππIMPLEMENTATIONππProcedure Bip;π BEGINπ Sound(1100);π Delay(5);π NoSound;π END;ππProcedure Init_Ansi; external; { defined for NEAR calls - do notπ call directly! }ππProcedure AnsiWrite; external; { defined for NEAR calls - do notπ call directly! }π{$L hansi.obj}ππProcedure ANSI_init;π BEGINπ if driver_init = 0 thenπ Init_Ansi;π END;ππProcedure A_Write(buf:string);π BEGINπ if buf<> '' thenπ BEGINπ input_buf := buf;π ega_rows := crt_EGA_rows;π AnsiWrite;π END;π END;ππProcedure A_WriteLn(buf:string);π BEGINπ input_buf := buf+#13+#10;π ega_rows := crt_EGA_rows;π AnsiWrite;π END;ππFunction CurrentMode:byte;π BEGINπ CurrentMode := crt_disp_mode;π END;ππFunction MaxRows:byte;π BEGINπ MaxRows := crt_EGA_rows;π END;ππBEGIN { init all EXTRN's req'd by the asm module }π Lines := Hi(WindMax)+1;π Columns := Lo(WindMax)+1;π driver_init := 0; buf_size := 127;π escvector := 0; wrap_flag := 1;π video_mode := LastMode;π string_term := 0; cur_page := crt_page;π crt_cols := columns;π recurse := 0; brkkeybuf := 3; fnkeybuf := 0;π ega_rows := crt_EGA_rows;π str_ofs := OFS(input_buf);π str_seg := SEG(input_buf);π Writeln;π ANSI_Init;π Writeln;πEND.ππ{------------------------- snip, snip ----------------------------}ππ Here is the .OBJ file that goes with the .pas "wrapper"π you will need XX3402 and PKZIP 2.04 to decode this output:ππ Cut this out to a file named HANSI.XX.π Execute XX3402 d HANSI.XXππ You will then get the file HANSI.ZIP which will contain theπ OBJ code.ππ*XX3401-006692-291193--68--85-59886-------HANSI.ZIP--1-OF--2πI2g1--E++U+6++-xFlVXLQHlg-Y++-Qa+++7++++G23CIoYiHo78hJdrT3H3xdwtQqNiπ0e3r8O5bEJl0SMUE67hYIm1NHLMr6I3l5mdK3+k7HMIUDUo7+WeWoY5oDG36IEEI77-4πYK635VOOAG4c3AKcYDnCr9h9S9wzTjzxK9znaTCRAySQ8TTAjFDnEpbk6lCSbDecnSt7π5JoEnVXntiLQDnbQDbLel0TibnEl7nkwQq9Cp2QbDlYyo-MpsAK03WmadeR6OBzMPK4-π60tZ8H1qW8uiLP7IAMlnlHgQPlUgsf6-b6zIJ9nROowU8cYlkLbf-Me7qCEohfU+KQmNπXgAK-1CJuD8ugf9NovRFQGZiVmi3fExE6Qm6RuGY71gRv85Pi4GblyHGzvif7wvBJhl4πXIpmi-pNv7LzHKKnZkBI8+jmCf8wRezLnQuON308XXIikwraab8rEEiOgGMSSuMXrVTbπQfbXDKmDqF+mSY2EYubq93wKClHcuaSmqQ2+2wN0AdDX5GtT8YoGinzEZIPVwPdxfUEDπuz4zC6wXYII4i8MgZ9VYNu9Dur0bgdw0NWZkWh4LNYxog9w0N-AKDBNhHzAZdBUHKT3hπfAAHZya6wvfQP4j+g1PUxh8EIXmgCY1GG0qfvZFT4Yp7IO0-dYvDIL6gKrpP-6t2iwzhπ4ihV3kAY1Q5h6-AS-lhxaq80QskXCnMXUFar-FLf5iBbDkekBBdsRr8akyp9RWNvqMrPπH70SntAwni5rNIqBrSZ7ph5OInognCFvqnFD2PURHewttOpiqnWoBaOw+zrQsiOAwK1HπUAzVX2xbv9s0mK9CVf+Yeoa5sRBS8UpONBrIVEqqaXEvpdrgROF7BiNKImheOa6Nd6UHπ54sLMxA1BfLLRTlZ9Jt2tWU6MX5bqnD3yge0M8dqc0Sm7qhapXjeCUwf08Lu5JHjEKVWπGdpA0KYehRHNZ1U9BeIidWEN3bFUASRWaDsbIVnCY-VuM3aygASvElsjO2uOLNIpxwUcπ1kkdO5B9bKQ3lL0hn9C1bWpcHOfREjG0KdgThDdNAw7Sf0Lf458Z60nEBFzgOPoy8qV7πPHq0n0tqRrN9rS2ygoA2mqQRUtvHUTcvg6U5H+yxEwnJxPcnsfntiYCOhZ7xKvfGKKXVπYfw2slRMOzs1OwifK5jy6yj+exYRj6NpsVRNNru7VTCTK5TyAyj3Tq3xy4IKkOykjjkeπuwRjgYVSnzfn-XO6AztrnjZR5DVE9jUkXXmOGnuG4rkI1y7q5glXSEWDtu2wWHTVcrYMπ5wCPwZHSX8TlthnBKr+DjsBvSGSSnPjkSrYTDdt5w+TtrzV2rdQzlDjlFrUYTsnTmNzUπBjsYvwybw0WSkkTkL1uEHyC1y0kya1x1IQmV8CPmizYwWi8TT1VzYG7Nk2TkFFHBmlHBπelHB2cfaBFv5Jz1vy2fmgcewf02juwX9KyHZ5TssznSTl1SGhorYvHoyaKwVXxj6szjYπvIAybSzWAzUSDdDj6wyZz4ZSkNzZ-zZgTcEWCAPnySQIkJTwSLuG3z-HT1vzZfz2jyQ9πyLa8t+S8t073Q6YjtNTtAbuJ9yTL8NcuWiEaFR3+IE0gtkfStg5k9Uy-1HkABj6KIAlPπksSw5SnUvK2bvkWvS0TsW5S3DHkQxj7ig6xrVzqw7tHmrZ146u0QxsI85UaJr+O5y4+sπnCy06rkM5CIXs-WDUSAw3fvWwT+p5kobS+fwVvjUBDT+Bnk9jiDXsLjy+7nV2y20TkFyπs6x03LwQ9j77IAhns-9DVNzsHDWNDkBLy4msmdy5Ozk3y7ILkKxw6RHllT+5Tlbyt8z-π1TsurCFjEXpT1Upw7EVM1EXfEA7uID+C49+-Ua+XB6BWO+uPc+Kw-mpV8vG0vR+ORY+Pπq+ZhsGDc-9iVArk0LO+2ig7y06Qmu+sJo+ACE0ws-9rV4DG-9u2jb6-yQ-6WsHxUUyyUπDtm381UD+y354+ELsSxk0Su0bq+sz+nFw+iAU8gk2bu3IT+vlA-TM6Q4W+IVsY08S102π+s73+cG87+UHmR-0X6MqMUmo2ovc63nEIOF-Nt2CLMIPSUUDx-7Su0Amc8z6V2Ul3e72πBUkIsq06i+S4WLgVKcm5YS6yW-2yW-KDE9ls3-nWAIUEXoCWa+H7sUYM6tu2312NL468πiAJHs-ItA3NAVKmF0yB25ckLow+bdgDxMUMw84P0F1295VNDkmHl11kVbcIdMXPYW1YkπHSH1R12LNcXbM8OM-vB26HkhWi-NwMrtx0y2CS7Ja0iKk1z3On-T96IWwHew7Bu2FK6Nπ9-P9sJKl+ZsHeq0dK+pjW1KkEem3ZK6Rf-JjkRhWDTl9j+rz3gLkfhU24wIKq0GqkqPlπ6KkJCy-xgEiqWszUEz2lv-0Tk0ul3nsK7P-5v6CxMXzg2uJE8geUL7F1dHU+-wF-C0kCπkF3l46u7Hy4sC+8TWuDkVHU4LsbXQ27w+OT2Zz+TwFKQ3Zz1hy6YT0xCkHZl4Wu6Pu38πT+QzWXBE9SsKBK82i0WS3NT2P53Nn-5Ll+jWibVFz0Y8FPpM91Wy9c9kHF44moFHL0uOπsofF2ZS7RfVORAEp6VnT3LpkUsX+XO6j3ch6r0Fgy7u6kgpW+4sJUr0L46MTWS5sgFW-πiwIcr0Dgi3T2MMZks1uFWDh38dM99pO6H8kIKLV+XAB1sZsw95lsF2n+cy7-D0sSlFDWπ8HkdQj0ImADHMXdy6tv4voEyTWySknDWSHkftiAtgE-z22jkFz2uzW7KsqKl-ey6RLVJπfARfsarwHPm1BwFvS3Bglbel3Fj2ywVkCk9iE64v2D3XZ9UP3Lu0-dNU2Cv1M0n3dbUMπay2FP6v5g+JyWOrk-9P4Pv2RTczhwGlqkDDM2Lz+Cz-5v6Epq-ZfgEjyVBrk3ym3Jv+rπLgIyS+rvsezM1uxX7DuCRy6Tq-xjM-HKsk+IQW-8CEV1tK+AYoCkeFm8nSHRq374Mqgtπ+hj7YRVSXg8CocuRNFlqZT2M9VrMLGNUHta6jKEGxdNXg6xAkPsm3Th77oP8B9lHdiB+πuQ4VAUC5mT2sEhu5AT6T40gbM78w5pDZN2mHIx+XQn-1HgJgaMTXtHHomSbs1nY1vtQnπwK2t0lyHny+YyGlCZfBledm1SH6TNwWtC2jCkxbmSNkfLw1btMhM7+hkUNmD9wZ0T2IKπsF8t+3yL9y28iF-LmIKsJWv4RT7ZT2gilErmRRkYrwHBQVZiYwhlVpm7iyIer0BLsrutπ3WjYSXkgBy4bwXow8XTXNr69TWursdRm7tuEiz+PyEaSZLjlb0n-0r6zJgZGf7NZy7Agπlmim+ez7GemH-z-DSEUPt43YuZDYuUW0CcecXa4kCcuVuYgAImSkdHe7fRJzg8ouXFrIπhrW5ic-RJCuGsQ1s1xVBzMUxJ+p4e6gMeKeljve2+xFDC3XxX2DI9nVILQPVuWeCIhTEπfbv3SDIP7eXfa8Vylx4e1gScDn-3zMLduUNu3AdA7SIxGYaTAiE23GETIA5m2FIW5pBBπt4EJ7eScdj6dpInaeCMmJvKEopF9yMle6qSfhb8SOWQ9J5hNd1f8ZpEbiJ-pZchJ3za8πuWeLe50tJ5KHPuXiQdbe6JScbb8JuWLLeBtmbScXpug6yMve8xxJYP7MqSFaBJ-iIsDYπVqekr8by9bSd6T6XBJFyf2P6HxF6iJSBYaIeFdMfiulIWT8EGd75J96wdYP9nxEMyMJ8πYJydJ5Z0CSJdtN9Te1FtJeL9wmdPJeZlwYRpXvmYvdIzez5m3rKTj8lwwceO85xJ1wYuπxP1wEnoWzp8HtIopFH9X8MZ4XZH4J-ZgtAZEMtdgNYmL9MoNgfIlIvMlNgZqlXCmUz4gπv4nAZZqBCP8PYGzv4Az7jgMwqRxsLUsktgj-Fe4wmmWGRlgjmS54EVZh976XXQImlbVNπlVajG6TleYkmZgXFlZ6tlbV1dVdjGdSlH8MNmqKugJNuXLImqrVPXXDy7Lr4BZZVv7OJπlVttmDV25X38t13XbznA87BT4CLmOyCUD4YQYeSBkz8AwOawM-mFBQMlSR2s9bwl2UiOπg7UezlhjJwCfrs0fPbifvKPQ94V8p8qrpVt4cOLHy3vOqvVMo6ecsCFsbzJ3Fezfx88QπfRxUeo6GT53dpfRP0B2CRY-zD3QNQKZi5rpw-F4Lm+tPejc9mzeMobEGyx7G7EjuiopnπmOn8ftdYds-G5+ZSPLIoiq1FzWx0QeXd3Decow4eN8TDaN4e1HVNEo3PcjvfGoHfiZW8πBMdPrnmOHKS10dcF8wrjh8v2S7XHgYY1w1XGBHKKzKtFpbSPditVTyUjVudEycdoiLpSπSqm8Ewy8XoohO2RwaDZxZi0oKfGb1Km7pGDFtMeDnTMuL-ZSrGCQfvBakQzFNkpjnIxPπkwr8xbZRDfQXoODdGDtCEISWamQuj9vM39hnX5wqROCLppXXcvg+Joe89mBBgyDtXzcnπdIcsAp8ohtJwiGIbNONdSFL7dbSGTRaiANdvWoQrQZYKxnuzgt5nCAn6DyFFyaCZ8gXYπz6c5yTvPG9z3fzVqmqhQkZUhby7DyiJMgzpvDgAztv3XT3OLWvRIsdpOjgETwggNNi-LπSOezGoOOjwhB5aSdSC7AZEMSOwZiGku-iunEr6tALq11hMKhzYu7PerI1bdMGWHvIZkiπgqQsH9QqZGPXL2tjgXD1LCv-2CLTZsbu0P0vst6oDEmyhLOJdURclUJX4ta-abY2FjXLπmywcmq8zgiNNglGbtWP-f2PB18STbErv4UBBG2Yq+poAPOrFC79BtGu4BE2tLgivsEpzπ7rCHC36pyFp3OytAIj8ZiJpl1cx5wnz0xtOmtiBRHbD2Zy0IBK7B7WQuLKuHzUa4K13eπqiiWdoinDwDQFaKb8wrZAHRCa9XSuB-9dBphwVr2gYMXd4uN5WU4KaC6xtUf30zez99Dπ5CDHsaAnmM2pt1aWZHK1mGYyJtf1r1lnlHFfxXJbvdJ3+jqRsfHsffVeWT4ai2ZQgzHXπsrnKWasKrBdiaf3AP-Tzge6ZmibmX9KP8r-8D5R9oKox7xLW6Qisltni4f58jlJGTKuDπlGnlvu7IgiHJ3pYKXJMigSV2bO7RPeiZZLwNIrra3Nh3vfMq8Sbu2gZ4Ib8Qrzlwztt8πxGKtIVoKpyEK3pXO4h5AWhBhlbaFsalDMZAfZKIssvn79eSNW3NGBf04YC7ka93S6iTaπYWPEzNLCyzMooyNpwIJ-Jy9P7AHG+t9hxB6JcQDhddGNODSO4jJWZXKKVBiuQGmptXP-π3yiqlsql7X667kSC57o-vSt2Qrlxw1gzHNRmXJhm23sBV8GpnPFjDdnsHqhO2l9HT8bqπP3xuVgg8lMj3zVvIYimtlRy9Paha9IiBNy-HK3LEaFdO7GFun5gvbtCiJ-hR9Q33UM+RπRifcG2rKx4dwr1wuVoQrK7jo5HkEI8Mdj4LXDPlLLqZJBRB-OEgyafmsJDDtCcnfzM3FπapvqU6TjQKNUGjF6+jdLg8BzUAaIB1Cwyh1IT3CNruUSNkwYVXsGzKbjhcLH1GCckJmnπy85YpaSZpxrmKi+sxkMGtkbN6f0CRC2OMAz80M2Zdl1WjCNnKmIrK15ci-ebi23K-qN3πRkyM03Az-lPLr7uCf4EfhOUJ+LLO63sTrOZfieruz5MfUFrTFJo7V8SnihhGnZFz-ZVuπ***** END OF XX-BLOCK *****ππ*XX3401-006692-291193--68--85-50512-------HANSI.ZIP--2-OF--2πCU6S7ui1hv2-0vDJIShlHx+bjNb0rpKf+sfKVXPNMfIvg6RiDG-akqOplrk1ExfetbPSπdUPvNmTKskjYUcxJHQ-D9DpNE3CTe4K-Xb5aeVlGbE9HqXXm8fIfgBRQ8PTAzOcS0DFBπGH1DHbL75pt8Ugtatj4U4o8Bk3dFEq1I5MmpXOGSCIrqBNvnjofdeH-DFyC7EB0-JTMOπJk69cTSfLXhBXnDS1B0XIxCw+SpllfyhjKzSBdhbouoM8ckppg-irIPH3H-DYorwvue-πuqjBJVd3Ot9p8ugakibijbxacXpwU0oeT4XIX831kWDWzdMm6GRbNbXGV+QbHNkNDi1iπikS4rlbyoCGQQCjjF4YHdXskMJ9s23hIK2XDVxQMydrq1cDxgeOdTf3YIJ3FtUommpaVπK7ZGo13bnLS0LV8hTkNj069T4RNlqN+TJA1OzgvOplYRtf+iROlf5MPLEPQupPqCxuWHπDSh2fncXMV5vqu8Mjcj0ymruFyGWtbQiGfAhWiezO+cRIzEWR6fSZpOOjpK2rLEHBoQwπ9PGwGOnYzxRDuxTsRGu8RbGT3KWVintuDqfIX5sk7mVhms+BKLQym9sAYJ3F9tnNEDyJπfa4gg1RXFGQ5LbWZg59UVLv5Mkh9DTIZVJosirvy5eXAzt87YhR9PMKxYpXyVHaZONtoπRoPaKBJZIACU2icRIrHmgnB3Zsh8fqgn-rOmbEhD9WmtxbPFsI0L9S5LBbMpTDSB5tRxπHpNdOIV79YxOlxaUYbZzE6sehaH4n2Us4uMMauN664dMvo0RgqdjEmbxTM5JbcWUQeegπc79J5a88gxem00cpFHiWRcTTo3iAZOtZf60eN8dq1LC45gn10aHqsjFc6nQVyctQPnH9πIvM8pFPMfUvgsrjNj37V4qOQeQjfOQgTGKmie9MnKp2WhsKf74M9cU5ROcVUqSSqZpdWπreyqSf7GrNfJLjEfb9DJBmI4KCr7BBiO73NstjWbpWzzkjGS-G3ZhbJ798jIbSMDhyV+πJi3jhRpnco6DtYN4wplDBCHpA+Rd1egucxsxu41V28dBfGywIRWKgNpA5KYyfhFRTHwFπ7CV4nFTOC8gj5zPnR-lsw2XnkeMKEwP9rRJruPt1eDrcX31eEVOd+mbdPdcyBCCxkdw5π5elxOulP9HWkgCHaLURPErl7xNuPKsNjc3Wdiira3jS49K4qyGCnqMORWOlTdSqhgSm4πAQtLyc4eVEyAkd4AxFp7OpYt1POkhCdxBkhjN4opkr-PffHHQOLPSGpgNwDqHsD0zKBTπ9efNncdy3pT2ZSibsB-qRiBu4Qxhwa9xnO7xGO72p6b9eWjhemDJCHTpZffV8mqhjHaTπoU4hR2o2334hUHNAHHEz7rQ4MSo3qw6i1ZMQTIzS7JhF3lSfA-WhhNAlOiu1hSL3oGBmπXSVFiQ7NOtmHnuoM-KIi9mx97rU64MGlV4n0DMHl--xV+i2-kYH0ksF50MwHbW-A7Xl3πa2f66okbn0EwHLWKA6QkZn0Dw2z0WsHtV090GsF3V7Q7fl7S6vlCS7Ckb90Gg7ekZj+KπsKo0LS5TITOtUWNZLmg68OjJlEoj9qxCJ5Zb-K5ZzIZ87fcwKlTrui6TibVEOnmeWoZOπb87pwrElEsjtibV-3khowOcirhH3OZqwfMhrRJ4g69FwWmsyoC6CLLlB5fyZqDt3S7SkπYP07g7akZT+yMHhV-yZR6jnZtFKA6+ah0No6jEYqkZ-08g39VWimRD4I9ePdMWt3Kp36π6uVMdKjfRCoRrO-1eRWdWkdRT82PHibOhvesGiNycocZooIn9uxgFSV+W0+nZN4O5OK9πSCdLaOEt4bvPmeI8KZSip9KpifO3Cbl2q2yUIJMSwD6aOzM8zbTQCElfhlJ5FyKoWPtvπScj6e+91r5Lwb4zbSpXvFbHrL6niYnRt7qA9Hp7WAXTdCPLn8Oltie5MN5I8BCbQZhFtπS7RoBiw9RiuwJgZec3pAqeil7fKVC5ds9hWRtpsVZnIX4vHDxiGnRKHI0sNvKwXpQyCMπQOu4jBNoOsUSbhQwMAdu0aerFwTYX6iSBHonShko3HoVlladAhCvFAOw6IfY-YPtiqW6πWzIvOfiicwzZxZTBs5H8vviT+jy+ISfC2mhWJhcOqbLBjgxAxtIuMP5EnqiCApDPYgqaπaV+keG7uy-TGgnecd9XcU4o-1RCY8JLf7vXkD1rBxNwKx1MD-59XDqyue4LOIjo-cU6pπncmizaB35ngZpPDyggpjCdfNtUx7MKuRCrZFKzxIrXWTBixDBWtLp7lYXIf3oNpmddnvπUoOOkalfFvByyqlzIuAd3tgF3qwQTSMjImwrh9O3OSNAOJuE4KvB+GhgAoDfz9tCXsV0πvfizjaGRZR7BiPsYXF7cH7cNx80GaWbwBazYGDgvrvfFrzYUKVtuhuZxkpMI0BDoJ2k5πJgTcgBn-oG4t1oE5tsN4-yIqdsCgTQp4JZD+OhkrOy7j1eDlHVQiJqmBem5RR7YRIZ6Hπpq+4obTz-ulTLPwubM7XHMxBS2qT-jhpDJBtGjTeo4+qxjinrtzINGWRD1amqjhbPRBuπeevFWluXIv4BrfuWKKuk4GefwHM2f7qexrh8rws81yGTBOuTmhwLpCyn3HdXfwmiqJJjπOaso7vDayLexlDzTjwATAKg4DkUyogqgv8IZanzGlQF6gt9C2grBQfVolEtSFVRjNLQEπvj9by1NSTW100qJr8aVFBd02YGH2Om4NKhq2QMFQTyNSuQzAtMFD0JxEVxDIsMlCoZIuπDpCy8qiU356kq+jZnOVGrhP91rMWcPi0NiKx3HEjXm7a21313HEhXpPEdhmiOsYuLsxKπo9swZT9GYSlAkonaFlv610dznAnPZ2zdL0abhBWVT74qjMEYWeRw+y31+iKgwbo2mZTZπblBCYuRnLXVsYPlRpfpy6v7CEL1tHNorIOTA63q2uO6J3ITPNo73HweW2ME-zWERHoUVπoC3tmCi3WXbIyKVF7exMeeqgpkJ3c3BnesdxKXecQzMFPTCY9YtffccoTW5IIHtZCjhqπppaNEATVsOK2pJuc73hRn6mvGI5bmapIcJCboz70yfx0Qjw5I2g-+VE+3++0++U++5p5π44BRlD4k4E++3mM+++Y++++++++++++U+++++++++2V-HZB79Yx0GZ-9-EM++++++E+-π+1Q+++1L4E++++++π***** END OF XX-BLOCK *****ππ---end of HANSI---π 32 08-24-9413:19ALL ERIK ANDERSON ANSI File Dump SWAG9408 ╚X ▌ 36 .g {πML>p.p.s I also need a routine (preferably in Turbo Pascal 7 ASM) that saves tπML> content of the current screen in an ANSI file on the disk. I saw oneπML> a while ago in SWAG, but I can't seem to find it now (I'm a dist siteπML> but still can't find it).ππAlso, since I didn't have anything better to do, I sat down and did aπversion of your screen->ANSI. It's rather primitive... it does a 80x24πdump with auto-EOLn seensing, does no CRLF if the line is 80 chars longπ(relies on screen wrap) and no macroing. If you want to, you can addπmacroing, which replaces a number of spaces with a single ANSI 'setπcursor' command. Well, here goes...ππ=================================================================== }ππ Procedure Xlate(var OutFile : text); {by Erik Anderson}π {The screen is basically an array of elements, each element containing oneπ a one-byte character and a one-byte color attribute}π constπ NUMROWS = 25;π NUMCOLS = 80;π typeπ ElementType = recordπ ch : char;π Attr : byte;π end;π ScreenType = array[1..NUMROWS,1..NUMCOLS] of ElementType;ππ {The Attribute is structured as follows:π bit 0: foreground blue elementπ bit 1: " green elementπ bit 2: " red elementπ bit 3: high intensity flagπ bit 4: background blue elementπ bit 5: " green elementπ bit 6: " red elementπ bit 7: flash flagππ The following constant masks help the program acess different partsπ of the attribute}π constπ TextMask = $07; {0000 0111}π BoldMask = $08; {0000 1000}π BackMask = $70; {0111 0000}π FlshMask = $80; {1000 0000}π BackShft = 4;ππ ESC = #$1B;ππ {ANSI colors are not the same as IBM colors... this table fixes theπ discrepancy:}π ANSIcolors : array[0..7] of byte = (0, 4, 2, 6, 1, 5, 3, 7);ππ {This procedure sends the new attribute to the ANSI dump file}π Procedure ChangeAttr(var Outfile : text; var OldAtr : byte; NewAtr : byte);π varπ Connect : string[1]; {Is a seperator needed?}π beginπ Connect := '';π write(Outfile, ESC, '['); {Begin sequence}π If (OldAtr AND (BoldMask+FlshMask)) <> {Output flash & blink}π (NewAtr AND (BoldMask+FlshMask)) then beginπ write(Outfile, '0');π If NewAtr AND BoldMask <> 0 then write(Outfile, ';1');π If NewAtr AND FlshMask <> 0 then write(Outfile, ';5');π OldAtr := $FF; Connect := ';'; {Force other attr's to print}π end;ππ If OldAtr AND BackMask <> NewAtr AND BackMask then beginπ write(OutFile, Connect,π ANSIcolors[(NewAtr AND BackMask) shr BackShft] + 40);π Connect := ';';π end;ππ If OldAtr AND TextMask <> NewAtr AND TextMask then beginπ write(OutFile, Connect,π ANSIcolors[NewAtr AND TextMask] + 30);π end;ππ write(outfile, 'm'); {Terminate sequence}π OldAtr := NewAtr;π end;ππ {Does this character need a changing of the attribute? If it is a space,π then only the background color matters}ππ Function AttrChanged(Attr : byte; ThisEl : ElementType) : boolean;π varπ Result : boolean;π beginπ Result := FALSE;π If ThisEl.ch = ' ' then beginπ If ThisEl.Attr AND BackMask <> Attr AND BackMask thenπ Result := TRUE;π end else beginπ If ThisEl.Attr <> Attr then Result := TRUE;π end;π AttrChanged := Result;π end;ππ varπ Screen : ScreenType absolute $b800:0000;π ThisAttr, TestAttr : byte;π LoopRow, LoopCol, LineLen : integer;π begin {Xlate}π ThisAttr := $FF; {Force attribute to be set}π For LoopRow := 1 to NUMROWS do beginππ LineLen := NUMCOLS; {Find length of line}π While (LineLen > 0) and (Screen[LoopRow, LineLen].ch = ' ')π and not AttrChanged($00, Screen[LoopRow, LineLen])π do Dec(LineLen);ππ For LoopCol := 1 to LineLen do begin {Send stream to file}π If AttrChanged(ThisAttr, Screen[LoopRow, LoopCol])π then ChangeAttr(Outfile, ThisAttr, Screen[LoopRow, LoopCol].Attr);π write(Outfile, Screen[LoopRow, LoopCol].ch);π end;π If LineLen < 80 then writeln(OutFile); {else wraparound occurs}π end;π end; {Xlate}ππvarπ OutFile : text;πbeginπ Assign(OutFile, 'dump.scn');π Rewrite(OutFile);π Xlate(OUtFile);π Close(OUtFile);πend.ππ
