(* this is all the stuff that probably makes lucid what it is *)

Unit IO;

Interface
 uses records,ansidrv;
 procedure showprompt(a:boolean);
 Procedure AnsiClr;
 Function  AnsiYn(YesOnStr,YesOffStr,NoOnStr,NoOffStr : String;ff:boolean): Boolean;
 Procedure AnsiColor (Attrib : Byte);
 Procedure Animated_HoldScreen;
 PROCEDURE BACK(X:BYTE);
 Procedure Blinking(State : Boolean);
 Procedure editline (Var S : String);
 function  totalprompts:integer;
 function  foba(a,b:byte):string;
 Procedure FastClrScr;
 PROCEDURE FORE(X:BYTE);
 Procedure FillWord(var x; count:integer; w:word);
 Function  Keyhit:BOOLEAN;
 Procedure FastSetBack(Y : Byte;Pair : Word);
 Procedure GoXy(X,Y : Byte);
 procedure scrolltext(a:byte);
 Procedure HideCursor;
 procedure printfile(fn:string;var mci:mcis;entry:boolean);
 procedure PLAINPRINT(s:String);
 Procedure print(S : String);
 procedure println(s:string);
 procedure printrandom(s:String;VAR mci:mcis;f:boolean);
 procedure printxy(x,y:byte;s:String;a:boolean);
 Procedure PipeWrite(S : String);
 Function  Time : String;
 Function  Date : String;
 Procedure SDATEInput(var Str : String);
 Procedure swrite(S : String);
 Procedure swriteLn(S : String);
 Function  SKeyPressed : Boolean;
 Procedure SReadLn (Var S : String);
 Procedure SPhoneInput(var Str : String);
 Procedure SClrScr;
 Function  SReadKey : Char;
 procedure viewlogs;
 Procedure SaveScreen;
 Procedure ShowScreen;
 procedure savexy;
 Procedure ShowCursor;
 Procedure WRITEDATE;
 procedure nextprompt;
 Procedure WRITETIME;
 function  yn(s:boolean):string;
 function  ynchange(s:boolean):boolean;
 procedure lprintxy(x,y:Byte;s:String);
 PROCEDURE UPDATEMCIS;
 procedure addtolog(S:string);
 procedure savecolor;
 procedure restorecolor;
 procedure togglehidden;
 procedure toggleabort;
 function showstring(x:integer):string;

 Implementation
 Uses Dos,Crt,ProtComm,Genstr,Chat,timeing,swapit,menu,
      barinfo,filehandle,stackuse,detector;


 function showstring(x:integer):string;
 var b:boolean;
     f:file;
     str:strrec;
     xx:byte;

 procedure writestring;
 begin
 nseek(f,filesize(F));
 nwrite(f,str,sizeof(Str));
 end;

 begin
 b:=nassign(f,config.data_dir+'strings.dat');
 if b=false then  begin
                    nreset(f);
                    str.str:='~CS~CR|15L|07o|08gin|07: ';
                    str.dsc:='Login Prompt';
                    writestring;
                    str.str :='|15P|07a|08ssword|07: ';
                    str.dsc:='Password Prompt';
                    writestring;
                    str.str :='|15User Found!~CR';
                    str.dsc:='User Found';
                    writestring;
                    str.str :='|15User not Found!';
                    str.dsc:='User not found';
                    writestring;
                    str.str :='~CR~CR|07Looking up User|15.|07.|08.';
                    str.dsc:='Looking up the user';
                    writestring;
                    str.str :='~CSWelcome to |15~BL!~CR';
                    str.dsc:='Welcome User String';
                    writestring;
                    str.str :='|08-|04*|08- |07Checking For |15ANSi.|07.|08. |07Hold yer fro, P|15u|07NK|08!~CR';
                    str.dsc:='Checking For Ansi';
                    writestring;
                    str.str :='~CR~CRThe System Operator wants to Chat. Acknowledge? ';
                    str.dsc:='Chat Open';
                    writestring;
                    str.str :='~CR~CR|15Ab|07or|08t Newuser Application? ';
                    str.dsc:='Abort Newuser App';
                    writestring;
                    str.str :='~CR|15Pl|07ea|08se Select a Handle~CR|07: |09';
                    str.dsc:='Handle Select';
                    writestring;
                    str.str :='~CR|15Ch|07ec|08king to see if handle is being Used|15.|07.|08.~CR';
                    str.dsc:='Checking handle';
                    writestring;
                    str.str :='~CR|08Sorr|04y, Y|12ou ca|14nnot u|15se that Handle.~CR';
                    str.dsc:='Handle already exist';
                    writestring;
                    str.str :='~CR|15Pl|07ea|08se Enter your Full Name~CR|07: |09';
                    str.dsc:='Full Name Input';
                    writestring;
                    str.str :='~CR|08Yo|04u mu|12st e|14nter bo|15th your First and Last Names.~CR';
                    str.dsc:='Both Names';
                    writestring;
                    str.str :='~CR|15En|07te|08r your Phone Number~CR|07: |09';
                    str.dsc:='Phone Input';
                    writestring;
                    str.str :='~CR|15En|07te|08r Desired UserNote~CR|07: |09';
                    str.dsc:='User Note';
                    writestring;
                    str.str :='~CR|15Pl|07ea|08se Select a Password~CR|07: |09';
                    str.dsc:='Password Selection';
                    writestring;
                    str.str :='~CR|08Pa|04ssw|12ord|14s do n|15ot Match!';
                    str.dsc:='Password match wrong';
                    writestring;
                    str.str :='~CR|15No|07w R|08e-Enter your Password for Verification. ~CR|07: |09';
                    str.dsc:='Re-enter Password to check';
                    writestring;
                    str.str :='~CR|15Wo|07ul|08d you like Expert Mode? ';
                    str.dsc:='Expert Mode ask';
                    writestring;
                    str.str :='~CRUse the Fullscreen Editor? ';
                    str.dsc:='Use the FSE for messages';
                    writestring;
                    str.str :='~CRUse ANSI Graphics? ';
                    str.dsc:='Use ANSI graphics as Default';
                    writestring;
                    str.str :='~CRPlease Wait..Filing User Data...~CR';
                    str.dsc:='Makeing User File';
                    writestring;
                    str.str :='~CRNow you must leave a Note to the SysOp.~CR';
                    str.dsc:='Note Notify';
                    writestring;
                    str.str :='~CRCall back in 48 Hours and Check to see if you have been validated!.~CR';
                    str.dsc:='Call Back time';
                    writestring;
                    end else
                    begin
                    nSEEK(F,SIZEOF(STR)*(X-1));
                    nread(f,str,sizeof(Str));
                    showstring:=str.str;
                    end;
                    nclose(F);
 end;

 procedure togglehidden;
 begin
 asm xor hide,1 end;
 end;

 procedure toggleabort;
 begin
 asm xor abort,1 end;
 end;

 procedure savecolor;
 begin
 colorf:=textattr mod 16;
 colorb:=textattr div 16;
 end;

 procedure restorecolor;
 begin
 ansicolor(colorb shl 4 + colorf);
 end;

 PROCEDURE UPDATEMCIS;
 BEGIN
 BASICMCI[16].STR:=USER.ALIAS;
 BASICMCI[17].STR:=STRR(TIMELEFT);
 BASICMCI[18].STR:=STRR(USER.PCR);
 BASICMCI[19].STR:=STRR(USER.MAINLEV);
 BASICMCI[20].STR:=STRR(USER.FILELEV);
 BASICMCI[21].STR:=STRR(USER.oldUploadKB)+'k';
 BASICMCI[22].STR:=strr(user.oldDownloadKb)+'k';
 END;

