program radar; {Version 2.3 04/05/85}

(* 04/05/85 V2.3 Added UL,UC,UR,LL,LC,LR,CL,CC,CR quadrants for full display *)

(* Program to display CompuServe weather map graphics.
** Written for Kaypro 4-84 by Bob Snider, Columbus, Ohio.
** This program takes as input a captured file from the CompuServe
** online weather graphics and displays it on the Kaypro. Because the
** Kaypro has only medium-resolution, only a window of the image can be
** viewed at a time. The window to view is specified as NE, SW, etc.
** (actually a combination of 2 chars, NW NC NE CW CC CE SW SC SE giving
** windows taylored to the radar map from AWX-4, or UL UC UR CL CC CR LL LC LR
** giving windows to the limits of the actual graphics display rectangle.)
*)

label
  enter_file, enter_limits;

type
  anystring = string[255];
  draw_sequence = string[6];  {Esc sequence for drawing lines}
  string2 = string[2];

const
  version_id : anystring = 'RADAR for Kaypro Version 2.3 04/05/85';
  esc = ^[;  {ASCII ESCape}
  escgh : string[3] = ^['GH';   {High-res sequence}
  endfile : boolean = false;
  found : boolean = false;
  memory_filled : boolean = false;  {if mapdata array filled from file}
  previous_file : string[20] = '';  {last used file name}
  mapdata_size = 8000; {size of mapdata memory array}
  default_left = 96;  {my default left to center on Ohio}
  default_top = 20;  {my default top}

var
  i, ior, pix : integer;
  s: anystring;
  radar_file : text;  {It is a text file}
  filename : string[20];
  ch : char; {contains char read from file}
  bigcol, bigrow : integer;  {256x192 screen pixel position}
  startcol, startrow, stopcol, stoprow
    : integer;  {start and stop posits for run-length line in big screen}
  mycol, myrow : integer;  {160x100 screen pixel position}
  left, right, top, bottom : integer; {window of my screen in big screen}
  outside : boolean; {if line is totally outside my screen area.}
  endwindow : boolean;  {if end of window below bottom detected}
  mapdata : array[1..mapdata_size] of char; {memory storage for file}
  mapindex : integer;  {index into mapdata}
  cpmfile : anystring;  {our work string for CPM file name}
  in_quadrant : string2;
  input_source : (use_defaults, get_quadrant, have_quadrant);

procedure comtail(var s:anystring);
  {Obtains command tail from CP/M command that started this program.}
  var
    comtail_string : anystring absolute $80;  {# chars in command tail}
  begin {comtail}
  if length(comtail_string)=255 then {invoked by turbo system}
    s:=''  {return no value available}
  else {invoked by CCP}
    s := comtail_string;  {copy command tail from CP/M}
  end {comtail};

procedure drawline(xstart,ystart,xend,yend : integer);
  {Generates character sequence for Kaypro screen graphics line from
   point (xstart,ystart) to (xend,yend).}
  begin
  write (esc, 'L', chr(ystart+32), chr(xstart+32),
                   chr(yend+32), chr(xend+32) );
  end {drawline};

procedure getchar;
  {Procedure to get a char from radar_file. Returns endfile=true if eof.}
  begin
  endfile := eof(radar_file);  {find out if at end of file}
  if endfile then ch := char(0) {return end of file char value}
  else read (radar_file, ch);  {get next char from file}
  end {getchar};

procedure getval;
  {Routine to get next graphic value in pix. Returns endfile=true on eof.}
  {Returns found=true when BEL char found.}
  begin
  ch := mapdata[mapindex];  {get next char from memory}
  pix := integer(ch)-32;  {convert char to number of pixels}
  found := (ch=^G);  {set if it is a BEL}
  if not found then mapindex := mapindex+1; {bump if not bell}
  end {getval};

procedure scan_graphics;
  {Scans input file for ESC G H sequence}
  begin
  found := false;  {init flag off}
  repeat
    getchar;  {get next char from file}
    if ch=esc then
      begin
      getchar;  {get next char}
      if ch='G' then
        begin
        getchar;  {get third char}
        if ch='H' then found:=true;  {got ESC G N sequence}
        end;
      end;
  until endfile or found;
  end;

procedure bigcalc;
  {Calculates next big screen position column and row.}
  begin
  bigcol := bigcol+pix;  {add background to column}
  if bigcol>255 then
    begin
    bigcol := bigcol-256;
    bigrow := bigrow+1;
    end;
  end;

procedure cursor_on;  {turn cursor on on video}
  begin
  write (esc,'B4');  {send escape sequence}
  end;

procedure cursor_off;  {turn cursor off}
  begin
  write (esc,'C4');  {send sequence}
  end;

procedure goodbye;  {stop processing and clear a line}
  begin
  write (esc,'=',char(23+32),' '^W);  {put cursor at bottom left, clr eos}
  cursor_on;  {turn cursor on in case was off}
  halt;  {exit program}
  end;

procedure process_quadrant;  {figure out left and top numbers from input}
  begin
  in_quadrant[1] := upcase(in_quadrant[1]);
  in_quadrant[2] := upcase(in_quadrant[2]);
  left := -1;  {default no match found yet}
  top := -1;   {ditto}
  if in_quadrant='NE' then begin left:=96; top:=0; end;
  if in_quadrant='SE' then begin left:=96; top:=80; end;
  if in_quadrant='CE' then begin left:=96; top:=40; end;
  if in_quadrant='NW' then begin left:=10; top:=20; end;
  if in_quadrant='SW' then begin left:=10; top:=80; end;
  if in_quadrant='CW' then begin left:=10; top:=40; end;
  if in_quadrant='NC' then begin left:=50; top:=10; end;
  if in_quadrant='SC' then begin left:=50; top:=90; end;
  if in_quadrant[1]='U' then top:=0;
  if in_quadrant[1]='C' then top:=46;
  if in_quadrant[1]='L' then top:=92;
  if in_quadrant[2]='L' then left:=0;
  if in_quadrant[2]='C' then left:=48;
  if in_quadrant[2]='R' then left:=96;
  if in_quadrant='' then begin left:=-2; top:=-2; end;  {signal no input}

  if ((left=-1) or (top=-1)) then begin  {invalid entry}
     writeln;
     writeln ('Quadrant must be 2 letters, the first from {N,S,C,U,L},');
     writeln ('  the second from {E,W,C,R,L}. (ie. NE).');
     left := -1;  {flag we had an error}
  end;
end {process_quadrant};

begin {Main Program}

writeln (version_id);
input_source := use_defaults;  {flag to use default map window}
comtail(cpmfile);  {get any file name from command}
if length(cpmfile)<2 then
  begin
  cpmfile:='';  {no input if too small}
  input_source := get_quadrant;  {set flag to ask which quadrant}
  end
else {there was a good file name}
  begin
  delete(cpmfile,1,1);  {remove starting blank}
  end;

enter_file:

cursor_on;   {turn on cursor}
repeat {until ior=0}
  repeat {until filename<>''}
    if cpmfile<>'' then
      begin
      filename:=cpmfile;  {use file passed by ccp}
      cpmfile:=''  {clear to not use again}
      end
    else {must get file name from console}
      begin
      write('Enter file to process');
      if memory_filled then write (' (* for memory)');
      write (': ');
      readln(filename);
      if filename='' then goodbye;  {exit program request}
      if filename='*' then if memory_filled then goto enter_limits
                                            else begin
                                              writeln ('Not filled yet.');
                                              filename:='';
                                              end;
      end;
  until filename<>'';
  assign (radar_file, filename);  {Assign file name}
  {$I-}  {Disable run-time error check for file lookup.}
  reset (radar_file);  {open file}
  {$I+}  {Re-enable run time error check.}
  ior:=ioresult;  {get result of reset}
  if ior<>0 then
    case ior of    {we have some sort of error}
      1: writeln('File not found.');
      else writeln('I/O error result code ',ior);
    end;
until ior=0;
previous_file := filename;  {save file name for re-process}

scan_graphics;  {Scan for ESC G H sequence.}
if not found then
  begin
  writeln ('No high-resolution graphics data found in file.');
  goto enter_file;
  end;

mapindex := 1;  {init memory index}
repeat
  getchar;  {get next char from file}
  mapdata[mapindex] := ch;   {put in memory}
  mapindex := mapindex+1;  {bump}
  if mapindex>mapdata_size then
    begin
    write ('File too large for memory.');
    goodbye;  {stop processing}
    end;
until endfile or (ch=^G) {bell};
mapdata[mapindex] := ^G;  {be sure array ended by bell}
memory_filled := true;  {flag file read in}

enter_limits:

repeat  {get valid quadrant input}
  case input_source of

    use_defaults:
      begin
      left := default_left;
      top := default_top;
      input_source := get_quadrant;  {in case invalid}
      end {case use_defaults};

    get_quadrant:
      begin
      write ('Enter quadrant: ');
      readln (in_quadrant);
      process_quadrant;  {set up left, top according to input}
      end {case get_quadrant};

    have_quadrant:
      begin
      process_quadrant;  {just do this routine}
      input_source := get_quadrant;  {in case invalid}
      end {case have_quadrant};

  end {case};

until left<>-1;  {until valid input or no input}

input_source := get_quadrant;
if left=-2 then goto enter_file;  {see if he wants new file}
right := left+159;
bottom := top+99;
endwindow:=false;  {init we have fresh window process}
bigcol := 0;  {start col and row}
bigrow := 0;
mapindex := 1;  {re-init memory index}

write(^Z); {clear screen}
cursor_off;  {turn off cursor}

repeat  {Convert each graphics pair to a line on the screen.}
  outside := false;  {assume wil be inside}
  getval; {get next value from file into pix}
  bigcalc;  {get next big screen pixel posit}
  startcol := bigcol;
  startrow := bigrow;
  getval;  {get next value of foregroung}
  pix := pix-1; {adjust for end of line}
  bigcalc;
  stopcol := bigcol;
  stoprow := bigrow;
  pix := 1;  {now undo end of line adjustment}
  bigcalc;
  if startcol<left then startcol := left;
  if startcol>right then
    begin
    startcol := left;
    startrow := startrow+1;
    end;
  if startrow<top then
    begin
    startrow := top;
    startcol := left;
    end;
  if startrow>bottom then
    begin
    outside := true;
    endwindow := true;
    end;
  if stopcol<left then
    begin
    stopcol := right;
    stoprow := stoprow-1;
    end;
  if stopcol>right then stopcol := right;
  if stoprow<top then outside := true;
  if stoprow>bottom then
    begin
    stoprow := bottom;
    stopcol := right;
    end;

  if startrow<>stoprow then outside := true
  else if startcol>stopcol then outside := true;

  {Now, start and stop are set up within my window, or outside is true.}

  if not outside then
    begin
    drawline(startcol-left, startrow-top, stopcol-left, stoprow-top);
    end;

(*  writeln (startcol:4,startrow:4,stopcol:4,stoprow:4,outside:6);*)

until found {bell} or endwindow;

read (s); {get anything from keyboard}
if (s<>'') then begin   {he entered something}
  in_quadrant := s;  {put it in passed param}
  input_source := have_quadrant;  {flag we got the quadrant already}
  end
else begin {just a CR entered}
  write (esc,'=',char(23+32),' '^W);  {put cursor at bottom left, clr eos}
  cursor_on;  {turn cursor back on}
  input_source := get_quadrant;  {flag prompt for quadrant}
end {if s};
goto enter_limits;

end.