2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -4,3 +4,4 @@ Create an HTML table.
|
|||
* An extra column should be added at either the extreme left or the extreme right of the table that has no heading, but is filled with sequential row numbers.
|
||||
* The rows of the "X", "Y", and "Z" columns should be filled with random or sequential integers having 4 digits or less.
|
||||
* The numbers should be aligned in the same fashion for all columns.
|
||||
<br><br>
|
||||
|
|
|
|||
78
Task/Create-an-HTML-table/ALGOL-68/create-an-html-table.alg
Normal file
78
Task/Create-an-HTML-table/ALGOL-68/create-an-html-table.alg
Normal file
|
|
@ -0,0 +1,78 @@
|
|||
INT not numbered = 0; # possible values for HTMLTABLE row numbering #
|
||||
INT numbered left = 1; # " " " " " " #
|
||||
INT numbered right = 2; # " " " " " " #
|
||||
|
||||
INT align centre = 0; # possible values for HTMLTABLE column alignment #
|
||||
INT align left = 1; # " " " " " " #
|
||||
INT align right = 2; # " " " " " " #
|
||||
|
||||
# allowable content for the HTML table - extend the UNION and TOSTRING #
|
||||
# operator to add additional modes #
|
||||
MODE HTMLTABLEDATA = UNION( INT, REAL, STRING );
|
||||
OP TOSTRING = ( HTMLTABLEDATA content )STRING:
|
||||
CASE content
|
||||
IN ( INT i ): whole( i, 0 )
|
||||
, ( REAL r ): fixed( r, 0, 0 )
|
||||
, ( STRING s ): s
|
||||
OUT "Unsupported HTMLTABLEDATA content"
|
||||
ESAC;
|
||||
# MODE to hold an html table #
|
||||
MODE HTMLTABLE = STRUCT( FLEX[ 0 ]STRING headings
|
||||
, FLEX[ 0, 0 ]HTMLTABLEDATA data
|
||||
, INT row numbering
|
||||
, INT column alignment
|
||||
, INT cell spacing
|
||||
, INT col spacing
|
||||
, INT border
|
||||
);
|
||||
# write an html table to a file #
|
||||
PROC write html table = ( REF FILE f, HTMLTABLE t )VOID:
|
||||
BEGIN
|
||||
STRING align = "align="""
|
||||
+ CASE column alignment OF t IN "left", "right" OUT "center" ESAC
|
||||
+ """";
|
||||
PROC th element = ( REF FILE f, HTMLTABLE t, STRING content )VOID:
|
||||
put( f, ( "<th " + align + ">" + content + "</th>", newline ) );
|
||||
PROC td element = ( REF FILE f, HTMLTABLE t, HTMLTABLEDATA content )VOID:
|
||||
put( f, ( "<td " + align + ">" + TOSTRING content + "</td>", newline ) );
|
||||
|
||||
# table element #
|
||||
put( f, ( "<table"
|
||||
+ " cellspacing=""" + whole( cell spacing OF t, 0 ) + """"
|
||||
+ " colspacing=""" + whole( col spacing OF t, 0 ) + """"
|
||||
+ " border=""" + whole( border OF t, 0 ) + """"
|
||||
+ ">"
|
||||
, newline
|
||||
)
|
||||
);
|
||||
# table headings #
|
||||
put( f, ( "<tr>", newline ) );
|
||||
IF row numbering OF t = numbered left THEN th element( f, t, "" ) FI;
|
||||
FOR col FROM LWB headings OF t TO UPB headings OF t DO
|
||||
th element( f, t, ( headings OF t )[ col ] )
|
||||
OD;
|
||||
IF row numbering OF t = numbered right THEN th element( f, t, "" ) FI;
|
||||
put( f, ( "</tr>", newline ) );
|
||||
# table rows #
|
||||
FOR row FROM 1 LWB data OF t TO 1 UPB data OF t DO
|
||||
put( f, ( "<tr>", newline ) );
|
||||
IF row numbering OF t = numbered left THEN th element( f, t, whole( row, 0 ) ) FI;
|
||||
FOR col FROM 2 LWB data OF t TO 2 UPB data OF t DO
|
||||
td element( f, t, ( data OF t )[ row, col ] )
|
||||
OD;
|
||||
IF row numbering OF t = numbered right THEN th element( f, t, whole( row, 0 ) ) FI;
|
||||
put( f, ( "</tr>", newline ) )
|
||||
OD;
|
||||
# end of table #
|
||||
put( f, ( "</table>", newline ) )
|
||||
END # write html table # ;
|
||||
|
||||
# create an HTMLTABLE and print it to standard output #
|
||||
HTMLTABLE t;
|
||||
cell spacing OF t := col spacing OF t := 0;
|
||||
border OF t := 1;
|
||||
column alignment OF t := align right;
|
||||
row numbering OF t := numbered left;
|
||||
headings OF t := ( "A", "B", "C" );
|
||||
data OF t := ( ( 1001, 1002, 1003 ), ( 21, 22, 23 ), ( 201, 202, 203 ) );
|
||||
write html table( stand out, t )
|
||||
9
Task/Create-an-HTML-table/AWK/create-an-html-table.awk
Normal file
9
Task/Create-an-HTML-table/AWK/create-an-html-table.awk
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#!/usr/bin/awk -f
|
||||
BEGIN {
|
||||
print "<table>\n <thead align = \"right\">"
|
||||
printf " <tr><th></th><td>X</td><td>Y</td><td>Z</td></tr>\n </thead>\n <tbody align = \"right\">\n"
|
||||
for (i=1; i<=10; i++) {
|
||||
printf " <tr><td>%2i</td><td>%5i</td><td>%5i</td><td>%5i</td></tr>\n",i, 10*i, 100*i, 1000*i-1
|
||||
}
|
||||
print " </tbody>\n</table>\n"
|
||||
}
|
||||
55
Task/Create-an-HTML-table/Agena/create-an-html-table.agena
Normal file
55
Task/Create-an-HTML-table/Agena/create-an-html-table.agena
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
notNumbered := 0; # possible values for html table row numbering
|
||||
numberedLeft := 1; # " " " " " " "
|
||||
numberedRight := 2; # " " " " " " "
|
||||
|
||||
alignCentre := 0; # possible values for html table column alignment
|
||||
alignLeft := 1; # " " " " " " "
|
||||
alignRight := 2; # " " " " " " "
|
||||
|
||||
# write an html table to a file
|
||||
writeHtmlTable := proc( fh, t :: table ) is
|
||||
local align := "align='";
|
||||
case t.columnAlignment
|
||||
of alignLeft then align := align & "left'"
|
||||
of alignRight then align := align & "right'"
|
||||
else align := align & "center'"
|
||||
esac;
|
||||
local put := proc( text :: string ) is io.write( fh, text & "\n" ) end;
|
||||
local thElement := proc( content :: string ) is put( "<th " & align & ">" & content & "</th>" ) end;
|
||||
local tdElement := proc( content ) is put( "<td " & align & ">" & content & "</td>" ) end;
|
||||
# table element
|
||||
put( "<table"
|
||||
& " cellspacing='" & t.cellSpacing & "'"
|
||||
& " colspacing='" & t.colSpacing & "'"
|
||||
& " border='" & t.border & "'"
|
||||
& ">"
|
||||
);
|
||||
# table headings
|
||||
put( "<tr>" );
|
||||
if t.rowNumbering = numberedLeft then thElement( "" ) fi;
|
||||
for col to size t.headings do thElement( t.headings[ col ] ) od;
|
||||
if t.rowNumbering = numberedRight then thElement( "" ) fi;
|
||||
put( "</tr>" );
|
||||
# table rows
|
||||
for row to size t.data do
|
||||
put( "<tr>" );
|
||||
if t.rowNumbering = numberedLeft then thElement( row & "" ) fi;
|
||||
for col to size t.data[ row ] do tdElement( t.data[ row, col ] ) od;
|
||||
if t.rowNumbering = numberedRight then thElement( row & "" ) fi;
|
||||
put( "</tr>" )
|
||||
od;
|
||||
# end of table
|
||||
put( "</table>" )
|
||||
end ;
|
||||
|
||||
# create an html table and print it to standard output
|
||||
scope
|
||||
local t := [];
|
||||
t.cellSpacing, t.colSpacing := 0, 0;
|
||||
t.border := 1;
|
||||
t.columnAlignment := alignRight;
|
||||
t.rowNumbering := numberedLeft;
|
||||
t.headings := [ "A", "B", "C" ];
|
||||
t.data := [ [ 1001, 1002, 1003 ], [ 21, 22, 23 ], [ 201, 202, 203 ] ];
|
||||
writeHtmlTable( io.stdout, t )
|
||||
epocs
|
||||
65
Task/Create-an-HTML-table/Forth/create-an-html-table.fth
Normal file
65
Task/Create-an-HTML-table/Forth/create-an-html-table.fth
Normal file
|
|
@ -0,0 +1,65 @@
|
|||
include random.hsf
|
||||
|
||||
\ parser routines
|
||||
: totag
|
||||
[char] < PARSE pad place \ parse input up to '<' char
|
||||
-1 >in +! \ move the interpreter pointer back 1 char
|
||||
pad count type ;
|
||||
|
||||
: '"' [char] " emit ;
|
||||
: '"..' '"' space ; \ output a quote char with trailing space
|
||||
|
||||
: toquote \ parse input to " then print as quoted text
|
||||
'"' [char] " PARSE pad place
|
||||
pad count type '"..' ;
|
||||
|
||||
: > [char] > emit space ; \ output the '>' with trailing space
|
||||
|
||||
\ Create some HTML extensions to the Forth interpreter
|
||||
: <table> ." <table>" cr ; : </table> ." </table>" cr ;
|
||||
: <table ." <table " ;
|
||||
: style=" ." style=" toquote ;
|
||||
: align=" ." align=" toquote ;
|
||||
: border=" ." border=" toquote ;
|
||||
: width=" ." width=" toquote ;
|
||||
: cellspacing=" ." cellspacing=" toquote ;
|
||||
: colspacing=" ." colspacing=" toquote ;
|
||||
|
||||
: <tr> ." <tr>" cr ; : </tr> ." </tr>" cr ;
|
||||
: <td> ." <td> " totag ; : </td> ." </td>" cr ;
|
||||
: <td ." <td " ;
|
||||
: <thead> ." <thead>" ; : </thead> ." </thead>" ;
|
||||
: <th> ." <th>" ; : </th> ." </th>" cr ;
|
||||
: <th ." <th " ;
|
||||
: <tbody ." <tbody " ; : </tbody> ." </tbody> " ;
|
||||
: <caption> cr ." <caption>" totag ; : </caption> ." </caption>" cr ;
|
||||
|
||||
\ Write the source code that generates HTML in our EXTENDED FORTH
|
||||
cr
|
||||
<table border=" 1" width=" 30%" >
|
||||
<caption> This table was created with FORTH HTML tags</caption>
|
||||
<tr>
|
||||
<th align=" right" > </th>
|
||||
<th align=" right" > ." A" </th>
|
||||
<th align=" right" > ." B" </th>
|
||||
<th align=" right" > ." C" </th>
|
||||
</tr>
|
||||
<tr>
|
||||
<th align=" right" > 1 . </th>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th align=" right" > 2 . </th>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th align=" right" > 3 . </th>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
<td align=" right" > 1000 RND . </td>
|
||||
</tr>
|
||||
</table>
|
||||
490
Task/Create-an-HTML-table/Fortran/create-an-html-table.f
Normal file
490
Task/Create-an-HTML-table/Fortran/create-an-html-table.f
Normal file
|
|
@ -0,0 +1,490 @@
|
|||
MODULE PARAMETERS !Assorted oddities that assorted routines pick and choose from.
|
||||
CHARACTER*5 I AM !Assuage finicky compilers.
|
||||
PARAMETER (IAM = "Gnash") !I AM!
|
||||
INTEGER LUSERCODE !One day, I'll get around to devising some string protocol.
|
||||
CHARACTER*28 USERCODE !I'm not too sure how long this can be.
|
||||
DATA USERCODE,LUSERCODE/"",0/!Especially before I have a text.
|
||||
END MODULE PARAMETERS
|
||||
|
||||
MODULE ASSISTANCE
|
||||
CONTAINS !Assorted routines that seem to be of general use but don't seem worth isolating..
|
||||
Subroutine Croak(Gasp) !A dying message, when horror is suddenly encountered.
|
||||
Casts out some final words and STOP, relying on the SubInOut stuff to have been used.
|
||||
Cut down from the full version of April MMI, that employed the SubIN and SubOUT protocol..
|
||||
Character*(*) Gasp !The last gasp.
|
||||
COMMON KBD,MSG
|
||||
WRITE (MSG,1) GASP
|
||||
1 FORMAT ("Oh dear! ",A)
|
||||
STOP "I STOP now. Farewell..." !Whatever pit I was in, I'm gone.
|
||||
End Subroutine Croak !That's it.
|
||||
|
||||
INTEGER FUNCTION LSTNB(TEXT) !Sigh. Last Not Blank.
|
||||
Concocted yet again by R.N.McLean (whom God preserve) December MM.
|
||||
Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness!
|
||||
Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces.
|
||||
Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully.
|
||||
Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable.
|
||||
Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone.
|
||||
Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only.
|
||||
Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L!
|
||||
Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB.
|
||||
CHARACTER*(*),INTENT(IN):: TEXT !The bumf. If there must be copy-in, at least there need not be copy back.
|
||||
INTEGER L !The length of the bumf.
|
||||
L = LEN(TEXT) !So, what is it?
|
||||
1 IF (L.LE.0) GO TO 2 !Are we there yet?
|
||||
IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 !Control chars are regarded as spaces also.
|
||||
L = L - 1 !Step back one.
|
||||
GO TO 1 !And try again.
|
||||
2 LSTNB = L !The last non-blank, possibly zero.
|
||||
RETURN !Unsafe to use LSTNB as a variable.
|
||||
END FUNCTION LSTNB !Compilers can bungle it.
|
||||
CHARACTER*2 FUNCTION I2FMT(N) !These are all the same.
|
||||
INTEGER*4 N !But, the compiler doesn't offer generalisations.
|
||||
IF (N.LT.0) THEN !Negative numbers cop a sign.
|
||||
IF (N.LT.-9) THEN !But there's not much room left.
|
||||
I2FMT = "-!" !So this means 'overflow'.
|
||||
ELSE !Otherwise, room for one negative digit.
|
||||
I2FMT = "-"//CHAR(ICHAR("0") - N) !Thus. Presume adjacent character codes, etc.
|
||||
END IF !So much for negative numbers.
|
||||
ELSE IF (N.LT.10) THEN !Single digit positive?
|
||||
I2FMT = " " //CHAR(ICHAR("0") + N) !Yes. This.
|
||||
ELSE IF (N.LT.100) THEN !Two digit positive?
|
||||
I2FMT = CHAR(N/10 + ICHAR("0")) !Yes.
|
||||
1 //CHAR(MOD(N,10) + ICHAR("0")) !These.
|
||||
ELSE !Otherwise,
|
||||
I2FMT = "+!" !Positive overflow.
|
||||
END IF !So much for that.
|
||||
END FUNCTION I2FMT !No WRITE and FORMAT unlimbering.
|
||||
CHARACTER*8 FUNCTION I8FMT(N) !Oh for proper strings.
|
||||
INTEGER*4 N
|
||||
CHARACTER*8 HIC
|
||||
WRITE (HIC,1) N
|
||||
1 FORMAT (I8)
|
||||
I8FMT = HIC
|
||||
END FUNCTION I8FMT
|
||||
CHARACTER*42 FUNCTION ERRORWORDS(IT) !Look for an explanation. One day, the system may offer coherent messages.
|
||||
Curious collection of encountered codes. Will they differ on other systems?
|
||||
Compaq's compiler was taken over by unintel; http://software.intel.com/sites/products/documentation/hpc/compilerpro/en-us/fortran/lin/compiler_f/bldaps_for/common/bldaps_rterrs.htm
|
||||
contains a schedule of error numbers that matched those I'd found for Compaq, and so some assumptions are added.
|
||||
Copying all (hundreds!) is excessive; these seem possible for the usage so far made of error diversion.
|
||||
Compaq's compiler interface ("visual" blah) has a help offering, which can provide error code information.
|
||||
Compaq messages also appear in http://cens.ioc.ee/local/man/CompaqCompilers/cf/dfuum028.htm#tab_runtime_errors
|
||||
Combines IOSTAT codes (file open, read etc) with STAT codes (allocate/deallocate) as their numbers are distinct.
|
||||
Completeness and context remains a problem. Excess brevity means cause and effect can be confused.
|
||||
INTEGER IT !The error code in question.
|
||||
INTEGER LASTKNOWN !Some codes I know about.
|
||||
PARAMETER (LASTKNOWN = 26) !But only a few, discovered by experiment and mishap.
|
||||
TYPE HINT !For them, I can supply a table.
|
||||
INTEGER CODE !The code number. (But, different systems..??)
|
||||
CHARACTER*42 EXPLICATION !An explanation. Will it be the answer?
|
||||
END TYPE HINT !Simple enough.
|
||||
TYPE(HINT) ERROR(LASTKNOWN) !So, let's have a collection.
|
||||
PARAMETER (ERROR = (/ !With these values.
|
||||
1 HINT(-1,"End-of-file at the start of reading!"), !From examples supplied with the Compaq compiler involving IOSTAT.
|
||||
2 HINT( 0,"No worries."), !Apparently the only standard value.
|
||||
3 HINT( 9,"Permissions - read only?"),
|
||||
4 HINT(10,"File already exists!"),
|
||||
5 HINT(17,"Syntax error in NameList input."),
|
||||
6 HINT(18,"Too many values for the recipient."),
|
||||
7 HINT(19,"Invalid naming of a variable."),
|
||||
8 HINT(24,"Surprise end-of-file during read!"), !From example source.
|
||||
9 HINT(25,"Invalid record number!"),
|
||||
o HINT(29,"File name not found."),
|
||||
1 HINT(30,"Unavailable - exclusive use?"),
|
||||
2 HINT(32,"Invalid fileunit number!"),
|
||||
3 HINT(35,"'Binary' form usage is rejected."), !From example source.
|
||||
4 HINT(36,"Record number for a non-existing record!"),
|
||||
5 HINT(37,"No record length has been specified."),
|
||||
6 HINT(38,"I/O error during a write!"),
|
||||
7 HINT(39,"I/O error during a read!"),
|
||||
8 HINT(41,"Insufficient memory available!"),
|
||||
9 HINT(43,"Malformed file name."),
|
||||
o HINT(47,"Attempting a write, but read-only is set."),
|
||||
1 HINT(66,"Output overflows single record size."), !This one from experience.
|
||||
2 HINT(67,"Input demand exceeds single record size."), !These two are for unformatted I/O.
|
||||
3 HINT(151,"Can't allocate: already allocated!"), !These different numbers are for memory allocation failures.
|
||||
4 HINT(153,"Can't deallocate: not allocated!"),
|
||||
5 HINT(173,"The fingered item was not allocated!"), !Such as an ordinary array that was not allocated.
|
||||
6 HINT(179,"Size exceeds addressable memory!")/))
|
||||
INTEGER I !A stepper.
|
||||
DO I = LASTKNOWN,1,-1 !So, step through the known codes.
|
||||
IF (IT .EQ. ERROR(I).CODE) GO TO 1 !This one?
|
||||
END DO !On to the next.
|
||||
1 IF (I.LE.0) THEN !Fail with I = 0.
|
||||
ERRORWORDS = I8FMT(IT)//" is a novel code!" !Reveal the mysterious number.
|
||||
ELSE !But otherwise, it is found.
|
||||
ERRORWORDS = ERROR(I).EXPLICATION !And these words might even apply.
|
||||
END IF !But on all systems?
|
||||
END FUNCTION ERRORWORDS !Hopefully, helpful.
|
||||
END MODULE ASSISTANCE
|
||||
|
||||
MODULE LOGORRHOEA
|
||||
CONTAINS
|
||||
SUBROUTINE ECART(TEXT) !Produces trace output with many auxiliary details.
|
||||
CHARACTER*(*) TEXT !The text to be annotated.
|
||||
COMMON KBD,MSG !I/O units.
|
||||
WRITE (MSG,1) TEXT !Just roll the text.
|
||||
1 FORMAT ("Trace: ",A) !Lacks the names of the invoking routine, and that which invoked it.
|
||||
END SUBROUTINE ECART
|
||||
SUBROUTINE WRITE(OUT,TEXT,ON) !We get here in the end. Cast forth some pearls.
|
||||
C Once upon a time, there was just confusion between ASCII and EBCDIC character codes and glyphs,
|
||||
c after many variant collections caused annoyance. Now I see that modern computing has introduced
|
||||
c many new variations, so that one text editor may display glyphs differing from those displayed
|
||||
c by another editor and also different from those displayed when a programme writes to the screen
|
||||
c in "teletype" mode, which is to say, employing the character/glyph combination of the moment.
|
||||
c And in particular, decimal points and degree symbols differ and annoyance has grown.
|
||||
c So, on re-arranging SAY to not send output to multiple distinations depending on the value of OUT,
|
||||
c except for the special output to MSG that is echoed to TRAIL, it became less messy to make an assault
|
||||
c on the text that goes to MSG, but after it was sent to TRAIL. I would have preferred to fiddle the
|
||||
c "code page" for text output that determines what glyph to show for which code, but not only
|
||||
c is it unclear how to do this, even if facilities were available, I suspect that the screen display
|
||||
c software only loads the mysterious code page during startup.
|
||||
c This fiddling means that any write to MSG should be done last, and writes of text literals
|
||||
c should not include characters that will be fiddled, as text literals may be protected against change.
|
||||
C Somewhere along the way, the cent character (¢) has disappeared. Perhaps it will return in "unicode".
|
||||
USE ASSISTANCE !But might still have difficulty.
|
||||
INTEGER OUT !The destination.
|
||||
CHARACTER*(*) TEXT !The message. Possibly damaged. Any trailing spaces will be sent forth.
|
||||
LOGICAL ON !Whether to terminate the line... TRUE sez that someone will be carrying on.
|
||||
INTEGER IOSTAT !Furrytran gibberish.
|
||||
c INCLUDE "cIOUnits.for" !I/O unit numbers.
|
||||
COMMON KBD,MSG
|
||||
c INTEGER*2,SAVE:: I Be !Self-identification.
|
||||
c CALL SUBIN("Write",I Be) !Hullo!
|
||||
IF (OUT.LE.0) GO TO 999 !Goodbye?
|
||||
c IF (IOGOOD(OUT)) THEN !Is this one in good heart?
|
||||
c IF (IOCOUNT(OUT).LE.0 .AND. OUT.NE.MSG) THEN !Is it attached to a file?
|
||||
c IF (IONAME(OUT).EQ."") IONAME(OUT) = "Anome" !"No name".
|
||||
c 1 //I2FMT(OUT)//".txt" !Clutch at straws.
|
||||
c IF (.NOT.OPEN(OUT,IONAME(OUT),"REPLACE","WRITE")) THEN !Just in time?
|
||||
c IOGOOD(OUT) = .FALSE. !No! Strangle further usage.
|
||||
c GO TO 999 !Can't write, so give up!
|
||||
c END IF !It might be better to hit the WRITE and fail.
|
||||
c END IF !We should be ready now.
|
||||
c IF (OUT.EQ.MSG .AND. SCRAGTEXTOUT) CALL SCRAG(TEXT) !Output to the screen is recoded for the screen.
|
||||
IF (ON) THEN !Now for the actual output at last. This is annoying.
|
||||
WRITE (OUT,1,ERR = 666,IOSTAT = IOSTAT) TEXT !Splurt.
|
||||
1 FORMAT (A,$) !Don't move on to a new line. (The "$"! Is it not obvious?)
|
||||
c IOPART(OUT) = IOPART(OUT) + 1 !Thus count a part-line in case someone fusses.
|
||||
ELSE !But mostly, write and advance.
|
||||
WRITE (OUT,2,ERR = 666,IOSTAT = IOSTAT) TEXT !Splurt.
|
||||
2 FORMAT (A) !*-style "free" format chops at 80 or some such.
|
||||
END IF !So much for last-moment dithering.
|
||||
c IOCOUNT(OUT) = IOCOUNT(OUT) + 1 !Count another write (whole or part) so as to be not zero..
|
||||
c END IF !So much for active passages.
|
||||
c 999 CALL SUBOUT("Write") !I am closing.
|
||||
999 RETURN !Done.
|
||||
Confusions.
|
||||
666 IF (OUT.NE.MSG) CALL CROAK("Can't write to unit "//I2FMT(OUT) !Why not?
|
||||
c 1 //" (file "//IONAME(OUT)(1:LSTNB(IONAME(OUT))) !Possibly, no more disc space! In which case, this may fail also!
|
||||
2 //") message "//ERRORWORDS(IOSTAT) !Hopefully, helpful.
|
||||
3 //" length "//I8FMT(LEN(TEXT))//", this: "//TEXT) !The instigation.
|
||||
STOP "Constipation!" !Just so.
|
||||
END SUBROUTINE WRITE !The moving hand having writ, moves on.
|
||||
|
||||
SUBROUTINE SAY(OUT,TEXT) !And maybe a copy to the trail file as well.
|
||||
USE PARAMETERS !Odds and ends.
|
||||
USE ASSISTANCE !Just a little.
|
||||
INTEGER OUT !The orifice.
|
||||
CHARACTER*(*) TEXT !The blather. Can be modified if to MSG and certain characters are found.
|
||||
CHARACTER*120 IS !For a snatched question.
|
||||
INTEGER L !A finger.
|
||||
c INCLUDE "cIOUnits.for" !I/O unit numbers.
|
||||
COMMON KBD,MSG
|
||||
c INTEGER*2,SAVE:: I Be !Self-identification.
|
||||
c CALL SUBIN("Say",I Be) !Me do be Me, I say!
|
||||
Chop off trailing spaces.
|
||||
L = LEN(TEXT) !What I say may be rather brief.
|
||||
1 IF (L.GT.0) THEN !So, is there a last character to look at?
|
||||
IF (ICHAR(TEXT(L:L)).LE.ICHAR(" ")) THEN !Yes. Is it boring?
|
||||
L = L - 1 !Yes! Trim it!
|
||||
GO TO 1 !And check afresh.
|
||||
END IF !A DO-loop has overhead with its iteration count as well.
|
||||
END IF !Function LEN_TRIM copies the text first!!
|
||||
Contemplate the disposition of TEXT(1:L)
|
||||
c IF (OUT.NE.MSG) THEN !Normal stuff?
|
||||
CALL WRITE(OUT,TEXT(1:L),.FALSE.) !Roll.
|
||||
c ELSE !Echo what goes to MSG to the TRAIL file.
|
||||
c CALL WRITE(TRAIL,TEXT(1:L),.FALSE.) !Thus.
|
||||
c CALL WRITE( MSG,TEXT(1:L),.FALSE.) !Splot to the screen.
|
||||
c IF (.NOT.BLABBERMOUTH) THEN !Do we know restraint?
|
||||
c IF (IOCOUNT(MSG).GT.BURP) THEN !Yes. Consider it.
|
||||
c WRITE (MSG,100) IOCOUNT(MSG) !Alas, triggered. So remark on quantity,
|
||||
c 100 FORMAT (//I9," lines! Your spirit might flag." !Hint. (Not copied to the TRAIL file)
|
||||
c 1 /," Type quit to set GIVEOVER to TRUE, with hope for "
|
||||
c 2 ,"a speedy palliation,",
|
||||
c 3 /," or QUIT to abandon everything, here, now",
|
||||
c 4 /," or blabber to abandon further restraint,",
|
||||
c 5 /," or anything else to carry on:")
|
||||
c IS = REPLY("QUIT, quit, blabber or continue") !And ask.
|
||||
c IF (IS.EQ."QUIT") CALL CROAK("Enough of this!") !No UPDATE, nothing.
|
||||
c CALL UPCASE(IS) !Now we're past the nice distinction, simplify.
|
||||
c IF (IS.EQ."QUIT") GIVEOVER = .TRUE. !Signal to those who listen.
|
||||
c IF (IS.EQ."BLABBER") BLABBERMOUTH = .TRUE. !Well?
|
||||
c IF (GIVEOVER) WRITE (MSG,101) !Announce hope.
|
||||
c 101 FORMAT ("Let's hope that the babbler notices...") !Like, IF (GIVEOVER) GO TO ...
|
||||
c IF (.NOT.GIVEOVER) WRITE (MSG,102) !Alternatively, firm resolve.
|
||||
c 102 FORMAT("Onwards with renewed vigour!") !Fight the good fight.
|
||||
c BURP = IOCOUNT(MSG) + ENOUGH !The next pause to come.
|
||||
c END IF !So much for last-moment restraint.
|
||||
c END IF !So much for restraint.
|
||||
c END IF !So much for selection.
|
||||
c CALL SUBOUT("Say") !I am merely the messenger.
|
||||
END SUBROUTINE SAY !Enough said.
|
||||
SUBROUTINE SAYON(OUT,TEXT) !Roll to the screen and to the trail file as well.
|
||||
C This differs by not ending the line so that further output can be appended to it.
|
||||
USE ASSISTANCE
|
||||
INTEGER OUT !The orifice.
|
||||
CHARACTER*(*) TEXT !The blather.
|
||||
INTEGER L !A finger.
|
||||
c INCLUDE "cIOUnits.for" !I/O unit numbers.
|
||||
COMMON KBD,MSG
|
||||
c INTEGER*2,SAVE:: I Be !Self-identification.
|
||||
c CALL SUBIN("SayOn",I Be) !Me do be another. Me, I say on!
|
||||
L = LEN(TEXT) !How much say I on?
|
||||
1 IF (L.GT.0) THEN !I say on anything?
|
||||
IF (ICHAR(TEXT(L:L)).LE.ICHAR(" ")) THEN !I end it spaceish?
|
||||
L = L - 1 !Yes. Trim such.
|
||||
GO TO 1 !And look afresh.
|
||||
END IF !So much for trailing off.
|
||||
END IF !Continue with L fingering the last non-blank.
|
||||
c IF (OUT.EQ.MSG) CALL WRITE(TRAIL,TEXT(1:L),.TRUE.) !Writes to the screen go also to the TRAIL.
|
||||
CALL WRITE( OUT,TEXT(1:L),.TRUE.) !It is said, and more is expected.
|
||||
c CALL SUBOUT("SayOn") !I am merely the messenger.
|
||||
END SUBROUTINE SAYON !And further messages impend.
|
||||
|
||||
END MODULE LOGORRHOEA
|
||||
|
||||
MODULE HTMLSTUFF !Assists with the production of decorated output.
|
||||
Can't say I think much of the scheme. How about <+blah> ... <-blah> rather than the assymetric <blah> ... </blah>?
|
||||
Cack-handed comment format as well...
|
||||
USE PARAMETERS !To ascertain who I AM.
|
||||
USE ASSISTANCE !To get at LSTNB.
|
||||
USE LOGORRHOEA !To get at SAYON and SAY.
|
||||
INTEGER INDEEP,HOLE !I keep track of some details.
|
||||
PRIVATE INDEEP,HOLE !Amongst myselves.
|
||||
DATA INDEEP,HOLE/0,0/ !Initially, I'm not doing anything.
|
||||
Choose amongst output formats.
|
||||
INTEGER LASTFILETYPENAME !Certain file types are recognised.
|
||||
PARAMETER (LASTFILETYPENAME = 2) !Thus, three options.
|
||||
INTEGER OUTTYPE,OUTTXT,OUTCSV,OUTHTML !The recognition.
|
||||
CHARACTER*5 OUTSTYLE,FILETYPENAME(0:LASTFILETYPENAME) !Via the tail end of a file name.
|
||||
PARAMETER (FILETYPENAME = (/".txt",".CSV",".HTML"/)) !Thusly. Note that WHATFILETYPE will not recognise ".txt" directly.
|
||||
PARAMETER (OUTTXT = 0,OUTCSV = 1,OUTHTML = 2) !Mnemonics.
|
||||
DATA OUTSTYLE/""/ !So OUTTYPE = OUTTXT. But if an output file is specified, its file type will be inspected.
|
||||
TYPE HTMLMNEMONIC !I might as well get systematic, as these are global names.
|
||||
CHARACTER* 9 COMMAH !This looks like a comma
|
||||
CHARACTER* 9 COMMAD !And in another context, so does this.
|
||||
CHARACTER* 6 SPACE !Some spaces are to be atomic.
|
||||
CHARACTER*18 RED !Decoration and
|
||||
CHARACTER* 7 DER !noitaroceD.
|
||||
END TYPE HTMLMNEMONIC !That's enough for now.
|
||||
TYPE(HTMLMNEMONIC) HTMLA !I'll have one set, please.
|
||||
PARAMETER (HTMLA = HTMLMNEMONIC( !With these values.
|
||||
1 "</th><th>", !But .html has its variants. For a heading.
|
||||
2 "</td><td>", !For a table datum.
|
||||
3 " ", !A space that is not to be split.
|
||||
4 '<font color="red">', !Dabble in decoration.
|
||||
5 '</font>')) !Grrrr. A font is for baptismal water.
|
||||
CONTAINS !Mysterious assistants.
|
||||
SUBROUTINE HTML(TEXT) !Rolls some text, with suitable indentation.
|
||||
CHARACTER*(*) TEXT !The text.
|
||||
c INCLUDE "cIOUnits.for" !I/O unit numbers.
|
||||
IF (LEN(TEXT).LE.0) RETURN !Possibly boring.
|
||||
IF (INDEEP.GT.0) THEN !Some indenting desired?
|
||||
CALL WRITE(HOLE,REPEAT(" ",INDEEP),.TRUE.) !Yep. SAYON trims trailing spaces.
|
||||
c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,REPEAT(" ",INDEEP),.TRUE.) !So I must copy.
|
||||
END IF !Enough indenting.
|
||||
CALL SAY(HOLE,TEXT) !Say the piece and end the line.
|
||||
END SUBROUTINE HTML !Maintain stacks? Check entry/exit matching?
|
||||
|
||||
SUBROUTINE HTML3(HEAD,BUMF,TAIL) !Rolls some text, with suitable indentation.
|
||||
Checks the BUMF for decimal points only. HTMLALINE handles text to HTML for troublesome characters, replacing them with special names for the desired glyph.
|
||||
Confusion might arise, if & is in BUMF and is not to be converted. "&" vs "&so on"; similar worries with < and >.
|
||||
CHARACTER*(*) HEAD !If not "", the start of the line, with indentation supplied.
|
||||
CHARACTER*(*) BUMF !The main body of the text.
|
||||
CHARACTER*(*) TAIL !If not "", this is for the end of the line.
|
||||
INTEGER LB,L1,L2 !A length and some fingers for scanning.
|
||||
CHARACTER*1 MUMBLE !These symbols may not be presented properly.
|
||||
CHARACTER*8 MUTTER !But these encodements may be interpreted as desired.
|
||||
PARAMETER (MUMBLE = "·") !I want certain glyphs, but encodement varies.
|
||||
PARAMETER (MUTTER = "·") !As does recognition.
|
||||
c INCLUDE "cIOUnits.for" !I/O unit numbers.
|
||||
COMMON KBD,MSG
|
||||
Commence with a new line?
|
||||
IF (HEAD.NE."") THEN !Is a line to be started? (Spaces are equivalent to "" as well)
|
||||
IF (INDEEP.GT.0) THEN !Some indentation is good.
|
||||
CALL WRITE(HOLE,REPEAT(" ",INDEEP),.TRUE.) !Yep. SAYON trims trailing spaces.
|
||||
c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL, !So I must copy for the log.
|
||||
c 1 REPEAT(" ",INDEEP),.TRUE.) !Hopefully, not generated a second time.
|
||||
ELSE !The accountancy may be bungled.
|
||||
CALL ECART("HTML huh? InDeep="//I8FMT(INDEEP)) !So, complain.
|
||||
END IF !Also, REPEAT has misbehaved.
|
||||
CALL SAYON(HOLE,HEAD) !Thus a suitable indentation.
|
||||
END IF !So much for a starter.
|
||||
Cast forth the bumf. Any trailing spaces will be dropped by SAYON.
|
||||
LB = LEN(BUMF) !How much bumf? Trailing spaces will be rolled.
|
||||
L1 = 1 !Waiting to be sent.
|
||||
L2 = 0 !Syncopation.
|
||||
1 L2 = L2 + 1 !Advance to the next character to be inspected..
|
||||
IF (L2.GT.LB) GO TO 2 !Is there another?
|
||||
IF (ICHAR(BUMF(L2:L2)).NE.ICHAR(MUMBLE)) GO TO 1 !Yes. Advance through the untroublesome.
|
||||
IF (L1.LT.L2) THEN !A hit. Have any untroubled ones been passed?
|
||||
CALL WRITE(HOLE,BUMF(L1:L2 - 1),.TRUE.) !Yes. Send them forth.
|
||||
c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,BUMF(L1:L2 - 1),.TRUE.) !With any trailing spaces included.
|
||||
END IF !Now to do something in place of BUMF(L2)
|
||||
L1 = L2 + 1 !Moving the marker past it, like.
|
||||
CALL SAYON(HOLE,MUTTER) !The replacement for BUMF(L2 as was).
|
||||
GO TO 1 !Continue scanning.
|
||||
2 IF (L2.GT.L1) THEN !Any tail end, but not ending the output line.
|
||||
CALL WRITE(HOLE,BUMF(L1:L2 - 1),.TRUE.) !Yes. Away it goes.
|
||||
c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,BUMF(L1:L2 - 1),.TRUE.) !And logged.
|
||||
END IF !So much for the bumf.
|
||||
Consider ending the line.
|
||||
3 IF (TAIL.NE."") CALL SAY(HOLE,TAIL) !Enough!
|
||||
END SUBROUTINE HTML3 !Maintain stacks? Check entry/exit matching?
|
||||
|
||||
SUBROUTINE HTMLSTART(OUT,TITLE,DESC) !Roll forth some gibberish.
|
||||
INTEGER OUT !The mouthpiece, mentioned once only at the start, and remembered for future use.
|
||||
CHARACTER*(*) TITLE !This should be brief.
|
||||
CHARACTER*(*) DESC !This a little less brief.
|
||||
CHARACTER*(*) METAH !Some repetition.
|
||||
PARAMETER (METAH = '<Meta Name="') !The syntax is dubious.
|
||||
CHARACTER*8 D !YYYYMMDD
|
||||
CHARACTER*10 T !HHMMSS.FFF
|
||||
HOLE = OUT !Keep a local copy to save on parameters.
|
||||
INDEEP = 0 !We start.
|
||||
CALL HTML('<!DOCTYPE HTML PUBLIC "' !Before we begin, we wave hands.
|
||||
1 //'-//W3C//DTD HTML 4.01 Transitional//EN"' !Otherwise "nowrap" is objected to, as in http://validator.w3.org/check
|
||||
2 //' "http://www.w3.org/TR/html4/loose.dtd">') !Endless blather.
|
||||
CALL HTML('<HTML lang="en-NZ">') ! H E R E W E G O !
|
||||
INDEEP = 1 !Its content.
|
||||
CALL HTML("<Head>") !And the first decoration begins.
|
||||
INDEEP = 2 !Its content.
|
||||
CALL HTML("<Title>"//I AM//" " !This appears in the web page tag.
|
||||
1 // TITLE(1:LSTNB(TITLE)) //"</Title>")!So it should be short.
|
||||
CALL HTML('<Meta http-equiv="Content-Type"' !Crazed gibberish.
|
||||
1 //' content="text/html; charset=utf-8">') !But said to be worthy.
|
||||
CALL HTML(METAH//'Description" Content="'//DESC//'">') !Hopefully, helpful.
|
||||
CALL HTML(METAH//'Generator" Content="'//I AM//'">') !I said.
|
||||
CALL DATE_AND_TIME(DATE = D,TIME = T) !Not assignments, but attachments.
|
||||
CALL HTML(METAH//'Created" Content="' !Convert the timestamp
|
||||
1 //D(1:4)//"-"//D(5:6)//"-"//D(7:8) !Into an international standard.
|
||||
2 //" "//T(1:2)//":"//T(3:4)//":"//T(5:10)//'">') !For date and time.
|
||||
IF (LUSERCODE.GT.0) CALL HTML(METAH !Possibly, the user's code is known.
|
||||
1 //'Author" Content="'//USERCODE(1:LUSERCODE) !If so, reveal.
|
||||
2 //'"> <!-- User code as reported by GetLog.-->') !Disclaiming responsibility...
|
||||
INDEEP = 1 !Finishing the content of the header.
|
||||
CALL HTML("</Head>") !Enough of that.
|
||||
CALL HTML("<BODY>") !A fresh line seems polite.
|
||||
INDEEP = 2 !Its content follows..
|
||||
END SUBROUTINE HTMLSTART !Others will follow on. Hopefully, correctly.
|
||||
SUBROUTINE HTMLSTOP !And hopefully, this will be a good closure.
|
||||
Could be more sophisticated and track the stack via INDEEP+- and names, to enable a desperate close-off if INDEEP is not 2.
|
||||
IF (INDEEP.NE.2) CALL ECART("Misclosure! InDeep not 2 but" !But,
|
||||
1 //I8FMT(INDEEP)) !It may not be.
|
||||
INDEEP = 1 !Retreat to the first level.
|
||||
CALL HTML("</BODY>") !End the "body".
|
||||
INDEEP = 0 !Retreat to the start level.
|
||||
CALL HTML("</HTML>") !End the whole thing.
|
||||
END SUBROUTINE HTMLSTOP !Ah...
|
||||
|
||||
SUBROUTINE HTMLTSTART(B,SUMMARY) !Start a table.
|
||||
INTEGER B !Border thickness.
|
||||
CHARACTER*(*) SUMMARY !Some well-chosen words.
|
||||
CALL HTML("<Table border="//I2FMT(B) !Just so. Text digits, or, digits in text?
|
||||
1 //' summary="'//SUMMARY//'">') !Not displayed, but potentially used by non-display agencies...
|
||||
INDEEP = INDEEP + 1 !Another level dug.
|
||||
END SUBROUTINE HTMLTSTART!That part was easy.
|
||||
SUBROUTINE HTMLTSTOP !And the ending is easy too.
|
||||
INDEEP = INDEEP - 1 !Withdraw a level.
|
||||
CALL HTML("</Table>") !Hopefully, aligning.
|
||||
END SUBROUTINE HTMLTSTOP !The bounds are easy.
|
||||
|
||||
SUBROUTINE HTMLTHEADSTART !Start a table's heading.
|
||||
CALL HTML("<tHead>") !Thus.
|
||||
INDEEP = INDEEP + 1 !Dig deeper.
|
||||
END SUBROUTINE HTMLTHEADSTART !Content should follow.
|
||||
SUBROUTINE HTMLTHEADSTOP !And now, enough.
|
||||
INDEEP = INDEEP - 1 !Retreat a level.
|
||||
CALL HTML("</tHead>") !And end the head.
|
||||
END SUBROUTINE HTMLTHEADSTOP !At the neck of the body?
|
||||
|
||||
SUBROUTINE HTMLTHEAD(N,TEXT) !Cast forth a whole-span table heading.
|
||||
INTEGER N !The count of columns to be spanned.
|
||||
CHARACTER*(*) TEXT !A brief description to place there.
|
||||
CALL HTML3("<tr><th colspan=",I8FMT(N)//' align="center">',"") !Start the specification.
|
||||
CALL HTML3("",TEXT(1:LSTNB(TEXT)),"</th></tr>") !This text, possibly verbose.
|
||||
END SUBROUTINE HTMLTHEAD !Thus, all contained on one line.
|
||||
|
||||
SUBROUTINE HTMLTBODYSTART !Start on the table body.
|
||||
CALL HTML('<tBody> <!--Profuse "align" usage ' !Simple, but I'm unhappy.
|
||||
1 //'for all cells can be factored out to "row" ' !Alas, so far as I can make out.
|
||||
2 //'but not to "body"-->') !And I don't think much of the "comment" formalism, either.
|
||||
INDEEP = INDEEP + 1 !Anyway, we're ready with the alignment.
|
||||
END SUBROUTINE HTMLTBODYSTART !Others will provide the body.
|
||||
SUBROUTINE HTMLTBODYSTOP !And, they've had enough.
|
||||
INDEEP = INDEEP - 1 !So, up out of the hole.
|
||||
CALL HTML("</tBody>") !Take a breath.
|
||||
END SUBROUTINE HTMLTBODYSTOP !And wander off.
|
||||
SUBROUTINE HTMLTROWTEXT(TEXT,N) !Roll a row of column headings.
|
||||
CHARACTER*(*) TEXT(:) !The headings.
|
||||
INTEGER N !Their number.
|
||||
INTEGER I,L !Assistants.
|
||||
CALL HTML3("<tr>","","") !Start a row of headings-to-come, and don't end the line.
|
||||
DO I = 1,N !Step through the headings.
|
||||
L = LSTNB(TEXT(I)) !Trailing spaces are to be ignored.
|
||||
IF (L.LE.0) THEN !Thus discovering blank texts.
|
||||
CALL HTML3("","<th> </th>","") !This prevents the cell being collapsed.
|
||||
ELSE !But for those with text,
|
||||
CALL HTML3("","<th>"//TEXT(I)(1:L)//"</th>","") !Roll it.
|
||||
END IF !So much for that text.
|
||||
END DO !On to the next.
|
||||
CALL HTML3("","","</tr>") !Finish the row, and thus the line.
|
||||
END SUBROUTINE HTMLTROWTEXT !So much for texts.
|
||||
SUBROUTINE HTMLTROWINTEGER(V,N) !Now for all integers.
|
||||
INTEGER V(:) !The integers.
|
||||
INTEGER N !Their number.
|
||||
INTEGER I !A stepper.
|
||||
CALL HTML3('<tr align="right">',"","") !Start a row of entries.
|
||||
DO I = 1,N !Work through the row's values.
|
||||
CALL HTML3("","<td>"//I8FMT(V(I))//"</td>","") !One by one.
|
||||
END DO !On to the next.
|
||||
CALL HTML3("","","</tr>") !Finish the row, and thus the line.
|
||||
END SUBROUTINE HTMLTROWINTEGER !All the same type is not troublesome.
|
||||
END MODULE HTMLSTUFF !Enough already.
|
||||
|
||||
PROGRAM MAKETABLE
|
||||
USE PARAMETERS
|
||||
USE ASSISTANCE
|
||||
USE HTMLSTUFF
|
||||
INTEGER KBD,MSG
|
||||
INTEGER NCOLS !The usage of V must conform to this!
|
||||
PARAMETER (NCOLS = 4) !Specified number of columns.
|
||||
CHARACTER*3 COLNAME(NCOLS) !And they have names.
|
||||
PARAMETER (COLNAME = (/"","X","Y","Z"/)) !As specified.
|
||||
INTEGER V(NCOLS) !A scratchpad for a line's worth.
|
||||
COMMON KBD,MSG !I/O units.
|
||||
KBD = 5 !Keyboard.
|
||||
MSG = 6 !Screen.
|
||||
CALL GETLOG(USERCODE) !Who has poked me into life?
|
||||
LUSERCODE = LSTNB(USERCODE) !Ah, text gnashing.
|
||||
|
||||
CALL HTMLSTART(MSG,"Powers","Table of integer powers") !Output to the screen will do.
|
||||
CALL HTMLTSTART(1,"Successive powers of successive integers") !Start the table.
|
||||
CALL HTMLTHEADSTART !The table heading.
|
||||
CALL HTMLTHEAD(NCOLS,"Successive powers") !A full-width heading.
|
||||
CALL HTMLTROWTEXT(COLNAME,NCOLS) !Headings for each column.
|
||||
CALL HTMLTHEADSTOP !So much for the heading.
|
||||
CALL HTMLTBODYSTART !Now for the content.
|
||||
DO I = 1,10 !This should be enough.
|
||||
V(1) = I !The unheaded row number.
|
||||
V(2) = I**2 !Its square.
|
||||
V(3) = I**3 !Cube.
|
||||
V(4) = I**4 !Fourth power.
|
||||
CALL HTMLTROWINTEGER(V,NCOLS) !Show a row's worth..
|
||||
END DO !On to the next line.
|
||||
CALL HTMLTBODYSTOP !No more content.
|
||||
CALL HTMLTSTOP !End the table.
|
||||
CALL HTMLSTOP
|
||||
END
|
||||
24
Task/Create-an-HTML-table/Lua/create-an-html-table.lua
Normal file
24
Task/Create-an-HTML-table/Lua/create-an-html-table.lua
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
function htmlTable (data)
|
||||
local html = "<table>\n<tr>\n<th></th>\n"
|
||||
for _, heading in pairs(data[1]) do
|
||||
html = html .. "<th>" .. heading .. "</th>" .. "\n"
|
||||
end
|
||||
html = html .. "</tr>\n"
|
||||
for row = 2, #data do
|
||||
html = html .. "<tr>\n<th>" .. row - 1 .. "</th>\n"
|
||||
for _, field in pairs(data[row]) do
|
||||
html = html .. "<td>" .. field .. "</td>\n"
|
||||
end
|
||||
html = html .. "</tr>\n"
|
||||
end
|
||||
return html .. "</table>"
|
||||
end
|
||||
|
||||
local tableData = {
|
||||
{"X", "Y", "Z"},
|
||||
{"1", "2", "3"},
|
||||
{"4", "5", "6"},
|
||||
{"7", "8", "9"}
|
||||
}
|
||||
|
||||
print(htmlTable(tableData))
|
||||
|
|
@ -1,21 +1,22 @@
|
|||
/*REXX program creates an HTML table of five rows and three columns. */
|
||||
arg rows .; if rows=='' then rows=5 /*no ROWS specified? Then use default.*/
|
||||
cols = 3 /*specify three columns for the table. */
|
||||
maxRand = 9999 /*4-digit numbers, allows negative nums*/
|
||||
headerInfo = 'X Y Z' /*specifify column header information. */
|
||||
oFID = 'a_table.html' /*name of the output file. */
|
||||
w = 0 /*number of writes to the output file. */
|
||||
/*REXX program creates (and displays) an HTML table of five rows and three columns.*/
|
||||
parse arg rows . /*obtain optional argument from the CL.*/
|
||||
if rows=='' | rows=="," then rows=5 /*no ROWS specified? Then use default.*/
|
||||
cols = 3 /*specify three columns for the table. */
|
||||
maxRand = 9999 /*4-digit numbers, allows negative nums*/
|
||||
headerInfo = 'X Y Z' /*specifify column header information. */
|
||||
oFID = 'a_table.html' /*name of the output file. */
|
||||
w = 0 /*number of writes to the output file. */
|
||||
|
||||
call wrt "<html>"
|
||||
call wrt "<head></head>"
|
||||
call wrt "<body>"
|
||||
call wrt "<table border=5 cellpadding=20 cellspace=0>"
|
||||
|
||||
do r=0 to rows /* [↓] handle row 0 as being special.*/
|
||||
if r==0 then call wrt "<tr><th></th>"
|
||||
else call wrt "<tr><th>" r "</th>"
|
||||
do r=0 to rows /* [↓] handle row 0 as being special.*/
|
||||
if r==0 then call wrt "<tr><th></th>" /*when it's the zeroth row. */
|
||||
else call wrt "<tr><th>" r "</th>" /* " " not " " " */
|
||||
|
||||
do c=1 for cols /* [↓] for row 0, add the header info*/
|
||||
do c=1 for cols /* [↓] for row 0, add the header info*/
|
||||
if r==0 then call wrt "<th>" word(headerInfo,c) "</th>"
|
||||
else call wrt "<td align=right>" rnd() "</td>"
|
||||
end /*c*/
|
||||
|
|
@ -25,7 +26,7 @@ call wrt "</table>"
|
|||
call wrt "</body>"
|
||||
call wrt "</html>"
|
||||
say; say w ' records were written to the output file: ' oFID
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
rnd: return right(random(0,maxRand*2)-maxRand,5) /*REXX doesn't gen neg RANDs.*/
|
||||
wrt: call lineout oFID,arg(1); say '══►' arg(1); w=w+1; return /*write.*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
rnd: return right(random(0,maxRand*2)-maxRand,5) /*RANDOM doesn't generate negative ints*/
|
||||
wrt: call lineout oFID,arg(1); say '══►' arg(1); w=w+1; return /*write.*/
|
||||
|
|
|
|||
|
|
@ -0,0 +1,34 @@
|
|||
(*
|
||||
* val mkHtmlTable : ('a list * 'b list) -> ('a -> string * 'b -> string)
|
||||
* -> (('a * 'b) -> string) -> string
|
||||
* The int list is list of colums, the function returns the values
|
||||
* at a given colum and row.
|
||||
* returns the HTML code of the generated table.
|
||||
*)
|
||||
fun mkHtmlTable (columns, rows) (rowToStr, colToStr) values =
|
||||
let
|
||||
val text = ref "<table border=1 cellpadding=10 cellspacing=0>\n<tr><td></td>"
|
||||
in
|
||||
(* Add headers *)
|
||||
map (fn colum => text := !text ^ "<th>" ^ (colToStr colum) ^ "</th>") columns;
|
||||
|
||||
text := !text ^ "</tr>\n";
|
||||
(* Add data rows *)
|
||||
map (fn row =>
|
||||
(* row name *)
|
||||
(text := !text ^ "<tr><th>" ^ (rowToStr row) ^ "</th>";
|
||||
(* data *)
|
||||
map (fn col => text := !text ^ "<td>" ^ (values (row, col)) ^ "</td>") columns;
|
||||
text := !text ^ "</tr>\n")
|
||||
) rows;
|
||||
!text ^ "</table>"
|
||||
end
|
||||
|
||||
fun mkHtmlWithBody (title, body) = "<html>\n<head>\n<title>" ^ title ^ "</title>\n</head>\n<body>\n" ^ body ^ "\n</body>\n</html>\n"
|
||||
|
||||
fun samplePage () = mkHtmlWithBody ("Sample Page",
|
||||
mkHtmlTable ([1.0,2.0,3.0,4.0,5.0], [1.0,2.0,3.0,4.0])
|
||||
(Real.toString, Real.toString)
|
||||
(fn (a, b) => Real.toString (Math.pow (a, b))))
|
||||
|
||||
val _ = print (samplePage ())
|
||||
Loading…
Add table
Add a link
Reference in a new issue