Unit Console;

Interface

Uses strings, crt, fkscr;

Const MAX_COMMANDS = 256;

Type proc_t        = Procedure;
     cmd_t         = Record
                       name : String[32];
                       help : String[64];
                       func : proc_t;
                     End;

Const whitespace = [#1..#32];
      special    = ['(',')','!','+','*','-','='];

Var  Con_Write   : Procedure(s : string);
     Con_WriteLn : Procedure(s : string);
     Con_Clear   : Procedure;
     con_x, con_y: Integer;
     cmds        : Array[0..MAX_COMMANDS-1] Of cmd_t;
     numcmds     : LongInt;
     cmd         : PChar;
     pr_token    : Array[0..2047] Of Char;
     lines       : Array[0..2047] Of PChar;
     lacc        : Word;

Function GetToken : PChar;
Procedure AddCmd(name : string; help : String; p : proc_t);

Implementation

Var  accumstr  : string;

Function GetToken : PChar;
Var i : PChar;
    o : LongInt;
Begin
  i := cmd; o := 0;
  While not (i^ in whitespace) and not (i^ in special) and (i^ <> #0) Do Begin
    pr_token[o] := i^;
    Inc(i); Inc(o);
  End;

  {Skip to beginning of next token:}
  While (i^ in whitespace) And (i^ <> #0) Do Inc(i);
  cmd := i;

  pr_token[o] := #0;
  GetToken := pr_token;
End;

Procedure CClear;
Var i : Integer;
Begin
  {Clear the buffer:}
  For i := 0 To lacc Do Begin
    If assigned(lines[i]) Then
      FreeMem(lines[i], strlen(lines[i]));
  End;
  lacc := 0;
  ClrScr;
End;

{This is just here to be portable.}
{You can rewrite this to write out to a graphics console with a font
 or something}
Procedure CWrite (s : string);
Var i,j : integer;
Begin
  GotoXY(con_x, con_y);
  For i := 1 To Length(s) Do Begin
    If (s[i] = #10) Then Begin
      If WhereY > 23 Then GotoXY(1,23);
      {Add lines to the buffer:}
      If lacc <= 2047 Then Begin
        If assigned(lines[lacc]) Then
          FreeMem(lines[lacc], strlen(lines[lacc]) + 1);
        GetMem(lines[lacc], Length(accumstr));
        StrPCopy(lines[lacc], accumstr);
        Inc(lacc);
      End Else Begin
        lacc := 2047;
        {Free very top line,}
        FreeMem(lines[0], strlen(lines[0]) + 1);
        {Shift all others up,}
        For j := 1 to 2047 Do lines[j-1] := lines[j];
        {And allocate room for the new line.}
        GetMem(lines[lacc], Length(accumstr));
        StrPCopy(lines[lacc], accumstr);
        Inc(lacc);
      End;
      WriteLn(accumstr); accumstr := '';
      continue;
    End;
    accumstr := accumstr + s[i];
  End;
  If WhereY > 23 Then GotoXY(1,23);
  con_x := WhereX; con_y := WhereY;
End;

Procedure CWriteLn (s : string);
Var i : integer;
Begin
  Con_Write(s+#10);
End;

Procedure AddCmd(name : string; help : String; p : proc_t);
Begin
  cmds[numcmds].name := name;
  cmds[numcmds].help := help;
  cmds[numcmds].func := p;
  Inc(numcmds);
End;

Var i : integer;
Begin
  con_x := 1; con_y := 23;
  numcmds := 0; lacc := 0;
  For i := 0 To 2047 Do lines[i] := nil;
  {This tells Con_Write what function to use.}
  {$IFNDEF TP}
    Con_Write := @CWrite;
    Con_WriteLn := @CWriteLn;
    Con_Clear := @CClear;
  {$ELSE}
    Con_Write := CWrite;
    Con_WriteLn := CWriteLn;
    Con_Clear := CClear;
  {$ENDIF}
End.
