Data update

This commit is contained in:
Ingy döt Net 2025-02-27 18:35:13 -05:00
parent 8e4e15fa56
commit 72eb4943cb
1853 changed files with 35514 additions and 9441 deletions

View file

@ -0,0 +1,212 @@
putc equ 2
puts equ 9
fopen equ 15
fclose equ 16
fread equ 20
FCB1 equ 5Ch
FCB2 equ 6Ch
DTA equ 80h
COLSEP equ '$'
org 100h
;;; Check arguments
lxi d,argmsg
lda FCB1+1 ; Check file argument
cpi ' '
jz prmsg
lda FCB2+1 ; Check alignment argument
cpi 'L'
jz setal
cpi 'R'
jz setar
cpi 'C'
jnz prmsg
lxi h,center ; Set alignment function to run
jmp setfn
setal: lxi h,left
jmp setfn
setar: lxi h,right
setfn: shld alnfn+1
;;; Initialize column lengths to 0
xra a
lxi h,colw
inicol: mov m,a
inr l
jnz inicol
;;; Open file
lxi d,FCB1
mvi c,fopen
call 5
inr a
jz efile ; FF = error
;;; Process file
lxi h,maxw ; Find maximum widths
call rdlins
lxi h,alnlin ; Read lines and align columns
call rdlins
;;; Close file
lxi d,FCB1
mvi c,fclose
jmp 5
;;; Update maximum widths of columns, given line
maxw: lxi h,colw ; Column widths
lxi d,linbuf
mcol: mvi b,0FFh ; B = column width
mscan: inr b
ldax d ; Get current item
inx d ; Next item
call colend ; End of column?
jc mscan
push psw ; Keep column comparison
mov a,m ; Current width
cmp b ; Compare to new width
jnc mnxcol
mov m,b ; New one is bigger
mnxcol: inr l ; Next column
pop psw ; Restore column comparison
jz mcol ; Keep going if not end of line
ret
;;; Align and print columns of line
alnlin: lxi h,colw
lxi b,linbuf
alncol: lxi d,colbuf-1
alnscn: inx d ; Copy current column to buffer
ldax b
stax d
inx b
call colend
jc alnscn
push psw
push h
push b
alncal: xra a ; Zero-terminate the buffer
stax d
mov a,m ; Current max column length
sub e ; Minus length of this column
mov b,a ; Set B = current padding needed
alnfn: call 0 ; Call selected alignment
pop b
pop h
inr l
pop psw
jz alncol ; Next column, if any
lxi d,newlin ; End line
mvi c,puts
jmp 5
;;; Align column left and print
left: push b ; Save padding needed
lxi h,colbuf ; Print column
call print0
pop b ; Restore padding
inr b ; Plus one, for separator between columns
;;; Print B spaces as padding
pad: xra a
ora b
rz ; No padding
padl: push b
mvi e,' '
mvi c,putc
call 5
pop b
dcr b
jnz padl
ret
;;; Align column right and print
right: call pad ; Padding first
lxi h,colbuf
call print0 ; Then column
mvi b,1
jmp pad ; Separator space
;;; Align column in the center and print
center: mov a,b ; Split padding in half
rar
mov b,a
aci 0
mov c,a
push b ; Keep both parts
call pad ; Left padding
lxi h,colbuf ; Print column
call print0
pop b ; Restore padding
mov b,c ; Right padding
inr b ; Plus one for the separator
jmp pad
;;; Print 0-terminated string at HL
print0: mov a,m
ana a
rz
push h
mov e,m
mvi c,putc
call 5
pop h
inx h
jmp print0
;;; Does character in A end a column?
;;; C clear if so. Z clear if also end of line.
colend: cpi 32 ; End of line?
cmc
rnc
cpi COLSEP ; Separator?
rz
stc ; If neither, set carry and return
ret
;;; Process file in FCB1 line by line
;;; HL = line callback
rdlins: shld linecb+1 ; Set callback
xra a ; Start at beginning of file
sta FCB1+0Ch ; EX
sta FCB1+0Eh ; S2
sta FCB1+0Fh ; RC
sta FCB1+20h ; AL
lxi d,linbuf ; Start write pointer at line buffer
rdrec: push d ; Keep write pointer
lxi d,FCB1 ; Read next record
mvi c,fread
call 5
pop d ; Restore write pointer
dcr a ; 1 = EOF
rz
inr a
jnz efile ; Otherwise, <>0 = error
lxi h,DTA ; Reset read pointer to DTA
cpydat: mov a,m ; Copy byte to line buffer
stax d
inx d
cpi 26 ; EOF -> done
rz
cpi 10 ; (\r)\n -> EOL
jnz cnexb
push h ; Keep record pointer
linecb: call 0 ; Call callback routine
pop h ; Restore record pointer
lxi d,linbuf ; Reset line pointer
cnexb: inr l ; Next byte
jz rdrec ; Next record
jmp cpydat
efile: lxi d,filerr
prmsg: mvi c,puts
jmp 5
;;; Messages
argmsg: db 'ALIGN FILE.TXT L/R/C$'
filerr: db 'FILE ERROR$'
newlin: db 13,10,'$'
;;; Variables
colw equ ($/256+1)*256 ; Column widths (page-aligned)
colbuf equ colw+256 ; Column buffer
linbuf equ colbuf+256 ; Line buffer