Procedure HideCursor; Assembler;
Asm
 MOV ax,$0100
 MOV   cx,$2607
 INT   $10
end;

Procedure ShowCursor; Assembler;
Asm
 MOV   ax,$0100
 MOV   cx,$0506
 INT   $10
end;

Procedure Blinking(State : Boolean);assembler;
Asm
 MOV AX,1003h
 MOV BH,0
 MOV BL,State
 INT 10h
End;

procedure addtolog(S:string);
var t:file;
begin
nassign(t,config.data_dir+'lucid.log');
nseek(t,filesize(t));
nwrite(t,S,sizeof(S));
nwrite(t,S,sizeof(S));
nwrite(t,S,sizeof(S));
nwrite(t,S,sizeof(S));
nwrite(t,S,sizeof(S));
nwrite(t,S,sizeof(S));
nwrite(t,S,sizeof(S));
nwrite(t,S,sizeof(S));
nclose(T);
end;



function totalprompts:integer;
var
 DirInfo: SearchRec;         { For Windows, use TSearchRec }
 X:INTEGER;
begin                          { For Windows, use faArchive }
 FindFirst(config.textfile_dir+'PROMPT.*', Archive, DirInfo); { Same as DIR *.PAS }
 X:=0;
 while DosError = 0 do
 begin
 INC(x);
   FindNext(DirInfo);
 end;
TOTALPROMPTS:=X;
end;

procedure nextprompt;
begin
inc(user.prompt);
if user.prompt>totalprompts then user.prompt:=1;
end;

procedure showprompt(a:boolean);
var f:text;
    s:string;
begin
assign(f,config.textfile_dir+'PROMPT.'+strr(user.prompt));
{$i-} reset(f); {$i+}
     if ioresult<>0 then
     begin
     print('|B0|04Menu Prompt >');
     exit;
     end;
