%
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1994 Guy Blelloch
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

This file requires Nesl 3.1 
It is not well documented and needs to be cleaned up.
% 

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SOME CONSTANTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

csd_command = "/usr/misc/bin/csd";
view_command = "/usr/misc/bin/xv";
mapdir = "/afs/cs.cmu.edu/project/scandal/fun/data/";

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THE MAP DATATYPE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

datatype point (int,int) $           % (x,y) %
datatype segment (int,int,int,int,int) $ 
   % (intersection1,intersection2,num1,num2,thickness)%
datatype street([char],[int]) $      % (street_name,[seg0,seg1,seg2,....]) %
datatype address (int,[char]) $      % (number,street_name) %
datatype place ([char],address,[char],[char],[int]) $ % (name,address,phone_number,info,[seg0,..])%
datatype box (point,int,[char],[char]) $ % (position,priority,name,info) %
datatype keyword ([char],[int]) $    % (name,[place1,place2,....]) %

% The second set of segments are the highlighted segments %
datatype maptype bound_box(int),[point],[segment],[segment],[street],
                 [place],[box],[keyword] $

function read_map(map_file) = 
  read_object_from_file(maptype(bound_box((0,0),(0,0)),
				[] point, [] segment, [] segment, [] street,
				[] place, [] box, [] keyword),
			map_file) $

function street_name(street(name,segs)) = name $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THE WINDOW DATATYPE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

datatype map_window(xps_window,[xps_gc],scale_box(int),
		    [(((int,int),(int,int)),[char])],[[char]]) $
function map_wind(map_window(wind,gc,box,buttons)) = wind $
function map_button_names(map_window(wind,gc,box,buttons,b_names)) = b_names $

function map_bounds(maptype(bounds,rest)) = bounds $

function gc_background(gc) = gc[0] $
function gc_map(gc) = gc[1] $
function gc_light_street(gc) = gc[2] $
function gc_dark_street(gc) = gc[3] $
function gc_xor(gc) = gc[4] $
function gc_button(gc) = gc[5] $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THE WINDOW LAYOUT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

window_offset = (20,10); % position of window on screen (top left corner) %
left_margin = 130;        % distance from left of window to the map %
right_margin = 130;        % distance from right of window to the map %
bottom_margin = 50;       % distance from bottom of window to the map %
top_margin = 25;          % distance from top of window to the map %
map_size = (700,580);     % maximum x and y sizes for the map itself %
button_size = (100,30);
button_offset = (15,55);  % relative to the top of the bottom margin %
button_stride = 50;       % distance between buttons %
query_box = ((150,15),(200,20));  % position and size of the query box %
info_box = ((400,15),(400,20));   % position and size of the information box %
help_window_offset = (300,200);   % position of the help/info windows %

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THE MENU HIERARCHY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

place_hierarchy = 
[("top",["restaurant","entertainment","food (shops)"]),
 ("food (shops)",["grocer","supermarket","convenience"]),
 ("restaurant",["american","asian","european","by food","other"]),
 ("entertainment",["symphony","theatre","live_music","cafe",
		   "pool_tables","cinema","dancing","bar"]),
 ("american",["caribbean","cajun","mexican","south_american","southern"]),
 ("asian",["chinese","indian","japanese","korean","thai","tibetan"]),
 ("european",["continental","french","german","greek","hungarian",
	      "irish","italian","spanish"]),
 ("by food",["bagels","ice_cream","pizza","seafood","ribs","vegetarian"]),
 ("other",["middle_eastern","patio","sunday_brunch","breakfast",
	   "late_night","guy's_choice"])
] $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GENERAL UTILITIES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function get_from_segments(segs,v) =
  {(e1,e2) : e1 in v->{e1: segment(e1,e2,rest) in segs} ; 
             e2 in v->{e2: segment(e1,e2,rest) in segs} } $

