#
# HTMLC Components for building web pages
#
# Gina Cannarozzi Aug 21, 2001
# Gaston Gonnet (Aug 30, 2001)
#
# Prints a well formed HTML document.
# Interface had to be adapted to allow for more input parameters;
# to keep interface backward compatible, implementation seems a
# little strange now.
# First parameter (a): HTML as string -> body content
# Second parameter (titl): Title of page as string
# Third and more parameters:
# - if string, get plugged directly into body tag
# (backward compatibility). Use parameter 'title=false'
# to prevent the standard behaviour of displaying the
# title parameter in body content.
# - if equation, are plugged into the header section
# of the HTML output. Use TextBlock as RHS element.
HTML := proc( a, titl:string ) option polymorphic;
if type(a,string) then
doctype := '
\n';
head := doctype . '
\n\n';
if nargs > 1 then
head := head . '' . titl . '\n';
for i from 3 to nargs do
if type(args[i],equal) and not args[i,1]='title' then
hs := HTMLC(args[i,2]):
if type(hs, string) then head := head . hs . '\n' fi:
fi:
od:
fi:
head := head . '':
body := '\n'
else for i from 3 to nargs do
if type(args[i],symbol=string) and not type(args[i], equal) then
body := body . sprintf( ' %s="%s"', args[i,1], args[i,2] )
elif not type(args[i], equal) then error(args,'illegal ' . i . 'th argument') fi
od;
body := body . '>\n'
fi;
if nargs > 1 then
showTitle := true:
if nargs > 2 then
for i in args[3..-1] do
if i[1] = 'title' and i[2] = false then
showTitle := false;
fi:
od:
fi:
if showTitle then
body := body . '' . titl . '
' fi;
fi:
body := body . a . '\n':
head . body
else for f in [HTMLC,string] do
t := traperror(f(a));
if t <> lasterror and not type(t,structure(anything,HTMLC)) then
if nargs >= 2 then return( HTML(t,args[2..nargs]) ) fi;
t2 := traperror(a[title]);
if t2 <> lasterror then return( HTML(t,t2) ) fi;
t2 := traperror(a[Title]);
if t2 <> lasterror then return( HTML(t,t2) ) fi;
return( HTML(t) )
fi;
od;
noeval( HTML(args) )
fi
end:
HTMLC := proc() option polymorphic;
noeval( procname(args) )
end:
SvdResult_HTMLC := proc (svr:SvdResult)
out := 'Results of Least Squares approximation using SVD Analysis
\n';
out := out . '
quadratic norm of the residuals: |r|² = ' .
sprintf('%f', svr[Norm2Err]) . '
\n
';
if length(svr[SingularValuesDiscarded]) > 0 then
out := out . sprintf( '
residual norm if all singular values ' .
'were used: |r|$sup2; =%.5f\n', svr[MinNorm2Err] );
out := out . sprintf( '
%d singular values discarded ',
length(svr[SingularValuesDiscarded]) );
for z in svr[SingularValuesDiscarded] do
out := out . sprintf( ' %.4g', z) od;
printf( '\n' );
fi;
out := out . sprintf( '%d singular values used: ',
length(svr[SingularValuesUsed]) );
for z in svr[SingularValuesUsed] do
out := out . sprintf( ' %.4g', z) od;
out := out . '
';
out := out . sprintf( '
norm of the raw data, |b|² =%.5g\n\n',
svr[Norm2Indep] );
table_data := Table( Row('variable','value/stdev','norm decrease'));
for r in svr[SensitivityAnalysis] do
if r[4] < 1e-10 then
row_data := Row( sprintf('%6s',r[1]),
sprintf('%9.4f±INF',r[2]), '0.0' );
else row_data := Row( sprintf('%6s',r[1]),
sprintf('%9.4f±%.4f',r[2],r[3]), sprintf('%.4g', r[4] ) ) fi;
table_data := append(table_data,row_data);
od;
out . Table_HTMLC(table_data)
end:
#
# Hyperlinks
#
HyperLink := proc( text:string, URL:string ) option polymorphic;
noeval( procname(args) ) end:
HyperLink_HTMLC := proc( hy:HyperLink ) option internal;
''.hy[text].'' end:
HyperLink_string := proc( hy:HyperLink ) option internal; hy[text] end:
CompleteClass( HyperLink );
#
# LastUpdatedBy
#
LastUpdatedBy := proc( who ) option polymorphic, internal;
noeval( procname(args) ) end:
LastUpdatedBy_HTMLC := proc( lub:LastUpdatedBy ) option internal;
if length(lub) = 0 then '
Last updated on ' . date() . '
\n'
else 'Last updated on ' . date() . ' by ' . HTMLC( lub[who] ) . '
\n' fi
end:
LastUpdatedBy_string := proc( lub:LastUpdatedBy ) option internal;
if length(lub) = 0 then '\nLast updated on ' . date() . '\n'
else '\nLast updated on ' . date() . ' by ' . string( lub[who] ) . '\n' fi
end:
CompleteClass( LastUpdatedBy );
#
# Copyright
#
Copyright := proc( who ) option polymorphic, internal;
noeval( procname(args) ) end:
Copyright_HTMLC := proc( copr:Copyright ) option internal;
d := date();
if length(copr) = 0 then
sprintf( '© %s
\n', d[-4..-1] )
else sprintf( '© %s by %s
\n', d[-4..-1], copr[who] ) fi
end:
Copyright_string := proc( copr:Copyright ) option internal;
d := date();
if length(copr) = 0 then
string( Paragraph( 5, '(c) ', d[-4..-1] ))
else string( Paragraph( 5, '(c) ', d[-4..-1] . ' ', copr[who] )) fi
end:
CompleteClass( Copyright );
#
# Center
#
Center := proc( ) option polymorphic;
noeval( procname(args) ) end:
Center_type := noeval(structure(anything,Center)):
Center_HTMLC := proc( cen:Center ) option internal;
r := ''; for z in cen do r := r . HTMLC(z) od; r . ''
end:
Center_string := proc( cen:Center ) option internal;
r := ''; for z in cen do r := r . string(z) od;
scrw := Set(screenwidth=80); Set(screenwidth=scrw);
r2 := '';
while length(r) > 0 do
i := SearchString( '\n', r );
if i < 0 then t := r; r := '' else t := r[1..i+1]; r := i+1+r fi;
if length(t) < scrw then
r2 := r2 . CreateString(floor((scrw - length(t))/2)) . t
else r2 := r2 . t fi
od;
r2;
end:
Center_LaTeXC := proc( cen:Center ) option internal;
r := '\\begin{center}'; for z in cen do r := r . LaTeXC(z) od;
r . '\\end{center}\n'
end:
CompleteClass( Center );
#
# Font
#
Font := proc( font:string ) option polymorphic, internal;
noeval( procname(args) ) end:
Font_type := noeval(structure(anything,Font)):
Font_HTMLC := proc( fon:Font ) option internal;
r := ''; for i from 2 to length(fon) do r := r . HTMLC(fon[i]) od;
if lowercase(fon[1]) = 'italic' or lowercase(fon[1]) = 'italics' then
'' . r . ''
elif lowercase(fon[1]) = 'bold' then '' . r . ''
else '' . r . '' fi
end:
Font_string := proc( fon:Font ) option internal;
r := ''; for i from 2 to length(fon) do r := r . string(fon[i]) od;
r
end:
CompleteClass( Font );
#
# Size
#
Size := proc( fsize:{string,integer} ) option polymorphic, internal;
noeval( procname(args) ) end:
Size_type := noeval(structure(anything,Size)):
Size_HTMLC := proc( siz:Size ) option internal;
r := ''; for i from 2 to length(siz) do r := r . HTMLC(siz[i]) od;
'' . r . '';
end:
Size_string := proc( siz:Size ) option internal;
r := ''; for i from 2 to length(siz) do r := r . string(siz[i]) od;
r
end:
CompleteClass( Size );
Paragraph_HTMLC := proc( p:Paragraph ) option internal;
# negative indents are not possible (?) in HTML, therfore we ignore them.
ind := max(p[indent],0);
r := '';
to ind do r := r . ' ' od;
for i from 2 to length(p) do r := r . HTMLC(p[i]) od;
r . '
\n'
end:
# try to force to an HTML string
Anything_HTMLC := proc( t1 ) option internal;
if type(t1,string) then return(t1) fi;
t2 := traperror(HTMLC(t1));
if t2 <> lasterror and type(t2,string) then return(t2) fi;
t2 := traperror(string(t1));
if t2 <> lasterror and type(t2,string) then return(t2) fi;
error(t1,'cannot be converted to a string')
end:
Table_HTMLC := proc( t:Table ) option internal;
opts := {};
colal := NULL;
tit := NULL;
wid := NULL;
rows := [];
gut := 2;
values := NULL;
for z in t do
if member(z,{'center','border','rowwise', 'hastitlerow'}) then opts := opts union {z};
elif type(z,structure({string,structure(posint,noeval(p))},ColAlign)) then colal := copy(z)
elif type(z,structure(string,RowAlign)) then rows := append(rows, z)
elif type(z,'title'=string) then tit := op(2,z)
elif type(z,'width'={string,posint}) then wid := op(2,z)
elif type(z,'gutter'={0,posint}) then gut := op(2,z)
elif type(z,structure(anything,Row)) then rows := append(rows, z)
elif type(z,'gutter'=list({0,posint})) then
if printlevel >= 3 then
printf( 'Warning: gutter list not implemented yet in html\n' ) fi;
gut := round( sum(z[2]) / length(z[2]) )
elif type(z,structure(anything,Values)) then values := [op(z)]
elif z='Rule' then rows := append(rows, z)
else error(z,'is an invalid argument of Table') fi
od;
if colal<>NULL then
for i to length(colal) do
if type(colal[i],structure(posint,noeval(p))) then colal[i] := 'l' fi;
od:
fi:
if values<>NULL then
if colal=NULL then error('ColAlign must be given when Values() is used') fi;
if rows<>[] then error('Values() and Rows() can not be given at the same time') fi;
ncol := length(colal);
while mod(length(values),ncol)<>0 do values := append(values,'') od:
if not member('rowwise',opts) then ncol := length(values)/ncol fi;
for r to length(values) by ncol do
rows := append(rows,[op(values[r..r+ncol-1])]);
od:
if not member('rowwise',opts) then rows := transpose(rows) fi;
rows := seq(Row(z),z=rows);
i := 1;
oldargs := [];
while not type(t[i],structure(anything,Values)) do oldargs := append(oldargs,t[i]); i:=i+1 od:
return(procname(Table(op(oldargs),rows)));
fi;
out := If( member(center, opts), '', '' );
out := out . 'NULL then out := out.' width="'.wid.'"' fi;
out := out . '>';
if tit <> NULL then
out := out . ''.tit.'' fi;
for z in rows do
if z <> 'Rule' then
if type(z,structure(string,RowAlign)) then next fi;
if assigned(ncols) then
if ncols <> length(z) then
error(ncols,'Rows have different number of columns') fi;
else ncols := length(z) fi fi
od;
if colal<>NULL then
colal2 := copy(colal);
for a to length(colal2) do
if colal2[a] = 'c' then colal2[a] := 'center'
elif colal2[a] = 'l' then colal2[a] := 'left'
elif colal2[a] = 'r' then colal2[a] := 'right'
elif colal2[a,1..2] = 'p{' then colal2[a] := 'left' # discard widths
else error ('ColAlign not l c or r ') fi
od
else colal2 := CreateArray(1..ncols,'center')
fi;
if length(colal2) <> ncols then error('ColAlign has an incorrect length') fi;
gut := CreateArray(1..ncols-1,gut);
if member(hastitlerow, opts) then
titleRow := true;
out := out . '\n':
else
titleRow := false;
out := out . '\n':
fi;
rowal := NULL;
for z in rows do
if type(z,structure(string,RowAlign)) then rowal := z[1]; next fi;
if rowal<>NULL then
out := out.'';
else
out := out . '
';
fi;
if z <> 'Rule' then for j to length(z) do
if z[j]='SpanPrevious' then next
elif z[j]='TitleRow' then titleRow := true; next;
elif z[j]='' then t1 := ' '
else t1 := Anything_HTMLC(z[j]) fi;
for sp from j+1 to length(z) while z[sp] = 'SpanPrevious' do od;
tag := 'td';
if titleRow then tag := 'th'; fi;
if sp > j+1 then
out := out . sprintf( '<' . tag . ' align="%s" colspan="%d">%s',
colal2[j], sp-j, t1 )
else
out := out . sprintf( '<'. tag. ' align="%s">%s', colal2[j], t1) fi;
od
else
tdstyle := 'padding: 0px; border-bottom:1px solid black':
out := out . sprintf( ' | ', ncols ):
fi:
out := out . '
\n';
if titleRow then
out := out . '\n':
fi:
titleRow := false;
od;
out := out . '\n';
if member(center, opts) then out := out.'' fi;
out . '\n'
end:
PlusMin := proc( s:string ) option internal; noeval(procname(args)) end:
PlusMin_HTMLC := proc( s ) option internal;
if not type(s,PlusMin(string)) then error(args,'invalid arguments')
else s1 := s[1];
i := CaseSearchString('+-',s1);
if i < 0 then return(s1) fi;
for i1 from i by -1 to 1 while s1[i1] = ' ' do od;
for i2 from i+3 to length(s1) while s1[i2] = ' ' do od;
procname( PlusMin(s1[1..i1] . '±' . s1[i2..-1]) )
fi
end:
PlusMin_string := proc( s ) option internal;
if not type(s,PlusMin(string)) then error(args,'invalid arguments')
else s[1] fi
end:
CompleteClass(PlusMin);
Stat_HTMLC := proc( s ) option internal;
'
' . s[Description] . '
| sample size |
mean | variance | skewness | excess |
minimum | maximum |
| ' . sprintf('%d',s[Number]) .
' | ' . HTMLC(PlusMin(s[MeanVar])) .
' | ' . HTMLC(PlusMin(s[VarVar])) .
' | ' . sprintf( '%.4g',s[Skewness]) .
' | ' . sprintf( '%.4g',s[Excess]) .
' | ' . sprintf( '%.4g',s[Min]) .
' | ' . sprintf( '%.4g',s[Max]) . ' |
\n'
end:
Document_HTMLC := proc( doc ) option internal;
r := '';
for z in doc do
t := traperror(HTMLC(z));
if t=lasterror or not type(t,string) then
t := sprintf( 'HTMLC did not convert
from %A
to %A',
z, t) fi;
r := r . t
od;
r
end:
Alignment_HTMLC := proc( al ) option internal;
wid := Set(screenwidth=80);
r := '' . string(al) . '\n
\n';
Set(screenwidth=wid);
r
end:
Code_HTMLC := proc( al ) option internal;
r := '';
for d in al do
if type(d,string) then r := r . ConvertToEntityName(d)
else r := r . HTMLC(d) fi od;
r . '\n'
end:
TT_HTMLC := proc( al ) option internal;
r := '';
for d in al do r := r . HTMLC(d) od;
r . '\n'
end:
IT_HTMLC := proc( al ) option internal;
r := '';
for d in al do r := r . HTMLC(d) od;
r . '\n'
end:
Bold_HTMLC := proc( al ) option internal;
r := '';
for d in al do r := r . HTMLC(d) od;
r . '\n'
end:
Color_HTMLC := proc( col:Color(string,anything) ) option internal;
if col[1,1]='#' then
htmlcol := col[1]
else
rgb := string_RGB(col[1]);
htmlcol := sprintf('#%02X%02X%02X',seq(round(z*255),z=rgb));
fi;
'' . HTMLC(col[2]) . ''
end:
string_HTMLC := proc( h ) option internal;
if h='' then '
' else h fi end:
list_HTMLC := proc( l:list ) option internal;
r := '';
for i in l do
r := r.HTMLC(i).'\n';
od:
return(r):
end:
symbol_HTMLC := proc( h ) option internal; h end:
SectionHeader_HTMLC := proc( h:SectionHeader ) option internal;
r := sprintf( '%s\n', h['level'], h['title'], h['level'] );
return(r);
end:
TextBlock_HTMLC := proc( b:TextBlock ) option internal;
starttag := '<'.b[1]:
content := '';
for i from 2 to length(b) do
if type(b[i], equal) then
starttag := starttag.' '.string(b[i,1]).'="'.string(b[i,2]).'"';
else
content := content.HTMLC(b[i]):
fi:
od:
starttag := starttag.'>':
r := starttag.content.'':
return(r);
end:
DocEl_HTMLC := proc( d:DocEl ) option internal;
r := '<'.d[1];
for i from 2 to length(d) do
if type(d[i], equal) then
r := r.' '.string(d[i,1]).'="'.string(d[i,2]).'"';
fi:
od:
r := r.' />':
return(r);
end:
### # Data structure Target for local anchors in HTML.
### # This is defined here, because Target makes only sense
### # in HTML
Target := proc( name:string ) option polymorphic;
noeval(procname(args)):
end:
Target_type := structure(anything,Target):
Target_string := proc( t:Target) option internal;
return( t['name'] ):
end:
Target_HTMLC := proc( t:Target ) option internal;
r := sprintf( '', t['name'], t['name'] ):
return(r):
end: