Metropoli BBS
VIEWER: ex2.pas MODE: TEXT (ASCII)
program ex2; uses crt;

const col : word = $1700;
      hex : array[0..15] of char = '0123456789ABCDEF';

var base : longint;
    ch : char;
    buf : array[0..15] of byte;
    ind, off : word;
    vid : array[0..8191] of word absolute $b800:0;
    x : longint; y : byte;

{$L flat.obj}
procedure FLAT_install; external;
procedure FLAT_destall; external;

{$L ex2.obj}
procedure FLAT_copy(sseg : word; soff : longint;
                    dseg : word; doff : longint;
                    length : longint); external;
begin
  FLAT_install; textmode(CO80 + Font8x8); gotoxy(2,1);

  off := 0;
  for ind := 0 to Hi(WindMax) do begin
    for y := 0 to 79 do begin vid[off] := col; inc(off) end;
    vid[off-70] := $173A; vid[off-44] := $172D
  end;

  base := 0;
  repeat
    off := 0; x := base;
    for ind := 0 to Hi(WindMax) do begin
      FLAT_copy(0, base + ind * 16, seg(buf), ofs(buf), 16);
      for y := 0 to 7 do vid[off+8-y] := col + ord(hex[(x shr (y shl 2)) and $F]);
      for y := 0 to 15 do begin
        vid[off+12+2*(ord(y>7)+y)+y] := col + ord(hex[buf[y] shr 4]);
        vid[off+13+2*(ord(y>7)+y)+y] := col + ord(hex[buf[y] and $F]);
        vid[off+63+y] := col + buf[y];
      end;
      inc(x, 16); inc(off,80)
    end;
    ch := readkey; case ch of
      #0 : begin
             ch := readkey; case ch of
               'G' : GotoXY(2,1);
               'H' : dec(base, 16);
               'I' : dec(base, 16*Hi(WindMax));
               'K' : if WhereX > 2 then GotoXY(pred(WhereX),WhereY);
               'M' : if WhereX < 8 then GotoXY(succ(WhereX),WhereY);
               'O' : GotoXY(9,1);
               'P' : inc(base, 16);
               'Q' : inc(base, 16*Hi(WindMax));
             end
           end;
      '0'..'9' : begin
                   y := (9 - WhereX) shl 2;
                   base := base and not(longint($F) shl y)
                         + longint(ord(ch) and $F) shl y;
                   if WhereX < 8 then GotoXY(succ(WhereX),WhereY)
                 end;
      'A'..'F',
      'a'..'f' : begin
                   y := (9 - WhereX) shl 2;
                   base := base and not(longint($F) shl y)
                         + longint(9 + ord(ch) and $F) shl y;
                   if WhereX < 8 then GotoXY(succ(WhereX),WhereY)
                 end
    end
  until ch = #27;

  textmode(lastmode and $7F); FLAT_destall
end.

[ RETURN TO DIRECTORY ]