colourize:= proc(P::specfunc(anything,{PLOT,PLOT3D}), f::{procedure,realcons}) ## P must be a 2D or 3D plot structure ## f a function of two variables (for 2D) or three (for 3D), ## returning a 3-element sequence (for RGB or HSV) or a single value ## (for HUE). ## Optional third argument RGB, HSV, HUE or [c1..c2] (RGB default) ## where c1 and c2 are colour names or RGB(r,g,b) specifications. ## Each segment of a curve in P is coloured with (for the RGB case) ## RGB(r,g,b) where f(xm) = r,g,b, ## xm the midpoint of the segment ## in [c1..c2] case with c1 + f(xm)*(c2-c1) ## Similarly for other structures. ## Only an ISOSURFACE (produced by implicitplot3d) can't be colourized ## Note that r,g,b values should be from 0 to 1: this is not checked, ## nor is any scaling done. option `Maple Advisor Database 1.01 for Maple 6`, `Copyright (c) 2000 by Robert B. Israel. All rights reserved`; local c; if nargs = 3 then eval(`plot/color`); c:= args[3]; if not type(c,{identical(RGB), identical(HSV), identical(HUE), [`colourize/colspec`,`colourize/colspec`]}) then ERROR(`Expected RGB, HSV, HUE or [c1,c2] but received `,c) fi; elif nargs = 2 then c:= RGB else ERROR(`Wrong number of arguments`,nargs) fi; map (`colourize/colourize`,P,f,c); end; colorize:= eval(colourize); `type/colourize/colspec`:= proc(c) option `Maple Advisor Database 1.01 for Maple 6`, `Copyright (c) 2000 by Robert B. Israel. All rights reserved`; if type(c,name) then assigned(`plot/colortable`[c]) else type(c,specfunc(numeric,RGB)) fi end; `colourize/colourize`:= proc(C,f,r) option `Maple Advisor Database 1.01 for Maple 6`, `Copyright (c) 2000 by Robert B. Israel. All rights reserved`; local segs, colours, L, a, b, i, j, c,d, pts, m, n, dims, others, fr, dx, dy, cs, rp; if type(C, specfunc(anything, ANIMATE)) then RETURN(map((t,F,R) -> map(`colourize/colourize`,t,F,R),C,f,r)) fi; rp:= r; if r = HUE then fr:= subs(_f=f, proc() local c; c:= evalf(_f(args)); if not type(c,numeric) then ERROR(`colour function returned`, c, `for arguments`,args) fi; c end); elif type(r,list) then for i from 1 to 2 do if type(r[i],name) then cs[i]:= `plot/colortable`[r[i]] else cs[i]:= convert(r[i],list) fi; od; rp:= RGB; fr:= subs(_f=f, _c1=cs[1], _c2=cs[2]-cs[1], proc() local c; c:= evalf(_f(args)); if not type(c,numeric) then ERROR(`colour function returned`, c, `for arguments`,args) fi; op(c*_c2+_c1); end); else fr:= subs(_f=f, proc() local c; c:= evalf(_f(args)); if not type(c,[numeric,numeric,numeric]) then ERROR(`colour function returned`, c, `for arguments`,args) fi; op(c) end); fi; if type(C, specfunc(anything, CURVES)) then segs := NULL; colours := NULL; others:= NULL; for L in C do if type(L,hfarray) then L:= convert(L,listlist); fi; if type(L,listlist) then a := L[1]; for j from 2 to nops(L) do b := L[j]; segs := segs, [a, b]; colours:= colours, fr(op(1/2*a + 1/2*b)); a := b od elif not type(L,specfunc(anything,{COLOR,COLOUR})) then others:= others,L fi od; CURVES(segs, COLOUR(rp, colours), others) elif type(C,specfunc(anything,POINTS)) then pts,others := selectremove(type,C,list); colours:= map(fr@op,pts); others:= remove(type,others,specfunc(anything,{COLOR,COLOUR})); POINTS(op(pts),COLOUR(rp,op(colours)),op(others)); elif type(C,specfunc(anything,TEXT)) then pts:= op(1,C); c:= fr(op(pts)); others:= op(remove(type,[op(3..-1,C)], specfunc(anything,{COLOR,COLOUR}))); TEXT(op(1..2,C),COLOUR(rp,c),others); elif type(C,specfunc(anything,POLYGONS)) then colours := NULL; others:= remove(type,C,specfunc(anything,{COLOR,COLOUR})); for L in others do if type(L,listlist) then colours:= colours,fr(op(convert(L,`+`)/nops(L))) elif type(L,hfarray) then dims:= [rtable_dims(L)]; m:= op([1,2],dims); n:= op([2,2],dims); c:= eval(add(L[i],i=1..m)/m); colours:= colours,fr(seq(c[i],i=1..n)); fi; od; if colours=NULL then C else POLYGONS(op(others),COLOUR(rp,colours)) fi; elif type(C,specfunc(anything,GRID)) then others:= remove(type,C,specfunc(anything,{COLOR,COLOUR})); # GRID has the form a..b, c..d, {listlist,hfarray}, options a,b:= op(op(1,C)); c,d:= op(op(2,C)); L:= op(3,C); if type(L, hfarray) then dims:= [rtable_dims(L)]; m:= op([1,2],dims); n:= op([2,2],dims); else m:= nops(L); n:= nops(L[1]); fi; dx:= (b-a)/(m-1); dy:= (d-c)/(n-1); if r = HUE then colours:= seq(seq(fr( a+(i-1)*dx,c+(j-1)*dy,L[i,j]),j=1..n),i=1..m) else colours:= hfarray(1..m,1..n,1..3); for i from 1 to m do for j from 1 to n do colours[i,j,1],colours[i,j,2],colours[i,j,3]:= fr(a+(i-1)*dx,c+(j-1)*dy,L[i,j]) od od; fi; GRID(op(others),COLOUR(rp,colours)); elif type(C,specfunc(anything,MESH)) then others:= remove(type,C,specfunc(anything,{COLOR,COLOUR})); # MESH has the form {listlist,hfarray}, options L:= op(1,C); if type(L, hfarray) then dims:= [rtable_dims(L)]; m:= op([1,2],dims); n:= op([2,2],dims); else m:= nops(L); n:= nops(L[1]); fi; if r = HUE then colours:= seq(seq(fr(L[i,j,1],L[i,j,2],L[i,j,3]),j=1..n),i=1..m) else colours:= hfarray(1..m,1..n,1..3); for i from 1 to m do for j from 1 to n do colours[i,j,1],colours[i,j,2],colours[i,j,3]:= fr(L[i,j,1],L[i,j,2],L[i,j,3]) od od; fi; MESH(op(others),COLOUR(rp,colours)); elif type(C,specfunc(anything,ISOSURFACE)) then ERROR(`Can''t colourize an ISOSURFACE`) else C fi; end;