View file

@ -0,0 +1,134 @@
include "cowgol.coh";
include "strings.coh";
include "file.coh";
include "argv.coh";
interface ColumnCb(colnum: uint8, col: [uint8], isLast: uint8);
sub ForEachColumn(fcb: [FCB], colfn: ColumnCb, colsep: uint8) is
var linebuf: uint8[256];
var bufptr := &linebuf[0];
sub HandleColumns() is
var colbuf: uint8[256];
var col: uint8 := 0;
var lineptr := &linebuf[0];
var colptr := &colbuf[0];
while [lineptr] != 0 loop
if [lineptr] == colsep or [lineptr] == '\n' then
[colptr] := 0;
colptr := &colbuf[0];
if [lineptr] == '\n' then
colfn(col, colptr, 1);
else
colfn(col, colptr, 0);
end if;
col := col + 1;
else
[colptr] := [lineptr];
colptr := @next colptr;
end if;
lineptr := @next lineptr;
end loop;
end sub;
var len := FCBExt(fcb);
FCBSeek(fcb, 0);
while len > 0 loop
var ch := FCBGetChar(fcb);
[bufptr] := ch;
bufptr := @next bufptr;
len := len - 1;
if ch == '\n' then
[bufptr] := 0;
HandleColumns();
bufptr := &linebuf[0];
end if;
end loop;
end sub;
var columnWidths: uint8[256];
sub FindColumnMaxWidths(fcb: [FCB], colsep: uint8) is
sub FindColumnMaxWidth implements ColumnCb is
var len := StrLen(col) as uint8;
if columnWidths[colnum] < len then
columnWidths[colnum] := len;
end if;
end sub;
ForEachColumn(fcb, FindColumnMaxWidth, colsep);
end sub;
sub Pad(padding: uint8) is
while padding > 0 loop
print_char(' ');
padding := padding - 1;
end loop;
end sub;
interface Alignment(padding: uint8, string: [uint8]);
sub Left implements Alignment is
print(string);
Pad(padding);
end sub;
sub Right implements Alignment is
Pad(padding);
print(string);
end sub;
sub Center implements Alignment is
Pad(padding >> 1);
print(string);
Pad((padding >> 1) + (padding & 1));
end sub;
sub PrintColumnsAligned(fcb: [FCB], colsep: uint8, alignment: Alignment) is
sub PrintColumnAligned implements ColumnCb is
var len := StrLen(col) as uint8;
var padding := columnWidths[colnum] - len;
alignment(padding, col);
if isLast != 0 then
print_nl();
else
print_char(' ');
end if;
end sub;
ForEachColumn(fcb, PrintColumnAligned, colsep);
end sub;
ArgvInit();
var filename := ArgvNext();
if filename == 0 as [uint8] then
print("No filename given\n");
ExitWithError();
end if;
var align := ArgvNext();
if align == 0 as [uint8] then
print("No alignment given\n");
ExitWithError();
end if;
var alignment: Alignment;
case [align] & ~32 is
when 'L': alignment := Left;
when 'R': alignment := Right;
when 'C': alignment := Center;
when else:
print("Alignment must be L(eft), R(ight), or C(enter)\n");
ExitWithError();
end case;
var file: FCB;
if FCBOpenIn(&file, filename) != 0 then
print("Cannot open file\n");
ExitWithError();
end if;
const separator := '$';
FindColumnMaxWidths(&file, separator);
PrintColumnsAligned(&file, separator, alignment);

