[Oberon] Component Pascal StdCoder.Decode ?
Treutwein Bernhard
Bernhard.Treutwein at Verwaltung.Uni-Muenchen.DE
Tue Apr 1 12:15:46 MEST 2008
Hi Chris,
enclosed are the source and the documentation of StdCoder
and a copy of the BlackBox Open Source license (which is
rumored to be a variant of the BSD license).
Beware:
1. The libraries used are very different.
2. Type sizes differ
PS: BlackBox runs nicely under Linux/Wine
--
Bernhard Treutwein
Ref. IIIA3 Anwendungsentwicklung
Martiusstr. 4
80802 München
Tel. 089 2180-2774
Fax. 089 2180-992774
Mobil. 0152-01549335
e-mail: bernhard treutwein (at) verwaltung uni-muenchen de
> -----Original Message-----
> From: Chris Glur [mailto:
> Sent: Tuesday, April 01, 2008 2:00 AM
> To: oberon at lists.inf.ethz.ch
> Cc: crglur at gmail.com
> Subject: [Oberon] Component Pascal StdCoder.Decode ?
>
>
>
> Component Pascal Collection
> from the goog-cache of
> http://www.zinnamturm.eu/downloadsAC.htm
> lists
> http://www.zinnamturm.eu/pac/Basic.txt
> http://www.zinnamturm.eu/pac/C2cp.txt
> http://www.zinnamturm.eu/pac/CpcBeautifier.txt
> which I fetched.
>
> But they are in an encoded format
> <1st line starts:"StdCoder.Decode ..,1">
> which seems not decodable with S3's [nor V4's] existing tools.
>
> Can someone help me get to the plain-text sources ?
> I strongly believe that we should have easy access to all
> Wirthian-language sources, to build on existing investments
> rather than continually reinventing the wheel.
>
> The */pac/C2cp.txt file is described as a [mostly] C to cp
> translator, which could be very interesting for efforts to
> port some of the massive GNU/linux sources to 'Wirthian'?
>
> Thanks for any help,
>
> == Chris Glur.
>
>
>
>
-------------- next part --------------
MODULE StdCoder;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT
Kernel, Files, Converters, Stores, Views, Controllers, Dialog, Documents, Windows,
TextModels, TextViews, TextControllers, TextMappers,
StdCmds;
CONST
N = 16384;
LineLength = 74;
OldVersion = 0; ThisVersion = 1;
Tag = "StdCoder.Decode"; (* first letter of Tag must not to appear within Tag again *)
Separator = "/";
View = 1; File = 2; List = 3;
TYPE
FileList = POINTER TO RECORD
next: FileList;
file: Files.File;
type: Files.Type;
name:Dialog.String
END;
ParList* = RECORD
list*: Dialog.Selection;
storeAs*: Dialog.String;
files: FileList
END;
VAR
par*: ParList;
code: ARRAY 64 OF CHAR;
revCode: ARRAY 256 OF BYTE;
table: ARRAY N OF BYTE;
stdDocuType: Files.Type;
PROCEDURE NofSelections(IN list: Dialog.Selection): INTEGER;
VAR i, n: INTEGER;
BEGIN
i := 0; n := 0;
WHILE i # list.len DO
IF list.In(i) THEN INC(n) END;
INC(i)
END;
RETURN n
END NofSelections;
PROCEDURE ShowError(n: INTEGER; par: ARRAY OF CHAR);
BEGIN
Dialog.Beep;
CASE n OF
1: Dialog.ShowParamMsg("#Std:bad characters", par, "", "")
| 2: Dialog.ShowParamMsg("#Std:checksum error", par, "", "")
| 3: Dialog.ShowParamMsg("#Std:incompatible version", par, "", "")
| 4: Dialog.ShowParamMsg("#Std:filing error", par, "", "")
| 5: Dialog.ShowParamMsg("#Std:directory ^0 not found", par, "", "")
| 6: Dialog.ShowParamMsg("#Std:file ^0 not found", par, "", "")
| 7: Dialog.ShowParamMsg("#Std:illegal path", par, "", "")
| 8: Dialog.ShowParamMsg("#Std:no tag", par, "", "")
| 9: Dialog.ShowParamMsg("#Std:disk write protected", par, "", "")
| 10: Dialog.ShowParamMsg("#Std:io error", par, "", "")
END
END ShowError;
PROCEDURE ShowSizeMsg(x: INTEGER);
VAR i, j: INTEGER; ch: CHAR; s: ARRAY 20 OF CHAR;
BEGIN
ASSERT(x >= 0, 20);
i := 0;
REPEAT s[i] := CHR(ORD("0") + x MOD 10); INC(i); x := x DIV 10 UNTIL x = 0;
s[i] := 0X;
DEC(i); j := 0;
WHILE j < i DO ch := s[j]; s[j] := s[i]; s[i] := ch; INC(j); DEC(i) END;
Dialog.ShowParamStatus("#Std:^0 characters coded", s, "", "")
END ShowSizeMsg;
PROCEDURE Write(dest: TextModels.Writer; x: INTEGER; VAR n: INTEGER);
BEGIN
dest.WriteChar(code[x]); INC(n);
IF n = LineLength THEN dest.WriteChar(0DX); dest.WriteChar(" "); n := 0 END
END Write;
PROCEDURE WriteHeader(dest: TextModels.Writer; VAR n: INTEGER;
name: ARRAY OF CHAR; type: BYTE
);
VAR byte, bit, i: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
BEGIN
tag := Tag; i := 0; ch := tag[0];
WHILE ch # 0X DO dest.WriteChar(ch); INC(n); INC(i); ch := tag[i] END;
dest.WriteChar(" "); INC(n);
bit := 0; byte := 0; i := 0;
REPEAT
ch := name[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
INC(i)
UNTIL ch = 0X;
IF bit # 0 THEN Write(dest, byte, n) END;
Write(dest, ThisVersion, n); Write(dest, type, n)
END WriteHeader;
PROCEDURE WriteFileType(dest: TextModels.Writer; VAR n: INTEGER; t: Files.Type);
VAR byte, bit, i: INTEGER; ch: CHAR;
BEGIN
IF t = Kernel.docType THEN t := stdDocuType END;
bit := 0; byte := 0; i := 0; dest.WriteChar(" ");
REPEAT
ch := t[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
INC(i)
UNTIL ch = 0X;
IF bit # 0 THEN Write(dest, byte, n) END
END WriteFileType;
PROCEDURE WriteFile(dest: TextModels.Writer; VAR n: INTEGER; f: Files.File);
VAR hash, byte, bit, i, j, sum, len: INTEGER; src: Files.Reader; b: BYTE;
BEGIN
len := f.Length(); j := len; i := 6;
WHILE i # 0 DO Write(dest, j MOD 64, n); j := j DIV 64; DEC(i) END;
i := 0;
REPEAT table[i] := 0; INC(i) UNTIL i = N;
hash := 0; bit := 0; byte := 0; sum := 0; src := f.NewReader(NIL);
WHILE len # 0 DO
src.ReadByte(b); DEC(len);
sum := (sum + b MOD 256) MOD (16 * 1024);
IF table[hash] = b THEN INC(bit) (* 0 bit for correct prediction *)
ELSE (* Incorrect prediction -> 1'xxxx'xxxx bits *)
table[hash] := b; INC(byte, ASH(1, bit)); INC(bit);
INC(byte, ASH(b MOD 256, bit)); INC(bit, 8)
END;
WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
hash := (16 * hash + b MOD 256) MOD N
END;
IF bit # 0 THEN Write(dest, byte, n) END;
i := 6;
WHILE i # 0 DO Write(dest, sum MOD 64, n); sum := sum DIV 64; DEC(i) END;
IF n # 0 THEN dest.WriteChar(0DX); n := 0 END
END WriteFile;
PROCEDURE Read(src: TextModels.Reader; VAR x: INTEGER; VAR res: INTEGER);
VAR ch: CHAR;
BEGIN
IF res = 0 THEN
REPEAT src.ReadChar(ch); x := revCode[ORD(ch)] UNTIL (x >= 0) OR src.eot;
IF src.eot THEN res := 1 END
END;
IF res # 0 THEN x := 0 END
END Read;
PROCEDURE ReadHeader(src: TextModels.Reader; VAR res: INTEGER;
VAR name: ARRAY OF CHAR; VAR type: BYTE
);
VAR x, bit, i, j: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
BEGIN
tag := Tag; i := 0;
WHILE ~src.eot & (tag[i] # 0X) DO
src.ReadChar(ch);
IF ch = tag[i] THEN INC(i) ELSIF ch = tag[0] THEN i := 1 ELSE i := 0 END
END;
IF ~src.eot THEN
res := 0; i := 0; bit := 0; x := 0;
REPEAT
WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
IF res = 0 THEN
ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); name[i] := ch; INC(i)
END
UNTIL (res # 0) OR (ch = 0X);
Read(src, j, res);
IF res = 0 THEN
IF (j = ThisVersion) OR (j = OldVersion) THEN
Read(src, j, res); type := SHORT(SHORT(j))
ELSE res := 3
END
END
ELSE res := 8
END
END ReadHeader;
PROCEDURE ReadFileType(src: TextModels.Reader; VAR res: INTEGER; VAR ftype: Files.Type);
VAR x, bit, i, j: INTEGER; ch: CHAR;
BEGIN
res := 0; i := 0; bit := 0; x := 0;
REPEAT
WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
IF res = 0 THEN ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); ftype[i] := ch; INC(i) END
UNTIL (res # 0) OR (ch = 0X);
IF ftype = stdDocuType THEN ftype := Kernel.docType END
END ReadFileType;
PROCEDURE ReadFile(src: TextModels.Reader; VAR res: INTEGER; f: Files.File);
VAR hash, x, bit, i, j, len, sum, s: INTEGER; byte: BYTE; dest: Files.Writer;
BEGIN
res := 0; i := 0; len := 0;
REPEAT Read(src, x, res); len := len + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
i := 0;
REPEAT table[i] := 0; INC(i) UNTIL i = N;
bit := 0; hash := 0; sum := 0; dest := f.NewWriter(NIL);
WHILE (res = 0) & (len # 0) DO
IF bit = 0 THEN Read(src, x, res); bit := 6 END;
IF ODD(x) THEN (* Incorrect prediction -> 1'xxxx'xxxx *)
x := x DIV 2; DEC(bit);
WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
i := x MOD 256;
IF i > MAX(BYTE) THEN i := i - 256 END;
byte := SHORT(SHORT(i)); x := x DIV 256; DEC(bit, 8);
table[hash] := byte
ELSE byte := table[hash]; x := x DIV 2; DEC(bit) (* correct prediction *)
END;
hash := (16 * hash + byte MOD 256) MOD N;
dest.WriteByte(byte); sum := (sum + byte MOD 256) MOD (16 * 1024); DEC(len)
END;
IF res = 0 THEN
i := 0; s := 0;
REPEAT Read(src, x, res); s := s + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
IF (res = 0) & (s # sum) THEN res := 2 END
END
END ReadFile;
PROCEDURE ShowText (t: TextModels.Model);
VAR l: INTEGER; v: Views.View; wr: TextMappers.Formatter; conv: Converters.Converter;
BEGIN
l := t.Length();
wr.ConnectTo(t); wr.SetPos(l); wr.WriteString(" --- end of encoding ---");
ShowSizeMsg(l);
v := TextViews.dir.New(t);
conv := Converters.list;
WHILE (conv # NIL) & (conv.imp # "HostTextConv.ImportText") DO conv := conv.next END;
Views.Open(v, NIL, "", conv);
Views.SetDirty(v)
END ShowText;
PROCEDURE EncodedView*(v: Views.View): TextModels.Model;
VAR n: INTEGER; f: Files.File; wrs: Stores.Writer; t: TextModels.Model; wr: TextModels.Writer;
BEGIN
f := Files.dir.Temp(); wrs.ConnectTo(f); Views.WriteView(wrs, v);
t := TextModels.dir.New(); wr := t.NewWriter(NIL);
n := 0; WriteHeader(wr, n, "", View); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
RETURN t
END EncodedView;
PROCEDURE EncodeDocument*;
VAR v: Views.View; w: Windows.Window;
BEGIN
w := Windows.dir.First();
IF w # NIL THEN
v := w.doc.OriginalView();
IF (v.context # NIL) & (v.context IS Documents.Context) THEN
v := v.context(Documents.Context).ThisDoc()
END;
IF v # NIL THEN ShowText(EncodedView(v)) END
END
END EncodeDocument;
PROCEDURE EncodeFocus*;
VAR v: Views.View;
BEGIN
v := Controllers.FocusView();
IF v # NIL THEN ShowText(EncodedView(v)) END
END EncodeFocus;
PROCEDURE EncodeSelection*;
VAR beg, end: INTEGER; t: TextModels.Model; c: TextControllers.Controller;
BEGIN
c := TextControllers.Focus();
IF (c # NIL) & c.HasSelection() THEN
c.GetSelection(beg, end);
t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, beg, end);
ShowText(EncodedView(TextViews.dir.New(t)))
END
END EncodeSelection;
PROCEDURE EncodeFile*;
VAR n: INTEGER; loc: Files.Locator; name: Files.Name; f: Files.File;
t: TextModels.Model; wr: TextModels.Writer;
BEGIN
Dialog.GetIntSpec("", loc, name);
IF loc # NIL THEN
f := Files.dir.Old(loc, name, TRUE);
IF f # NIL THEN
t := TextModels.dir.New(); wr := t.NewWriter(NIL);
n := 0; WriteHeader(wr, n, name, File); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
ShowText(t)
END
END
END EncodeFile;
PROCEDURE GetFile(VAR path: ARRAY OF CHAR; VAR loc: Files.Locator; VAR name: Files.Name);
VAR i, j: INTEGER; ch: CHAR;
BEGIN
i := 0; ch := path[0]; loc := Files.dir.This("");
WHILE (ch # 0X) & (loc # NIL) DO
j := 0;
WHILE (ch # 0X) & (ch # Separator) DO name[j] := ch; INC(j); INC(i); ch := path[i] END;
name[j] := 0X;
IF ch = Separator THEN loc := loc.This(name); INC(i); ch := path[i] END;
IF loc.res # 0 THEN loc := NIL END
END;
path[i] := 0X
END GetFile;
PROCEDURE ReadPath(rd: TextModels.Reader; VAR path: ARRAY OF CHAR; VAR len: INTEGER);
VAR i, l: INTEGER; ch: CHAR;
BEGIN
i := 0; l := LEN(path) - 1;
REPEAT rd.ReadChar(ch) UNTIL rd.eot OR (ch > " ");
WHILE ~rd.eot & (ch > " ") & (i < l) DO path[i] := ch; INC(i); rd.ReadChar(ch) END;
path[i] := 0X; len := i
END ReadPath;
PROCEDURE WriteString(w: Files.Writer; IN str: ARRAY OF CHAR; len: INTEGER);
VAR i: INTEGER;
BEGIN
i := 0;
WHILE i < len DO
IF ORD(str[i]) > MAX(BYTE) THEN w.WriteByte(SHORT(SHORT(ORD(str[i]) - 256)))
ELSE w.WriteByte(SHORT(SHORT(ORD(str[i]))))
END;
INC(i)
END
END WriteString;
PROCEDURE EncodeFileList*;
TYPE
FileList = POINTER TO RECORD
next: FileList;
f: Files.File
END;
VAR
beg, end, i, j, n: INTEGER; err: BOOLEAN;
files, last: FileList;
list, f: Files.File; w: Files.Writer; loc: Files.Locator;
rd: TextModels.Reader; wr: TextModels.Writer; t: TextModels.Model;
c: TextControllers.Controller;
name: Files.Name; path, next: ARRAY 2048 OF CHAR;
BEGIN
c := TextControllers.Focus();
IF (c # NIL) & c.HasSelection() THEN c.GetSelection(beg, end);
rd := c.text.NewReader(NIL); rd.SetPos(beg); err := FALSE;
list := Files.dir.Temp(); w := list.NewWriter(NIL); files := NIL; last := NIL;
ReadPath(rd, path, i);
WHILE (path # "") & (rd.Pos() - i < end) & ~err DO
GetFile(path, loc, name);
IF loc # NIL THEN
f := Files.dir.Old(loc, name, TRUE); err := f = NIL;
IF ~err THEN
IF last = NIL THEN NEW(last); files := last ELSE NEW(last.next); last := last.next END;
last.f := f;
ReadPath(rd, next, j);
IF (next = "=>") & (rd.Pos() - j < end) THEN
ReadPath(rd, next, j);
IF next # "" THEN WriteString(w, next, j + 1); ReadPath(rd, next, j)
ELSE err := TRUE
END
ELSE WriteString(w, path, i + 1)
END;
path := next; i := j
END
ELSE err := TRUE
END
END;
IF ~err & (files # NIL) THEN
t := TextModels.dir.New(); wr := t.NewWriter(NIL);
n := 0; WriteHeader(wr, n, "", List);
WriteFileType(wr, n, list.type); WriteFile(wr, n, list);
WHILE files # NIL DO
WriteFileType(wr, n, files.f.type); WriteFile(wr, n, files.f); files := files.next
END;
ShowText(t)
ELSIF err THEN
IF path = "" THEN ShowError(7, path)
ELSIF loc # NIL THEN ShowError(6, path)
ELSE ShowError(5, path)
END
END
END
END EncodeFileList;
PROCEDURE DecodeView(rd: TextModels.Reader; name: Files.Name);
VAR res: INTEGER; f: Files.File; ftype: Files.Type; rds: Stores.Reader; v: Views.View;
BEGIN
ReadFileType(rd, res, ftype);
IF res = 0 THEN
f := Files.dir.Temp(); ReadFile(rd, res, f);
IF res = 0 THEN
rds.ConnectTo(f); Views.ReadView(rds, v); Views.Open(v, NIL, name, NIL);
Views.SetDirty(v)
ELSE ShowError(res, "")
END
ELSE ShowError(res, "")
END
END DecodeView;
PROCEDURE DecodeFile(rd: TextModels.Reader; name: Files.Name);
VAR res: INTEGER; ftype: Files.Type; loc: Files.Locator; f: Files.File;
BEGIN
ReadFileType(rd, res, ftype);
IF res = 0 THEN
Dialog.GetExtSpec(name, ftype, loc, name);
IF loc # NIL THEN
f := Files.dir.New(loc, Files.ask);
IF f # NIL THEN
ReadFile(rd, res, f);
IF res = 0 THEN
f.Register(name, ftype, Files.ask, res);
IF res # 0 THEN ShowError(4, "") END
ELSE ShowError(res, "")
END
ELSIF loc.res = 4 THEN ShowError(9, "")
ELSIF loc.res = 5 THEN ShowError(10, "")
END
END
ELSE ShowError(res, "")
END
END DecodeFile;
PROCEDURE DecodeFileList (rd: TextModels.Reader; VAR files: FileList; VAR len, res: INTEGER);
VAR i, n: INTEGER; b: BYTE; p: FileList;
ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
BEGIN
ReadFileType(rd, res, ftype);
IF res = 0 THEN
f := Files.dir.Temp(); ReadFile(rd, res, f);
IF res = 0 THEN
files := NIL; p := NIL; n := 0;
frd := f.NewReader(NIL); frd.ReadByte(b);
WHILE ~frd.eof & (res = 0) DO
INC(n); i := 0;
WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
& (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
THEN path[i - 4] := 0X
ELSE path[i] := 0X
END;
IF ~frd.eof THEN
IF p = NIL THEN NEW(p); files := p ELSE NEW(p.next); p := p.next END;
p.name := path;
frd.ReadByte(b)
ELSE res := 1
END
END;
p := files; len := n;
WHILE (res = 0) & (p # NIL) DO
ReadFileType(rd, res, p.type);
IF res = 0 THEN p.file := Files.dir.Temp(); ReadFile(rd, res, p.file) END;
p := p.next
END
END
END
END DecodeFileList;
PROCEDURE OpenDialog(files: FileList; len: INTEGER);
VAR i: INTEGER; p: FileList;
BEGIN
par.files := files; par.list.SetLen(len);
p := files; i := 0;
WHILE p # NIL DO par.list.SetItem(i, p.name); INC(i); p := p.next END;
par.storeAs := "";
Dialog.Update(par); Dialog.UpdateList(par.list);
StdCmds.OpenAuxDialog("Std/Rsrc/Coder", "Decode")
END OpenDialog;
PROCEDURE CloseDialog*;
BEGIN
par.files := NIL; par.list.SetLen(0); par.storeAs := "";
Dialog.UpdateList(par.list); Dialog.Update(par)
END CloseDialog;
PROCEDURE Select*(op, from, to: INTEGER);
VAR p: FileList; i: INTEGER;
BEGIN
IF (op = Dialog.included) OR (op = Dialog.excluded) OR (op = Dialog.set) THEN
IF NofSelections(par.list) = 1 THEN
i := 0; p := par.files;
WHILE ~par.list.In(i) DO INC(i); p := p.next END;
par.storeAs := p.name
ELSE par.storeAs := ""
END;
Dialog.Update(par)
END
END Select;
PROCEDURE CopyFile(from: Files.File; loc: Files.Locator; name: Files.Name; type: Files.Type);
CONST BufSize = 4096;
VAR res, k, l: INTEGER; f: Files.File; r: Files.Reader; w: Files.Writer;
buf: ARRAY BufSize OF BYTE;
BEGIN
f := Files.dir.New(loc, Files.ask);
IF f # NIL THEN
r := from.NewReader(NIL); w := f.NewWriter(NIL); l := from.Length();
WHILE l # 0 DO
IF l <= BufSize THEN k := l ELSE k := BufSize END;
r.ReadBytes(buf, 0, k); w.WriteBytes(buf, 0, k);
l := l - k
END;
f.Register(name, type, Files.ask, res);
IF res # 0 THEN ShowError(4, "") END
ELSIF loc.res = 4 THEN ShowError(9, "")
ELSIF loc.res = 5 THEN ShowError(10, "")
END
END CopyFile;
PROCEDURE StoreSelection*;
VAR i, n: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
BEGIN
n := NofSelections(par.list);
IF n > 1 THEN
i := 0; p := par.files;
WHILE n # 0 DO
WHILE ~par.list.In(i) DO INC(i); p := p.next END;
GetFile(p.name, loc, name); CopyFile(p.file, loc, name, p.type);
DEC(n); INC(i); p := p.next
END
ELSIF (n = 1) & (par.storeAs # "") THEN
i := 0; p := par.files;
WHILE ~par.list.In(i) DO INC(i); p := p.next END;
GetFile(par.storeAs, loc, name); CopyFile(p.file, loc, name, p.type)
END
END StoreSelection;
PROCEDURE StoreSelectionGuard*(VAR p: Dialog.Par);
VAR n: INTEGER;
BEGIN
n := NofSelections(par.list);
p.disabled := (n = 0) OR ((n = 1) & (par.storeAs = ""))
END StoreSelectionGuard;
PROCEDURE StoreSingle*;
VAR i: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
BEGIN
IF NofSelections(par.list) = 1 THEN
i := 0; p := par.files;
WHILE ~par.list.In(i) DO INC(i); p := p.next END;
GetFile(p.name, loc, name);
Dialog.GetExtSpec(name, p.type, loc, name);
IF loc # NIL THEN CopyFile(p.file, loc, name, p.type) END
END
END StoreSingle;
PROCEDURE StoreSingleGuard*(VAR p: Dialog.Par);
BEGIN
p.disabled := NofSelections(par.list) # 1
END StoreSingleGuard;
PROCEDURE StoreAllFiles(files: FileList);
VAR loc: Files.Locator; name: Files.Name;
BEGIN
WHILE files # NIL DO
GetFile(files.name, loc, name); CopyFile(files.file, loc, name, files.type); files := files.next
END
END StoreAllFiles;
PROCEDURE StoreAll*;
BEGIN
StoreAllFiles(par.files)
END StoreAll;
PROCEDURE DecodeAllFromText*(text: TextModels.Model; beg: INTEGER; ask: BOOLEAN);
VAR res, i: INTEGER; type: BYTE; name: Files.Name; rd: TextModels.Reader; files: FileList;
BEGIN
CloseDialog;
rd := text.NewReader(NIL); rd.SetPos(beg);
ReadHeader(rd, res, name, type);
i := 0;
WHILE name[i] # 0X DO INC(i) END;
IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
& (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
THEN name[i - 4] := 0X
END;
IF res = 0 THEN
IF type = View THEN DecodeView(rd, name)
ELSIF type = File THEN DecodeFile(rd, name)
ELSIF type = List THEN
DecodeFileList(rd, files, i, res);
IF res = 0 THEN
IF ask THEN OpenDialog(files, i) ELSE StoreAllFiles(files) END
ELSE ShowError(res, "")
END
ELSE ShowError(3, "")
END
ELSE ShowError(res, "")
END
END DecodeAllFromText;
PROCEDURE Decode*;
VAR beg, end: INTEGER; c: TextControllers.Controller;
BEGIN
CloseDialog;
c := TextControllers.Focus();
IF c # NIL THEN
IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
DecodeAllFromText(c.text, beg, TRUE)
END
END Decode;
PROCEDURE ListFiles(rd: TextModels.Reader; VAR wr: TextMappers.Formatter);
VAR i, n, res: INTEGER; b: BYTE;
ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
BEGIN
ReadFileType(rd, res, ftype);
IF res = 0 THEN
f := Files.dir.Temp(); ReadFile(rd, res, f);
IF res = 0 THEN
n := 0;
frd := f.NewReader(NIL); frd.ReadByte(b);
WHILE ~frd.eof & (res = 0) DO
INC(n); i := 0;
WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
& (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
THEN path[i - 4] := 0X
ELSE path[i] := 0X
END;
IF ~frd.eof THEN wr.WriteString(path); wr.WriteLn; frd.ReadByte(b) ELSE res := 1 END
END
ELSE ShowError(res, "")
END
ELSE ShowError(res, "")
END
END ListFiles;
PROCEDURE ListSingleton(type, name: ARRAY OF CHAR; VAR wr: TextMappers.Formatter);
BEGIN
wr.WriteString(type);
IF name # "" THEN wr.WriteString(": '"); wr.WriteString(name); wr.WriteChar("'") END;
wr.WriteLn
END ListSingleton;
PROCEDURE EncodedInText*(text: TextModels.Model; beg: INTEGER): TextModels.Model;
VAR res, i: INTEGER; type: BYTE; name: Files.Name;
rd: TextModels.Reader; report: TextModels.Model; wr: TextMappers.Formatter;
BEGIN
report := TextModels.dir.New(); wr.ConnectTo(report);
rd := text.NewReader(NIL); rd.SetPos(beg);
ReadHeader(rd, res, name, type);
i := 0;
WHILE name[i] # 0X DO INC(i) END;
IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
& (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
THEN name[i - 4] := 0X
END;
IF res = 0 THEN
IF type = View THEN ListSingleton("View", name, wr)
ELSIF type = File THEN ListSingleton("File", name, wr)
ELSIF type = List THEN ListFiles(rd, wr)
ELSE ShowError(3, "")
END
ELSE ShowError(res, "")
END;
RETURN report
END EncodedInText;
PROCEDURE ListEncodedMaterial*;
VAR beg, end: INTEGER; c: TextControllers.Controller;
BEGIN
c := TextControllers.Focus();
IF c # NIL THEN
IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
Views.OpenView(TextViews.dir.New(EncodedInText(c.text, beg)))
END
END ListEncodedMaterial;
PROCEDURE InitCodes;
VAR i: BYTE; j: INTEGER;
BEGIN
j := 0;
WHILE j # 256 DO revCode[j] := -1; INC(j) END;
code[0] := "."; revCode[ORD(".")] := 0; code[1] := ","; revCode[ORD(",")] := 1;
i := 2; j := ORD("0");
WHILE j <= ORD("9") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
j := ORD("A");
WHILE j <= ORD("Z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
j := ORD("a");
WHILE j <= ORD("z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
ASSERT(i = 64, 60)
END InitCodes;
BEGIN
InitCodes;
stdDocuType[0] := 3X; stdDocuType[1] := 3X; stdDocuType[2] := 3X; stdDocuType[3] := 0X
END StdCoder.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: (Std)Coder.pdf
Type: application/octet-stream
Size: 15135 bytes
Desc: (Std)Coder.pdf
Url : https://lists.inf.ethz.ch/pipermail/oberon/attachments/20080401/c1409eb1/StdCoder.obj
More information about the Oberon
mailing list