function substringp(a,b) = 
  if (#a > #b) then f 
  else string_eql(a,take(b,#a)) $

function nested_get(a,i) =
  let lens = {#i:i};
      vals = a->flatten(i)
  in partition(vals,lens) $

function check_command(command) =
let check = shell_command("ls " ++ command,"")
in eql(command++[newline],check)  $

first_map = [
("South","S"),("S.","S"),
("North","N"),("N.","N"),
("East","E"),("E.","E"),
("West","W"),("W.","W"),
("Saint","St"),("St.","St"),
("First","1st"),("Second","2nd"),("Third","3rd"),("Fourth","4th"),
("Fifth","5th"),("Sixth","6th"),("Seventh","7th"),("Eighth","8th"),
("Ninth","9th")] $

last_map = [
("St.","St"),("Street","St"),
("Pl.","Pl"),("Place","Pl"),
("Ave.","Ave"),("Avenue","Ave"),
("Dr.","Dr"),("Drive","Dr"),
("Pkwy.","Pkwy"),("Parkway","Pkwy"),
("Sq.","Sq"),("Square","Sq"),
("Ct.","Ct"),("Court","Ct"),
("Ter.","Ter"),("Terrace","Ter"),
("Brdg.","Brdg"),("Bridge","Brdg"),
("Blvd.","Blvd"),("Boulevard","Blvd")] $

function substitute_name(name,map) =
let 
    names = {s: (n,s) in map | string_eql(n, name)}
in if (#names == 0) then name else names[0] $

function substitute_name_b(name,map) =
  substitute_name(name,{(b,a): (a,b) in map}) $

function parse_street_name(names) =
let
    names = [substitute_name(names[0], first_map)] ++ drop(names,1);
    names = drop(names,-1) ++ [substitute_name(names[#names-1], last_map)];
in drop(flatten({name ++ "_": name in names}),-1) $

function print_street_name(name) =
let
    names = group_by_space(name,"_");
    names = [substitute_name_b(names[0], first_map)] ++ drop(names,1);
    names = drop(names,-1) ++ [substitute_name_b(names[#names-1], last_map)];
in drop(flatten({name ++ " ": name in names}),-1) $

function simp_print_street_name(name) =
  {select((ch == `_),space,ch): ch in name} $

function parse_address(line) =
let words = wordify(line);
in 
    if (#words < 2) then (f,address(0,""))
    else
	let (num,flag) = parse_int(words[0]);
	in 
	    if not(flag) then (f,address(0,""))
	    else (t,address(num,parse_street_name(drop(words,1)))) $

function print_address(address(num,name)) =
let print_name = print_street_name(name)
in if (num > 3) then @num ++ " " ++ print_name else print_name $

function simp_print_address(address(num,name)) =
let print_name = simp_print_street_name(name)
in if (num > 3) then @num ++ " " ++ print_name else print_name $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FUNCTIONS FOR DRAWING THE MAP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function draw_segs(segs,points,width,(win,street_gc,box)) =
let
    endpoints = get_from_segments(segs,points);
    scaled_points =  {first(scale_and_clip_segment((pt1,pt2),box))
		      : point(pt1),point(pt2) in endpoints}
    % The conditional is a hack so it does not need to clip at top_level %
    % scaled_points = if (#segs > 15000)
                    then {scale_point(pt1,box),scale_point(pt2,box)
			  : point(pt1),point(pt2) in endpoints }
                    else {first(scale_and_clip_segment((pt1,pt2),box))
			  : point(pt1),point(pt2) in endpoints} %
in xps_draw_segments(scaled_points,width,street_gc,win) $
    
function draw_street_segments(segments,points,width,map_window(w,gc,b,bu)) =
if width == 1 
then
  let 
      wide = if box_ratio(b) > 250. then 2 else 3;
      s1 = {segment(i1,i2,n1,n2,w) in segments | w == 1};
      s2 = {segment(i1,i2,n1,n2,w) in segments | w == 2};
      foo = draw_segs(s2,points,wide,(w,gc_dark_street(gc),b))
  in draw_segs(s1,points,1,(w,gc_light_street(gc),b)) 
else 
    let	wide = if box_ratio(b) > 250. then 5 else 8;
    in draw_segs(segments,points,wide,(w,gc_background(gc),b)) $

% This determines the position of the point fract between two endpoints %
function name_position(fract,point(x1,y1),point(x2,y2)) =
let 
    xmid = x1 + round(float(x2-x1)*fract);
    ymid = y1 + round(float(y2-y1)*fract);
in xmid,ymid $

function draw_street_box(((x,y),name),win,gc) =
let 
    gcb = gc_map(gc);
    gcl = gc_light_street(gc);
    length = 6 * #name + 1;
    height = 12;
    bar = xps_shade_rectangle(((x+1,y),(length,height)),gcb,win);
    foo = xps_draw_string((x+2,y+3),name,gcl,win)
in t $

function draw_x_box(((x,y),name),win,gc) =
let 
    gcb = gc_light_street(gc);
    gcl = gc_button(gc);
    length = 6 * #name + 5;
    height = 14;
    bar = xps_shade_rectangle(((x,y),(length,height)),gcl,win);
    foo = xps_draw_string((x+3,y+3),name,gcb,win)
in t $

% This plots a name at position x,y on the screen.  The name is put on
  a solid black background with a white box around it and a little box 
  at the lower left corner to mark the actual point %
function draw_mousable_box(((x,y),name),win,gc) =
let 
    gcb = gc_map(gc);
    gcl = gc_background(gc);
    length = 6 * #name + 8;
    height = 16;
    bar = xps_shade_rectangle(((x+1,y+1),(length,height)),gcl,win);
    bar = xps_draw_rectangle(((x+1,y+1),(length,height)),1,gcb,win);
    bar = xps_shade_rectangle(((x-2,y-2),(4,4)),gcl,win);
    bar = xps_draw_rectangle(((x-2,y-2),(4,4)),1,gcb,win);
    foo = xps_draw_string((x+6,y+5),name,gcb,win)
in t $

function overlap(((x1,y1),l1),((x2,y2),l2)) =
diff(y1,y2) < 16 and x2-x1<l1 and x1-x2<l2 $

function get_order(is,edges) =
let nis = {max(i,1+max_val(ni)): i in is; ni in nested_get(is,edges)}
in if eql(nis,is) then nis else get_order(nis,edges) $

function fast_draw_boxes_r(boxes,draw_function,win,gc) =
if #boxes == 0 then t
else 
    all({draw_function(box,win,gc): box in boxes[0]}) and 
    fast_draw_boxes_r(drop(boxes,1),draw_function,win,gc) $

function fast_draw_boxes(boxes,draw_function,w) =
let
    map_window(win,gc,wbox,bu) = w;
    boxes = {pt,name in boxes | in_scale_box_p(pt,wbox)};
    loc = {scale_point(pt,wbox),#name*6+8: pt,name in boxes};
    l = #boxes;
    keep = {{i :l1 in loc; i in [0:l]| overlap(l1,l2) and i < j}: 
	    l2 in loc; j in [0:l]};
    bar = get_order(dist(1,l),keep);
    nboxes = int_collect({b,(scale_point(pt,wbox),name): b in bar; 
			  pt,name in boxes});
in fast_draw_boxes_r({b: (a,b) in nboxes},draw_function,win,gc) $

% These need to be drawn serially so that they properly cover each other %
function draw_boxes_r(boxes,draw_function,i,n,win,gc) =
if i == n then t
else draw_function(boxes[i],win,gc) or 
     draw_boxes_r(boxes,draw_function,i+1,n,win,gc) $

function draw_boxes(boxes,draw_function,w) =
let 
    map_window(win,gc,wbox,bu) = w;
    boxes = {scale_point(pt,wbox),name: pt,name in boxes
	     | in_scale_box_p(pt,wbox)}
in draw_boxes_r(boxes,draw_function,0,#boxes,win,gc) $

function draw_street_names(points,segments,streets,w) =
if (#streets > 100) then t
else
  let 
      segs  = segments->{s[if #s > 1 then 1 else 0]: street(n,s) in streets};
      boxes = {name_position(.5,e),simp_print_street_name(n)
	       : e in get_from_segments(segs, points)
	       ; street(n,s) in streets}
  in fast_draw_boxes(boxes,draw_street_box,w) $

function draw_mousable_boxes(boxes,w) =
let
    map_window(win,gc,wbox,bu) = w;
    flag = (box_ratio(wbox) < 400.);
    nboxes = {pt,name: box(point(pt),pri,name,info) in boxes
	     | flag or pri < 1}
in fast_draw_boxes(nboxes,draw_mousable_box,w) $

function draw_map(map,window) =
  let 
      maptype(bounds,points,segments,subsegs,streets,places,boxes,keys) = map;
      s = draw_street_segments(segments,points,1,window);
      s = draw_street_segments(subsegs,points,5,window);
      n = draw_street_names(points,segments,streets,window);
      win = map_wind(window);
      n = draw_mousable_boxes(boxes,window);
  in window $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FUNCTIONS FOR DISPLAYING HELP ON THE WINDOW
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

process_error =
"ERROR: Cannot create the window process.  
You might have run out of process slots.
Try removing the map info windows (each one has its own process)
" $

function print_map_error(fl,line) =
if fl then t else print_string(process_error) $

function help_line(string,window) = 
let
    map_window(win,gc,rest) = window;
    % foo = xps_shade_rectangle(info_box,gc_background(gc),win); %
    (x0,y0),(w,h) = info_box;
    width = #string*6 + 8;
    foo = xps_shade_rectangle(((x0,y0),(width,h)),gc_map(gc),win);
    ypos = y0 + (h-8)/2;
    bar = xps_draw_string((x0+4,ypos),string,gc_light_street(gc),win)
in t $

% Not used %
function other_help_line(string,window) = 
let
    map_window(win,gc,rest) = window;
    (x0,y0),(w,h) = info_box;
    ypos = y0 + (h-8)/2;
    bar = xps_draw_string((x0,ypos),string,gc_map(gc),win)
in t $

function clear_help_line(window) = 
let
    map_window(win,gc,rest) = window;
    foo = xps_shade_rectangle(info_box,gc_background(gc),win)
in t $

function help_box(text,window,display) = 
let lines = linify(text)
in
    if #lines == 1 then help_line(lines[0],window)
    else
	let
	    lines = lines ++ ["","CLICK TO REMOVE"];
	    x = help_line("Window inactive: See Information window",window);
	    e = text_window(lines,help_window_offset,("6x13",6,13),
			    "Pittsburgh Map Information", display);
	    foo = print_map_error(e);
	in clear_help_line(window) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FUNCTIONS FOR CREATING THE MAP WINDOW
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

button_names = ["help","street","address","csd","refresh",
		"zoom up","write","info","exit"] $

function button((position,size),text,gc,win) =
let
    (x,y),(width,height) = position,size;
    foo = xps_shade_rectangle(((x+4,y-4),size),gc_light_street(gc), win);
    foo = xps_shade_rectangle((position,size),gc_button(gc),win);
    strpos = x + (width-(#text*6))/2, y + (height-8)/2;
    foo = xps_draw_string(strpos,text,gc_light_street(gc),win)
in (position,size),text $

function draw_buttons(win,gc,button_categories) =
let
    bx,by = button_offset;
    sx,sy = button_size;
    map_w,map_h = map_size;
    buttons = {button(((bx,bottom_margin+by+i*button_stride),button_size),
		      b,gc,win)
	       : b in reverse(button_names); i in [0:#button_names]};
    button_category = button_categories[0];
    extra_button_names = {s: (n,s) in place_hierarchy | 
			  eql(button_category,n)}[0];
    menu_x, menu_y = (map_w + left_margin + bx), bottom_margin;
    z = xps_shade_rectangle(((menu_x,menu_y),(sx+5,map_h)),
			    gc_background(gc),win);
    b2 = ["all","by name"] ++ (if (#button_categories == 1) 
                               then [] [char] else ["menu up"]);
    buttons2 = {button(((menu_x,i*button_stride+menu_y),button_size),
		       b,gc,win)
		: b in b2; i in [0:#b2]};
    y_offset = menu_y + 30 + #b2*button_stride;
    buttons3 = {button(((menu_x,i*button_stride+y_offset),button_size),
		       b,gc,win)
		: b in extra_button_names; i in [0:#extra_button_names]};
in buttons ++ buttons2 ++ buttons3 $

function make_gcs(screen_type,win) =
let
    black = xps_black_pixel(win);   
    white = xps_white_pixel(win);
    gc_xor = xps_line_gc(xps_func_xor,1,0,win);
in
    if (screen_type == 3)
    then 
	let
	    gc_light_streets=xps_text_gc(xps_func_copy,black,white,"6x13",win);
	    gc_map = xps_text_gc(xps_func_copy,white,black,"6x13",win);
	    gc_dark_streets = xps_color_gc(xps_func_copy,xps_color_red,win);
	    gc_background = xps_color_gc(xps_func_copy,xps_color_blue,win);
	    gc_buttons = xps_color_gc(xps_func_copy,xps_color_cyan,win);
	in [gc_background,gc_map,gc_light_streets,gc_dark_streets,
	    gc_xor,gc_buttons]
    else
	let
	    gc_black = xps_text_gc(xps_func_copy,black,white,"6x13",win);
	    gc_white = xps_text_gc(xps_func_copy,white,black,"6x13",win);
	in [gc_white,gc_black,gc_white,gc_white,gc_xor,gc_black] $


function draw_map_background(bounds,button_categories,gc,win) =
let
    map_w,map_h = map_size;
    window_size = map_w + left_margin + right_margin, 
		  map_h + top_margin + bottom_margin;
    (w,h),box=make_scale_box(((left_margin,bottom_margin),map_size),bounds);
    foo = xps_shade_rectangle(((0,0),window_size),gc_background(gc),win);
    foo = xps_shade_rectangle(((left_margin,bottom_margin),(w,h)),
			      gc_map(gc),win);
    foo = xps_draw_rectangle(((left_margin-2,bottom_margin-2),(w+4,h+4)),
			     1,gc_map(gc),win);
    foo = xps_draw_string((10,5+bottom_margin),"middle button: zoom",
			  gc_map(gc),win);
    foo = xps_draw_string((10,25+bottom_margin),"left button: query",
			  gc_map(gc),win);
    buttons = draw_buttons(win,gc,button_categories);
in box,buttons $

function display_map(map,window) =
let
  foo = help_line("Hold on while map is drawing",window);
  bar = draw_map(map,window);
  foo = clear_help_line(window);
in window $

function make_x_map(map,button_categories,display) =
let
    bounds = map_bounds(map);
    map_w,map_h = map_size;
    window_size = map_w + left_margin + right_margin, 
		  map_h + top_margin + bottom_margin;
    win,screen_type,e = xps_nmake_window((window_offset,window_size),
					 "Pittsburgh Map",display);
    foo = print_map_error(e);
    gc = make_gcs(screen_type,win);
    box,buttons = draw_map_background(bounds,button_categories,gc,win);
    window = map_window(win,gc,box,buttons,button_categories);
in display_map(map,window) $

function redraw_x_map(map,window) = 
let
    bounds = map_bounds(map);
    map_window(win,gc,box,buttons,button_categories) = window;
    box,buttons = draw_map_background(bounds,button_categories,gc,win);
in display_map(map,window) $

function redraw_buttons(window,button_categories) =
let
    map_window(win,gc,b,buttons,old_names) = window;
    new_buttons = draw_buttons(win,gc,button_categories);
in map_window(win,gc,b,new_buttons,button_categories) $

function make_ps_map_window(bounds,display) =
let
    map_size = (504,648);
    window_offset = (54,148);
    window_size,b = make_scale_box(((0,0),map_size),bounds);
    win,e = xps_make_ps_window((window_offset,window_size),display);
    buttons = [] (((int,int),(int,int)),[char]);
    window = map_window(win,dist(xps_gc(0),5),b,buttons,[] [char]);
in window $

function make_ps_map(map,display) = 
  draw_map(map,make_ps_map_window(map_bounds(map),display)) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FUNCTIONS FOR GETTING MOUSE INPUT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function rect((x0,y0),(x1,y1)) =
  ((min(x0,x1),min(y0,y1)),(diff(x0,x1),diff(y0,y1))) $

function next_button_or_key(win) =
let
    type,rest = xps_next_event(win)
in 
    if (type == xps_event_button_press) or (type == xps_event_key_press) 
    then type,rest 
    else next_button_or_key(win) $

function mouse_info(window) =
let
    map_window(win,gc,rest) = window;
    mask = xps_event_mask_button2_motion or xps_event_mask_button_press or 
           xps_event_mask_button_release or xps_event_mask_key_press;
    foo = xps_select_input(mask,win);
    type,pt,(state,button) = next_button_or_key(win);
    result = (if type == xps_event_key_press then 
                 0,key_char(button,state,win),pt,pt
              else if (button == 2) then 
                 1,`x,rect(pt,xps_get_box(pt,2,gc_xor(gc),win))
              else 
	        let foo = xps_next_selected_event(xps_event_button_release,win)
		in (2,`x,pt,pt));
    foo = xps_select_input(0,win)
in result $

function get_button((x,y),window) =
let
    map_window(wind,gc,box,buttons,button_names) = window;
    foo = {text: ((x0,y0),(w,h)),text in buttons
	   | (x >= x0 and x <= x0+w and y >= y0 and y <= y0+h)}
in 
    if #foo == 0 then "",f 
    else foo[0],t $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; OTHER WINDOW FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function flip_button(name,window) =
let
    map_window(win,gc,b,buttons,button_names) = window;
    rect = {rect: rect,str in buttons | eql(name,str)}[0];
    foo = xps_shade_rectangle(rect,gc_xor(gc),win);
in t $

function get_argument(help,name,window) =
let
    foo = flip_button(name,window);
    map_window(win,gc,b,buttons,button_names) = window;
    foo = xps_shade_rectangle(query_box,gc_map(gc),win); % make the query box %
    (x0,y0),(w,h) = query_box;
    ypos = y0 + (h-8)/2;
    xpos = x0-#help*6-6;
    foo = xps_draw_string((xpos,ypos),help,gc_map(gc),win);
    arg = read_plot_line((x0+6,ypos),(6,12),
			 gc_light_street(gc),gc_map(gc),win);
    foo = flip_button(name,window);
    gc_back = gc_background(gc);
    foo = xps_shade_rectangle(query_box,gc_back,win);  % clear query box %
    foo = xps_shade_rectangle(((xpos,y0+2),(#help*6,h-4)),gc_back,win)
in arg $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THE FOLLOWING ARE FOR FUNCTIONS THAT SUPPORT THE VARIOUS MENU CHOICES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
% 

% Used to allow mutually recursive calls %
function main_loop(a) 
: (maptype, bool, map_window, [char]) -> bool 
= t $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; HELP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

help_string =
"The commands are:

  street    : highlight a street
  address   : display an address 
  csd       : find an entry from the csd database and add it to the map
  refresh   : clear the window of displayed information
  zoom up   : zoom back out to previous level
  write     : write a PostScript file of the current map
  info      : information on the program
  exit      : exit program

  by name   : find a place by name
  all       : find all entries in current menu options
  menu up   : move up one level in the place menu

You can use the first letter of the command instead of using the button.
All names are case insensitive.
Any prefix will work for street or restaurant names.

To zoom -- click the middle mouse button down on one corner of the region 
  and release it on the other corner.

To make queries -- use the left mouse button.

You can also use this program to create a personalized map for directions.
The following features should help:
  (1) Typing the letter l will allow you to enter a label anywhere
      on the map.
  (2) Typing the letter d will allow you to delete a label.
  (3) Giving a range to the street command will highlight subsections of
      streets.  For example you can type \"1000 2000 Forbes Ave\" instead 
      of just \"Forbes Ave\", to highlight the street from 1000 to 2000.
" $

info_string = 
"THE PROGRAM:

This map inteface was written by Guy Blelloch as a demonstration of
NESL -- a parallel programming language.  The source code can be found
in the file:

   /afs/cs/project/scandal/nesl/fun/src/map.nesl

THE DATA:

The map data comes from the City of Pittsburgh via David McKeown and
Bernd Bruegge.  The data is quite detailed, but it has many minor
errors (e.g. misspelled and out-of-date streets, and incorrect street
numbers).  The restaurant data comes from the Guide To Living in
Pittsburgh extended by Guy Blelloch.  The raw data can be found in:

   /afs/cs/project/scandal/nesl/fun/data/*
" $

function map_help(map,top_p,w,display) =
let
    foo = flip_button("help",w);
    message = help_box(help_string,w,display);
    foo = flip_button("help",w)
in main_loop(map,top_p,w,display) $

function map_info(map,top_p,w,display) =
let
    foo = flip_button("info",w);
    message = help_box(info_string,w,display);
    foo = flip_button("info",w)
in main_loop(map,top_p,w,display) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FUNCTIONS FOR SELECTING A SUBMAP (Used for Zooming)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function subselect_points(points,(xmin,ymin),(xmax,ymax)) =
let p_flags = {(x >= xmin) and (x <= xmax) and (y >= ymin) and (y <= ymax):
               point(x,y) in points};
in (p_flags,points) $

function subselect_segments(segments,p_flags) =
let s_flags = {f1 or f2: (f1,f2) in get_from_segments(segments,p_flags)};
    newsegs = {segments; s_flags | s_flags}
in (s_flags,newsegs) $

function subselect_streets(streets,s_flags) =
let str_segs  = {segs: street(name,segs) in streets};
    n_streets = {street(name,pack(segs))
		 : segs in nested_get(zip(enumerate(s_flags),s_flags),str_segs)
		 ; street(name,gsegs) in streets};
    n_streets = {street(name,segs) in n_streets | #segs > 0};
in n_streets $

function subselect_entries(places,s_flags) =
let str_segs = {segs: place(name,addr,phone,info,segs) in places};
    n_places = {place(name,addr,phone,info,pack(segs))
		: segs in nested_get(zip(enumerate(s_flags),s_flags),str_segs)
		; place(name,addr,phone,info,gsegs) in places}
in n_places $

function subselect_boxes(boxes,(xmin,ymin),(xmax,ymax)) =
  {box(point(x,y),pri,name,info) in boxes|
   (x >= xmin) and (x <= xmax) and (y >= ymin) and (y <= ymax)} $

function subselect_map(maptype(bounds,points,segments,subsegs,streets,places,
			       boxes,keys),
		       ((x0,y0),(w,h))) =
let 
    corners = (x0,y0),(x0+w,y0+h);
    (p_flags,new_points)   = subselect_points(points,corners);
    (s_flags,new_segments) = subselect_segments(segments,p_flags);
    (ignore,new_subsegs)   = subselect_segments(subsegs,p_flags);
    new_streets            = subselect_streets(streets,s_flags);
    new_places             = subselect_entries(places,s_flags);
    new_boxes              = subselect_boxes(boxes,corners);
    new_bounds             = bound_box((x0,y0),(w,h))
in maptype(new_bounds,new_points,new_segments,new_subsegs,new_streets,
	   new_places,new_boxes,keys) $

function unscale_box(p0,size,map_window(wind,gc,box,buttons)) =
  unscale_point(p0,box),unscale_size(size,box) $

function map_zoom((p0,(w,h)),map,top_p,window,display) =
if (w > 2000 and h > 2000)
then 
    let 
	new_map    = subselect_map(map,(p0,(w,h)));
	new_window = make_x_map(new_map, map_button_names(window), display);
	foo        = help_line("Window is inactive -- Zoomed in.",window);
	donep      = main_loop(new_map,f,new_window,display);
	kill       = xps_kill_window(map_wind(new_window));
	foo        = clear_help_line(window);
    in
	if donep then t
	else main_loop(map, top_p, window, display)
else
    let str = help_line("Press on one corner of the region and release on the other.",window)
    in main_loop(map, top_p, window, display) $

function map_zoom_up(map,top_p,window,display) =
if top_p then
    let foo = help_line("Already at top level.",window)
    in main_loop(map,top_p,window,display)
else f $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; QUERY -- allows user to mouse on the map to get an address on place info
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

% For a line and a point in the plane this finds
   1) The parallel distance of the point along the line as a fraction 
      of the length of the line.
   2) The perpendicular distance (absolute) of the point from the line
%
function distance_to_seg(o,line) =
let (xo,yo) = o; 
    ((x1,y1),(x2,y2)) = line;
    len_squared = (x2-x1)^2+(y2-y1)^2;
    dot = (xo-x1)*(x2-x1)+(yo-y1)*(y2-y1);
    cross = (x1-xo)*(y2-yo) - (y1-yo)*(x2-xo)
in dot/len_squared,abs(cross/sqrt(len_squared)) $

function segment_from_coordinate(map,pt,window) =
let
  maptype(bounds,points,segments,subsegs,streets,rests) = map;
  map_window(wind,gc,b,buttons) = window;
  xo,yo = unscale_point(pt,b);
  pt = float(xo),float(yo);
  pts   = {(float(x),float(y)): point(x,y) in points};
  edges = get_from_segments(segments,pts);
  foo   = {(distance,i,fract) : i in index(#segments)
	   ; (fract,distance) in {distance_to_seg(pt,e) : e in edges}
	   | fract > 0.0 and fract < 1.0};
in 
    if #foo == 0 then (f,-1,0.0)
    else t,rest(foo[min_index({dist:(dist,i,fract) in foo})]) $

function address_from_coordinate(map,pt,window) =
let (found_p,i,fraction) = segment_from_coordinate(map,pt,window)
in if not(found_p) then help_line("no street",window)
   else
     let 
	 maptype(bounds,points,segments,subsegs,streets,rests) = map;
	 foo  = {{s,i:s}: street(n,s) in streets; i in index(#streets)};
	 sti  = (dist(-1,#segments) <- flatten(foo))[i];
         name = if sti == -1 then "Unnamed Street" 
	        else street_name(streets[sti]);
         segment(x1,x2,n1,n2,w) = segments[i];
         number = n1 + round(float(n2-n1)*fraction);
      in help_line(print_address(address(number, name)),window) $

function in_box_p(box,(x,y),scale_map) =
let
    flag = (box_ratio(scale_map) < 400.);
    box(point(pt),pri,name,info) = box;
    x0,y0 = scale_point(pt,scale_map);
    length = 6*#name + 9;
    height = 16;
in (flag or pri < 1) and
   (x >= x0) and (x <= x0+length) and (y >= y0) and (y <= y0+height) $

function deal_with_box(b,window,display) =
let
    box(position,pri,name,info) = b;
    foo = draw_mousable_boxes([b],window);
in
    if eql(take(info,3),"xv ")
    then 
	if not(check_command(view_command))
	then help_line(name,window)
	else
	    let
		x = help_line("Hold on: displaying image",window);
		x = shell_command(view_command++drop(info,2),"");
	    in clear_help_line(window)
    else help_box(info,window,display) $

function buttons_from_coordinate(boxes,position,window) =
let
    map_window(win,gc,scale_map,buttons) = window;
    % foo = print_line(@unscale_point(position,scale_map)); %
    match = {bx in boxes| in_box_p(bx,position,scale_map)};
in match $

function place_from_coordinate(map,position,window,display) =
let 
    maptype(bds,pts,segs,subsegs,streets,places,boxes,keys) = map;
    matches = buttons_from_coordinate(boxes,position,window)
in
    if (#matches == 0) then (f,map)
    else
	let
	    b = matches[#matches-1];
	    foo = deal_with_box(b,window,display)
	in t,maptype(bds,pts,segs,subsegs,streets,places,boxes++[b],keys) $

function map_query(pt,map,top_p,window,display) =
let 
    (flag,nmap) = place_from_coordinate(map,pt,window,display)
in 
    if flag then main_loop(nmap,top_p,window,display)
    else 
	let x = address_from_coordinate(map,pt,window)
	in main_loop(map,top_p,window,display) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; STREET -- find a street and highlight it
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function street_name_and_segment(arg) =
if (if (#arg > 1) then 
    (rest(parse_int(arg[0])) and rest(parse_int(arg[0])) )
    else f)
then (parse_street_name(drop(arg,2)),
      first(parse_int(arg[0])),first(parse_int(arg[1])))
else (parse_street_name(arg),0,100000) $
  
function map_street(map,top_p,window,display) =
let 
    maptype(bounds,points,segments,subsegs,streets,rest) = map;
    arg = wordify(get_argument("enter street name: ","street",window));
in
    if (#arg == 0) then main_loop(map,top_p,window,display)
    else
	let
	    name,start,end = street_name_and_segment(arg);
	    s    = flatten({e: street(s,e) in streets| substringp(name,s)});
	    foo  = if (#s == 0) 
	           then help_line("No such street in current region.",window)
	           else t;
	    segs = {segment(i1,i2,n1,n2,w) in segments->s 
		    | n1 >= start and n2 <= end};
	    foo  = draw_street_segments(segs,points,5,window);
	    nmap = maptype(bounds,points,segments,segs++subsegs,streets,rest)
	in main_loop(nmap,top_p,window,display) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ADDRESS -- find an address and display it
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function get_address_segments(map,addr)=
let
    address(num,street_name) = addr;
    maptype(bounds,points,segments,subsegs,streets,rest) = map;
    sub_streets = {street(s,e) in streets | substringp(street_name,s)};
    sub_segs    = nested_get(segments,{e: street(s,e) in sub_streets});
    active      = {(name, {segment(x,y,bot,top,w) in segments
			   | num >= bot and num <= top})
		   : segments in sub_segs
		   ; street(name,s) in sub_streets};
    active = {(name,segs) in active | #segs == 1}
in {(name,segs[0]): (name,segs) in active} $

function warn_no_address(segs,top_p,win) =
if (#segs == 0) 
then 
    if top_p 
    then help_line("Address not found.",win) 
    else help_line("Address not found in current region, try zooming up.",win) 
else t $

function add_boxes(map,box_info,w) =
let
    maptype(bounds,points,segments,subsegs,streets,places,boxes,keys) = map;
    endpoints = get_from_segments({s:s,n,a,i in box_info},points);
    new_boxes = {box(point(name_position(float(n-n1)/float(n2-n1),e)),
		     -1,name,i):
		 (segment(p1,p2,n1,n2,w),name,address(n,s_name),i) in box_info;
		 e in endpoints};
    plot  = draw_mousable_boxes(new_boxes,w)
in 
    maptype(bounds,points,segments,subsegs,streets,places,
	    boxes++new_boxes,keys) $

addr_help = "Address should be in the format: <number> <street_name>" $

function map_address(map,top_p,window,display) =
let 
    (fl,addr) = parse_address(get_argument("enter address: ","address",window))
in
    if not(fl) then 
	let foo = help_line(addr_help,window)
	in main_loop(map,top_p,window,display)
    else
	let
	    address(number,sname) = addr;
	    addr_segs = get_address_segments(map, addr);
	    warn = warn_no_address(addr_segs,top_p,window);
	    addr_strings = {simp_print_address(address(number,name))
			    : name,seg in addr_segs};
	    new_map = add_boxes(map,{(seg,str,addr,str++[newline])
				     : (n,seg) in addr_segs
				     ; str in addr_strings},window)
	in main_loop(new_map,top_p,window,display) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CSD -- find an entry in the CSD database and display the address
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%


function get_csd_address(name,window,display) =
let entry = shell_command(csd_command++" "++name,"")
in 
    if (entry[0] == `') then
	let foo = help_box(entry,window,display) in "",f,address(0,"")
    else entry,parse_address(linify(entry)[2]) $

function map_csd(map,top_p,window,display) =
if not(check_command(csd_command)) then
    let a = help_line("csd not available on this machine.",window)
    in main_loop(map,top_p,window,display)
else
    let 
	arg = get_argument("enter name: ","csd",window);
	(entry,flag,addr) = get_csd_address(arg,window,display)
    in 
	if not(flag) then 
	    let foo = help_line("Can't parse CSD address",window) 
	    in main_loop(map,top_p,window,display)
	else 
	    let 
		name = linify(entry)[0];
		segs = get_address_segments(map, addr);
		info = name ++ ", " ++ print_address(addr);
		foo = help_line((if (#segs > 0) then info
				 else "address not found: " ++ info),
				window);
		new_map = add_boxes(map,{(s,name,addr,entry): (n,s) in segs},
				    window)
	    in main_loop(new_map,top_p,window,display) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FIND -- find a place by name or type (e.g. chinese, cinema, ...)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function print_place_name(name,addr,phone_number,info) =
if substringp("xv ",info) then info
else
    ({select(c==`_,` ,c): c in name} ++ ", " 
     ++ simp_print_address(addr) ++ 
     (if #phone_number > 0 then (", "++phone_number) else "") ++ [newline] 
     ++ info) $

function warn_about_too_many_places(places,window) =
if #places > 10 
then help_line("Consider zooming in for more detail.",window)
else t $

function generate_place_info(points,segments,places) =
let 
    segs = segments->{s[0]:(n,a,s,str) in places}
in 
    {s,{select((c == `_),` ,uppercase(c)): c in name},addr,str
     : (name,addr,x,str) in places; 
     s in segs} $

function add_places(matches,map,points,segments,w) =
if (#matches == 0) then
    let foo = help_line("Nothing found in current region.",w)
    in map
else
    let 
	warn  = warn_about_too_many_places(matches,w)
    in add_boxes(map,generate_place_info(points,segments,matches),w) $

function find_places_by_name(search_key,entries) =
let search_key = {select((ch == ` ),`_,ch):ch in search_key};
in {(name,a,s,print_place_name(name,a,p,i))
    :place(name,a,p,i,s) in entries 
    | substringp(search_key,name) and #s > 0} $

function map_places_by_name(map,top_p,w,d) =
let 
    arg = get_argument("enter name: ","by name",w);
    foo = clear_help_line(w);
    maptype(bounds,points,segments,subsegs,streets,entries,boxes,keys) = map;
in
    if (#arg == 0) then main_loop(map,top_p,w,d)
    else
	main_loop(add_places(find_places_by_name(arg,entries),
			     map,points,segments,w),
		  top_p,w,d) $

function find_places_by_types_r(search_keys,flags,keys) =
if (#search_keys == 0) then flags
else
    let
	search_key = {select((ch == ` ),`_,ch):ch in search_keys[0]};
	match_idx = flatten({pts: keyword(key,pts) in keys 
			     | substringp(search_key,key)});
	flags = flags<-{(i,t): i in match_idx}
    in find_places_by_types_r(drop(search_keys,1),flags,keys) $

function find_places_by_types(search_keys,entries,keys) =
let
    match_flags = find_places_by_types_r(search_keys,dist(f,#entries),keys);
    match = {place(n,a,p,i,s) in entries; fl in match_flags| fl and #s > 0}
in
    {(n,a,s,print_place_name(n,a,p,i)): place(n,a,p,i,s) in match} $


function map_places_by_type(name,map,top_p,w,d) =
let
    maptype(bounds,points,segments,subsegs,streets,entries,boxes,keys) = map;
    foo = {s: (n,s) in place_hierarchy | eql(n,name)};
in
    if plusp(#foo)
    then main_loop(map,top_p,redraw_buttons(w,[name]++map_button_names(w)),d) 
    else
	main_loop(add_places(find_places_by_types([name],entries,keys),
			     map,points,segments,w),
		  top_p,w,d) $

function map_menu_all(map,top_p,w,d) =
let
    maptype(bounds,points,segments,subsegs,streets,entries,boxes,keys) = map;
    menu_name = map_button_names(w)[0];
    names1 = flatten({s: (n,s) in place_hierarchy | eql(n,menu_name)});
    names2 = flatten(flatten({{s: (n,s) in place_hierarchy | eql(n,name)}: 
			      name in names1}));
    names = names1++names2;
in
    main_loop(add_places(find_places_by_types(names,entries,keys),
			 map,points,segments,w),
	      top_p,w,d) $

function map_menu_up(map,top_p,w,d) =
let
    bnames = map_button_names(w);
in
    if #bnames == 1 then main_loop(map,top_p,w,d)
    else main_loop(map,top_p,redraw_buttons(w,drop(bnames,1)),d) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; REFRESH, WRITE and DUMP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function map_refresh(map,top_p,window,display) =
let 
    maptype(bounds,points,segments,subsegs,streets,places,boxes,keys) = map;
    new_boxes = {box(pt,priority,rest) in boxes| priority > -1};
    new_map = maptype(bounds,points,segments,[] segment,streets,places,
		      new_boxes,keys);
    new_window = redraw_x_map(new_map,window);
in main_loop(new_map,top_p,window,display) $

function map_write(map,top_p,window,display) =
let
    args = wordify(get_argument("enter filename: ","write",window));
in 
    if (#args == 0) then main_loop(map,top_p,window,display)
    else
	let check = xps_close_window(map_wind(make_ps_map(map,args[0])))
	in main_loop(map,top_p,window,display) $

function map_dump(map,top_p,window,display) =
let
    arg = get_argument("enter filename: ","dump", window);
    check = write_object_to_file(map,arg);
in main_loop(map,top_p,window,display) $

function map_add_label(map,top_p,window,display) =
let 
    map_window(win,gc,sbox,rest) = window;
    maptype(bds,pts,segs,subsegs,streets,places,boxes,keys) = map;
    name = get_argument("enter string: ","foo",window);
    foo = help_line("click mouse at label position.",window);
    foo = xps_select_input(xps_event_mask_button_press,win);
    type,pt,(state,button) = next_button_or_key(win);
    b = box(point(unscale_point(pt,sbox)),1,name,name);
    foo = draw_mousable_box((pt,name),win,gc);
    new_map = maptype(bds,pts,segs,subsegs,streets,places,boxes++[b],keys)
in main_loop(new_map,top_p,window,display) $

function splice_out(boxes,i) = 
let box(ptx,rest) = boxes[i];
in {box(pt,rest) in boxes | not(eql(pt,ptx))} $

function map_delete_label(map,top_p,window,display) =
let 
    maptype(bds,pts,segs,subsegs,streets,places,boxes,keys) = map;
    map_window(win,gc,scale_map,buttons) = window;
    foo = help_line("click mouse on label to remove",window);
    foo = xps_select_input(xps_event_mask_button_press,win);
    type,pt,(state,button) = next_button_or_key(win);
    matches = {i in index(#boxes); bx in boxes| in_box_p(bx,pt,scale_map)};
    new_boxes = if (#matches == 0) then boxes
                else splice_out(boxes,matches[#matches-1]);
    new_map = maptype(bds,pts,segs,subsegs,streets,places,new_boxes,keys);
    new_window = redraw_x_map(new_map,window);
in main_loop(new_map,top_p,window,display) $

% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THE MAIN MENU LOOP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%

function select_choice(choice,state) =
      if substringp(choice,"help")    then map_help(state)
 else if substringp(choice,"street")  then map_street(state)
 else if substringp(choice,"address") then map_address(state)
 else if substringp(choice,"csd")     then map_csd(state)
 else if substringp(choice,"refresh") then map_refresh(state)
 else if substringp(choice,"zoom up") then map_zoom_up(state)
 else if substringp(choice,"write")   then map_write(state)
 else if substringp(choice,"info")    then map_info(state)
 % else if substringp(choice,"dump")    then map_dump(state) %
 else if substringp(choice,"label")   then map_add_label(state)
 else if substringp(choice,"delete")  then map_delete_label(state)
 else if substringp(choice,"menu up") then map_menu_up(state)
 else if substringp(choice,"by name") then map_places_by_name(state)
 else if substringp(choice,"all")     then map_menu_all(state)
 else if substringp(choice,"exit") or eql(choice,"q") then t
 else if (#choice > 1)                then map_places_by_type(choice,state)
 else main_loop(state) $

function main_loop(state) =
let
    map,top_p,window,display = state;
    fl,ch,pt,size = mouse_info(window);
    foo = clear_help_line(window);
    choice,flag = get_button(pt,window)
in
    if (fl == 1) then map_zoom(unscale_box(pt,size,window),state)
    else if (fl == 0) then select_choice([ch],state)
    else if flag then select_choice(choice,state)
    else map_query(pt,state) $

function pittsburgh_map(mapdir,display) =
let 
    map = read_map(mapdir++"map.data");
    window = make_x_map(map,["top"],display);
    foo = main_loop(map,t,window,display);
in xps_kill_window(map_wind(window)) $


% 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The rest of this file contains functions for building the map 
;;; datastructure.  These functions only need to be run when the dat
;;; has been changed.  They create a file map.data from the files
;;;   streets.txt, segments.txt, intersections.txt, places.txt and boxes.txt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
%


function read_intersections(filename) =
  let a = {first(parse_unsigned_int(i)): 
	   i in wordify(read_string_from_file(filename))}
  in {point(e,o): e in even_elts(a); o in odd_elts(a)} $

function write_intersections(pts,filename) =
  let a = flatten({@v1 ++ " " ++ @v2 ++ [newline]: point(v1,v2) in pts})
  in write_string_to_file(a,filename) $

function read_segments(filename) =
let data = {first(parse_unsigned_int(i)): 
	    i in wordify(read_string_from_file(filename))}
in {segment(a[0],a[1],a[3],a[4],1): a in group_by(data,5)} $

function write_segments(segs,filename) =
  let a = flatten({@v1++" "++@v2++" "++"0"++" "++@v4++" "++@v5++[newline]:
                   segment(v1,v2,v4,v5,x) in segs})
  in write_string_to_file(a,filename) $

function read_streets(filename) =
let 
    parse_line = l => (let words = wordify(l) 
                       in (first(parse_unsigned_int(words[1])), 
   		           street(words[0], {first(parse_unsigned_int(i)): 
					     i in drop(words,3)})))
in {parse_line(l): l in linify(read_string_from_file(filename))} $

function write_streets(strs,filename) =
  let a = flatten({v1 ++ " " ++ @(#v2) ++ flatten({" "++@v2: v2})++ [newline]: 
                   street(v1,v2) in strs});
  in write_string_to_file(a,filename) $

function process_entry(entry) =
let
    lines = drop(linify(entry),1);    
    name = lines[0];
    addr = let w = wordify(lines[1]) in address(first(parse_int(w[0])),w[1]);
    keywords = wordify(lines[2]);
    phone_number = lines[3];
    info = flatten({l ++ [newline]: l in drop(lines,4)})
in 
    (name,addr,keywords,phone_number,info) $

function read_entries(filename) =
let 
    input = read_string_from_file(filename);
    entries = group_by_separator_flags(input,{c == `*: c in input});
    entries = {process_entry(e): e in entries};
    keys    = collect(flatten({{(field,i): field in fields}:
			       (n,a,fields,phone,info) in entries; 
			       i in [0:#entries]}));
    keys = {keyword(keys): keys};
    entries = {name,addr,phone,info:(name,addr,fields,phone,info)in entries};
    lines = group_by({key++" ":keyword(key,pts) in keys},8);
    foo = print_line(flatten({"  "++flatten(line)++[newline]: line in lines}))
in keys,entries $

function process_box(entry) =
let
    lines = {l in linify(entry)| #l > 0};
    line1 = wordify(lines[0]);
    coords = point(first(parse_int(line1[0])),first(parse_int(line1[1])));
    priority = first(parse_int(lines[1]));
    name = lines[2];
    info = flatten({l ++ [newline]: l in drop(lines,3)})
in 
    box(coords,priority,name,info) $

function read_boxes(filename) =
let 
    input = read_string_from_file(filename);
    entries = group_by_separator_flags(input,{c == `*: c in input})
in {process_box(e): e in entries} $

function select_street_segments(snums,street,num) =
  {snum in snums; segment(p1,p2,bot,top,w) in street 
   | num >= bot and num <= top} $

function fix_street(streetsegs) =
let ends =   max_scan({end: segment(x0,x1,start,end,w) in streetsegs});
in {segment(x0,x1,max(start,e),max(end,e),w)
    : segment(x0,x1,start,end,w) in streetsegs
    ; e in ends} $

function fix_street_numbers(streets,segments) =
let 
    (name,sg) = unzip(streets);
    fsegs = flatten({zip(sg,fix_street(str)): 
		     str in nested_get(segments,sg);sg});
    new_segs = segments<-fsegs
in new_segs $

function get_place_segments(streets,segments,places) =
let
    strs     = {name,segs: street(name,segs) in streets};
    table    = create_table(strs);
    vals     = search_table({street
			     :name,address(num,street),phone,info in places},
			    table);
    seg_nums = {key: (key,flag) in vals};
    nplaces   = {place(entry_name,
		       address(street_num,street),
		       phone,
		       info,
		       select_street_segments(seg_num,segs,street_num)): 
		(entry_name,address(street_num,street),phone,info) in places;
		seg_num in seg_nums;
		segs in nested_get(segments,seg_nums)};
    warn = print_string(flatten({"address for "++name++" not found"++[newline]
				 ++ simp_print_address(addr) ++ [newline]
				 : place(name,a,p,i,segs) in nplaces 
				 ; n,addr,x in places
				 | #segs == 0}))
in nplaces $

function set_segment_lengths(ws,streets,segments) =
let 
    foo = flatten({{(s,w): s} : street(n,s) in streets; w in ws});
    bar = dist(1,#segments) <- foo;
in {segment(i1,i2,n1,n2,wn): segment(i1,i2,n1,n2,w) in segments; wn in bar} $

function make_map(ignore) =
let 
    points      = read_intersections(mapdir++"intersections.txt");
    segments    = read_segments(mapdir++"segments.txt");
    ws,streets  = unzip(read_streets(mapdir++"streets.txt"));
    keys,places = read_entries(mapdir++"places.txt");
    boxes       = read_boxes(mapdir++"boxes.txt");
    subsegs     = [] segment;
    % segments = fix_street_numbers(streets,segments); %
    % foo = write_segments(segments,mapdir++"nsegments.txt"); %
    places   = get_place_segments(streets,segments,places);
    segments = set_segment_lengths(ws,streets,segments);
    bounds = bound_box((0,0),(0,0));
    map = maptype(bounds,points,segments,subsegs,streets,places,boxes,keys);
    bounds = (273000,261000),(616000,495000);
    nmap = subselect_map(map,bounds)
in write_object_to_file(nmap,mapdir++"map.data") $