Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,19 +0,0 @@
|
|||
with Ada.Strings.Unbounded;
|
||||
|
||||
generic
|
||||
type Item_Type is private;
|
||||
with function To_String(Item: Item_Type) return String is <>;
|
||||
with procedure Put(S: String) is <>;
|
||||
with procedure Put_Line(Line: String) is <>;
|
||||
package HTML_Table is
|
||||
|
||||
subtype U_String is Ada.Strings.Unbounded.Unbounded_String;
|
||||
function Convert(S: String) return U_String renames
|
||||
Ada.Strings.Unbounded.To_Unbounded_String;
|
||||
|
||||
type Item_Array is array(Positive range <>, Positive range <>) of Item_Type;
|
||||
type Header_Array is array(Positive range <>) of U_String;
|
||||
|
||||
procedure Print(Items: Item_Array; Column_Heads: Header_Array);
|
||||
|
||||
end HTML_Table;
|
||||
|
|
@ -1,56 +0,0 @@
|
|||
package body HTML_Table is
|
||||
|
||||
procedure Print(Items: Item_Array; Column_Heads: Header_Array) is
|
||||
|
||||
function Blanks(N: Natural) return String is
|
||||
-- indention for better readable HTML
|
||||
begin
|
||||
if N=0 then
|
||||
return "";
|
||||
else
|
||||
return " " & Blanks(N-1);
|
||||
end if;
|
||||
end Blanks;
|
||||
|
||||
procedure Print_Row(Row_Number: Positive) is
|
||||
begin
|
||||
Put(Blanks(4) & "<tr><td>" & Positive'Image(Row_Number) & "</td>");
|
||||
for I in Items'Range(2) loop
|
||||
Put("<td>" & To_String(Items(Row_Number, I)) & "</td>");
|
||||
end loop;
|
||||
Put_Line("</tr>");
|
||||
end Print_Row;
|
||||
|
||||
procedure Print_Body is
|
||||
begin
|
||||
Put_Line(Blanks(2)&"<tbody align = ""right"">");
|
||||
for I in Items'Range(1) loop
|
||||
Print_Row(I);
|
||||
end loop;
|
||||
Put_Line(Blanks(2)&"</tbody>");
|
||||
end Print_Body;
|
||||
|
||||
procedure Print_Header is
|
||||
function To_Str(U: U_String) return String renames
|
||||
Ada.Strings.Unbounded.To_String;
|
||||
begin
|
||||
Put_Line(Blanks(2) & "<thead align = ""right"">");
|
||||
Put(Blanks(4) & "<tr><th></th>");
|
||||
for I in Column_Heads'Range loop
|
||||
Put("<td>" & To_Str(Column_Heads(I)) & "</td>");
|
||||
end loop;
|
||||
Put_Line("</tr>");
|
||||
Put_Line(Blanks(2) & "</thead>");
|
||||
end Print_Header;
|
||||
|
||||
begin
|
||||
if Items'Length(2) /= Column_Heads'Length then
|
||||
raise Constraint_Error with "number of headers /= number of columns";
|
||||
end if;
|
||||
Put_Line("<table>");
|
||||
Print_Header;
|
||||
Print_Body;
|
||||
Put_Line("</table>");
|
||||
end Print;
|
||||
|
||||
end HTML_Table;
|
||||
|
|
@ -1,32 +0,0 @@
|
|||
with Ada.Text_IO, Ada.Numerics.Discrete_Random, HTML_Table;
|
||||
|
||||
procedure Test_HTML_Table is
|
||||
|
||||
-- define the Item_Type and the random generator
|
||||
type Four_Digits is mod 10_000;
|
||||
package Rand is new Ada.Numerics.Discrete_Random(Four_Digits);
|
||||
Gen: Rand.Generator;
|
||||
|
||||
-- now we instantiate the generic package HTML_Table
|
||||
package T is new HTML_Table
|
||||
(Item_Type => Four_Digits,
|
||||
To_String => Four_Digits'Image,
|
||||
Put => Ada.Text_IO.Put,
|
||||
Put_Line => Ada.Text_IO.Put_Line);
|
||||
|
||||
-- define the object that will the values that the table contains
|
||||
The_Table: T.Item_Array(1 .. 4, 1..3);
|
||||
|
||||
begin
|
||||
-- fill The_Table with random values
|
||||
Rand.Reset(Gen);
|
||||
for Rows in The_Table'Range(1) loop
|
||||
for Cols in The_Table'Range(2) loop
|
||||
The_Table(Rows, Cols) := Rand.Random(Gen);
|
||||
end loop;
|
||||
end loop;
|
||||
|
||||
-- output The_Table
|
||||
T.Print(Items => The_Table,
|
||||
Column_Heads => (T.Convert("X"), T.Convert("Y"), T.Convert("Z")));
|
||||
end Test_HTML_Table;
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
<table>
|
||||
<thead align = "right">
|
||||
<tr><th></th><td>X</td><td>Y</td><td>Z</td></tr>
|
||||
</thead>
|
||||
<tbody align = "right">
|
||||
<tr><td> 1</td><td> 7255</td><td> 3014</td><td> 9436</td></tr>
|
||||
<tr><td> 2</td><td> 554</td><td> 3314</td><td> 8765</td></tr>
|
||||
<tr><td> 3</td><td> 4832</td><td> 129</td><td> 2048</td></tr>
|
||||
<tr><td> 4</td><td> 31</td><td> 6897</td><td> 8265</td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
|
|
@ -45,12 +45,12 @@ int main( ) {
|
|||
oss << row ;
|
||||
tabletext += oss.str( ) ;
|
||||
for ( int col = 0 ; col < 3 ; col++ ) {
|
||||
oss.str( "" ) ;
|
||||
int randnumber = rand( ) % 10000 ;
|
||||
oss << randnumber ;
|
||||
tabletext += "<td>" ;
|
||||
tabletext.append( oss.str( ) ) ;
|
||||
tabletext += "</td>" ;
|
||||
oss.str( "" ) ;
|
||||
int randnumber = rand( ) % 10000 ;
|
||||
oss << randnumber ;
|
||||
tabletext += "<td>" ;
|
||||
tabletext.append( oss.str( ) ) ;
|
||||
tabletext += "</td>" ;
|
||||
}
|
||||
tabletext += "</tr>\n" ;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,32 +3,32 @@ using System.Text;
|
|||
|
||||
namespace prog
|
||||
{
|
||||
class MainClass
|
||||
{
|
||||
public static void Main (string[] args)
|
||||
{
|
||||
StringBuilder s = new StringBuilder();
|
||||
Random rnd = new Random();
|
||||
|
||||
s.AppendLine("<table>");
|
||||
s.AppendLine("<thead align = \"right\">");
|
||||
s.Append("<tr><th></th>");
|
||||
for(int i=0; i<3; i++)
|
||||
s.Append("<td>" + "XYZ"[i] + "</td>");
|
||||
s.AppendLine("</tr>");
|
||||
s.AppendLine("</thead>");
|
||||
s.AppendLine("<tbody align = \"right\">");
|
||||
for( int i=0; i<3; i++ )
|
||||
{
|
||||
s.Append("<tr><td>"+i+"</td>");
|
||||
for( int j=0; j<3; j++ )
|
||||
s.Append("<td>"+rnd.Next(10000)+"</td>");
|
||||
s.AppendLine("</tr>");
|
||||
}
|
||||
s.AppendLine("</tbody>");
|
||||
s.AppendLine("</table>");
|
||||
|
||||
Console.WriteLine( s );
|
||||
}
|
||||
}
|
||||
class MainClass
|
||||
{
|
||||
public static void Main (string[] args)
|
||||
{
|
||||
StringBuilder s = new StringBuilder();
|
||||
Random rnd = new Random();
|
||||
|
||||
s.AppendLine("<table>");
|
||||
s.AppendLine("<thead align = \"right\">");
|
||||
s.Append("<tr><th></th>");
|
||||
for(int i=0; i<3; i++)
|
||||
s.Append("<td>" + "XYZ"[i] + "</td>");
|
||||
s.AppendLine("</tr>");
|
||||
s.AppendLine("</thead>");
|
||||
s.AppendLine("<tbody align = \"right\">");
|
||||
for( int i=0; i<3; i++ )
|
||||
{
|
||||
s.Append("<tr><td>"+i+"</td>");
|
||||
for( int j=0; j<3; j++ )
|
||||
s.Append("<td>"+rnd.Next(10000)+"</td>");
|
||||
s.AppendLine("</tr>");
|
||||
}
|
||||
s.AppendLine("</tbody>");
|
||||
s.AppendLine("</table>");
|
||||
|
||||
Console.WriteLine( s );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,44 +4,44 @@ using System.Xml;
|
|||
|
||||
namespace N
|
||||
{
|
||||
public class T
|
||||
{
|
||||
public static void Main()
|
||||
{
|
||||
var headers = new [] { "", "X", "Y", "Z" };
|
||||
|
||||
var cols = headers.Select(name =>
|
||||
new XElement(
|
||||
"th",
|
||||
name,
|
||||
new XAttribute("text-align", "center")
|
||||
)
|
||||
);
|
||||
|
||||
var rows = Enumerable.Range(0, 4).Select(ri =>
|
||||
new XElement(
|
||||
"tr",
|
||||
new XElement("td", ri),
|
||||
Enumerable.Range(0, 4).Select(ci =>
|
||||
new XElement(
|
||||
"td",
|
||||
ci,
|
||||
new XAttribute("text-align", "center")
|
||||
)
|
||||
)
|
||||
)
|
||||
);
|
||||
|
||||
var xml = new XElement(
|
||||
"table",
|
||||
new XElement(
|
||||
"thead",
|
||||
new XElement("tr", cols),
|
||||
new XElement("tbody", rows)
|
||||
)
|
||||
);
|
||||
|
||||
Console.WriteLine(xml.ToString());
|
||||
}
|
||||
}
|
||||
public class T
|
||||
{
|
||||
public static void Main()
|
||||
{
|
||||
var headers = new [] { "", "X", "Y", "Z" };
|
||||
|
||||
var cols = headers.Select(name =>
|
||||
new XElement(
|
||||
"th",
|
||||
name,
|
||||
new XAttribute("text-align", "center")
|
||||
)
|
||||
);
|
||||
|
||||
var rows = Enumerable.Range(0, 4).Select(ri =>
|
||||
new XElement(
|
||||
"tr",
|
||||
new XElement("td", ri),
|
||||
Enumerable.Range(0, 4).Select(ci =>
|
||||
new XElement(
|
||||
"td",
|
||||
ci,
|
||||
new XAttribute("text-align", "center")
|
||||
)
|
||||
)
|
||||
)
|
||||
);
|
||||
|
||||
var xml = new XElement(
|
||||
"table",
|
||||
new XElement(
|
||||
"thead",
|
||||
new XElement("tr", cols),
|
||||
new XElement("tbody", rows)
|
||||
)
|
||||
);
|
||||
|
||||
Console.WriteLine(xml.ToString());
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,14 +3,14 @@
|
|||
|
||||
int main()
|
||||
{
|
||||
int i;
|
||||
printf("<table style=\"text-align:center; border: 1px solid\"><th></th>"
|
||||
"<th>X</th><th>Y</th><th>Z</th>");
|
||||
for (i = 0; i < 4; i++) {
|
||||
printf("<tr><th>%d</th><td>%d</td><td>%d</td><td>%d</td></tr>", i,
|
||||
rand() % 10000, rand() % 10000, rand() % 10000);
|
||||
}
|
||||
printf("</table>");
|
||||
int i;
|
||||
printf("<table style=\"text-align:center; border: 1px solid\"><th></th>"
|
||||
"<th>X</th><th>Y</th><th>Z</th>");
|
||||
for (i = 0; i < 4; i++) {
|
||||
printf("<tr><th>%d</th><td>%d</td><td>%d</td><td>%d</td></tr>", i,
|
||||
rand() % 10000, rand() % 10000, rand() % 10000);
|
||||
}
|
||||
printf("</table>");
|
||||
|
||||
return 0;
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,115 +0,0 @@
|
|||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. Table.
|
||||
AUTHOR. Bill Gunshannon.
|
||||
INSTALLATION. Home.
|
||||
DATE-WRITTEN. 1 January 2022.
|
||||
************************************************************
|
||||
** Program Abstract:
|
||||
** Data values are hardcoded in this example but they
|
||||
** could come from anywhere. Computed, read from a
|
||||
** file, input from the keyboard.
|
||||
************************************************************
|
||||
|
||||
ENVIRONMENT DIVISION.
|
||||
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT Table-File ASSIGN TO "index.html"
|
||||
ORGANIZATION IS LINE SEQUENTIAL.
|
||||
|
||||
DATA DIVISION.
|
||||
|
||||
FILE SECTION.
|
||||
|
||||
FD Table-File
|
||||
DATA RECORD IS Table-Record.
|
||||
01 Table-Record.
|
||||
05 Field1 PIC X(80).
|
||||
|
||||
WORKING-STORAGE SECTION.
|
||||
|
||||
01 Table-Data.
|
||||
05 Line3.
|
||||
10 Line3-Value1 PIC S9(4) VALUE 1234.
|
||||
10 Line3-Value2 PIC S9(4) VALUE 23.
|
||||
10 Line3-Value3 PIC S9(4) VALUE -123.
|
||||
05 Line4.
|
||||
10 Line4-Value1 PIC S9(4) VALUE 123.
|
||||
10 Line4-Value2 PIC S9(4) VALUE 12.
|
||||
10 Line4-Value3 PIC S9(4) VALUE -1234.
|
||||
05 Line5.
|
||||
10 Line5-Value1 PIC S9(4) VALUE 567.
|
||||
10 Line5-Value2 PIC S9(4) VALUE 6789.
|
||||
10 Line5-Value3 PIC S9(4) VALUE 3.
|
||||
|
||||
|
||||
01 Table-HTML.
|
||||
05 Line1 PIC X(16) VALUE
|
||||
"<table border=1>".
|
||||
05 Line2 PIC X(40) VALUE
|
||||
"<th></th><th>X</th><th>Y</th><th>Z</th>".
|
||||
05 Line3.
|
||||
10 Line3-Field1 PIC X(31) VALUE
|
||||
"<tr align=center><th>1</th><td>".
|
||||
10 Line3-Value1 PIC -ZZZ9.
|
||||
10 Line3-Field3 PIC X(9) VALUE
|
||||
"</td><td>".
|
||||
10 Line3-Value2 PIC -ZZZ9.
|
||||
10 Line3-Field5 PIC X(9) VALUE
|
||||
"</td><td>".
|
||||
10 Line3-Value3 PIC -ZZZ9.
|
||||
10 Line3-Field5 PIC X(10) VALUE
|
||||
"</td></tr>".
|
||||
05 Line4.
|
||||
10 Line4-Field1 PIC X(31) VALUE
|
||||
"<tr align=center><th>2</th><td>".
|
||||
10 Line4-Value1 PIC -ZZZ9.
|
||||
10 Line4-Field3 PIC X(9) VALUE
|
||||
"</td><td>".
|
||||
10 Line4-Value2 PIC -ZZZ9.
|
||||
10 Line4-Field5 PIC X(9) VALUE
|
||||
"</td><td>".
|
||||
10 Line4-Value3 PIC -ZZZ9.
|
||||
10 Line4-Field5 PIC X(10) VALUE
|
||||
"</td></tr>".
|
||||
05 Line5.
|
||||
10 Line5-Field1 PIC X(31) VALUE
|
||||
"<tr align=center><th>3</th><td>".
|
||||
10 Line5-Value1 PIC -ZZZ9.
|
||||
10 Line5-Field3 PIC X(9) VALUE
|
||||
"</td><td>".
|
||||
10 Line5-Value2 PIC -ZZZ9.
|
||||
10 Line5-Field5 PIC X(9) VALUE
|
||||
"</td><td>".
|
||||
10 Line5-Value3 PIC -ZZZ9.
|
||||
10 Line5-Field5 PIC X(10) VALUE
|
||||
"</td></tr>".
|
||||
05 Line6 PIC X(8) VALUE
|
||||
"</table>".
|
||||
|
||||
PROCEDURE DIVISION.
|
||||
|
||||
Main-Program.
|
||||
OPEN OUTPUT Table-File.
|
||||
MOVE CORRESPONDING Table-Data TO Table-HTML.
|
||||
PERFORM Write-Table.
|
||||
CLOSE Table-File.
|
||||
STOP RUN.
|
||||
|
||||
|
||||
Write-Table.
|
||||
WRITE Table-Record FROM Line1 OF Table-HTML
|
||||
AFTER ADVANCING 1 LINE.
|
||||
WRITE Table-Record FROM Line2 OF Table-HTML
|
||||
AFTER ADVANCING 1 LINE.
|
||||
WRITE Table-Record FROM Line3 OF Table-HTML
|
||||
AFTER ADVANCING 1 LINE.
|
||||
WRITE Table-Record FROM Line4 OF Table-HTML
|
||||
AFTER ADVANCING 1 LINE.
|
||||
WRITE Table-Record FROM Line5 OF Table-HTML
|
||||
AFTER ADVANCING 1 LINE.
|
||||
WRITE Table-Record FROM Line6 OF Table-HTML
|
||||
AFTER ADVANCING 1 LINE.
|
||||
|
||||
|
||||
END-PROGRAM.
|
||||
|
|
@ -2,11 +2,11 @@
|
|||
(use-package :closure-html)
|
||||
(serialize-lhtml
|
||||
`(table nil
|
||||
(tr nil ,@(mapcar (lambda (x)
|
||||
(list 'th nil x))
|
||||
'("" "X" "Y" "Z")))
|
||||
,@(loop for i from 1 to 4
|
||||
collect `(tr nil
|
||||
(th nil ,(format nil "~a" i))
|
||||
,@(loop repeat 3 collect `(td nil ,(format nil "~a" (random 10000)))))))
|
||||
(tr nil ,@(mapcar (lambda (x)
|
||||
(list 'th nil x))
|
||||
'("" "X" "Y" "Z")))
|
||||
,@(loop for i from 1 to 4
|
||||
collect `(tr nil
|
||||
(th nil ,(format nil "~a" i))
|
||||
,@(loop repeat 3 collect `(td nil ,(format nil "~a" (random 10000)))))))
|
||||
(make-string-sink))
|
||||
|
|
|
|||
|
|
@ -6,21 +6,20 @@
|
|||
;; generic html5 builder
|
||||
;; pushes <tag style=..> (proc content) </tag>
|
||||
(define (emit-tag tag html-proc content )
|
||||
(if (style tag)
|
||||
(push html (format "<%s style='%a'>" tag (style tag)))
|
||||
(push html (format "<%s>" tag )))
|
||||
(html-proc content)
|
||||
(push html (format "</%s> " tag )))
|
||||
|
||||
(if (style tag)
|
||||
(push html (format "<%s style='%a'>" tag (style tag)))
|
||||
(push html (format "<%s>" tag )))
|
||||
(html-proc content)
|
||||
(push html (format "</%s> " tag )))
|
||||
|
||||
;; html procs : 1 tag, 1 proc
|
||||
(define (h-raw content)
|
||||
(push html (format "%s" content)))
|
||||
(push html (format "%s" content)))
|
||||
(define (h-header headers)
|
||||
(for ((h headers)) (emit-tag 'th h-raw h)))
|
||||
(for ((h headers)) (emit-tag 'th h-raw h)))
|
||||
(define (h-row row)
|
||||
(for ((item row)) (emit-tag 'td h-raw item)))
|
||||
(for ((item row)) (emit-tag 'td h-raw item)))
|
||||
(define (h-table table )
|
||||
(emit-tag 'tr h-header (first table))
|
||||
;; add row-num i at head of row
|
||||
(for ((i 1000)(row (rest table))) (emit-tag 'tr h-row (cons i row))))
|
||||
|
||||
(emit-tag 'tr h-header (first table))
|
||||
;; add row-num i at head of row
|
||||
(for ((i 1000)(row (rest table))) (emit-tag 'tr h-row (cons i row))))
|
||||
|
|
|
|||
|
|
@ -5,14 +5,14 @@
|
|||
external_format( XML ) -> remove_quoutes( lists:flatten(xmerl:export_simple_content([XML], xmerl_xml)) ).
|
||||
|
||||
html_table( Table_options, Headers, Contents ) ->
|
||||
Header = html_table_header( Headers ),
|
||||
Records = [html_table_record(X) || X <- Contents],
|
||||
{table, Table_options, [Header | Records]}.
|
||||
Header = html_table_header( Headers ),
|
||||
Records = [html_table_record(X) || X <- Contents],
|
||||
{table, Table_options, [Header | Records]}.
|
||||
|
||||
task() ->
|
||||
Headers = [" ", "X", "Y", "Z"],
|
||||
Contents = [[erlang:integer_to_list(X), random(), random(), random()] || X <- lists:seq(1, 3)],
|
||||
external_format( html_table([{border, 1}, {cellpadding, 10}], Headers, Contents) ).
|
||||
Headers = [" ", "X", "Y", "Z"],
|
||||
Contents = [[erlang:integer_to_list(X), random(), random(), random()] || X <- lists:seq(1, 3)],
|
||||
external_format( html_table([{border, 1}, {cellpadding, 10}], Headers, Contents) ).
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +0,0 @@
|
|||
puts(1,"<table>\n")
|
||||
puts(1," <tr><th></th><th>X</th><th>Y</th><th>Z</th></tr>\n")
|
||||
for i = 1 to 3 do
|
||||
printf(1," <tr><td>%d</td>",i)
|
||||
for j = 1 to 3 do
|
||||
printf(1,"<td>%d</td>",rand(10000))
|
||||
end for
|
||||
puts(1,"</tr>\n")
|
||||
end for
|
||||
puts(1,"</table>")
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
<table>
|
||||
<tr><th></th><th>X</th><th>Y</th><th>Z</th></tr>
|
||||
<tr><td>1</td><td>7978</td><td>7376</td><td>2382</td></tr>
|
||||
<tr><td>2</td><td>3632</td><td>1947</td><td>8900</td></tr>
|
||||
<tr><td>3</td><td>4098</td><td>1563</td><td>2762</td></tr>
|
||||
</table>
|
||||
|
|
@ -1,68 +1,68 @@
|
|||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
|
|
@ -71,28 +71,28 @@ Compaq's compiler interface ("visual" blah) has a help offering, which can provi
|
|||
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.
|
||||
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.
|
||||
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.
|
||||
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!"),
|
||||
|
|
@ -100,33 +100,33 @@ Completeness and context remains a problem. Excess brevity means cause and effec
|
|||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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
|
||||
|
|
@ -142,349 +142,349 @@ 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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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!
|
||||
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!!
|
||||
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 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 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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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?
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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?
|
||||
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.
|
||||
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.
|
||||
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...
|
||||
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.
|
||||
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 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 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 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.
|
||||
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.
|
||||
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 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
|
||||
|
|
|
|||
|
|
@ -1,25 +1,25 @@
|
|||
public class HTML {
|
||||
|
||||
public static String array2HTML(Object[][] array){
|
||||
StringBuilder html = new StringBuilder(
|
||||
"<table>");
|
||||
for(Object elem:array[0]){
|
||||
html.append("<th>" + elem.toString() + "</th>");
|
||||
}
|
||||
for(int i = 1; i < array.length; i++){
|
||||
Object[] row = array[i];
|
||||
html.append("<tr>");
|
||||
for(Object elem:row){
|
||||
html.append("<td>" + elem.toString() + "</td>");
|
||||
}
|
||||
html.append("</tr>");
|
||||
}
|
||||
html.append("</table>");
|
||||
return html.toString();
|
||||
}
|
||||
|
||||
public static void main(String[] args){
|
||||
Object[][] ints = {{"","X","Y","Z"},{1,1,2,3},{2,4,5,6},{3,7,8,9},{4,10,11,12}};
|
||||
System.out.println(array2HTML(ints));
|
||||
}
|
||||
public static String array2HTML(Object[][] array){
|
||||
StringBuilder html = new StringBuilder(
|
||||
"<table>");
|
||||
for(Object elem:array[0]){
|
||||
html.append("<th>" + elem.toString() + "</th>");
|
||||
}
|
||||
for(int i = 1; i < array.length; i++){
|
||||
Object[] row = array[i];
|
||||
html.append("<tr>");
|
||||
for(Object elem:row){
|
||||
html.append("<td>" + elem.toString() + "</td>");
|
||||
}
|
||||
html.append("</tr>");
|
||||
}
|
||||
html.append("</table>");
|
||||
return html.toString();
|
||||
}
|
||||
|
||||
public static void main(String[] args){
|
||||
Object[][] ints = {{"","X","Y","Z"},{1,1,2,3},{2,4,5,6},{3,7,8,9},{4,10,11,12}};
|
||||
System.out.println(array2HTML(ints));
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,32 +4,32 @@
|
|||
Node.prototype.a = function (e) { this.appendChild(e); return this }
|
||||
|
||||
function ce(tag, txt) {
|
||||
var x = document.createElement(tag);
|
||||
x.textContent = (txt === undefined) ? '' : txt;
|
||||
return x;
|
||||
var x = document.createElement(tag);
|
||||
x.textContent = (txt === undefined) ? '' : txt;
|
||||
return x;
|
||||
}
|
||||
|
||||
function make_table(cols, rows) {
|
||||
var tbl = ce('table', ''), tr = ce('tr'), th;
|
||||
var tbl = ce('table', ''), tr = ce('tr'), th;
|
||||
|
||||
tbl.a(tr.a(ce('th')));
|
||||
tbl.a(tr.a(ce('th')));
|
||||
|
||||
var z = 'Z'.charCodeAt(0);
|
||||
for (var l = z - cols + 1; l <= z; l++)
|
||||
tr.a(ce('th', String.fromCharCode(l)));
|
||||
var z = 'Z'.charCodeAt(0);
|
||||
for (var l = z - cols + 1; l <= z; l++)
|
||||
tr.a(ce('th', String.fromCharCode(l)));
|
||||
|
||||
for (var r = 1; r <= rows; r++) {
|
||||
tbl.a(tr = ce('tr').a(ce('th', r)));
|
||||
for (var c = 0; c < cols; c++)
|
||||
tr.a(ce('td', Math.floor(Math.random() * 10000)));
|
||||
}
|
||||
for (var r = 1; r <= rows; r++) {
|
||||
tbl.a(tr = ce('tr').a(ce('th', r)));
|
||||
for (var c = 0; c < cols; c++)
|
||||
tr.a(ce('td', Math.floor(Math.random() * 10000)));
|
||||
}
|
||||
|
||||
document.body
|
||||
.a(ce('style',
|
||||
'td, th {border: 1px solid #696;' +
|
||||
'padding:.4ex} td {text-align: right }' +
|
||||
'table { border-collapse: collapse}'))
|
||||
.a(tbl);
|
||||
document.body
|
||||
.a(ce('style',
|
||||
'td, th {border: 1px solid #696;' +
|
||||
'padding:.4ex} td {text-align: right }' +
|
||||
'table { border-collapse: collapse}'))
|
||||
.a(tbl);
|
||||
}
|
||||
</script></head>
|
||||
<body><script>make_table(5, 4)</script></body></html>
|
||||
|
|
|
|||
|
|
@ -1,20 +1,20 @@
|
|||
define rand4dig => integer_random(9999, 1)
|
||||
|
||||
local(
|
||||
output = '<table border=2 cellpadding=5 cellspace=0>\n<tr>'
|
||||
output = '<table border=2 cellpadding=5 cellspace=0>\n<tr>'
|
||||
)
|
||||
|
||||
with el in (' ,X,Y,Z') -> split(',') do {
|
||||
#output -> append('<th>' + #el + '</th>')
|
||||
#output -> append('<th>' + #el + '</th>')
|
||||
}
|
||||
#output -> append('</tr>\n')
|
||||
|
||||
loop(5) => {
|
||||
#output -> append('<tr>\n<td style="font-weight: bold;">' + loop_count + '</td>')
|
||||
loop(3) => {
|
||||
#output -> append('<td>' + rand4dig + '</td>')
|
||||
}
|
||||
#output -> append('</tr>\n')
|
||||
#output -> append('<tr>\n<td style="font-weight: bold;">' + loop_count + '</td>')
|
||||
loop(3) => {
|
||||
#output -> append('<td>' + rand4dig + '</td>')
|
||||
}
|
||||
#output -> append('</tr>\n')
|
||||
}
|
||||
#output -> append('</table>\n')
|
||||
|
||||
|
|
|
|||
|
|
@ -1,36 +1,36 @@
|
|||
MODULE HtmlTable {
|
||||
tag$=LAMBDA$ (a$)-> {
|
||||
=LAMBDA$ a$ -> {
|
||||
IF ISNUM THEN w$=STR$(NUMBER,0) ELSE w$=LETTER$
|
||||
READ ? part$
|
||||
="<"+a$+IF$(LEN(part$)>0->" "+part$,"")+">"+w$+"</"+a$+">"+CHR$(13)+CHR$(10)
|
||||
}
|
||||
}
|
||||
INVENTORY Fun
|
||||
STACK NEW {
|
||||
DATA "html", "head", "body", "table", "tr", "th", "td"
|
||||
WHILE NOT EMPTY
|
||||
OVER ' duplicate top of stack
|
||||
APPEND Fun, LETTER$:=tag$(LETTER$)
|
||||
END WHILE
|
||||
}
|
||||
DEF body0$="",body$=""
|
||||
STACK NEW {
|
||||
DATA "", "X", "Y", "Z"
|
||||
FOR i=1 TO 4
|
||||
body0$+=Fun$("th")(LETTER$)
|
||||
z$=""
|
||||
FOR j=1 TO 3 : z$+=Fun$("td")(RANDOM(0, 9999), {align="right"}) : NEXT j
|
||||
body$+=Fun$("tr")(Fun$("th")(i)+z$)
|
||||
NEXT i
|
||||
}
|
||||
table$=fun$("table")(fun$("tr")(body0$)+body$,"border=1 cellpadding=10 cellspacing=0")
|
||||
DOCUMENT final$="<!DOCTYPE html>"+CHR$(13)+CHR$(10)
|
||||
final$=fun$("html")(fun$("head")("")+fun$("body")(table$), {lang="en"})
|
||||
file$="c:\doc.html"
|
||||
REPORT final$
|
||||
CLIPBOARD final$
|
||||
SAVE.DOC final$, file$
|
||||
WIN file$ ' execute, no wait
|
||||
tag$=LAMBDA$ (a$)-> {
|
||||
=LAMBDA$ a$ -> {
|
||||
IF ISNUM THEN w$=STR$(NUMBER,0) ELSE w$=LETTER$
|
||||
READ ? part$
|
||||
="<"+a$+IF$(LEN(part$)>0->" "+part$,"")+">"+w$+"</"+a$+">"+CHR$(13)+CHR$(10)
|
||||
}
|
||||
}
|
||||
INVENTORY Fun
|
||||
STACK NEW {
|
||||
DATA "html", "head", "body", "table", "tr", "th", "td"
|
||||
WHILE NOT EMPTY
|
||||
OVER ' duplicate top of stack
|
||||
APPEND Fun, LETTER$:=tag$(LETTER$)
|
||||
END WHILE
|
||||
}
|
||||
DEF body0$="",body$=""
|
||||
STACK NEW {
|
||||
DATA "", "X", "Y", "Z"
|
||||
FOR i=1 TO 4
|
||||
body0$+=Fun$("th")(LETTER$)
|
||||
z$=""
|
||||
FOR j=1 TO 3 : z$+=Fun$("td")(RANDOM(0, 9999), {align="right"}) : NEXT j
|
||||
body$+=Fun$("tr")(Fun$("th")(i)+z$)
|
||||
NEXT i
|
||||
}
|
||||
table$=fun$("table")(fun$("tr")(body0$)+body$,"border=1 cellpadding=10 cellspacing=0")
|
||||
DOCUMENT final$="<!DOCTYPE html>"+CHR$(13)+CHR$(10)
|
||||
final$=fun$("html")(fun$("head")("")+fun$("body")(table$), {lang="en"})
|
||||
file$="c:\doc.html"
|
||||
REPORT final$
|
||||
CLIPBOARD final$
|
||||
SAVE.DOC final$, file$
|
||||
WIN file$ ' execute, no wait
|
||||
}
|
||||
HtmlTable
|
||||
|
|
|
|||
|
|
@ -5,16 +5,16 @@ FROM Fmt IMPORT Int, F;
|
|||
|
||||
BEGIN
|
||||
IO.Put("<table style=\"text-align:center; "
|
||||
& "border: 1px solid\"><th></th>"
|
||||
& "<th>X</th><th>Y</th><th><Z</th>");
|
||||
& "border: 1px solid\"><th></th>"
|
||||
& "<th>X</th><th>Y</th><th><Z</th>");
|
||||
WITH rand = NEW(Random.Default).init() DO
|
||||
FOR I := 0 TO 3 DO
|
||||
IO.Put(F("<tr><th>%s</th><td>%s</td>"
|
||||
& "<td>%s</td><td>%s</td></tr>",
|
||||
Int(I),
|
||||
Int(rand.integer(0, 1000)),
|
||||
Int(rand.integer(0, 1000)),
|
||||
Int(rand.integer(0, 1000))));
|
||||
END;
|
||||
FOR I := 0 TO 3 DO
|
||||
IO.Put(F("<tr><th>%s</th><td>%s</td>"
|
||||
& "<td>%s</td><td>%s</td></tr>",
|
||||
Int(I),
|
||||
Int(rand.integer(0, 1000)),
|
||||
Int(rand.integer(0, 1000)),
|
||||
Int(rand.integer(0, 1000))));
|
||||
END;
|
||||
END;
|
||||
END Table.
|
||||
|
|
|
|||
|
|
@ -9,11 +9,11 @@ println "<tr><th></th><th>X</th><th>Y</th><th>Z</th></tr>"
|
|||
|
||||
// generate five rows
|
||||
for i in range(1, 5)
|
||||
println "<tr><td style=\"font-weight: bold;\">" + i + "</td>"
|
||||
println "<td>" + int($random.getInt(8999) + 1000) + "</td>"
|
||||
println "<td>" + int($random.getInt(8999) + 1000) + "</td>"
|
||||
println "<td>" + int($random.getInt(8999) + 1000) + "</td>"
|
||||
println "</tr>"
|
||||
println "<tr><td style=\"font-weight: bold;\">" + i + "</td>"
|
||||
println "<td>" + int($random.getInt(8999) + 1000) + "</td>"
|
||||
println "<td>" + int($random.getInt(8999) + 1000) + "</td>"
|
||||
println "<td>" + int($random.getInt(8999) + 1000) + "</td>"
|
||||
println "</tr>"
|
||||
end for
|
||||
|
||||
println "</table>"
|
||||
|
|
|
|||
|
|
@ -5,30 +5,30 @@ declare
|
|||
fun {Table Session}
|
||||
html(
|
||||
head(title("Show a table with row and column headings")
|
||||
style(type:"text/css"
|
||||
css(td 'text-align':center)
|
||||
))
|
||||
style(type:"text/css"
|
||||
css(td 'text-align':center)
|
||||
))
|
||||
body(
|
||||
{TagFromList table
|
||||
tr(th th("X") th("Y") th("Z"))
|
||||
|
|
||||
{CreateRows 3 5}
|
||||
}))
|
||||
{TagFromList table
|
||||
tr(th th("X") th("Y") th("Z"))
|
||||
|
|
||||
{CreateRows 3 5}
|
||||
}))
|
||||
end
|
||||
|
||||
fun {CreateRows NumCols NumRows}
|
||||
{List.map {List.number 1 NumRows 1}
|
||||
fun {$ Row}
|
||||
{TagFromList tr
|
||||
td( {Int.toString Row} )
|
||||
|
|
||||
{List.map {List.number 1 NumCols 1}
|
||||
fun {$ Col}
|
||||
SequentialNumber = (Row-1)*NumCols + Col
|
||||
in
|
||||
td( {Int.toString SequentialNumber} )
|
||||
end
|
||||
}}
|
||||
td( {Int.toString Row} )
|
||||
|
|
||||
{List.map {List.number 1 NumCols 1}
|
||||
fun {$ Col}
|
||||
SequentialNumber = (Row-1)*NumCols + Col
|
||||
in
|
||||
td( {Int.toString SequentialNumber} )
|
||||
end
|
||||
}}
|
||||
end
|
||||
}
|
||||
end
|
||||
|
|
|
|||
|
|
@ -9,27 +9,27 @@ $rows = 3;
|
|||
$html = '<html><body><table><colgroup>';
|
||||
foreach($cols as $col)
|
||||
{
|
||||
$html .= '<col style="text-align: left;" />';
|
||||
$html .= '<col style="text-align: left;" />';
|
||||
}
|
||||
unset($col);
|
||||
$html .= '</colgroup><thead><tr>';
|
||||
|
||||
foreach($cols as $col)
|
||||
{
|
||||
$html .= "<td>{$col}</td>";
|
||||
$html .= "<td>{$col}</td>";
|
||||
}
|
||||
unset($col);
|
||||
|
||||
$html .= '</tr></thead><tbody>';
|
||||
for($r = 1; $r <= $rows; $r++)
|
||||
{
|
||||
$html .= '<tr>';
|
||||
foreach($cols as $key => $col)
|
||||
{
|
||||
$html .= '<td>' . (($key > 0) ? rand(1, 9999) : $r) . '</td>';
|
||||
}
|
||||
unset($col);
|
||||
$html .= '</tr>';
|
||||
$html .= '<tr>';
|
||||
foreach($cols as $key => $col)
|
||||
{
|
||||
$html .= '<td>' . (($key > 0) ? rand(1, 9999) : $r) . '</td>';
|
||||
}
|
||||
unset($col);
|
||||
$html .= '</tr>';
|
||||
}
|
||||
$html .= '</tbody></table></body></html>';
|
||||
|
||||
|
|
|
|||
|
|
@ -9,27 +9,27 @@ $rows = 3;
|
|||
<html>
|
||||
<body>
|
||||
<table>
|
||||
<colgroup>
|
||||
<?php foreach($cols as $col):?>
|
||||
<col style="text-align: left;" />
|
||||
<?php endforeach; unset($col) ?>
|
||||
</colgroup>
|
||||
<thead>
|
||||
<tr>
|
||||
<?php foreach($cols as $col): ?>
|
||||
<td><?php echo $col?></td>
|
||||
<?php endforeach; unset($col)?>
|
||||
</tr>
|
||||
</thead>
|
||||
<tbody>
|
||||
<?php for($r = 1; $r <= $rows; $r++): ?>
|
||||
<tr>
|
||||
<?php foreach($cols as $key => $col): ?>
|
||||
<td><?php echo ($key > 0) ? rand(1, 9999) : $r ?></td>
|
||||
<?php endforeach; unset($col) ?>
|
||||
</tr>
|
||||
<?php endfor; ?>
|
||||
</tbody>
|
||||
<colgroup>
|
||||
<?php foreach($cols as $col):?>
|
||||
<col style="text-align: left;" />
|
||||
<?php endforeach; unset($col) ?>
|
||||
</colgroup>
|
||||
<thead>
|
||||
<tr>
|
||||
<?php foreach($cols as $col): ?>
|
||||
<td><?php echo $col?></td>
|
||||
<?php endforeach; unset($col)?>
|
||||
</tr>
|
||||
</thead>
|
||||
<tbody>
|
||||
<?php for($r = 1; $r <= $rows; $r++): ?>
|
||||
<tr>
|
||||
<?php foreach($cols as $key => $col): ?>
|
||||
<td><?php echo ($key > 0) ? rand(1, 9999) : $r ?></td>
|
||||
<?php endforeach; unset($col) ?>
|
||||
</tr>
|
||||
<?php endfor; ?>
|
||||
</tbody>
|
||||
</table>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
|
|
@ -1,17 +1,17 @@
|
|||
<@ SDCLIT>
|
||||
<@ DTBLIT>
|
||||
<@ DTRLITLIT>
|
||||
<@ DTDLITLIT>|[style]background-color:white</@>
|
||||
<@ DTD>X</@>
|
||||
<@ DTD>Y</@>
|
||||
<@ DTD>Z</@>|[style]width:100%; background-color:brown;color:white; text-align:center</@>
|
||||
<@ ITEFORLIT>10|
|
||||
<@ DTRLITCAP>
|
||||
<@ DTDPOSFORLIT>...|[style]background-color:Brown; color:white; text-align:right</@>
|
||||
<@ DTDCAPLIT><@ SAYR!ILI2>1|9999</@>|[style]width:50;text-align:right</@>
|
||||
<@ DTDCAPLIT><@ SAYR!ILI2>1|9999</@>|[style]width:50;text-align:right</@>
|
||||
<@ DTDCAPLIT><@ SAYR!ILI2>1|9999</@>|[style]width:50;text-align:right</@>
|
||||
|[style]background-color:white;color:black</@>
|
||||
</@>
|
||||
</@>
|
||||
<@ DTBLIT>
|
||||
<@ DTRLITLIT>
|
||||
<@ DTDLITLIT>|[style]background-color:white</@>
|
||||
<@ DTD>X</@>
|
||||
<@ DTD>Y</@>
|
||||
<@ DTD>Z</@>|[style]width:100%; background-color:brown;color:white; text-align:center</@>
|
||||
<@ ITEFORLIT>10|
|
||||
<@ DTRLITCAP>
|
||||
<@ DTDPOSFORLIT>...|[style]background-color:Brown; color:white; text-align:right</@>
|
||||
<@ DTDCAPLIT><@ SAYR!ILI2>1|9999</@>|[style]width:50;text-align:right</@>
|
||||
<@ DTDCAPLIT><@ SAYR!ILI2>1|9999</@>|[style]width:50;text-align:right</@>
|
||||
<@ DTDCAPLIT><@ SAYR!ILI2>1|9999</@>|[style]width:50;text-align:right</@>
|
||||
|[style]background-color:white;color:black</@>
|
||||
</@>
|
||||
</@>
|
||||
|Number Table</@>
|
||||
|
|
|
|||
|
|
@ -1,10 +0,0 @@
|
|||
# Converts Microsoft .NET Framework objects into HTML that can be displayed in a Web browser.
|
||||
ConvertTo-Html -inputobject (Get-Date)
|
||||
|
||||
# Create a PowerShell object using a HashTable
|
||||
$object = [PSCustomObject]@{
|
||||
'A'=(Get-Random -Minimum 0 -Maximum 10);
|
||||
'B'=(Get-Random -Minimum 0 -Maximum 10);
|
||||
'C'=(Get-Random -Minimum 0 -Maximum 10)}
|
||||
|
||||
$object | ConvertTo-Html
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||
<html xmlns="http://www.w3.org/1999/xhtml">
|
||||
<head>
|
||||
<title>HTML TABLE</title>
|
||||
</head><body>
|
||||
<table>
|
||||
<colgroup><col/><col/><col/><col/><col/><col/><col/><col/><col/><col/><col/><col/><col/><col/><col/></colgroup>
|
||||
<tr><th>DisplayHint</th><th>DateTime</th><th>Date</th><th>Day</th><th>DayOfWeek</th><th>DayOfYear</th><th>Hour</th><th>Kind</th><th>Milliseco
|
||||
nd</th><th>Minute</th><th>Month</th><th>Second</th><th>Ticks</th><th>TimeOfDay</th><th>Year</th></tr>
|
||||
<tr><td>DateTime</td><td>Sunday, October 26, 2014 2:32:31 PM</td><td>10/26/2014 12:00:00 AM</td><td>26</td><td>Sunday</td><td>299</td><td>14<
|
||||
/td><td>Local</td><td>563</td><td>32</td><td>10</td><td>31</td><td>635499307515634638</td><td>14:32:31.5634638</td><td>2014</td></tr>
|
||||
</table>
|
||||
</body></html>
|
||||
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||
<html xmlns="http://www.w3.org/1999/xhtml">
|
||||
<head>
|
||||
<title>HTML TABLE</title>
|
||||
</head><body>
|
||||
<table>
|
||||
<colgroup><col/><col/><col/></colgroup>
|
||||
<tr><th>C</th><th>B</th><th>A</th></tr>
|
||||
<tr><td>8</td><td>7</td><td>3</td></tr>
|
||||
</table>
|
||||
</body></html>
|
||||
|
|
@ -1 +0,0 @@
|
|||
$object | ConvertTo-Html | Out-File -FilePath $env:temp\test.html ; invoke-item $env:temp\test.html
|
||||
|
|
@ -5,12 +5,12 @@ trows([],_) --> []. trows([R|T], N) --> html(tr([td(N),\trow(R)])), { N1 is N +
|
|||
trow([]) --> []. trow([E|T]) --> html(td(E)), trow(T).
|
||||
|
||||
table :-
|
||||
Header = ['X','Y','Z'],
|
||||
Rows = [
|
||||
[7055,5334,5795],
|
||||
[2895,3019,7747],
|
||||
[140,7607,8144],
|
||||
[7090,475,4140]
|
||||
],
|
||||
phrase(html(table([tr(\theader(Header)), \trows(Rows,1)])), Out, []),
|
||||
print_html(Out).
|
||||
Header = ['X','Y','Z'],
|
||||
Rows = [
|
||||
[7055,5334,5795],
|
||||
[2895,3019,7747],
|
||||
[140,7607,8144],
|
||||
[7090,475,4140]
|
||||
],
|
||||
phrase(html(table([tr(\theader(Header)), \trows(Rows,1)])), Out, []),
|
||||
print_html(Out).
|
||||
|
|
|
|||
|
|
@ -8,11 +8,11 @@ str tr(str content) = item("tr", content);
|
|||
str td(str content) = item("td", content);
|
||||
|
||||
public str generateTable(int rows){
|
||||
int i(){return arbInt(10000);};
|
||||
rows = (tr(td("")+td("X")+td("Y")+td("Z"))
|
||||
| it + tr(td("<x>")+td("<i()>")+td("<i()>")+td("<i()>"))
|
||||
| x <- [1..rows]);
|
||||
writeFile(|file:///location|,
|
||||
html("Rosetta Code Table", table(rows)));
|
||||
return "written";
|
||||
int i(){return arbInt(10000);};
|
||||
rows = (tr(td("")+td("X")+td("Y")+td("Z"))
|
||||
| it + tr(td("<x>")+td("<i()>")+td("<i()>")+td("<i()>"))
|
||||
| x <- [1..rows]);
|
||||
writeFile(|file:///location|,
|
||||
html("Rosetta Code Table", table(rows)));
|
||||
return "written";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
* HTML Table
|
||||
output = "<table>"
|
||||
output = " <tr><th></th><th>X</th><th>Y</th><th>Z</th></tr>"
|
||||
i = 1
|
||||
o1 output = "<tr><td>" i "</td>"
|
||||
j = 1
|
||||
o2 output = "<td>" i j "</td>"
|
||||
j = lt(j,3) j + 1 :s(o2)
|
||||
output = "</tr>"
|
||||
i = lt(i,3) i + 1 :s(o1)
|
||||
output = "</table>"
|
||||
output = "<table>"
|
||||
output = " <tr><th></th><th>X</th><th>Y</th><th>Z</th></tr>"
|
||||
i = 1
|
||||
o1 output = "<tr><td>" i "</td>"
|
||||
j = 1
|
||||
o2 output = "<td>" i j "</td>"
|
||||
j = lt(j,3) j + 1 :s(o2)
|
||||
output = "</tr>"
|
||||
i = lt(i,3) i + 1 :s(o1)
|
||||
output = "</table>"
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,34 +1,34 @@
|
|||
(*
|
||||
* val mkHtmlTable : ('a list * 'b list) -> ('a -> string * 'b -> string)
|
||||
* -> (('a * 'b) -> string) -> 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;
|
||||
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
|
||||
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))))
|
||||
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 ())
|
||||
|
|
|
|||
|
|
@ -16,19 +16,19 @@ file write `f' `"<table border="1">"' _n
|
|||
file write `f' "<tr>" _n
|
||||
file write `f' "<td></td>" _n
|
||||
forv j = 1/`nc' {
|
||||
local s `: word `j' of `cn''
|
||||
file write `f' `"<td>`s'</td>"' _n
|
||||
local s `: word `j' of `cn''
|
||||
file write `f' `"<td>`s'</td>"' _n
|
||||
}
|
||||
file write `f' "</tr>" _n
|
||||
* write row names & data
|
||||
forv i = 1/`nr' {
|
||||
file write `f' "<tr>" _n
|
||||
local s `: word `i' of `rn''
|
||||
file write `f' `"<td>`s'</td>"' _n
|
||||
forv j = 1/`nc' {
|
||||
file write `f' `"<td>`=el(`1',`i',`j')'</td>"' _n
|
||||
}
|
||||
file write `f' "</tr>" _n
|
||||
file write `f' "<tr>" _n
|
||||
local s `: word `i' of `rn''
|
||||
file write `f' `"<td>`s'</td>"' _n
|
||||
forv j = 1/`nc' {
|
||||
file write `f' `"<td>`=el(`1',`i',`j')'</td>"' _n
|
||||
}
|
||||
file write `f' "</tr>" _n
|
||||
}
|
||||
file write `f' "</table>" _n
|
||||
file write `f' "</body>" _n
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ proc TAG {name args} {
|
|||
set body [lindex $args end]
|
||||
set result "<$name"
|
||||
foreach {t v} [lrange $args 0 end-1] {
|
||||
append result " $t=\"" $v "\""
|
||||
append result " $t=\"" $v "\""
|
||||
}
|
||||
append result ">" [string trim [uplevel 1 [list subst $body]]] "</$name>"
|
||||
}
|
||||
|
|
@ -21,21 +21,21 @@ set data {}
|
|||
for {set x 0} {$x < 4} {incr x} {
|
||||
# Inspired by the Go solution, but with extra arbitrary digits to show 4-char wide values
|
||||
lappend data [list \
|
||||
[expr {$x+1}] [expr {$x*3010}] [expr {$x*3+1298}] [expr {$x*2579+2182}]]
|
||||
[expr {$x+1}] [expr {$x*3010}] [expr {$x*3+1298}] [expr {$x*2579+2182}]]
|
||||
}
|
||||
|
||||
# Write the table to standard out
|
||||
puts [TAG table border 1 {
|
||||
[TAG tr bgcolor #f0f0f0 {
|
||||
[FOREACH head $titles {
|
||||
[TAG th {$head}]
|
||||
}]
|
||||
[FOREACH head $titles {
|
||||
[TAG th {$head}]
|
||||
}]
|
||||
}]
|
||||
[FOREACH row $data {
|
||||
[TAG tr bgcolor #ffffff {
|
||||
[FOREACH col $row {
|
||||
[TAG td align right {$col}]
|
||||
}]
|
||||
}]
|
||||
[TAG tr bgcolor #ffffff {
|
||||
[FOREACH col $row {
|
||||
[TAG td align right {$col}]
|
||||
}]
|
||||
}]
|
||||
}]
|
||||
}]
|
||||
|
|
|
|||
|
|
@ -1,40 +0,0 @@
|
|||
Set objFSO = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
'Open the input csv file for reading. The file is in the same folder as the script.
|
||||
Set objInFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_
|
||||
"\in.csv",1)
|
||||
|
||||
'Create the output html file.
|
||||
Set objOutHTML = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_
|
||||
"\out.html",2,True)
|
||||
|
||||
'Write the html opening tags.
|
||||
objOutHTML.Write "<html><head></head><body>" & vbCrLf
|
||||
|
||||
'Declare table properties.
|
||||
objOutHTML.Write "<table border=1 cellpadding=10 cellspacing=0>" & vbCrLf
|
||||
|
||||
'Write column headers.
|
||||
objOutHTML.Write "<tr><th></th><th>X</th><th>Y</th><th>Z</th></tr>" & vbCrLf
|
||||
|
||||
'Go through each line of the input csv file and write to the html output file.
|
||||
n = 1
|
||||
Do Until objInFile.AtEndOfStream
|
||||
line = objInFile.ReadLine
|
||||
If Len(line) > 0 Then
|
||||
token = Split(line,",")
|
||||
objOutHTML.Write "<tr align=""right""><td>" & n & "</td>"
|
||||
For i = 0 To UBound(token)
|
||||
objOutHTML.Write "<td>" & token(i) & "</td>"
|
||||
Next
|
||||
objOutHTML.Write "</tr>" & vbCrLf
|
||||
End If
|
||||
n = n + 1
|
||||
Loop
|
||||
|
||||
'Write the html closing tags.
|
||||
objOutHTML.Write "</table></body></html>"
|
||||
|
||||
objInFile.Close
|
||||
objOutHTML.Close
|
||||
Set objFSO = Nothing
|
||||
Loading…
Add table
Add a link
Reference in a new issue