uses crt, dos;

const
  short_delay=1;
  medium_delay=2; { after strobe }
  long_delay=150; { after reset }

  baseaddr=$378; { $278, $3BC }

  data_mode=$04;
  control_mode=$00;
  neg_strobe=$01;

  display_on=$0C;
  cursor_under=$02;
  cursor_blink=$01;
  display_off=$08;

  displaymode=$38; { 5x7, 8-bit, 2 rows }

  clear=$01;
  return=$02;

  set_address=$80;
  first_row_first_char=$00;
  second_row_first_char=$40;

var
  ch: char;

function extend(s:string;len:byte;ch:char;d:boolean):string;
  var st:string;
begin
  st:=s;
  while length(st)<len do if d then st:=st+ch else st:=ch+st;
  extend:=st
end;

procedure send_command(b: byte);
begin
  port[baseaddr+2]:=(control_mode or neg_strobe);
  delay(short_delay);
  port[baseaddr]:=b;
  delay(short_delay);
  port[baseaddr+2]:=control_mode;
  delay(medium_delay);
  port[baseaddr+2]:=(control_mode or neg_strobe);
  delay(medium_delay);
end;

procedure send_data(ch: char);
begin
  port[baseaddr+2]:=(data_mode or neg_strobe);
  delay(short_delay);
  port[baseaddr]:=ord(ch);
  delay(short_delay);
  port[baseaddr+2]:=data_mode;
  delay(medium_delay);
  port[baseaddr+2]:=(data_mode or neg_strobe);
  delay(medium_delay);
end;

procedure resetlcd;
begin
  send_command(display_on);
{  send_command(display_on or cursor_under or cursor_blink);}
  send_command(displaymode);
  send_command(clear);
end;

procedure wrlcd(st1, st2: string);
var
  i: byte;
  s1, s2: string;
begin
  s1:=extend(st1,16,' ',true);
  s2:=extend(st2,16,' ',true);
  send_command(set_address or first_row_first_char);
  for i:=1 to length(s1) do send_data(s1[i]);
  send_command(set_address or second_row_first_char);
  for i:=1 to length(s2) do send_data(s2[i]);
end;

begin
  resetlcd;
  delay(long_delay);
  wrlcd('   -=STADI=-    ','LCD Display Test');
  send_command(set_address or first_row_first_char);
  repeat
    repeat until keypressed;
    ch:=readkey;
    if ch=#13 then
      begin
        writeln;
        send_command(set_address or second_row_first_char);
      end
    else if ch<>#27 then
      begin
        write(ch);
        send_data(ch);
      end;
  until ch=#27;
end.