home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / KAYPRO / KP-RADAR.LBR / KRADAR.NZW / KRADAR.NEW
Text File  |  2000-06-30  |  12KB  |  353 lines
  1. program radar; {Version 2.3 04/05/85}
  2.  
  3. (* 04/05/85 V2.3 Added UL,UC,UR,LL,LC,LR,CL,CC,CR quadrants for full display *)
  4.  
  5. (* Program to display CompuServe weather map graphics.
  6. ** Written for Kaypro 4-84 by Bob Snider, Columbus, Ohio.
  7. ** This program takes as input a captured file from the CompuServe
  8. ** online weather graphics and displays it on the Kaypro. Because the
  9. ** Kaypro has only medium-resolution, only a window of the image can be
  10. ** viewed at a time. The window to view is specified as NE, SW, etc.
  11. ** (actually a combination of 2 chars, NW NC NE CW CC CE SW SC SE giving
  12. ** windows taylored to the radar map from AWX-4, or UL UC UR CL CC CR LL LC LR
  13. ** giving windows to the limits of the actual graphics display rectangle.)
  14. *)
  15.  
  16. label
  17.   enter_file, enter_limits;
  18.  
  19. type
  20.   anystring = string[255];
  21.   draw_sequence = string[6];  {Esc sequence for drawing lines}
  22.   string2 = string[2];
  23.  
  24. const
  25.   version_id : anystring = 'RADAR for Kaypro Version 2.3 04/05/85';
  26.   esc = ^[;  {ASCII ESCape}
  27.   escgh : string[3] = ^['GH';   {High-res sequence}
  28.   endfile : boolean = false;
  29.   found : boolean = false;
  30.   memory_filled : boolean = false;  {if mapdata array filled from file}
  31.   previous_file : string[20] = '';  {last used file name}
  32.   mapdata_size = 8000; {size of mapdata memory array}
  33.   default_left = 96;  {my default left to center on Ohio}
  34.   default_top = 20;  {my default top}
  35.  
  36. var
  37.   i, ior, pix : integer;
  38.   s: anystring;
  39.   radar_file : text;  {It is a text file}
  40.   filename : string[20];
  41.   ch : char; {contains char read from file}
  42.   bigcol, bigrow : integer;  {256x192 screen pixel position}
  43.   startcol, startrow, stopcol, stoprow
  44.     : integer;  {start and stop posits for run-length line in big screen}
  45.   mycol, myrow : integer;  {160x100 screen pixel position}
  46.   left, right, top, bottom : integer; {window of my screen in big screen}
  47.   outside : boolean; {if line is totally outside my screen area.}
  48.   endwindow : boolean;  {if end of window below bottom detected}
  49.   mapdata : array[1..mapdata_size] of char; {memory storage for file}
  50.   mapindex : integer;  {index into mapdata}
  51.   cpmfile : anystring;  {our work string for CPM file name}
  52.   in_quadrant : string2;
  53.   input_source : (use_defaults, get_quadrant, have_quadrant);
  54.  
  55. procedure comtail(var s:anystring);
  56.   {Obtains command tail from CP/M command that started this program.}
  57.   var
  58.     comtail_string : anystring absolute $80;  {# chars in command tail}
  59.   begin {comtail}
  60.   if length(comtail_string)=255 then {invoked by turbo system}
  61.     s:=''  {return no value available}
  62.   else {invoked by CCP}
  63.     s := comtail_string;  {copy command tail from CP/M}
  64.   end {comtail};
  65.  
  66. procedure drawline(xstart,ystart,xend,yend : integer);
  67.   {Generates character sequence for Kaypro screen graphics line from
  68.    point (xstart,ystart) to (xend,yend).}
  69.   begin
  70.   write (esc, 'L', chr(ystart+32), chr(xstart+32),
  71.                    chr(yend+32), chr(xend+32) );
  72.   end {drawline};
  73.  
  74. procedure getchar;
  75.   {Procedure to get a char from radar_file. Returns endfile=true if eof.}
  76.   begin
  77.   endfile := eof(radar_file);  {find out if at end of file}
  78.   if endfile then ch := char(0) {return end of file char value}
  79.   else read (radar_file, ch);  {get next char from file}
  80.   end {getchar};
  81.  
  82. procedure getval;
  83.   {Routine to get next graphic value in pix. Returns endfile=true on eof.}
  84.   {Returns found=true when BEL char found.}
  85.   begin
  86.   ch := mapdata[mapindex];  {get next char from memory}
  87.   pix := integer(ch)-32;  {convert char to number of pixels}
  88.   found := (ch=^G);  {set if it is a BEL}
  89.   if not found then mapindex := mapindex+1; {bump if not bell}
  90.   end {getval};
  91.  
  92. procedure scan_graphics;
  93.   {Scans input file for ESC G H sequence}
  94.   begin
  95.   found := false;  {init flag off}
  96.   repeat
  97.     getchar;  {get next char from file}
  98.     if ch=esc then
  99.       begin
  100.       getchar;  {get next char}
  101.       if ch='G' then
  102.         begin
  103.         getchar;  {get third char}
  104.         if ch='H' then found:=true;  {got ESC G N sequence}
  105.         end;
  106.       end;
  107.   until endfile or found;
  108.   end;
  109.  
  110. procedure bigcalc;
  111.   {Calculates next big screen position column and row.}
  112.   begin
  113.   bigcol := bigcol+pix;  {add background to column}
  114.   if bigcol>255 then
  115.     begin
  116.     bigcol := bigcol-256;
  117.     bigrow := bigrow+1;
  118.     end;
  119.   end;
  120.  
  121. procedure cursor_on;  {turn cursor on on video}
  122.   begin
  123.   write (esc,'B4');  {send escape sequence}
  124.   end;
  125.  
  126. procedure cursor_off;  {turn cursor off}
  127.   begin
  128.   write (esc,'C4');  {send sequence}
  129.   end;
  130.  
  131. procedure goodbye;  {stop processing and clear a line}
  132.   begin
  133.   write (esc,'=',char(23+32),' '^W);  {put cursor at bottom left, clr eos}
  134.   cursor_on;  {turn cursor on in case was off}
  135.   halt;  {exit program}
  136.   end;
  137.  
  138. procedure process_quadrant;  {figure out left and top numbers from input}
  139.   begin
  140.   in_quadrant[1] := upcase(in_quadrant[1]);
  141.   in_quadrant[2] := upcase(in_quadrant[2]);
  142.   left := -1;  {default no match found yet}
  143.   top := -1;   {ditto}
  144.   if in_quadrant='NE' then begin left:=96; top:=0; end;
  145.   if in_quadrant='SE' then begin left:=96; top:=80; end;
  146.   if in_quadrant='CE' then begin left:=96; top:=40; end;
  147.   if in_quadrant='NW' then begin left:=10; top:=20; end;
  148.   if in_quadrant='SW' then begin left:=10; top:=80; end;
  149.   if in_quadrant='CW' then begin left:=10; top:=40; end;
  150.   if in_quadrant='NC' then begin left:=50; top:=10; end;
  151.   if in_quadrant='SC' then begin left:=50; top:=90; end;
  152.   if in_quadrant[1]='U' then top:=0;
  153.   if in_quadrant[1]='C' then top:=46;
  154.   if in_quadrant[1]='L' then top:=92;
  155.   if in_quadrant[2]='L' then left:=0;
  156.   if in_quadrant[2]='C' then left:=48;
  157.   if in_quadrant[2]='R' then left:=96;
  158.   if in_quadrant='' then begin left:=-2; top:=-2; end;  {signal no input}
  159.  
  160.   if ((left=-1) or (top=-1)) then begin  {invalid entry}
  161.      writeln;
  162.      writeln ('Quadrant must be 2 letters, the first from {N,S,C,U,L},');
  163.      writeln ('  the second from {E,W,C,R,L}. (ie. NE).');
  164.      left := -1;  {flag we had an error}
  165.   end;
  166. end {process_quadrant};
  167.  
  168. begin {Main Program}
  169.  
  170. writeln (version_id);
  171. input_source := use_defaults;  {flag to use default map window}
  172. comtail(cpmfile);  {get any file name from command}
  173. if length(cpmfile)<2 then
  174.   begin
  175.   cpmfile:='';  {no input if too small}
  176.   input_source := get_quadrant;  {set flag to ask which quadrant}
  177.   end
  178. else {there was a good file name}
  179.   begin
  180.   delete(cpmfile,1,1);  {remove starting blank}
  181.   end;
  182.  
  183. enter_file:
  184.  
  185. cursor_on;   {turn on cursor}
  186. repeat {until ior=0}
  187.   repeat {until filename<>''}
  188.     if cpmfile<>'' then
  189.       begin
  190.       filename:=cpmfile;  {use file passed by ccp}
  191.       cpmfile:=''  {clear to not use again}
  192.       end
  193.     else {must get file name from console}
  194.       begin
  195.       write('Enter file to process');
  196.       if memory_filled then write (' (* for memory)');
  197.       write (': ');
  198.       readln(filename);
  199.       if filename='' then goodbye;  {exit program request}
  200.       if filename='*' then if memory_filled then goto enter_limits
  201.                                             else begin
  202.                                               writeln ('Not filled yet.');
  203.                                               filename:='';
  204.                                               end;
  205.       end;
  206.   until filename<>'';
  207.   assign (radar_file, filename);  {Assign file name}
  208.   {$I-}  {Disable run-time error check for file lookup.}
  209.   reset (radar_file);  {open file}
  210.   {$I+}  {Re-enable run time error check.}
  211.   ior:=ioresult;  {get result of reset}
  212.   if ior<>0 then
  213.     case ior of    {we have some sort of error}
  214.       1: writeln('File not found.');
  215.       else writeln('I/O error result code ',ior);
  216.     end;
  217. until ior=0;
  218. previous_file := filename;  {save file name for re-process}
  219.  
  220. scan_graphics;  {Scan for ESC G H sequence.}
  221. if not found then
  222.   begin
  223.   writeln ('No high-resolution graphics data found in file.');
  224.   goto enter_file;
  225.   end;
  226.  
  227. mapindex := 1;  {init memory index}
  228. repeat
  229.   getchar;  {get next char from file}
  230.   mapdata[mapindex] := ch;   {put in memory}
  231.   mapindex := mapindex+1;  {bump}
  232.   if mapindex>mapdata_size then
  233.     begin
  234.     write ('File too large for memory.');
  235.     goodbye;  {stop processing}
  236.     end;
  237. until endfile or (ch=^G) {bell};
  238. mapdata[mapindex] := ^G;  {be sure array ended by bell}
  239. memory_filled := true;  {flag file read in}
  240.  
  241. enter_limits:
  242.  
  243. repeat  {get valid quadrant input}
  244.   case input_source of
  245.  
  246.     use_defaults:
  247.       begin
  248.       left := default_left;
  249.       top := default_top;
  250.       input_source := get_quadrant;  {in case invalid}
  251.       end {case use_defaults};
  252.  
  253.     get_quadrant:
  254.       begin
  255.       write ('Enter quadrant: ');
  256.       readln (in_quadrant);
  257.       process_quadrant;  {set up left, top according to input}
  258.       end {case get_quadrant};
  259.  
  260.     have_quadrant:
  261.       begin
  262.       process_quadrant;  {just do this routine}
  263.       input_source := get_quadrant;  {in case invalid}
  264.       end {case have_quadrant};
  265.  
  266.   end {case};
  267.  
  268. until left<>-1;  {until valid input or no input}
  269.  
  270. input_source := get_quadrant;
  271. if left=-2 then goto enter_file;  {see if he wants new file}
  272. right := left+159;
  273. bottom := top+99;
  274. endwindow:=false;  {init we have fresh window process}
  275. bigcol := 0;  {start col and row}
  276. bigrow := 0;
  277. mapindex := 1;  {re-init memory index}
  278.  
  279. write(^Z); {clear screen}
  280. cursor_off;  {turn off cursor}
  281.  
  282. repeat  {Convert each graphics pair to a line on the screen.}
  283.   outside := false;  {assume wil be inside}
  284.   getval; {get next value from file into pix}
  285.   bigcalc;  {get next big screen pixel posit}
  286.   startcol := bigcol;
  287.   startrow := bigrow;
  288.   getval;  {get next value of foregroung}
  289.   pix := pix-1; {adjust for end of line}
  290.   bigcalc;
  291.   stopcol := bigcol;
  292.   stoprow := bigrow;
  293.   pix := 1;  {now undo end of line adjustment}
  294.   bigcalc;
  295.   if startcol<left then startcol := left;
  296.   if startcol>right then
  297.     begin
  298.     startcol := left;
  299.     startrow := startrow+1;
  300.     end;
  301.   if startrow<top then
  302.     begin
  303.     startrow := top;
  304.     startcol := left;
  305.     end;
  306.   if startrow>bottom then
  307.     begin
  308.     outside := true;
  309.     endwindow := true;
  310.     end;
  311.   if stopcol<left then
  312.     begin
  313.     stopcol := right;
  314.     stoprow := stoprow-1;
  315.     end;
  316.   if stopcol>right then stopcol := right;
  317.   if stoprow<top then outside := true;
  318.   if stoprow>bottom then
  319.     begin
  320.     stoprow := bottom;
  321.     stopcol := right;
  322.     end;
  323.  
  324.   if startrow<>stoprow then outside := true
  325.   else if startcol>stopcol then outside := true;
  326.  
  327.   {Now, start and stop are set up within my window, or outside is true.}
  328.  
  329.   if not outside then
  330.     begin
  331.     drawline(startcol-left, startrow-top, stopcol-left, stoprow-top);
  332.     end;
  333.  
  334. (*  writeln (startcol:4,startrow:4,stopcol:4,stoprow:4,outside:6);*)
  335.  
  336. until found {bell} or endwindow;
  337.  
  338. read (s); {get anything from keyboard}
  339. if (s<>'') then begin   {he entered something}
  340.   in_quadrant := s;  {put it in passed param}
  341.   input_source := have_quadrant;  {flag we got the quadrant already}
  342.   end
  343. else begin {just a CR entered}
  344.   write (esc,'=',char(23+32),' '^W);  {put cursor at bottom left, clr eos}
  345.   cursor_on;  {turn cursor back on}
  346.   input_source := get_quadrant;  {flag prompt for quadrant}
  347. end {if s};
  348. goto enter_limits;
  349.  
  350. end.
  351.  
  352.  
  353.