View file

@ -0,0 +1,93 @@
\util.g
char separator = '$';
type
colHandler = proc(byte n; *char col; bool last)void,
alignment = proc(byte padding; *char col)void;
[256]byte ColWidths;
alignment Alignment;
proc find_max_col_width(byte n; *char col; bool last) void:
if ColWidths[n] < CharsLen(col) then
ColWidths[n] := CharsLen(col)
fi
corp
proc write_col_aligned(byte n; *char col; bool last) void:
byte padding;
padding := ColWidths[n] - CharsLen(col);
Alignment(padding, col);
if last then writeln() else write(' ') fi
corp
proc pad(byte padding) void:
while padding>0 do write(' '); padding := padding-1 od
corp
proc align_left(byte padding; *char col) void: write(col); pad(padding) corp
proc align_right(byte padding; *char col) void: pad(padding); write(col) corp
proc align_center(byte padding; *char col) void:
pad(padding>>1);
write(col);
pad((padding>>1) + (padding&1))
corp
proc do_line(*char line; colHandler handler) void:
byte col;
bool last;
char ch;
*char colstart;
col := 0;
colstart := line;
while
ch := line*;
last := ch = '\e';
if last or ch = separator then
line* := '\e';
handler(col, colstart, last);
colstart := line+1;
col := col+1
fi;
not last
do
line := line+1
od
corp
proc do_columns(*char filename; colHandler handler) void:
[256]char linebuf;
*char line;
channel input text in;
file(1024) infile;
open(in, infile, filename);
line := &linebuf[0];
while readln(in; line) do do_line(line, handler) od;
close(in);
corp
proc ucase(char c) char: pretend(pretend(c, byte) & ~32, char) corp
proc main() void:
*char filename, align;
word i;
for i from 0 upto 255 do ColWidths[i] := 0 od;
filename := GetPar();
if filename = nil then writeln("No filename given"); exit(1) fi;
align := GetPar();
if align = nil then writeln("No alignment given"); exit(1) fi;
case ucase(align*)
incase 'L': Alignment := align_left
incase 'R': Alignment := align_right
incase 'C': Alignment := align_center
default: writeln("Alignment must be L/R/C"); exit(1)
esac;
do_columns(filename, find_max_col_width);
do_columns(filename, write_col_aligned)
corp

View file