if a then goxy(wherex,wherey-1) else if user.xpermode then print(#10#13);

repeat
readln(f,s);
print(#27+'[K'+s);
until eof(F);
close(F);
end;

procedure viewlogs;
var t:file;
    s:string;
    x:byte;
begin
textattr:=7;
clrscr;
nassign(t,config.data_dir+'lucid.log');
x:=1;
repeat
nread(t,s,sizeof(s));
pipewrite(s);
WRITELN;
inc(X);
if x=24 then begin
             readkey;
             x:=1;
             end;
until eof(t);
nclose(t);
readkey;
end;

 procedure lprintxy(x,y:Byte;s:String);
 var xx,yy:byte;
 begin
 xx:=wherex;
 yy:=wherey;
 crt.gotoxy(x,y);
 pipewrite(s);
 crt.GOTOXY(xx,yy);
 end;

Procedure PipeWrite(S : String);
Var x,y:integer;
    r:string;
    g:integer;
begin
g:=1;
r:='';
y:=0;
for X:=1 TO LENGTH(S) DO BEGIN
case S[X] OF '|':BEGIN
case S[X+1] OF 'B':BEGIN
Y:=VALU(S[X+2]);
CRT.TEXTBACKGROUND(Y);
INC(X,2);
END ELSE BEGIN
R:=S[X+1]+S[X+2];
Y:=VALU(R);
CRT.TEXTCOLOR(Y);
INC(X,2);
END;
END;
END ELSE WRITE(S[X]);
END;
END;
END;

Procedure FastClrScr; Assembler;
asm
 cld;
 mov ax,$b800;
 mov es,ax;
 xor di,di;
 xor ah,ah;
 mov cx,2000;
 rep stosw
end;

Procedure FastSetBack(Y : Byte;Pair : Word);
Begin
 FillWord(mem[$b800:(Y-1)*160],80,Pair);
End;

procedure FillWord(var x; count:integer; w:word);
Begin
 Inline($c4/$be/x/$8b/$86/w/$8b/$8e/count/$fc/$f2/$ab);
End;

 function  ynchange(s:boolean):boolean;
 begin
 asm xor s,1 end;
 ynchange:=s;
 end;

 FUNCTION KEYHIT:BOOLEAN;
 BEGIN
 KEYHIT:=FALSE;
 IF KEYPRESSED THEN KEYHIT:=TRUE;
 END;

Procedure editline (Var S : String);
Var Ch : Char;
    x:integer;
Begin
  x:=1;
  x:=length(s);
  swrite(s);
  Repeat
    if ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
    Ch := SReadKey;
    IF X<BUFLEN THEN
    If Ord (Ch) in [32..122] Then
    Begin
      inc(x);
      S := S + Ch;
      if charit.use then
      ansicolor(charit.Back shl 4 + charit.Fore);
      If records.Hide=true then
       Begin
        Write(CH);
        If not localon then AWrite('*');
       End else Swrite(CH);
    End;
    If Ord(Ch) = Ord(8) Then
    Begin
      If Length (S) > 0 Then
      Begin
        if charit.use then
        SWrite (#8+charit.ch+#8) else
        SWrite (#8' '#8);
        Delete (S, Length (S), 1);
        dec(x);
      End;
    End;
  Until (Ord (Ch) = 13) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);
  SWrite (#13#10);
End;

procedure println(s:string);
begin
print(s+#10+#13);
end;

 function foba(a,b:byte):string;
  var s:string;
  begin
  s:='|';
  if a in [0..9] then s:=s+'0'+strr(a)+'|'+strr(32+b) else
                      s:=s+strr(a)+'|'+strr(32+b);
  foba:=s;
  end;

  procedure printxy(x,y:byte;s:String;a:boolean);
  begin
  goxy(x,y);
  if a=false then print(s) else plainprint(S);
  end;

 Procedure FORE(X:BYTE);
 BEGIN
 ANSICOLOR(X);
 END;

 Procedure BACK(X:BYTE);
 BEGIN
 ANSICOLOR(x shl 4);
 END;

procedure printrandom(s:String;VAR mci:mcis;f:boolean);
var
 DirInfo: SearchRec;
 a,x:word;
begin
 clearit;
 if fileexist(s+'.ans')=true then
 begin
 printfile(s+'.ans',mci,f);
 exit;
 end;

 FindFirst(S+'.???' ,Archive, DirInfo);
 X:=0;
 while DosError = 0 do
 begin
   inc(x);
   FindNext(DirInfo);
 end;
randomize;
a:=random(x);
if a=0 then a:=1;
printfile(s+'.'+strr(a),mci,f);
end;

function yn(s:boolean):string;
begin
if s=true then yn:='Yes' else yn:='No ';
end;

procedure savexy;
begin
savedx:=crt.wherex;
savedy:=crt.wherey;
end;

procedure printfile(fn:string;var mci:mcis;entry:boolean);
 var t        : text;
     c        : char;
     x,y      : integer;
     mcic     : string[4];
     mcifound : BOOLEAN;
     s        : string[2];
     error    : boolean;
     linecount: byte;

 procedure testcode(code:byte);
 begin
 savexy;
 mci[code].x:=wherex;
 mci[code].y:=wherey;
 mci[code].attr:=textattr;
 mci[code].fore:=textattr mod 16;
 mci[code].back:=textattr div 16;
 mci[code].used:=true;
 if mci[code].lng <> 0 then begin
 wleng:=mci[code].lng;
 buflen:=mci[code].lng;
 end;

 if entry=false then begin
                     if mci[code].phone=true then print(mci[code].str) else
                     if mci[code].DATE =true then print(mci[code].str) else
                     if mci[code].yesno=true then
                      BEGIN
                      WLENG:=255;
                      print(yn(mci[code].yesnoresult))
                      END
                     else print(mci[code].str);
                     end
                     else if mci[code].useproc=false then
                     begin
                     if mci[code].phone=true then sphoneinput(mci[code].str) else
                     if mci[code].DATE =true then sdateinput(mci[code].str) else
                     if mci[code].yesno=true then
                     mci[code].yesnoresult:=ansiyn('|15|B1 Yes ','|B0|07 Yes ','|15|B1 No ','|B0|07 No ',false)
                     else
                     editline(mci[code].str);
                     end;
 error:=false;
 end;

 procedure testcodeb(code:byte);
 begin
 savexy;
 mci[code].x:=wherex;
 mci[code].y:=wherey;
 mci[code].attr:=textattr;
 mci[code].fore:=textattr mod 16;
 mci[code].back:=textattr div 16;
 mci[code].used:=true;
 if mci[code].lng <> 0 then begin
 wleng:=mci[code].lng;
 buflen:=mci[code].lng;
 end;
 IF basicmci[code].useproc=true then BEGIN
                                     basicmci[code].action;
                                     ERROR:=FALSE;
                                     END;
 end;

 procedure til;
      var count:byte;
 begin
 savexy;
 read(t,s);

 if (s[2]=#27) or (s[1]=#27) then begin
                                  {write(ansi,'~'+s);}
                                  sansi('~'+s);
                                  awrite('~'+s);
                                  exit;
                                  end;


 for count:=1 to 30 do
 if basicmci[count].mci='~'+s then testcodeb(count);
 for count:=1 to 30 do
 if mci[count].mci='~'+s then testcode(count);
 if (s[1] in ['0'..'9']) and (s[2] in ['0'..'9']) then
 begin
 if valu(s) in [0..80] then begin
                            pb.x[valu(s)]:=savedx;
                            pb.y[valu(s)]:=savedy;
                            pb.bar[valu(s)]:=true;
                            error:=false;
                            end;
 end;
 if error=true then begin
{                    write(ansi,'~'+S);}
                    sansi('~'+s);
                    awrite('~'+s);
                    end;
 if error=false then goxy(Savedx+3,savedy);
 end;


 procedure per;
     var count:byte;
 begin
 savexy;
 read(t,s);
 if (s[2]=#27) or (s[1]=#27) then begin
{                  write(ansi,'%'+s);}
                  sansi('%'+s);
                  awrite('%'+s);
                  exit;
                  end;


 for count:=1 to 30 do
 if basicmci[count].mci='%'+s then testcodeb(count);
 for count:=1 to 30 do
 if mci[count].mci='%'+s then testcode(count);
 if error=true then begin;
                    swrite('%'+S);
                    end;
 if error=false then goxy(Savedx+3,savedy);
 end;

 procedure chars;
      var count:byte;
 begin
 savexy;
 read(t,s);
 error:=false;
 if (s[2]=#27) or (s[1]=#27) then begin
{                  write(ansi,'#'+s);}
                  sansi('#'+s);
                  awrite('#'+s);
                  exit;
                  end;
 if s[1]='C' then charit.ch:=s[2];
 if s[1] in ['0'..'2'] then charit.FORE:=valu(s[1]+s[2]);
 if s[1]='B' then charit.back:=valu(s[2]);
 if s='ON' then charit.use:=true;
 if s='OF' then charit.use:=false;
 if s='RR' then begin
                charit.use:=false;
                charit.fore:=7;
                charit.back:=0;
                charit.ch:=' ';
                end;
 if error=true then print('#'+S);
 if error=false then goxy(Savedx+3,savedy);
 end;

 procedure at;
     var count:byte;
 begin
 savexy;
 read(t,s);
 if (s[2]=#27) or (s[1]=#27) then begin
                                  sansi('@'+s);
                                  awrite('@'+s);
                                  exit;
                                  end;

 if (s[1] in ['0'..'9']) and (s[2] in ['0'..'9']) then
 begin
 if valu(s) in [0..80] then goxy(valu(s),wherey)
 end { had to do add the begin end, kinda dumb }
 else swrite('@'+S);
 end;

 procedure leng;
     var count:byte;
 begin
 savexy;
 read(t,s);
 if (s[2]=#27) or (s[1]=#27) then begin
                  sansi('{'+s);
                  awrite('{'+s);
                  exit;
                  end;

 if (s[1] in ['0'..'9']) and (s[2] in ['0'..'9']) then
 begin
 if valu(s) in [0..80] then wleng:=valu(s)
 end { had to do add the begin end, kinda dumb }
 else
     begin;
     swrite('{'+S);
     end;
 if error=false then goxy(Savedx+3,savedy);
 end;

 procedure bufit;
     var count:byte;
 begin
 savexy;
 read(t,s);
 if (s[2]=#27) or (s[1]=#27) then begin
                  sansi('}'+s);
                  awrite('}'+s);
                  exit;
                  end;

 if (s[1] in ['0'..'9']) and (s[2] in ['0'..'9']) then
 begin
 if valu(s) in [0..80] then buflen:=valu(s)
 end { had to do add the begin end, kinda dumb }
     else
     begin
     swrite('}'+S);
     end;
 if error=false then goxy(Savedx+3,savedy);
 end;

 procedure pipe;
      var count:byte;
 begin
 savexy;
 read(t,s);
 if (s[2]=#27) or (s[1]=#27) then begin
{                 write(ansi,'|'+s);}
                  sansi('|'+s);
                  awrite('|'+s);
                  exit;
                  end;

 for count:=1 to 30 do
 if basicmci[count].mci='|'+s then testcodeb(count);

 for count:=1 to 30 do
 if mci[count].mci='|'+s then testcode(count);

 if error=true then print('|'+S);

 if error=false then goxy(Savedx,savedy);
 end;

 var cb   : byte;
     oy   : byte;
     ly   : byte;
 begin
 clearit;
 abort:=true; { turns abort off }
 wleng:=255;
 buflen:=80;
 assign(t,fn);
 {$i-} reset(t); {$i+}
 if ioresult<>0 then exit;
 linecount:=0;
 ly:=wherey;
 oy:=wherey;
 repeat
 read(t,c);
 error:=true;

 if (abort=true) and (keypressed) then begin;
                      savexy;
                      animated_holdscreen;
                      close(t);
                      goxy(savedx,savedy);
                      print(#27+'[K');
                      goxy(savedx,savedy);
                      exit;
                      end;

 case c of
 '@':at; {this is mainly used for listing ansi}
 '#':chars; {change char record}
 '~':til; {usually for just displaying}
 '%':per; {usually input strings}
 '|':pipe; {colors and displaying string}
 '{':leng; {fix length of whatever}
 '}':bufit;
 else begin
      awrite(C);
{     write(ansi,c);}
      sansi(c);
      end;
 end;

 until (eof(t))  OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);
 close(T);
 wleng:=255;
 buflen:=80;
 end;

Procedure ShowScreen;
Begin
printfile(Config.Textfile_Dir+'SAVE.SCR',basicmci,False);
goxy(savedx,savedy);
End;

Procedure SAVESCREEN;

Type ScreenBuf = Record
                 CH : Char;
                 CO : Byte;
                 End;

type Screen=Array[1..1920] of ScreenBuf;
    var
    screenx:^screen;
    T      : Text;
    X      : 0..2000;
    Fore   : Byte;
    Back   : Byte;
         blink:boolean;
         bright:boolean;
         COVER:0..2000;
         COLORSAME:BOOLEAN;
begin
getmem(screenx,4000);
FILLCHAR(sCREENx^,SIZEOF(sCREEN),#0);
ASSIGN(T,CONFIG.Textfile_Dir+'SAVE.SCR');
REWRITE(T);
Move(Mem[$B800:0000],SCREENx^,3840);
COVER:=0;
WRITE(T,'[2J');
FOR X := 1 TO 1919 DO BEGIN
fore:=0;
back:=0;
COLORSAME:=FALSE;
blink:=false;
bright:=false;
fore:=screenx^[x].co mod 16;
back:=screenx^[x].co div 16;
blink:=screenx^[x].co shr 7<>0;
IF screenx^[x].co MOD 16 IN[0,1,2,3,4,5,6,7,16,17,18,19,20,21,22,23] THEN
bright:=false else bright:=true;
IF    (SCREENx^[X].CO MOD 16)= (SCREENx^[X-1].CO MOD 16) THEN
IF    (SCREENx^[X].CO DIV 16)= (SCREENx^[X-1].CO DIV 16) THEN
IF     SCREENx^[X].CO SHR 7= SCREENx^[X-1].CO SHR 7 THEN COLORSAME:=TRUE;
IF COLORSAME=FALSE THEN BEGIN
WRITE(T,'[');
case screenx^[x].co mod 16 of
    0:write(t,'0;30m');
    1:write(t,'0;34m');
    2:write(t,'0;32m');
    3:write(t,'0;36m');
    4:write(t,'0;31m');
    5:write(t,'0;35m');
    6:write(t,'0;33m');
    7:write(t,'0;37m');
    8:write(t,'1;30m');
    9:write(t,'1;34m');
    10:write(t,'1;32m');
    11:write(t,'1;36m');
    12:write(t,'1;31m');
    13:write(t,'1;35m');
    14:write(t,'1;33m');
    15:write(t,'1;37m');
    16:write(t,'5;0;30m');
    17:write(t,'5;0;34m');
    18:write(t,'5;0;32m');
    19:write(t,'5;0;36m');
    20:write(t,'5;0;31m');
    21:write(t,'5;0;35m');
    22:write(t,'5;0;33m');
    23:write(t,'5;0;37m');
    24:write(t,'5;1;30m');
    25:write(t,'5;1;34m');
    26:write(t,'5;1;32m');
    27:write(t,'5;1;36m');
    28:write(t,'5;1;31m');
    29:write(t,'5;1;35m');
    30:write(t,'5;1;33m');
    31:write(t,'5;1;37m');
 end;
write(t,'[');
case screenx^[x].co div 16 of
    0:WRITE(t,'40m');
    1:WRITE(t,'44m');
    2:WRITE(t,'42m');
    3:WRITE(t,'46m');
    4:WRITE(t,'41m');
    5:WRITE(t,'45m');
    6:WRITE(t,'43m');
    7:WRITE(t,'47m');
    end;

END;
write(t,screenx^[x].ch);
END;
write(t,'['+strr(wherey)+';'+strr(wherex)+'H');
CLOSE(T);
SavedX := WhereX;
SavedY := WhereY;
freemem(screenx,4000);
end;


Procedure GoXy(X,Y : Byte);
var lx,ly:Byte;
Begin
 lx:=x;
 ly:=y;
 gotoxy(lx,lY);
 if wherey=user.scrln then inc(y);
 Awrite(    #27+'['+Strr(Y)+';'+Strr(X)+'H');
End;

Procedure AnsiClr;
Begin
 textattr:=7;
 ClrScr;
 Awrite(#27+'[0m'+#27+'[2J');
End;

Procedure SWrite (S : String);
Begin
 {write(ansi,s);}
 sansi(s);
 if localon=false then AWrite(S);
End;

Procedure SWriteLn (S : String);
Begin
 sansi(s+#10#13);
 if localon=false then AWriteLn(S);
End;

Procedure CmdHelp;External;{$L COMMAND.OBJ}

Function SReadKey : Char;

Type Buffer = Array[1..4000] of Byte;

Var Done  : Boolean;
    tempv:array[1..4000] of byte;
    Buff  : ^Buffer;
    C1,c2 : Char;
    X : Byte;
    Chars : Byte;
    temptime:integer;
    lastmin:string;
    SX,SY:BYTE;
Begin
 Done := False;
 C1 := #0;C2 := #0;
 Repeat
  if ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
  stackreport;
  checktime;
  if loggedoff=true then exit;
  If {Not Localon Then If} DataAvailable Then
   Begin
    C1 := Chr(GetChar);
    Done := True;
   End;

  If KeyPressed Then
   Begin
    C1 := #0;C2 := #0;
    C1 := ReadKey;
    timeslice;
    MemW[$0000:$041C] := MemW[$0000:$041A];
    If C1 = #0 then C2 := Readkey;
    If C1 = #0 then begin
     timeslice;
     MemW[$0000:$041C] := MemW[$0000:$041A];
     sx:=wherex;
     sy:=wherey;
     Case C2 of
      #8: C1:=#8;
      #33 : Begin
             Randomize;
             Chars := Random(10);
             If Chars < 1 then Chars := 1;
             For X := 1 to Chars do
              Begin
               SWrite(Chr(Random(255)));
              End;
            End;
      #48 : Begin
             If CurrentBar < 3 then Inc(CurrentBar) else CurrentBar := 1;
             InfoBar(CurrentBar,'');
            End;
      #59 : CallChat(1);
      #60 : begin
            asm xor infoit,1 end;
            c1:=#0;
            c2:=#0;
            fillchar(tempv,sizeof(tempv),#0);
                      if infoit=false then begin
                      move(mem[$b800:0000],tempv,4000);
                      savexy;
                      textmode(3);
                      window(1,1,80,25);
                      move(tempv,mem[$b800:0000],4000);
                      crt.gotoxy(savedx,savedy);
                      end else
                      begin
                      savexy;
                      move(mem[$b800:0000],tempv,4000);
                      textmode(c80+font8x8);
                      window(1,1,80,25);
                      move(tempv,mem[$b800:0000],4000);
                      crt.gotoxy(savedx,savedy);
                      end;
                      end;

      #35 : Begin
             textattr:=7;
             HideCursor;
             GetMem(Buff,4000);
             Move(Mem[$b800:0],Buff^,4000);
             clrscr;
             Move(@CmdHelp^,Mem[$b800:0000],3040);
             Repeat Until Keypressed;
             MemW[$0000:$041C] := MemW[$0000:$041A];
             Move(Buff^,Mem[$b800:0],4000);
             FreeMem(Buff,4000);
             ShowCursor;
            End;
      #36 : begin
            SX:=WHEREX;
            SY:=WHEREY;
            savescreen;
            println('|B0|15Sysop Shelling to DOS');
            textattr:=7;
            WINDOW(1,1,25,80);
            if swap then doexec(GETENV('COMSPEC')+' ')
                         else
                         exec(GETENV('COMSPEC'),'');
            showscreen;
            INFOBAR(CURRENTBAR,'');
            GOXY(SX,SY);
            end;
      #49 : Begin
             hungup:=true;
             loggedoff:=true;
             hangup;
             hangup;
             c1:=#0;
             c2:=#0;
             sreadkey:=#0;
             exit;
            End;
      #130: TAKETIME;
      #131: ADDTIME;
        else Done := True;
     End;
     goxy(sx,sy);
     end else  Done := True;
   If C2 in[#75,#77,#80,#72] then BEGIN; C1 := C2; DONE:=TRUE; END;
   End;
   Until (Done) or (hungup) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);;;
 SReadKey := C1;
End;

Function SKeyPressed : Boolean;
Begin
  SKeyPressed := False;
  If DataAvailable Then SKeyPressed := True;
  If KeyPressed Then SKeyPressed := True;
End;

Procedure SDATEInput(var Str : String);
Var P       : String;
    Counter : Byte;
    Done    : Boolean;
    StartX,y  : Byte;
    Key : Char;
Begin
 P := '';
 Counter := 0;
 Done := False;
 SWrite(P);
 Repeat
  Key := #0;
  Key := SReadkey;
  Case Key of
   #8 : If Counter > 0 then
         Begin
          Delete(P,Counter,1);
          SWrite(^H+' '+^H);
          Dec(Counter);
          If Counter in[3,7] then
           Begin
            Delete(P,Length(P),1);
            SWrite(^H+' '+^H);
            Dec(Counter,1);
           End;
         End;
  #13 : If Counter = 8 then Done := True;
  '0'..'9' : If Counter < 8 then
              Begin
               Inc(Counter);
               P := P + (Key);
               SWrite(Key);
               If (Counter in[2,5]) then
                Begin
                 P := P + '/';
                 SWrite('/');
                 Inc(Counter);
                End;
              End;
  End;
 Until (Done) or ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);
 Str := P;
End;


Procedure SPhoneInput(var Str : String);
Var P       : String;
    Counter : Byte;
    Done    : Boolean;
    Key : Char;
Begin
 P := '';
 Counter := 0;
 Done := False;

 Repeat
  Key := #0;
  Key := SReadkey;
  Case Key of
   #8 : If Counter > 0 then
         Begin
          Delete(P,Counter,1);
          SWrite(^H+' '+^H);
          Dec(Counter);
          If Counter in[3,7] then
           Begin
            Delete(P,Length(P),1);
            SWrite(^H+' '+^H);
            Dec(Counter,1);
           End;
         End;
  #13 : If Counter = 12 then Done := True;
  '0'..'9' : If Counter < 12 then
              Begin
               Inc(Counter);
               P := P + (Key);
               SWrite(Key);
               If (Counter in[3,7]) then
                Begin
                 P := P + '-';
                 SWrite('-');
                 Inc(Counter);
                End;
              End;
  End;
 Until (Done) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);
 Str := P;
End;

procedure scrolltext(a:byte);
var f:text;
    x:integer;
    s:string;
    temp:string;
    b:byte;
begin
case a of
1:begin { inits the scroller }
  assign(f,CONFIG.TEXTFILE_DIR+scroller.filename);
  {$i-} reset(F); {$i+}
  if ioresult<>0 then exit;
  readln(f,scroller.x);
  readln(f,scroller.y);
  readln(f,scroller.delay);
  scroller.total:=0;
  scroller.used:=true;
  if not eof(f) then
  repeat
  inc(scroller.total);
  readln(f,s);
  until eof(f);
  close(F);
  end;
2:begin
  if scroller.used=false then exit;
  savexy;
  assign(f,CONFIG.TEXTFILE_DIR+'scroll.1');
  reset(F);
  for x:=1 to 3 do readln(f,temp); {gets rid of header}

  for x:=1 to scroller.current do readln(f,temp);
  readln(f,s);
  goxy(scroller.x,scroller.y);
  delay(scroller.delay);
  print(s);
  goxy(savedx,savedy);
  inc(scroller.current);
  if scroller.current>scroller.total then scroller.current:=1;
  close(F);
  end;
3:begin {de inits}
 fillchar(scroller,sizeof(Scroller),#0);
 scroller.used:=false;
 scroller.total:=0;
 scroller.current:=0;

  end;

end;
end;

Procedure Animated_HoldScreen;
var pause:text;
    s:string;
    tempv:array[1..4000] of byte;
    delayr : byte;
    c:char;
    a,X:INTEGER;
    dirinfo:searchrec;
    temp:String;
    chars:byte;
Begin
 FindFirst(CONFIG.TEXTFILE_DIR+'pause.???' ,Archive, DirInfo);
 X:=0;
 while DosError = 0 do
 begin
   inc(x);
   FindNext(DirInfo);
 end;
 randomize;
 a:=random(x);
 if a=0 then a:=1;
 if tassign(pause,config.textfile_dir+'pause.'+STRR(a))=false then
 begin
 print('|B0|04 Press Any Key ');
 sreadkey;
 exit;
 end;
 savexy;
 c:=#0;
 savecolor;
 repeat
 treadln(pause,temp);
 delayr:=valu(temp);
 repeat
  If (Keypressed) or ((Not Localon) and (DataAvailable)) Then
  If Keypressed then begin{c := Readkey Else c:= Chr(GetChar);}
      c:=readkey;
      case c of
      #33 : Begin
             Randomize;
             Chars := Random(10);
             If Chars < 1 then Chars := 1;
             For X := 1 to Chars do
              Begin
               SWrite(Chr(Random(255)));
              End;
            End;
      #48 : Begin
             If CurrentBar < 3 then Inc(CurrentBar) else CurrentBar := 1;
             InfoBar(CurrentBar,'');
            End;
      #59 : CallChat(1);
      #60 : begin
            asm xor infoit,1 end;
            fillchar(tempv,sizeof(tempv),#0);
                      if infoit=false then begin
                      move(mem[$b800:0000],tempv,4000);
                      savexy;
                      textmode(3);
                      window(1,1,80,25);
                      move(tempv,mem[$b800:0000],4000);
                      crt.gotoxy(savedx,savedy);
                      end else
                      begin
                      savexy;
                      move(mem[$b800:0000],tempv,4000);
                      textmode(c80+font8x8);
                      window(1,1,80,25);
                      move(tempv,mem[$b800:0000],4000);
                      crt.gotoxy(savedx,savedy);
                      end;
                      end;
      #35 : Begin
             textattr:=7;
             HideCursor;
             Move(Mem[$b800:0],tempv,4000);
             clrscr;
             Move(@CmdHelp^,Mem[$b800:0000],3040);
             Repeat Until Keypressed;
             MemW[$0000:$041C] := MemW[$0000:$041A];
             Move(tempv,Mem[$b800:0],4000);
             ShowCursor;
            End;
      #49 : Begin
             hungup:=true;
             loggedoff:=true;
            End;
      #130: TAKETIME;
      #131: ADDTIME;
      end;
      end else c:= Chr(GetChar);
 goxy(savedx,savedy);
 treadln(pause,s);
 print(s);
 goxy(savedx,savedy);
 delay(delayr);
 until (eof(pause)) or (c<>#0);
 treset(pause);
 until (c<>#0) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) or (Dataavailable);
 if dataavailable then repeat
                       getchar;
                       until not dataavailable;
 tclose(pause);
End;

Procedure SReadLn (Var S : String);
Var Ch : Char;
    x:integer;
Begin
  S := '';
  x:=1;
  Repeat
    if scroller.used then
    repeat
    scrolltext(2);
    until skeypressed;
    if ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
    Ch := SReadKey;
    IF X<BUFLEN+1 THEN
    If Ord (Ch) in [32..122] Then
    Begin
      inc(x);
      S := S + Ch;
      If Hide then
       Begin
        if charit.use then
        ansicolor(charit.Back shl 4 + charit.Fore);
        Write(CH);
        If not localon then AWrite('*');
       End else Swrite(CH);
    End;
    If Ord(Ch) = Ord(8) Then
    Begin
      If Length (S) > 0 Then
      Begin
        if charit.use then
        SWrite (#8+charit.ch+#8) else
        SWrite (#8' '#8);
        Delete (S, Length (S), 1);
        dec(x);
      End;
    End;
  Until (Ord (Ch) = 13) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);
  SWrite (#13#10);
End;

Procedure SClrScr;
Begin
  SWriteLn (#27+'[2J');
  ClrScr;
End;

Function Date : String;
Var Year,MOnth,Day,DOW : Word;
Begin
 GetDate(Year,Month,Day,DOW);
 Date := Leadingzero(Month)+'/'+Leadingzero(Day)+'/'+Copy(Strr(Year),3,2);
End;

Function Time : String;
Var Hour,Minute,Second,MSec : Word;
    Marker : Char;
Begin
 GetTime(Hour,Minute,Second,MSec);
 If Hour > 12 then
  Begin
   Dec(Hour,12);
   Marker := 'p';
  End else Marker := 'a';
 Time := Leadingzero(Hour)+':'+LeadingZero(Minute)+' '+Marker+'m';
End;

PROCEDURE WRITETIME;
BEGIN
swrite(TIME);
END;

PROCEDURE WRITEDATE;
BEGIN
swrite(DATE);
END;

Procedure print(S : String);
Var X,Code : Byte;
    Error  : Integer;
Begin
records.fore:=7;
records.back:=0;
stackreport;
checktime;
For X := 1 to Length(S) do
 Begin
  if ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
  if hungup then exit;
  If X > wleng then Exit;

  if s[x] = '{' then
       begin;
       if valu(s[x+1]+s[x+2]) in [0..80] then wleng:=valu(s[x+1]+s[x+2]);
       inc(x,2);
       end else

  If S[X] = '@' then
  BEGIN
  IF VALU(S[X+1]+S[X+2]) IN [1..80] THEN
              begin
              GOXY(VALU(S[X+1]+S[X+2]),whereY);
              INC(X,2);
              end;
  end else

  if s[x] = '?' then
  begin
     case s[x+1] of
     'Y' : Case S[x+2] of
            'N':begin;
                doyn:=true;
                if ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
                tempyn:=AnsiYn('|B1|15 YES ','|B0|15 YES ','|B1|15 NO ' ,'|B0|15 NO ',true);
                inc(x,2);
                 END;
            END;
     'N' : Case S[x+2] of
            'Y':begin;
                doyn:=true;
                if ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
                tempyn:=AnsiYn('|B1|15 YES ','|B0|15 YES ','|B1|15 NO ' ,'|B0|15 NO ',FALSE);
                inc(x,2);
                 END;
            END;
                 END
                 end else


  If S[X] = '~' then
   Begin
    Case s[X+1] of
     '0'..'2':IF VALU(S[X+1]+S[X+2]) IN [1..80] THEN
              begin
              GOXY(WHEREX,VALU(S[X+1]+S[X+2]));
              INC(X,2);
              end;
     'C' : Case S[X+2] of
            'R' : Begin Swrite(#10#13); Inc(X,2); End;
            'S' : Begin AnsiClr; Inc(X,2); End;
            'A' : BEGIN swrite(menuname); inc(x,2); end;
           End;
     'T' : Case S[X+2] of
            'D' : Begin SWrite(Date); Inc(X,2); End;
            'T' : Begin writetime; Inc(X,2); End;
{            'A' : BEGIN swrite(tempstr[1]); inc(x,2); end;
            'B' : BEGIN swrite(tempstr[2]); inc(x,2); end;
            'C' : BEGIN swrite(tempstr[3]); inc(x,2); end;
            'D' : BEGIN swrite(tempstr[4]); inc(x,2); end;
            'E' : BEGIN swrite(tempstr[5]); inc(x,2); end;}
           End;
     'M' : Case S[X+2] of (* ~Mx - Movement Commands *)
            'L' : Begin Swrite(#27+'[D'); Inc(X,2); End;
            'R' : Begin Swrite(#27+'[C'); Inc(X,2); End;
            'U' : Begin Swrite(#27+'[A'); Inc(X,2); End;
            'D' : Begin Swrite(#27+'[B'); Inc(X,2); End;
           End;
     'B' : Case S[X+2] of (* ~Bx = BBS Information *)
            'L' : Begin Swrite(Config.LongName); Inc(X,2); End;
            'S' : Begin Swrite(Config.ShortName); Inc(X,2);End;
            'P' : Begin Swrite(Config.BoardPhone); Inc(X,2);End;
            'Y' : Begin Swrite(Config.SysOpName); Inc(X,2);End;
            'N' : Begin Swrite(Strr(Config.NodeNumber)); Inc(X,2);End;
            'B' : Begin Swrite(Strr(Config.LockBaud));Inc(X,2); End;
            'C' : Begin Swrite(Strr(Config.Comport));Inc(X,2); End;
           End;
     'U' : Case S[X+2] of (* ~Ux = User Information *)
            'A' : Begin Swrite(User.Alias); Inc(X,2);End;
            'B' : Begin Swrite(Copy(User.Phone,1,3));Inc(X,2); End;
            'C' : Begin Swrite(Strr(User.Credits));Inc(X,2); End;
            'D' : Begin Swrite(Strr(User.Downloads));Inc(X,2); End;
            'F' : Begin Swrite(Strr(User.FileLev));Inc(X,2); End;
            'M' : Begin Swrite(Strr(User.Posts));Inc(X,2); End;
            'N' : Begin Swrite(User.UserNote);Inc(X,2); End;
            'P' : Begin Swrite(User.Phone);Inc(X,2); End;
            'R' : Begin Swrite(User.RealName);Inc(X,2); End;
            'S' : Begin Swrite(Strr(User.MainLev));Inc(X,2); End;
            'T' : Begin Swrite(Strr({user.}timeleft));Inc(X,2); End;
            'U' : Begin Swrite(Strr(USer.Uploads));Inc(X,2); End;
            'V' : Begin Swrite(Strr(User.BytesUp));Inc(X,2); End;
            'W' : Begin Swrite(Strr(User.BytesDown));Inc(X,2); End;
            '%' : Begin Swrite(Strr(User.PCR));Inc(X,2); End;
            'Z' : Begin Swrite(Strr(User.UDRatio));Inc(X,2); End;
            '@' : Begin Swrite(Strr(User.Calls));Inc(X,2); End;
            '$' : Begin Swrite(Strr(User.TimePerday));Inc(X,2); End;
            '*' : Begin Swrite(Strr(User.CallsPerDay));Inc(X,2); End;
           else swrite('~');
           End;

    End;
   End else
  If S[X] = '|' then
       if s[x+1]='B' then begin
                          io.back(strtoint(s[x+2]));
                          records.back:=strtoint(s[x+2]);

                          AnsiColor(records.Back shl 4 + records.Fore);
                          inc(x,2);
                          end
                          else
   Begin
    Val(Copy(S,X+1,2),Code,Error);
    If Error = 0 then
     Begin
      If Code < 16 then records.Fore := Code else records.Back := Code-16;
      If X+2 > Length(S) then Inc(X,1) else Inc(X,2);
      AnsiColor(records.Back shl 4 + records.Fore);
     End else Swrite(S[X]);
   End else SWrite(S[X])
 End;
End;

Procedure plainprint(S : String);
Var X,Code : Byte;
    Error  : Integer;
    Back,Fore : Byte;
Begin
fore:=7;
back:=0;
stackreport;
checktime;
For X := 1 to Length(S) do
 Begin
  if ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
  if hungup then exit;
  If X > wleng then Exit;

  If S[X] = '|' then
       if s[x+1]='B' then begin
                          back:=strtoint(s[x+2]);
                          AnsiColor(Back shl 4 + Fore);
                          inc(x,2);
                          end
                          else
   Begin
    Val(Copy(S,X+1,2),Code,Error);
    If Error = 0 then
     Begin
      If Code < 16 then Fore := Code else Back := Code-16;
      If X+2 > Length(S) then Inc(X,1) else Inc(X,2);
      AnsiColor(Back shl 4 + Fore);
     End else Swrite(S[X]);
   End else SWrite(S[X])
 End;
End;

Procedure AnsiColor(Attrib : Byte);
Var TC : Integer;
    W  : Byte;
Const ColorID : Array [0..7] of Byte = (30,34,32,36,31,35,33,37);
Begin
  If Attrib = 0 Then TextAttr := 7 Else TextAttr := Attrib;
  swrite(#27'[0');
  TC := Attrib AND 7;
  If TC <> 7 Then swrite(';'+Strr(ColorID[TC]));
  TC := (Attrib SHR 4) AND 7;
  If TC <> 0 Then swrite(';'+Strr(colorid[tc]+10));
  if (attrib and 8)=8 then Swrite(';1');
  if (attrib and 128)=128 then Swrite(';5');
  swrite('m');
End;

Function AnsiYn(YesOnStr,YesOffStr,NoOnStr,NoOffStr : String;ff:boolean): Boolean;
Var Bah : Boolean;
    CH  : Char;
    X   : Byte;
    y   : byte;

Begin
 if user.yesno=false then
 begin
 print('|B0|01[|09Y|01/|09N|01]');
 CH:=UPCASE(SREADKEY);
 CASE upcase(CH) OF
 'Y' : Bah := True;
 'N' : Bah := False;
 END;
 AnsiYn := Bah;
 Ansicolor(7);
 EXIT;
 end;
 Bah := FF;
 CH := #0;
 savexy;
 Repeat
  goxy(savedx,savedy);
  If (Not localon) and (not carrier) or ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff) then exit;
  If Bah then print(YesOnStr+NoOffStr)
         else print(YesOffStr+NoOnStr);
  CH := Upcase(SReadkey);
  Case CH of
   'C','D',#75,#77 : asm xor bah,1 end;
   'y','Y' : Bah := True;
   'n','N' : Bah := False;
  End;
 Until (CH in[#13,^M,'Y','N']) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);;
 AnsiYn := Bah;
 Ansicolor(7);
End;


begin
end.
