[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