@ -0,0 +1,251 @@
(defun rob-even-p (integer)
"Test if INTEGER is even."
(= (% integer 2) 0))
(defun rob-odd-p (integer)
"Test if INTEGER is odd."
(not (rob-even-p integer)))
(defun both-odd-or-both-even-p (x y)
"Test if X and Y are both even or both odd."
(or (and (rob-even-p x) (rob-even-p y))
(and (rob-odd-p x) (rob-odd-p y))))
(defun word-lengths (words)
"Convert WORDS into list of lengths of each word."
(mapcar 'length words))
(defun get-one-row (row-number rows-columns-words)
"Get ROW-NUMBER row from ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is list of lists in form of row, column, word."
(seq-filter
(lambda (element)
(= row-number (car element)))
rows-columns-words))
(defun get-one-word (row-number column-number rows-columns-words)
"Get one word from ROWS-COLUMNS-WORDS at ROW-NUMBER and COLUMN-NUMBER.
ROWS-COLUMNS-WORDS is list of lists in form of row, column, word."
(delq nil
(mapcar
(lambda (element)
(when (= column-number (nth 1 element))
(nth 2 element)))
(get-one-row row-number rows-columns-words))))
(defun get-last-row (rows-columns-words)
"Get the number of the last row of ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is a list of lists, each list in the form of
row, column, word."
(apply 'max (mapcar 'car rows-columns-words)))
(defun list-nth-column (column rows-columns-words)
"List the words in column COLUMN of ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is a list of lists, each list in the form of row, column,
word."
(let ((row 1)
(column-word)
(last-row (get-last-row rows-columns-words ))
(matches nil))
(while (and (<= row last-row)
(<= column (get-last-column rows-columns-words)))
(setq column-word (get-one-word row column rows-columns-words))
(when (null column-word)
(setq column-word ""))
(push column-word matches)
(setq row (1+ row)))
(flatten-tree (nreverse matches))))
(defun get-widest-in-column (column)
"Get the widest word in COLUMN, which is a list of words."
(apply #'max (word-lengths column)))
(defun get-column-width (column)
"Calculate the width of COLUMN, which is a list of words."
(+ (get-widest-in-column column) 2))
(defun get-column-widths (rows-columns-words)
"Make a list of the column widths in ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is list of lists, with each list in the form of row, column,
word."
(let ((last-column (get-last-column rows-columns-words))
(column 1)
(columns))
(while (<= column last-column)
(push (get-column-width (list-nth-column column rows-columns-words)) columns)
(setq column (1+ column)))
(reverse columns)))
(defun add-column-widths (widths rows-columns-words)
"Add WIDTHS to ROWS-COLUMNS-WORDS.
ROWS-COLUMNS-WORDS is a list of lists, with each list in the form of row,
column, word. WIDTHS are the widths of each column. Output is a
list of lists, with each list in the form of column-width, row,
column, word."
(let ((new-data)
(new-database)
(column)
(width))
(dolist (data rows-columns-words)
(setq column (cadr data))
(setq width (nth (- column 1) widths))
(setq new-data (push width data))
(push new-data new-database))
(nreverse new-database)))
(defun get-last-column (rows-columns-words)
"Get the number of the last column in ROWS-COLUMNS-WORDS."
(apply 'max (mapcar 'cadr rows-columns-words)))
(defun create-rows-columns-words ()
"Put text from column-data.txt file in lists.
Each list consists of a row number, a column number, and a word."
(let ((lines)
(line-number 0)
(word-number)
(words))
(with-temp-buffer
(insert-file-contents "~/Documents/Elisp/column_data.txt")
(beginning-of-buffer)
(dolist (line (split-string (buffer-string) "[\r\n]" :no-nulls))
(push line lines))
(setq lines (nreverse lines)))
(dolist (line lines)
(setq line-number (1+ line-number))
(setq word-number 0)
(dolist (word (split-string line "\\$" :no-nulls))
(setq word-number (1+ word-number))
(push (list line-number word-number word) words)))
(setq words (nreverse words))))
(defun pad-for-center-align (column-width text)
"Pad TEXT to center in space of COLUMN-WIDTH."
(let* ((text-width (length text))
(total-padding-length (- column-width text-width))
(pre-padding-length)
(post-padding-length)
(pre-padding)
(post-padding))
(if (both-odd-or-both-even-p text-width column-width)
(progn
(setq pre-padding-length (/ total-padding-length 2))
(setq post-padding-length pre-padding-length))
(setq pre-padding-length (+ (/ total-padding-length 2) 1))
(setq post-padding-length (- pre-padding-length 1)))
(setq pre-padding (make-string pre-padding-length ? ))
(setq post-padding (make-string post-padding-length ? ))
(format "%s%s%s" pre-padding text post-padding)))
(defun create-a-center-aligned-line (widths-1row-columns-words)
"Create a centered line based on WIDTHS-1ROW-COLUMNS-WORDS.
WIDTHS-1ROW-COLUMNS-WORDS is a list of lists. Each list consists
of the column-width, the row number, the column number, and the
word. The row number is the same in all lists."
(let ((full-line "")
(next-section))
(insert "\n")
(dolist (word-data widths-1row-columns-words)
;; below, nth 0 is the column width, nth 3 is the word
(setq next-section (pad-for-center-align (nth 0 word-data) (nth 3 word-data)))
(setq full-line (concat full-line next-section)))
(insert full-line)))
(defun pad-for-left-align (column-width text)
"Pad TEXT to left-align in space of COLUMN-WIDTH."
(let* ((text-width (length text))
(post-padding-length (- column-width text-width)))
(setq post-padding (make-string post-padding-length ? ))
(format "%s%s" text post-padding)))
(defun create-a-left-aligned-line (widths-1row-columns-words)
"Create a left-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS.
Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column
width, the row number, the column number, and the word. The row
number is the same in every case."
(let ((full-line "")
(next-section))
(insert "\n")
(dolist (one-item widths-1row-columns-words)
(setq next-section (pad-for-left-align (nth 0 one-item) (nth 3 one-item)))
(setq full-line (concat full-line next-section)))
(insert full-line)))
(defun pad-for-right-align (column-width text)
"Pad TEXT to right-align in space of COLUMN-WIDTH."
(let* ((text-width (length text))
(pre-padding-length (- column-width text-width)))
(setq pre-padding (make-string pre-padding-length ? ))
(format "%s%s" pre-padding text)))
(defun create-a-right-aligned-line (widths-1row-columns-words)
"Create a right-aligned line based on WIDTHS-1ROW-COLUMNS-WORDS.
Each element of WIDTHS-1ROW-COLUMNS-WORDS consists of the column
width, the row number, the column number, and the word. The row
number is the same in every case."
(let ((full-line "")
(next-section))
(insert "\n")
(dolist (one-item widths-1row-columns-words)
(setq next-section (pad-for-right-align (nth 0 one-item) (nth 3 one-item)))
(setq full-line (concat full-line next-section)))
(insert full-line)))
(defun left-align-lines (rows-columns-words)
"Write ROWS-COLUMNS-WORDS in left-aligned columns.
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
row number, the column number, and the word."
(let* ((row-number 1)
(column-widths (get-column-widths rows-columns-words))
(last-row (get-last-row rows-columns-words))
(one-row)
(width-place 0))
(while (<= row-number last-row)
(setq one-row (get-one-row row-number rows-columns-words))
(setq one-row (add-column-widths column-widths one-row))
(create-a-left-aligned-line one-row)
(setq row-number (1+ row-number))
(setq width-place (1+ width-place)))))
(defun right-align-lines (rows-columns-words)
"Write ROWS-COLUMNS-WORDS in right-aligned columns.
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
row number, the column number, and the word."
(let* ((row-number 1)
(column-widths (get-column-widths rows-columns-words))
(last-row (get-last-row rows-columns-words))
(one-row)
(width-place 0))
(while (<= row-number last-row)
(setq one-row (get-one-row row-number rows-columns-words))
(setq one-row (add-column-widths column-widths one-row))
(create-a-right-aligned-line one-row)
(setq row-number (1+ row-number))
(setq width-place (1+ width-place)))))
(defun center-align-lines (rows-columns-words)
"Write ROWS-COLUMNS-WORDS in center-aligned columns.
ROWS-COLUMNS-WORDS is a list of lists. Each list consists of the
row number, the column number, and the word."
(let* ((row-number 1)
(column-widths (get-column-widths rows-columns-words))
(last-row (get-last-row rows-columns-words))
(one-row)
(width-place 0))
(while (<= row-number last-row)
(setq one-row (get-one-row row-number rows-columns-words))
(setq one-row (add-column-widths column-widths one-row))
(create-a-center-aligned-line one-row)
(setq row-number (1+ row-number))
(setq width-place (1+ width-place)))))
(defun align-lines (alignment rows-columns-words)
"Write ROWS-COLUMNS-WIDTHS with given ALIGNMENT.
ROWS-COLUMNS-WIDTHS consists of a list of lists. Each internal list contains width of column, row number, column number, and a word."
(let ((align-function (pcase alignment
('left 'left-align-lines)
("left" 'left-align-lines)
('center 'center-align-lines)
("center" 'center-align-lines)
('right 'right-align-lines)
("right" 'right-align-lines))))
(funcall align-function rows-columns-words)))

View file

@ -0,0 +1,34 @@
#! /usr/bin/mira -exec
main :: [sys_message]
main = [Stdout (align (alignment algm) '$' (read file))]
where [cmd, file, algm] = $*
alignment :: [char]->num->[char]->[char]
alignment "left" = ljustify
alignment "center" = cjustify
alignment "right" = rjustify
alignment x = error "Alignment must be left, center, or right"
align :: (num->[char]->[char])->char->[char]->[char]
align just sep text = (lay . map (alignline just sep cols) . lines) text
where cols = colwidths sep text
split :: *->[*]->[[*]]
split sep = s []
where s acc [] = [acc]
s acc (a:as) = acc:s [] as, if a==sep
= s (acc++[a]) as, otherwise
colwidths :: char->[char]->[num]
colwidths sep text = (map max . transpose . map (extend maxwidth 0)) widths
where widths = map (map (#) . split sep) (lines text)
maxwidth = max (map (#) widths)
alignline :: (num->[char]->[char])->char->[num]->[char]->[char]
alignline just sep cols = concat . map (++" ") . zipwith just cols . split sep
zipwith :: (*->**->***)->[*]->[**]->[***]
zipwith f xs ys = map f' (zip2 xs ys) where f' (x,y) = f x y
extend :: num->*->[*]->[*]
extend n k ls = ls ++ take (n-#ls) (repeat k)

View file

@ -0,0 +1,71 @@
$ENTRY Go {
, <Arg 1>: e.File
, <Arg 2>: e.Alignment
, <ReadFile 1 e.File>: e.Lines
, <Each (Split ('$')) e.Lines>: e.Parts
, <Each (MaxWidth) <Transpose e.Parts>>: e.Cols
= <Each (AlignLine (e.Alignment) (e.Cols)) e.Parts>;
};
ReadFile {
s.Chan e.File = <Open 'r' s.Chan e.File>
<ReadFile (s.Chan)>;
(s.Chan), <Get s.Chan>: {
0 = <Close s.Chan>;
e.Line = (e.Line) <ReadFile (s.Chan)>;
};
};
Split {
(e.Sep) e.Part e.Sep e.Rest = (e.Part) <Split (e.Sep) e.Rest>;
(e.Sep) e.Part = (e.Part);
};
Each {
(e.F) = ;
(e.F) (e.X) e.Xs = (<Mu e.F e.X>) <Each (e.F) e.Xs>;
};
MaxWidth {
(Acc s.W) = s.W;
(Acc s.W) (e.P) e.X, <Len e.P>: s.L, <Compare s.L s.W>: {
'+' = <MaxWidth (Acc s.L) e.X>;
s.C = <MaxWidth (Acc s.W) e.X>;
};
e.X = <MaxWidth (Acc 0) e.X>;
};
Transpose {
e.X, <Each (Head) e.X>: e.L, <Empty e.L>: {
True = ;
False = (e.L) <Transpose <Each (Tail) e.X>>;
};
};
ZipWith {
(e.F) () e.Ys = ;
(e.F) e.Xs () = ;
(e.F) (t.X e.Xs) (t.Y e.Ys) = <Mu e.F t.X t.Y> <ZipWith (e.F) (e.Xs) (e.Ys)>;
};
AlignCell {
('left') (e.Cell) (s.Width),
<Len e.Cell>: s.L = e.Cell <Rep <Sub s.Width s.L> ' '> ' ';
('right') (e.Cell) (s.Width),
<Len e.Cell>: s.L = <Rep <Sub s.Width s.L> ' '> e.Cell ' ';
('center') (e.Cell) (s.Width),
<Divmod <Sub s.Width <Len e.Cell>> 2>: (s.P) s.V,
<Rep s.P ' '>: e.LP,
<Rep <Add s.P s.V> ' '>: e.RP = e.LP e.Cell e.RP ' ';
};
AlignLine {
(e.Alignment) (e.Cols) e.Line =
<Prout <ZipWith (AlignCell (e.Alignment)) (e.Line) (e.Cols)>>;
};
Rep { 0 s.C = ; s.N s.C = s.C <Rep <Sub s.N 1> s.C>; };
Empty { = True; () e.X = <Empty e.X>; e.X = False; };
Len { e.X, <Lenw e.X>: s.L e.X = s.L; };
Head { = ; (e.X) e.Xs = e.X; };
Tail { = ; (e.X) e.Xs = e.Xs; };