%const %real halfsize=.1 %const %real x0=0+halfsize, x0a=1, x1=3, x2=6, x2a=7, x3=8, x4=9, x5=10, x6=11, x7=12 %const %real y0=1, y1=3, y1a=3.4 {y1+2*halfsize}, y2=4.5, y3=6, y4=7, y4a=8, y5=10, y6=12, y6a=12.5, y7=13.5 %const %integer black=21, red=22, brown=23, blue=24, green=25, purple=26, orange=27, thick black=28 %const %string (15) %array colours(black:thick black)="black", "red", "brown", "blue", "green", "purple", "orange", "thick black" !------------------------------------------------------------------------------- ! The following statement needs to be changed on a price change. %const %string (2) %array price(1:13)= "15", "20", "20", "25", "30", "30", "30", "35", "35", "35", "40", "40", "40" !------------------------------------------------------------------------------- %const %integer %array stage colours sequence(1:7)=black, red, orange, green, blue(3) %begin %integer mdrive id, cdrive id, msta id, merchpl id, tollc id, wend id, forrrd id, hanst id, stand id, antig id, nbri id, surg id, rank id, salis id, giff id, warrpk id, kilg id, grloan id, blsta id, midmar id, chur id, balc id %integer ids, dash, stage, extra stages, stages, inc, sink %string (2) extra price posn, wks %integer %array stage colours(0:13) %external %routine %spec notice(%string (255) s) %external %routine %spec define(%string (255) s) %external %routine %spec clear(%string (255) s) %record %format bf(%real centrex, centrey) %const %integer topb=32 %record (bf) %array bb(1:topb) %const %integer one=1, two=2, three=3, four=4, five=5, six=6, seven=7, eight=8, nine=9, ten=10, eleven=11, twlev=12, thirteen=13 %const %integer yes=1, no=0, zero=0 %const %integer down=10, up=11, left=12, right=13 %const %string (2) nul="" %const %real textsize=0.15, pricesize=0.23 %const %string (1) a="A", b="B", l="L", r="R" %integerfn colour(%integer new) %own %integer current colour=black %integer old old=current colour %result=old %if new=old printstring("{{colour=".colours(new)."}}") newline current colour=new %result=old %end {colour} %integer %fn colour for stage(%integer i) %result=colour(stage colours(i-stage)) %end {colour for stage} %routine box(%real centrex, centrey, %string (2) text posn, %string (63) text, %integer %name id, %integer stages, %string (2) price posn) %integer save save=-1 ids=ids+1; id=ids printstring("{{box(") print(centrex-halfsize, 2, 1) printstring(",") print(centrey-halfsize, 2, 1) printstring(")(") print(centrex+halfsize, 2, 1) printstring(",") print(centrey+halfsize, 2, 1) ! Outlabel printstring(")") %if text#"" %start printstring("; outlabel(") printstring(text posn) printstring(",") print(textsize, 2, 1) printstring(",""".text.""")") %finish %if price posn#nul %start printstring("; outlabel(".price posn.",") print(pricesize, 2, 1) printstring(",""".price(stages-stage).""")") %finish %if extra price posn#nul %start printstring("}}"); newline save=colour for stage(extra stages) printstring("{{outlabel(".extra price posn.",") print(pricesize, 2, 1) printstring(",""".price(extra stages-stage).""")") extra price posn=nul %finish printstring("}}") newline save=colour(save) %if save>=0 bb(ids)_centrex=centrex bb(ids)_centrey=centrey %end {box} %routine join(%integer id1, id2) printstring("{{") %if dash=yes %then printstring("DASH(0.2,0.2);") printstring("join(b") write(id1, 1) printstring(",b") write(id2, 1) printstring(")") %if dash=yes %then printstring("; SOLID") printstring("}}") newline %end {join} %routine line join(%real x1, y1, x2, y2) printstring("{{line("); print(x1, 2, 1); printstring(",") print(y1, 2, 1) printstring(")(") print(x2, 2, 1); printstring(","); print(y2, 2, 1) printstring(")}}") newline %end {line join} %routine bent join(%integer id1, id2, dir1, dir2) %real x1, y1, x2, y2, x3, y3, c1x, c1y, c3x, c3y c1x=bb(id1)_centrex c1y=bb(id1)_centrey c3x=bb(id2)_centrex c3y=bb(id2)_centrey x3=bb(id2)_centrex y3=bb(id2)_centrey %if dir1=left %start x1=c1x-halfsize y1=c1y x2=c3x; y2=c1y %finish %else %if dir1=right %start x1=c1x+halfsize y1=c1y x2=c3x; y2=c1y %finish %else %if dir1=up %start x1=c1x; y1=c1y+halfsize x2=c1x; y2=c3y %finish %else %if dir1=down %start x1=c1x; y1=c1y-halfsize x2=c1x; y2=c3y %finish %if dir2=left %then x3=x3+halfsize %else %if dir2=right %then x3=x3-halfsize %else %if %c dir2=up %then y3=y3-halfsize %else %if dir2=down %then y3=y3+halfsize line join(x1, y1, x2, y2); line join(x2, y2, x3, y3) %end {bent join} !----------------------------------- body ------------------------------------ ! Initialise the stage-colours array: take next colour from sequence when ! the price changes. inc=1 %for stages=1, 1,13 %cycle %if stages>1 %and price(stages)#price(stages-1) %then inc=inc+1 stage colours(stages)=stage colours sequence(inc) %repeat stage colours(0)=stage colours(1) {there is a "zero-stages" for the second picture} define("1,T#D") printstring("File T#D") newline selectoutput(1) printstring("{{origin(1.0,0)}}") newline dash=no extra price posn=nul %for stage=0, 1, 1 %cycle ids=0 sink=colour for stage(one) box(x0a, y1a, a, "Balcarres@bStreet", balc id, zero, nul) box(x1, y0, l, "Comiston@bDrive", cdrive id, zero, nul) %if stage=0 %then wks=a.r %else wks=nul {fare to Mngsde Sta, second pictue only} box(x1, y1, b.r, "Morningside@bStation", msta id, one, wks) join(cdrive id, msta id) join(balc id, msta id) box(x0, y1, b, "Morningside@bDrive", mdrive id, zero, nul) join(mdrive id, msta id) dash=no sink=colour for stage(two) box(x1, y3, l, "Churchhill", chur id, two, b.r) join(msta id, chur id) box(x2, y1, b, "Midmar@bAvenue", midmar id, two, a) join(msta id, midmar id) sink=colour for stage(three) box(x1, y4, l, "Merchiston@bPlace", merchpl id, three, r) join(chur id, merchpl id) box(x4, y1a, r, "Blackford@bStation", blsta id, three, l) bent join(midmar id, blsta id, right, up) sink=colour for stage(four) box(x1, y5, l, "Tollcross", tollc id, four, b.r) join(merchpl id, tollc id) box(x2a, y2, a, "Grange@bLoan", grloan id, four, b) bent join(blsta id, grloan id, up, right) sink=colour for stage(five) box(x1, y6, l, "West@bEnd", wend id, five, b.r) join(tollc id, wend id) extra price posn=a.l; extra stages=three box(x2, y3, a.r, "Kilgraston@bRoad", kilg id, five, b.r) bent join(grloan id, kilg id, left, up) sink=colour for stage(six) extra price posn=b.r extra stages=nine box(x2, y6, a.l, "Hanover@bStreet", hanst id, six, a.r) join(wend id, hanst id) box(x2, y4, a.l, "Warrender@bPark Road", warrpk id, six, a.r) join(kilg id, warrpk id) sink=colour for stage(seven) box(x4, y6a, l, "St Andrew@bSquare", stand id, seven, r) bent join(hanst id, stand id, right, up) box(x3, y4a, r, "Gifford@bPark", giff id, seven, b.l) bent join(warrpk id, giff id, right, up) sink=colour for stage(eight) box(x6, y7, a.l, "Antigua@bStreet", antig id, eight, r) bent join(stand id, antig id, up, right) extra price posn=a.l; extra stages=five box(x2, y5, a.r, "Forrest@bRoad", forrrd id, eight, b.l) join(giff id, forrrd id) sink=colour for stage(four) box(x5, y3, b.r, "Salisbury@bPlace", salis id, four, a.l) join(kilg id, salis id) sink=colour for stage(five) box(x5, y4a, r, "Rankeillor@bStreet", rank id, five, l) join(salis id, rank id) sink=colour for stage(six) box(x5, y5, r, "Surgeon's@bHall", surg id, six, l) join(rank id, surg id) sink=colour for stage(seven) box(x5, y6, r.b, "North@bBridge", nbri id, seven, l) join(surg id, nbri id) join(nbri id, antig id) sink=colour for stage(three) join(chur id, kilg id) sink=colour for stage(five) join(tollc id, forrrd id) sink=colour for stage(nine) join(forrrd id, hanst id) sink=colour for stage(six) line join(bb(forrrd id)_centrex-half size, bb(forrrd id)_centrey+half size, bb(hanst id)_centrex-half size, bb(hanst id)_centrey-half size) printstring("{{origin(14.0, 0)}}") newline dash=yes %repeat select output(0) close stream(1) clear("1") notice("T#D/gp15/v") %end %of %program