unit scroller;

interface

uses dos;

type
  screen = array [1..25,1..160] of char;

var
  n,len,dir,ccol,speed:integer;
  normint:procedure;

procedure start_bounce(a,l:integer);
procedure start_scroll(a:integer);
procedure stop_interrupt;
procedure interrupt_speed(s:integer);

implementation
  function getchar(x,y:integer):char;
  var
    t:screen absolute $b800:0000;
  begin
    getchar:=t[y,x*2-1];
  end;

  procedure putchar(x,y:integer;ch:char);
  var
    t:screen absolute $b800:0000;
  begin
    t[y,x*2-1]:=ch;
  end;

{$f+}
  procedure scroll; interrupt;
  var
    ch:char;
    i,x,y,s:integer;
  begin
    for s:=1 to speed do begin
    ch:=getchar(1,n);
    for i:=1 to 79 do
    begin
      putchar(i,n,getchar(i+1,n));
    end;
    putchar(80,n,ch);
    end;
    inline ($9C); { PUSHF -- Push flags }
    normint;
  end;
{$f-}

{$f+}
  procedure bounce; interrupt;
  var
    ch:char;
    i,x,y,s:integer;
  begin
    for s:=1 to speed do begin
    if dir=1 then
      if ccol+len+1>80 then dir:=-1
      else
    else if ccol<2 then dir:=1;
    if dir=-1 then
    begin
      for i:=ccol to ccol+len do
      begin
        putchar(i-1,n,getchar(i,n));
      end;
    end else begin
      for i:=ccol+len downto ccol do
      begin
        putchar(i+1,n,getchar(i,n));
      end;
      putchar(ccol,n,' ');
    end;
    ccol:=ccol+dir;
    end;
    inline ($9C); { PUSHF -- Push flags }
    normint;
  end;
{$f-}

procedure start_scroll(a:integer);
begin
  n:=a;
  GetIntVec($8,@normint);
  SetIntVec($8,Addr(scroll));
end;

procedure start_bounce(a,l:integer);
begin
  n:=a;
  len:=l;
  ccol:=1;
  dir:=1;
  GetIntVec($8,@normint);
  SetIntVec($8,Addr(bounce));
end;

procedure interrupt_speed(s:integer);
begin
  speed:=s;
end;

procedure stop_interrupt;
begin
  setIntVec($8,Addr(normint));
end;

begin
speed:=1;
end.