Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/FLASH.ZIP/FLASH.PAS

Pascal/Delphi Source File | 1985-12-28 | 4.9 KB | 209 lines

program flash;

type    registers = record
                      ax, bx, cx, dx, bp, si, di, ds, es, flags: integer
                    end;

        page_ptr = ^page;
        page     = packed array[0..4095] of char;

        cursor_rec = record
                       cur_x, cur_y: byte;
                       cur_mode    : integer;
                     end;

        s80      = string[80];

        mode_type= (save, view);

var     cmd_line    : s80 absolute cseg:$0080;
        cmd_len     : integer;
        regs        : registers;
        mesg        : s80;
        page_num    : integer;
        p1,
        p2,
        temp        : page_ptr;
        cursor_1,
        cursor_2,
        cursor_temp : cursor_rec;
        mode        : mode_type;


procedure get_cursor( page: byte; var cursor: cursor_rec );
begin
  regs.ax := $0300;
  regs.bx := page shl 8;
  intr($10, regs);
  with cursor do
    begin
      cur_x := regs.dx and $ff;
      cur_y := regs.dx shr 8;
      cur_mode := regs.cx;
    end
end;


procedure set_cursor( page: byte; var cursor: cursor_rec );
begin
  regs.ax := $0200;
  regs.bx := page shl 8;
  with cursor do
    begin
      regs.dx := cur_x + cur_y * $100;
      regs.cx := cur_mode
    end;
  intr($10, regs)
end;


procedure hide_display;
var       crt_mode_set: ^byte;
begin
  crt_mode_set  := ptr($0040, $0065);
  crt_mode_set^ := crt_mode_set^ and $F7;
  port[$03d8]   := crt_mode_set^
end;


procedure restore_display;
var       crt_mode_set: ^byte;
begin
  crt_mode_set  := ptr($0040, $0065);
  crt_mode_set^ := crt_mode_set^ and $F7 + $08;
  port[$03d8]   := crt_mode_set^
end;


procedure select_page( page: byte);
begin
  regs.ax := $0500 + page;
  intr($10, regs)
end;


function has_cga: boolean;
var      base_6845: ^integer;
begin
  base_6845 := ptr($0040, $0063);
  has_cga := base_6845^ = $3D4
end;


procedure get_args( var page_num: integer; var mode: mode_type );
var       i : integer;
begin
  cmd_len := length(cmd_line) + 7;
  i := pos('s', cmd_line);
  if i = 0 then i := pos('S', cmd_line);
  if i > 0 then mode := save else mode := view;
  i := pos('1', cmd_line);
  if i > 0 then page_num := 1 else
    begin
      i := pos('2', cmd_line);
      if i > 0 then page_num := 2 else
        begin
          i := pos('3', cmd_line);
          if i > 0 then page_num := 3 else page_num := 0
        end
    end
end;


procedure give_message;
begin
  clrscr;
  writeln('FLASH   copyright 1985 - John D. Falconer');
  writeln;
  writeln('Usage:  FLASH <1..3> [S]');
  writeln;
  writeln('         1..3  - specify a video page number on the CGA,');
  writeln('            S  - save the current screen.');
  writeln;
  writeln('                 If S is not on the command line the selected video ');
  writeln('                 page will be displayed until any key is pressed.');
  writeln;
  write(  '                 { requires color graphics adaptor }')
end;


procedure clear_from_cursor( p: page_ptr; c: cursor_rec; n: integer );
var       bs  : packed array [0..159] of char;
          attr: char;
          i, c_offset: integer;
begin
  with c do
    begin
      c_offset := 160 * cursor_1.cur_y + 2 * cursor_1.cur_x;
      attr     := p^[c_offset + 1];
      fillchar(bs, sizeof(bs), ' ');
      for i := 1 to n do bs[2 * i] := attr;
      move(bs[1], p1^[c_offset], 2 * n);
    end
end;


procedure blank_command;
begin
  cursor_1.cur_y := cursor_1.cur_y - 1;
  clear_from_cursor( p1, cursor_1, cmd_len );
  cursor_1.cur_y := cursor_1.cur_y - 1;
  set_cursor( 0, cursor_1 )
end;


procedure save_page;
begin
  move(p1^, p2^, sizeof(page));
  mesg := 'S A V E D   T O   P A G E   ' + mesg + ' ';
  move(mesg[1], p1^[3998 - length(mesg)], length(mesg));
  restore_display
end;


procedure view_page;
var       ch: char;
begin
  new(temp);
  move(p1^, temp^, sizeof(page));
  with cursor_2 do
    begin
      cur_x    := 79;
      cur_y    := 24;
      cur_mode := 7
    end;
  set_cursor( 0, cursor_2 );
  move(p2^, p1^, sizeof(page));
  mesg := 'P A G E   ' + mesg + '   < p r e s s   a n y   k e y   t o   c o n t i n u e > ';
  move(mesg[1], p1^[3998 - length(mesg)], length(mesg));
  restore_display;
  read(kbd, ch);
  hide_display;
  move(temp^, p1^, sizeof(page));
  set_cursor( 0, cursor_1 );
  restore_display
end;


procedure set_up;
begin
  hide_display;
  p1 := ptr($B800, 0);
  p2 := ptr($B800, page_num * 4096);
  get_cursor( 0, cursor_1 );
  blank_command;
  str(page_num:1, mesg)
end;


begin { main program }
  get_args(page_num, mode);
  if has_cga and (page_num > 0) then
    begin
      set_up;
      if mode = save then save_page else view_page
    end
  else
    give_message
end.