Coder.txt 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682
  1. MODULE StdCoder;
  2. (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Coder.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT
  5. Kernel, Files, Converters, Stores, Views, Controllers, Dialog, Documents, Windows,
  6. TextModels, TextViews, TextControllers, TextMappers,
  7. StdCmds;
  8. CONST
  9. N = 16384;
  10. LineLength = 74;
  11. OldVersion = 0; ThisVersion = 1;
  12. Tag = "StdCoder.Decode"; (* first letter of Tag must not to appear within Tag again *)
  13. Separator = "/";
  14. View = 1; File = 2; List = 3;
  15. TYPE
  16. FileList = POINTER TO RECORD
  17. next: FileList;
  18. file: Files.File;
  19. type: Files.Type;
  20. name:Dialog.String
  21. END;
  22. ParList* = RECORD
  23. list*: Dialog.Selection;
  24. storeAs*: Dialog.String;
  25. files: FileList
  26. END;
  27. VAR
  28. par*: ParList;
  29. code: ARRAY 64 OF CHAR;
  30. revCode: ARRAY 256 OF BYTE;
  31. table: ARRAY N OF BYTE;
  32. stdDocuType: Files.Type;
  33. PROCEDURE NofSelections(IN list: Dialog.Selection): INTEGER;
  34. VAR i, n: INTEGER;
  35. BEGIN
  36. i := 0; n := 0;
  37. WHILE i # list.len DO
  38. IF list.In(i) THEN INC(n) END;
  39. INC(i)
  40. END;
  41. RETURN n
  42. END NofSelections;
  43. PROCEDURE ShowError(n: INTEGER; par: ARRAY OF CHAR);
  44. BEGIN
  45. Dialog.Beep;
  46. CASE n OF
  47. 1: Dialog.ShowParamMsg("#Std:bad characters", par, "", "")
  48. | 2: Dialog.ShowParamMsg("#Std:checksum error", par, "", "")
  49. | 3: Dialog.ShowParamMsg("#Std:incompatible version", par, "", "")
  50. | 4: Dialog.ShowParamMsg("#Std:filing error", par, "", "")
  51. | 5: Dialog.ShowParamMsg("#Std:directory ^0 not found", par, "", "")
  52. | 6: Dialog.ShowParamMsg("#Std:file ^0 not found", par, "", "")
  53. | 7: Dialog.ShowParamMsg("#Std:illegal path", par, "", "")
  54. | 8: Dialog.ShowParamMsg("#Std:no tag", par, "", "")
  55. | 9: Dialog.ShowParamMsg("#Std:disk write protected", par, "", "")
  56. | 10: Dialog.ShowParamMsg("#Std:io error", par, "", "")
  57. END
  58. END ShowError;
  59. PROCEDURE ShowSizeMsg(x: INTEGER);
  60. VAR i, j: INTEGER; ch: CHAR; s: ARRAY 20 OF CHAR;
  61. BEGIN
  62. ASSERT(x >= 0, 20);
  63. i := 0;
  64. REPEAT s[i] := CHR(ORD("0") + x MOD 10); INC(i); x := x DIV 10 UNTIL x = 0;
  65. s[i] := 0X;
  66. DEC(i); j := 0;
  67. WHILE j < i DO ch := s[j]; s[j] := s[i]; s[i] := ch; INC(j); DEC(i) END;
  68. Dialog.ShowParamStatus("#Std:^0 characters coded", s, "", "")
  69. END ShowSizeMsg;
  70. PROCEDURE Write(dest: TextModels.Writer; x: INTEGER; VAR n: INTEGER);
  71. BEGIN
  72. dest.WriteChar(code[x]); INC(n);
  73. IF n = LineLength THEN dest.WriteChar(0DX); dest.WriteChar(" "); n := 0 END
  74. END Write;
  75. PROCEDURE WriteHeader(dest: TextModels.Writer; VAR n: INTEGER;
  76. name: ARRAY OF CHAR; type: BYTE
  77. );
  78. VAR byte, bit, i: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
  79. BEGIN
  80. tag := Tag; i := 0; ch := tag[0];
  81. WHILE ch # 0X DO dest.WriteChar(ch); INC(n); INC(i); ch := tag[i] END;
  82. dest.WriteChar(" "); INC(n);
  83. bit := 0; byte := 0; i := 0;
  84. REPEAT
  85. ch := name[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
  86. WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
  87. INC(i)
  88. UNTIL ch = 0X;
  89. IF bit # 0 THEN Write(dest, byte, n) END;
  90. Write(dest, ThisVersion, n); Write(dest, type, n)
  91. END WriteHeader;
  92. PROCEDURE WriteFileType(dest: TextModels.Writer; VAR n: INTEGER; t: Files.Type);
  93. VAR byte, bit, i: INTEGER; ch: CHAR;
  94. BEGIN
  95. IF t = Kernel.docType THEN t := stdDocuType END;
  96. bit := 0; byte := 0; i := 0; dest.WriteChar(" ");
  97. REPEAT
  98. ch := t[i]; INC(byte, ASH(ORD(ch), bit)); INC(bit, 8);
  99. WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
  100. INC(i)
  101. UNTIL ch = 0X;
  102. IF bit # 0 THEN Write(dest, byte, n) END
  103. END WriteFileType;
  104. PROCEDURE WriteFile(dest: TextModels.Writer; VAR n: INTEGER; f: Files.File);
  105. VAR hash, byte, bit, i, j, sum, len: INTEGER; src: Files.Reader; b: BYTE;
  106. BEGIN
  107. len := f.Length(); j := len; i := 6;
  108. WHILE i # 0 DO Write(dest, j MOD 64, n); j := j DIV 64; DEC(i) END;
  109. i := 0;
  110. REPEAT table[i] := 0; INC(i) UNTIL i = N;
  111. hash := 0; bit := 0; byte := 0; sum := 0; src := f.NewReader(NIL);
  112. WHILE len # 0 DO
  113. src.ReadByte(b); DEC(len);
  114. sum := (sum + b MOD 256) MOD (16 * 1024);
  115. IF table[hash] = b THEN INC(bit) (* 0 bit for correct prediction *)
  116. ELSE (* Incorrect prediction -> 1'xxxx'xxxx bits *)
  117. table[hash] := b; INC(byte, ASH(1, bit)); INC(bit);
  118. INC(byte, ASH(b MOD 256, bit)); INC(bit, 8)
  119. END;
  120. WHILE bit >= 6 DO Write(dest, byte MOD 64, n); byte := byte DIV 64; DEC(bit, 6) END;
  121. hash := (16 * hash + b MOD 256) MOD N
  122. END;
  123. IF bit # 0 THEN Write(dest, byte, n) END;
  124. i := 6;
  125. WHILE i # 0 DO Write(dest, sum MOD 64, n); sum := sum DIV 64; DEC(i) END;
  126. IF n # 0 THEN dest.WriteChar(0DX); n := 0 END
  127. END WriteFile;
  128. PROCEDURE Read(src: TextModels.Reader; VAR x: INTEGER; VAR res: INTEGER);
  129. VAR ch: CHAR;
  130. BEGIN
  131. IF res = 0 THEN
  132. REPEAT src.ReadChar(ch); x := revCode[ORD(ch)] UNTIL (x >= 0) OR src.eot;
  133. IF src.eot THEN res := 1 END
  134. END;
  135. IF res # 0 THEN x := 0 END
  136. END Read;
  137. PROCEDURE ReadHeader(src: TextModels.Reader; VAR res: INTEGER;
  138. VAR name: ARRAY OF CHAR; VAR type: BYTE
  139. );
  140. VAR x, bit, i, j: INTEGER; ch: CHAR; tag: ARRAY 16 OF CHAR;
  141. BEGIN
  142. tag := Tag; i := 0;
  143. WHILE ~src.eot & (tag[i] # 0X) DO
  144. src.ReadChar(ch);
  145. IF ch = tag[i] THEN INC(i) ELSIF ch = tag[0] THEN i := 1 ELSE i := 0 END
  146. END;
  147. IF ~src.eot THEN
  148. res := 0; i := 0; bit := 0; x := 0;
  149. REPEAT
  150. WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
  151. IF res = 0 THEN
  152. ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); name[i] := ch; INC(i)
  153. END
  154. UNTIL (res # 0) OR (ch = 0X);
  155. Read(src, j, res);
  156. IF res = 0 THEN
  157. IF (j = ThisVersion) OR (j = OldVersion) THEN
  158. Read(src, j, res); type := SHORT(SHORT(j))
  159. ELSE res := 3
  160. END
  161. END
  162. ELSE res := 8
  163. END
  164. END ReadHeader;
  165. PROCEDURE ReadFileType(src: TextModels.Reader; VAR res: INTEGER; VAR ftype: Files.Type);
  166. VAR x, bit, i, j: INTEGER; ch: CHAR;
  167. BEGIN
  168. res := 0; i := 0; bit := 0; x := 0;
  169. REPEAT
  170. WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
  171. IF res = 0 THEN ch := CHR(x MOD 256); x := x DIV 256; DEC(bit, 8); ftype[i] := ch; INC(i) END
  172. UNTIL (res # 0) OR (ch = 0X);
  173. IF ftype = stdDocuType THEN ftype := Kernel.docType END
  174. END ReadFileType;
  175. PROCEDURE ReadFile(src: TextModels.Reader; VAR res: INTEGER; f: Files.File);
  176. VAR hash, x, bit, i, j, len, sum, s: INTEGER; byte: BYTE; dest: Files.Writer;
  177. BEGIN
  178. res := 0; i := 0; len := 0;
  179. REPEAT Read(src, x, res); len := len + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
  180. i := 0;
  181. REPEAT table[i] := 0; INC(i) UNTIL i = N;
  182. bit := 0; hash := 0; sum := 0; dest := f.NewWriter(NIL);
  183. WHILE (res = 0) & (len # 0) DO
  184. IF bit = 0 THEN Read(src, x, res); bit := 6 END;
  185. IF ODD(x) THEN (* Incorrect prediction -> 1'xxxx'xxxx *)
  186. x := x DIV 2; DEC(bit);
  187. WHILE (res = 0) & (bit < 8) DO Read(src, j, res); INC(x, ASH(j, bit)); INC(bit, 6) END;
  188. i := x MOD 256;
  189. IF i > MAX(BYTE) THEN i := i - 256 END;
  190. byte := SHORT(SHORT(i)); x := x DIV 256; DEC(bit, 8);
  191. table[hash] := byte
  192. ELSE byte := table[hash]; x := x DIV 2; DEC(bit) (* correct prediction *)
  193. END;
  194. hash := (16 * hash + byte MOD 256) MOD N;
  195. dest.WriteByte(byte); sum := (sum + byte MOD 256) MOD (16 * 1024); DEC(len)
  196. END;
  197. IF res = 0 THEN
  198. i := 0; s := 0;
  199. REPEAT Read(src, x, res); s := s + ASH(x, 6 * i); INC(i) UNTIL (res # 0) OR (i = 6);
  200. IF (res = 0) & (s # sum) THEN res := 2 END
  201. END
  202. END ReadFile;
  203. PROCEDURE ShowText (t: TextModels.Model);
  204. VAR l: INTEGER; v: Views.View; wr: TextMappers.Formatter; conv: Converters.Converter;
  205. BEGIN
  206. l := t.Length();
  207. wr.ConnectTo(t); wr.SetPos(l); wr.WriteString(" --- end of encoding ---");
  208. ShowSizeMsg(l);
  209. v := TextViews.dir.New(t);
  210. conv := Converters.list;
  211. WHILE (conv # NIL) & (conv.imp # "HostTextConv.ImportText") DO conv := conv.next END;
  212. Views.Open(v, NIL, "", conv);
  213. Views.SetDirty(v)
  214. END ShowText;
  215. PROCEDURE EncodedView*(v: Views.View): TextModels.Model;
  216. VAR n: INTEGER; f: Files.File; wrs: Stores.Writer; t: TextModels.Model; wr: TextModels.Writer;
  217. BEGIN
  218. f := Files.dir.Temp(); wrs.ConnectTo(f); Views.WriteView(wrs, v);
  219. t := TextModels.dir.New(); wr := t.NewWriter(NIL);
  220. n := 0; WriteHeader(wr, n, "", View); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
  221. RETURN t
  222. END EncodedView;
  223. PROCEDURE EncodeDocument*;
  224. VAR v: Views.View; w: Windows.Window;
  225. BEGIN
  226. w := Windows.dir.First();
  227. IF w # NIL THEN
  228. v := w.doc.OriginalView();
  229. IF (v.context # NIL) & (v.context IS Documents.Context) THEN
  230. v := v.context(Documents.Context).ThisDoc()
  231. END;
  232. IF v # NIL THEN ShowText(EncodedView(v)) END
  233. END
  234. END EncodeDocument;
  235. PROCEDURE EncodeFocus*;
  236. VAR v: Views.View;
  237. BEGIN
  238. v := Controllers.FocusView();
  239. IF v # NIL THEN ShowText(EncodedView(v)) END
  240. END EncodeFocus;
  241. PROCEDURE EncodeSelection*;
  242. VAR beg, end: INTEGER; t: TextModels.Model; c: TextControllers.Controller;
  243. BEGIN
  244. c := TextControllers.Focus();
  245. IF (c # NIL) & c.HasSelection() THEN
  246. c.GetSelection(beg, end);
  247. t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, beg, end);
  248. ShowText(EncodedView(TextViews.dir.New(t)))
  249. END
  250. END EncodeSelection;
  251. PROCEDURE EncodeFile*;
  252. VAR n: INTEGER; loc: Files.Locator; name: Files.Name; f: Files.File;
  253. t: TextModels.Model; wr: TextModels.Writer;
  254. BEGIN
  255. Dialog.GetIntSpec("", loc, name);
  256. IF loc # NIL THEN
  257. f := Files.dir.Old(loc, name, TRUE);
  258. IF f # NIL THEN
  259. t := TextModels.dir.New(); wr := t.NewWriter(NIL);
  260. n := 0; WriteHeader(wr, n, name, File); WriteFileType(wr, n, f.type); WriteFile(wr, n, f);
  261. ShowText(t)
  262. END
  263. END
  264. END EncodeFile;
  265. PROCEDURE GetFile(VAR path: ARRAY OF CHAR; VAR loc: Files.Locator; VAR name: Files.Name);
  266. VAR i, j: INTEGER; ch: CHAR;
  267. BEGIN
  268. i := 0; ch := path[0]; loc := Files.dir.This("");
  269. WHILE (ch # 0X) & (loc # NIL) DO
  270. j := 0;
  271. WHILE (ch # 0X) & (ch # Separator) DO name[j] := ch; INC(j); INC(i); ch := path[i] END;
  272. name[j] := 0X;
  273. IF ch = Separator THEN loc := loc.This(name); INC(i); ch := path[i] END;
  274. IF loc.res # 0 THEN loc := NIL END
  275. END;
  276. path[i] := 0X
  277. END GetFile;
  278. PROCEDURE ReadPath(rd: TextModels.Reader; VAR path: ARRAY OF CHAR; VAR len: INTEGER);
  279. VAR i, l: INTEGER; ch: CHAR;
  280. BEGIN
  281. i := 0; l := LEN(path) - 1;
  282. REPEAT rd.ReadChar(ch) UNTIL rd.eot OR (ch > " ");
  283. WHILE ~rd.eot & (ch > " ") & (i < l) DO path[i] := ch; INC(i); rd.ReadChar(ch) END;
  284. path[i] := 0X; len := i
  285. END ReadPath;
  286. PROCEDURE WriteString(w: Files.Writer; IN str: ARRAY OF CHAR; len: INTEGER);
  287. VAR i: INTEGER;
  288. BEGIN
  289. i := 0;
  290. WHILE i < len DO
  291. IF ORD(str[i]) > MAX(BYTE) THEN w.WriteByte(SHORT(SHORT(ORD(str[i]) - 256)))
  292. ELSE w.WriteByte(SHORT(SHORT(ORD(str[i]))))
  293. END;
  294. INC(i)
  295. END
  296. END WriteString;
  297. PROCEDURE EncodeFileList*;
  298. TYPE
  299. FileList = POINTER TO RECORD
  300. next: FileList;
  301. f: Files.File
  302. END;
  303. VAR
  304. beg, end, i, j, n: INTEGER; err: BOOLEAN;
  305. files, last: FileList;
  306. list, f: Files.File; w: Files.Writer; loc: Files.Locator;
  307. rd: TextModels.Reader; wr: TextModels.Writer; t: TextModels.Model;
  308. c: TextControllers.Controller;
  309. name: Files.Name; path, next: ARRAY 2048 OF CHAR;
  310. BEGIN
  311. c := TextControllers.Focus();
  312. IF (c # NIL) & c.HasSelection() THEN c.GetSelection(beg, end);
  313. rd := c.text.NewReader(NIL); rd.SetPos(beg); err := FALSE;
  314. list := Files.dir.Temp(); w := list.NewWriter(NIL); files := NIL; last := NIL;
  315. ReadPath(rd, path, i);
  316. WHILE (path # "") & (rd.Pos() - i < end) & ~err DO
  317. GetFile(path, loc, name);
  318. IF loc # NIL THEN
  319. f := Files.dir.Old(loc, name, TRUE); err := f = NIL;
  320. IF ~err THEN
  321. IF last = NIL THEN NEW(last); files := last ELSE NEW(last.next); last := last.next END;
  322. last.f := f;
  323. ReadPath(rd, next, j);
  324. IF (next = "=>") & (rd.Pos() - j < end) THEN
  325. ReadPath(rd, next, j);
  326. IF next # "" THEN WriteString(w, next, j + 1); ReadPath(rd, next, j)
  327. ELSE err := TRUE
  328. END
  329. ELSE WriteString(w, path, i + 1)
  330. END;
  331. path := next; i := j
  332. END
  333. ELSE err := TRUE
  334. END
  335. END;
  336. IF ~err & (files # NIL) THEN
  337. t := TextModels.dir.New(); wr := t.NewWriter(NIL);
  338. n := 0; WriteHeader(wr, n, "", List);
  339. WriteFileType(wr, n, list.type); WriteFile(wr, n, list);
  340. WHILE files # NIL DO
  341. WriteFileType(wr, n, files.f.type); WriteFile(wr, n, files.f); files := files.next
  342. END;
  343. ShowText(t)
  344. ELSIF err THEN
  345. IF path = "" THEN ShowError(7, path)
  346. ELSIF loc # NIL THEN ShowError(6, path)
  347. ELSE ShowError(5, path)
  348. END
  349. END
  350. END
  351. END EncodeFileList;
  352. PROCEDURE DecodeView(rd: TextModels.Reader; name: Files.Name);
  353. VAR res: INTEGER; f: Files.File; ftype: Files.Type; rds: Stores.Reader; v: Views.View;
  354. BEGIN
  355. ReadFileType(rd, res, ftype);
  356. IF res = 0 THEN
  357. f := Files.dir.Temp(); ReadFile(rd, res, f);
  358. IF res = 0 THEN
  359. rds.ConnectTo(f); Views.ReadView(rds, v); Views.Open(v, NIL, name, NIL);
  360. Views.SetDirty(v)
  361. ELSE ShowError(res, "")
  362. END
  363. ELSE ShowError(res, "")
  364. END
  365. END DecodeView;
  366. PROCEDURE DecodeFile(rd: TextModels.Reader; name: Files.Name);
  367. VAR res: INTEGER; ftype: Files.Type; loc: Files.Locator; f: Files.File;
  368. BEGIN
  369. ReadFileType(rd, res, ftype);
  370. IF res = 0 THEN
  371. Dialog.GetExtSpec(name, ftype, loc, name);
  372. IF loc # NIL THEN
  373. f := Files.dir.New(loc, Files.ask);
  374. IF f # NIL THEN
  375. ReadFile(rd, res, f);
  376. IF res = 0 THEN
  377. f.Register(name, ftype, Files.ask, res);
  378. IF res # 0 THEN ShowError(4, "") END
  379. ELSE ShowError(res, "")
  380. END
  381. ELSIF loc.res = 4 THEN ShowError(9, "")
  382. ELSIF loc.res = 5 THEN ShowError(10, "")
  383. END
  384. END
  385. ELSE ShowError(res, "")
  386. END
  387. END DecodeFile;
  388. PROCEDURE DecodeFileList (rd: TextModels.Reader; VAR files: FileList; VAR len, res: INTEGER);
  389. VAR i, n: INTEGER; b: BYTE; p: FileList;
  390. ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
  391. BEGIN
  392. ReadFileType(rd, res, ftype);
  393. IF res = 0 THEN
  394. f := Files.dir.Temp(); ReadFile(rd, res, f);
  395. IF res = 0 THEN
  396. files := NIL; p := NIL; n := 0;
  397. frd := f.NewReader(NIL); frd.ReadByte(b);
  398. WHILE ~frd.eof & (res = 0) DO
  399. INC(n); i := 0;
  400. WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
  401. IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
  402. & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
  403. THEN path[i - 4] := 0X
  404. ELSE path[i] := 0X
  405. END;
  406. IF ~frd.eof THEN
  407. IF p = NIL THEN NEW(p); files := p ELSE NEW(p.next); p := p.next END;
  408. p.name := path;
  409. frd.ReadByte(b)
  410. ELSE res := 1
  411. END
  412. END;
  413. p := files; len := n;
  414. WHILE (res = 0) & (p # NIL) DO
  415. ReadFileType(rd, res, p.type);
  416. IF res = 0 THEN p.file := Files.dir.Temp(); ReadFile(rd, res, p.file) END;
  417. p := p.next
  418. END
  419. END
  420. END
  421. END DecodeFileList;
  422. PROCEDURE OpenDialog(files: FileList; len: INTEGER);
  423. VAR i: INTEGER; p: FileList;
  424. BEGIN
  425. par.files := files; par.list.SetLen(len);
  426. p := files; i := 0;
  427. WHILE p # NIL DO par.list.SetItem(i, p.name); INC(i); p := p.next END;
  428. par.storeAs := "";
  429. Dialog.Update(par); Dialog.UpdateList(par.list);
  430. StdCmds.OpenAuxDialog("Std/Rsrc/Coder", "Decode")
  431. END OpenDialog;
  432. PROCEDURE CloseDialog*;
  433. BEGIN
  434. par.files := NIL; par.list.SetLen(0); par.storeAs := "";
  435. Dialog.UpdateList(par.list); Dialog.Update(par)
  436. END CloseDialog;
  437. PROCEDURE Select*(op, from, to: INTEGER);
  438. VAR p: FileList; i: INTEGER;
  439. BEGIN
  440. IF (op = Dialog.included) OR (op = Dialog.excluded) OR (op = Dialog.set) THEN
  441. IF NofSelections(par.list) = 1 THEN
  442. i := 0; p := par.files;
  443. WHILE ~par.list.In(i) DO INC(i); p := p.next END;
  444. par.storeAs := p.name
  445. ELSE par.storeAs := ""
  446. END;
  447. Dialog.Update(par)
  448. END
  449. END Select;
  450. PROCEDURE CopyFile(from: Files.File; loc: Files.Locator; name: Files.Name; type: Files.Type);
  451. CONST BufSize = 4096;
  452. VAR res, k, l: INTEGER; f: Files.File; r: Files.Reader; w: Files.Writer;
  453. buf: ARRAY BufSize OF BYTE;
  454. BEGIN
  455. f := Files.dir.New(loc, Files.ask);
  456. IF f # NIL THEN
  457. r := from.NewReader(NIL); w := f.NewWriter(NIL); l := from.Length();
  458. WHILE l # 0 DO
  459. IF l <= BufSize THEN k := l ELSE k := BufSize END;
  460. r.ReadBytes(buf, 0, k); w.WriteBytes(buf, 0, k);
  461. l := l - k
  462. END;
  463. f.Register(name, type, Files.ask, res);
  464. IF res # 0 THEN ShowError(4, "") END
  465. ELSIF loc.res = 4 THEN ShowError(9, "")
  466. ELSIF loc.res = 5 THEN ShowError(10, "")
  467. END
  468. END CopyFile;
  469. PROCEDURE StoreSelection*;
  470. VAR i, n: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
  471. BEGIN
  472. n := NofSelections(par.list);
  473. IF n > 1 THEN
  474. i := 0; p := par.files;
  475. WHILE n # 0 DO
  476. WHILE ~par.list.In(i) DO INC(i); p := p.next END;
  477. GetFile(p.name, loc, name); CopyFile(p.file, loc, name, p.type);
  478. DEC(n); INC(i); p := p.next
  479. END
  480. ELSIF (n = 1) & (par.storeAs # "") THEN
  481. i := 0; p := par.files;
  482. WHILE ~par.list.In(i) DO INC(i); p := p.next END;
  483. GetFile(par.storeAs, loc, name); CopyFile(p.file, loc, name, p.type)
  484. END
  485. END StoreSelection;
  486. PROCEDURE StoreSelectionGuard*(VAR p: Dialog.Par);
  487. VAR n: INTEGER;
  488. BEGIN
  489. n := NofSelections(par.list);
  490. p.disabled := (n = 0) OR ((n = 1) & (par.storeAs = ""))
  491. END StoreSelectionGuard;
  492. PROCEDURE StoreSingle*;
  493. VAR i: INTEGER; p: FileList; loc: Files.Locator; name: Files.Name;
  494. BEGIN
  495. IF NofSelections(par.list) = 1 THEN
  496. i := 0; p := par.files;
  497. WHILE ~par.list.In(i) DO INC(i); p := p.next END;
  498. GetFile(p.name, loc, name);
  499. Dialog.GetExtSpec(name, p.type, loc, name);
  500. IF loc # NIL THEN CopyFile(p.file, loc, name, p.type) END
  501. END
  502. END StoreSingle;
  503. PROCEDURE StoreSingleGuard*(VAR p: Dialog.Par);
  504. BEGIN
  505. p.disabled := NofSelections(par.list) # 1
  506. END StoreSingleGuard;
  507. PROCEDURE StoreAllFiles(files: FileList);
  508. VAR loc: Files.Locator; name: Files.Name;
  509. BEGIN
  510. WHILE files # NIL DO
  511. GetFile(files.name, loc, name); CopyFile(files.file, loc, name, files.type); files := files.next
  512. END
  513. END StoreAllFiles;
  514. PROCEDURE StoreAll*;
  515. BEGIN
  516. StoreAllFiles(par.files)
  517. END StoreAll;
  518. PROCEDURE DecodeAllFromText*(text: TextModels.Model; beg: INTEGER; ask: BOOLEAN);
  519. VAR res, i: INTEGER; type: BYTE; name: Files.Name; rd: TextModels.Reader; files: FileList;
  520. BEGIN
  521. CloseDialog;
  522. rd := text.NewReader(NIL); rd.SetPos(beg);
  523. ReadHeader(rd, res, name, type);
  524. i := 0;
  525. WHILE name[i] # 0X DO INC(i) END;
  526. IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
  527. & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
  528. THEN name[i - 4] := 0X
  529. END;
  530. IF res = 0 THEN
  531. IF type = View THEN DecodeView(rd, name)
  532. ELSIF type = File THEN DecodeFile(rd, name)
  533. ELSIF type = List THEN
  534. DecodeFileList(rd, files, i, res);
  535. IF res = 0 THEN
  536. IF ask THEN OpenDialog(files, i) ELSE StoreAllFiles(files) END
  537. ELSE ShowError(res, "")
  538. END
  539. ELSE ShowError(3, "")
  540. END
  541. ELSE ShowError(res, "")
  542. END
  543. END DecodeAllFromText;
  544. PROCEDURE Decode*;
  545. VAR beg, end: INTEGER; c: TextControllers.Controller;
  546. BEGIN
  547. CloseDialog;
  548. c := TextControllers.Focus();
  549. IF c # NIL THEN
  550. IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
  551. DecodeAllFromText(c.text, beg, TRUE)
  552. END
  553. END Decode;
  554. PROCEDURE ListFiles(rd: TextModels.Reader; VAR wr: TextMappers.Formatter);
  555. VAR i, n, res: INTEGER; b: BYTE;
  556. ftype: Files.Type; f: Files.File; frd: Files.Reader; path: Dialog.String;
  557. BEGIN
  558. ReadFileType(rd, res, ftype);
  559. IF res = 0 THEN
  560. f := Files.dir.Temp(); ReadFile(rd, res, f);
  561. IF res = 0 THEN
  562. n := 0;
  563. frd := f.NewReader(NIL); frd.ReadByte(b);
  564. WHILE ~frd.eof & (res = 0) DO
  565. INC(n); i := 0;
  566. WHILE ~frd.eof & (b # 0) DO path[i] := CHR(b MOD 256); INC(i); frd.ReadByte(b) END;
  567. IF (i > 4) & (path[i - 4] = ".") & (CAP(path[i - 3]) = "O")
  568. & (CAP(path[i - 2]) = "D") & (CAP(path[i - 1]) = "C")
  569. THEN path[i - 4] := 0X
  570. ELSE path[i] := 0X
  571. END;
  572. IF ~frd.eof THEN wr.WriteString(path); wr.WriteLn; frd.ReadByte(b) ELSE res := 1 END
  573. END
  574. ELSE ShowError(res, "")
  575. END
  576. ELSE ShowError(res, "")
  577. END
  578. END ListFiles;
  579. PROCEDURE ListSingleton(type, name: ARRAY OF CHAR; VAR wr: TextMappers.Formatter);
  580. BEGIN
  581. wr.WriteString(type);
  582. IF name # "" THEN wr.WriteString(": '"); wr.WriteString(name); wr.WriteChar("'") END;
  583. wr.WriteLn
  584. END ListSingleton;
  585. PROCEDURE EncodedInText*(text: TextModels.Model; beg: INTEGER): TextModels.Model;
  586. VAR res, i: INTEGER; type: BYTE; name: Files.Name;
  587. rd: TextModels.Reader; report: TextModels.Model; wr: TextMappers.Formatter;
  588. BEGIN
  589. report := TextModels.dir.New(); wr.ConnectTo(report);
  590. rd := text.NewReader(NIL); rd.SetPos(beg);
  591. ReadHeader(rd, res, name, type);
  592. i := 0;
  593. WHILE name[i] # 0X DO INC(i) END;
  594. IF (i > 4) & (name[i - 4] = ".") & (CAP(name[i - 3]) = "O")
  595. & (CAP(name[i - 2]) = "D") & (CAP(name[i - 1]) = "C")
  596. THEN name[i - 4] := 0X
  597. END;
  598. IF res = 0 THEN
  599. IF type = View THEN ListSingleton("View", name, wr)
  600. ELSIF type = File THEN ListSingleton("File", name, wr)
  601. ELSIF type = List THEN ListFiles(rd, wr)
  602. ELSE ShowError(3, "")
  603. END
  604. ELSE ShowError(res, "")
  605. END;
  606. RETURN report
  607. END EncodedInText;
  608. PROCEDURE ListEncodedMaterial*;
  609. VAR beg, end: INTEGER; c: TextControllers.Controller;
  610. BEGIN
  611. c := TextControllers.Focus();
  612. IF c # NIL THEN
  613. IF c.HasSelection() THEN c.GetSelection(beg, end) ELSE beg := 0 END;
  614. Views.OpenView(TextViews.dir.New(EncodedInText(c.text, beg)))
  615. END
  616. END ListEncodedMaterial;
  617. PROCEDURE InitCodes;
  618. VAR i: BYTE; j: INTEGER;
  619. BEGIN
  620. j := 0;
  621. WHILE j # 256 DO revCode[j] := -1; INC(j) END;
  622. code[0] := "."; revCode[ORD(".")] := 0; code[1] := ","; revCode[ORD(",")] := 1;
  623. i := 2; j := ORD("0");
  624. WHILE j <= ORD("9") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
  625. j := ORD("A");
  626. WHILE j <= ORD("Z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
  627. j := ORD("a");
  628. WHILE j <= ORD("z") DO code[i] := CHR(j); revCode[j] := i; INC(i); INC(j) END;
  629. ASSERT(i = 64, 60)
  630. END InitCodes;
  631. BEGIN
  632. InitCodes;
  633. stdDocuType[0] := 3X; stdDocuType[1] := 3X; stdDocuType[2] := 3X; stdDocuType[3] := 0X
  634. END StdCoder.