8 const progname = 'NGDUMP';
\r
10 copyright = 'Copyright 1989 J.P.Pedersen, 1990 E.v.Asperen';
\r
15 type gentry = record {General entry type}
\r
17 name:string[MaxNameLen];
\r
19 line = string[MaxLineLen];
\r
22 mennu:array[0..3,0..8] of gentry; {Buffer to hold variable part of guide menu structure}
\r
23 itemlist:array[0..3] of byte; {Menu structure info}
\r
24 errorinfo:array[3..6] of string[14]; {Buffer for error messages}
\r
25 f:file; {The guide file}
\r
26 propath,homedir,streng:string; {String variables, mostly for path and file use}
\r
30 menunr : byte; {Byte variables}
\r
31 entrytype : (et_misc, et_short, et_long);
\r
34 const MaxLevel = 10;
\r
37 type FileBuffer = array [1..OutBufSize] of byte;
\r
39 var outf : array [1..MaxLevel] of text;
\r
40 flevel : 1..MaxLevel;
\r
41 OutBuf : array [1..MaxLevel] of ^FileBuffer;
\r
43 numentries : longint;
\r
47 procedure threenitvars; {Initialize variables}
\r
52 procedure twonitvars; {Initialize variables}
\r
57 procedure initvars; {Initialize variables}
\r
61 errorinfo[3] := 'File not found';
\r
62 errorinfo[4] := 'Not an NG file';
\r
63 errorinfo[5] := 'Unexpected EOF';
\r
64 errorinfo[6] := 'Corrupted file';
\r
65 str5 := '';propath := paramstr(0);
\r
66 while (pos('\',propath) > 0) do begin
\r
67 str5 := str5+copy(propath,1,pos('\',propath));
\r
68 propath := copy(propath,pos('\',propath)+1,length(propath)-(pos('\',propath)+1));
\r
73 var attr, startattr : byte;
\r
75 procedure WriteNgString(var outf:text; s:string);
\r
81 while (i <= length(s)) do begin
\r
83 if c = #255 then begin
\r
87 for j := 1 to ord(c) do begin
\r
92 if (c = '!') and (i = 1) then write(outf, c);
\r
101 procedure WriteString(s:string);
\r
103 WriteNgString(outf[flevel], s);
\r
106 const Fx = 10; Fy = 2;
\r
114 procedure ShowShort(s:string);
\r
116 gotoxy(Sx, Sy); ClrEol;
\r
117 gotoxy(1, Sy+1); ClrEol;
\r
118 gotoxy(Sx, Sy); WriteNgString(Output, s);
\r
121 procedure ShowLong(n:longint);
\r
123 gotoxy(Lx, Ly); write(n:7);
\r
126 procedure ShowEndLong;
\r
128 gotoxy(Lx, Ly); ClrEol;
\r
131 procedure ShowFile(s:string);
\r
133 gotoxy(Fx, Fy); ClrEol; write(s);
\r
136 procedure ShowGuide(s:string);
\r
138 gotoxy(Gx, Gy); ClrEol; write(s);
\r
141 procedure ShowCount(n:longint);
\r
143 gotoxy(Cx, Cy); write(n:7);
\r
146 procedure ShowMenu(s:string);
\r
148 gotoxy(Mx, My); ClrEol; WriteNgString(output, s);
\r
151 procedure ScreenInit;
\r
154 gotoxy(Fx-8, Fy); write(' file:');
\r
155 gotoxy(Gx-8, Gy); write('guide:');
\r
156 gotoxy(Mx-8, My); write(' menu:');
\r
157 gotoxy(Cx-8, Cy); write('count:');
\r
158 gotoxy(Lx-8, Ly); write('lines:');
\r
159 gotoxy(Sx-8, Sy); write('entry:');
\r
162 procedure ScreenExit;
\r
164 gotoxy(1, Sy+3); ClrScr;
\r
167 procedure Usage; {Write usage info}
\r
170 writeln('usage: ngdump filename');
\r
175 procedure slutlort(b:byte); {Exit on error and display relevant error message}
\r
177 if b > 3 then close(f);
\r
178 if b > 2 then begin
\r
179 writeln('NGDUMP ERROR #', b, ': '+errorinfo[b]+', cannot proceed');
\r
181 if b < 3 then usage;
\r
185 procedure sllut(b:byte); {Error handler without exit, just indicating the error type}
\r
189 if b > 3 then close(f);
\r
190 writeln(' ',errorinfo[b],' - Press any key');
\r
194 function decrypt(b:byte):byte; {Decrypt byte from NG format}
\r
197 if ((b mod 32)>=16) then b := b-16 else b := b+16;
\r
198 if ((b mod 16)>=8) then b := b-8 else b := b+8;
\r
199 if ((b mod 4)>=2) then b := b-2 else b := b+2;
\r
202 decrypt := b xor (16+8+2); { this is somewhat more efficient... EVAS}
\r
205 function read_byte:byte; {Read and decrypt byte}
\r
209 bread(f, tb, 1, numread);
\r
210 read_byte := tb xor 26;
\r
213 function read_word:word; {Read and decrypt word}
\r
217 read_word := word(tb) or (word(read_byte) shl 8);
\r
220 function read_long:longint; {Read and decrypt longint}
\r
224 read_long := longint(tw) or (longint(read_word) shl 16);
\r
227 type BigStr = string[255];
\r
229 procedure read_string(maxlen:byte; var s:BigStr);
\r
237 until (c = 0) or (j = maxlen);
\r
241 procedure read_menu; {Read a menu structure into the menu buffer}
\r
242 var items,i,j:word;
\r
244 mennu[menunr,0].filptr := bpos(f)-2;
\r
246 items := read_word;
\r
247 itemlist[menunr] := items;
\r
249 for i := 1 to items-1 do begin
\r
250 mennu[menunr,i].filptr := read_long;
\r
252 bskip(f, items * 8);
\r
253 for i := 0 to items-1 do begin
\r
254 with mennu[menunr, i] do begin
\r
255 read_string( 40, name );
\r
261 procedure skip_short_long; {Skip procedure for the initial menu bseek}
\r
264 length := read_word;
\r
265 bskip(f, length + 22);
\r
268 procedure read_header(modf:byte); {Read NG file header and enter the guide name in the screen template}
\r
269 var buf : array[0..377] of byte;
\r
272 bread(f, buf, sizeof(buf), numread);
\r
273 if ((buf[0]<>ord('N')) or (buf[1]<>ord('G'))) then begin
\r
274 {If the two first characters in the file are not 'NG', the file is no guide}
\r
280 menuantal := buf[6];
\r
283 guidename[i+1] := chr(buf[i+8]);
\r
285 until (buf[i+8] = 0);
\r
286 guidename[0] := chr(i);
\r
288 ShowGuide( guidename );
\r
292 procedure read_menus(modf:boolean); {Initial menu bseek, indexing the whole file}
\r
297 if (id < 2) then begin
\r
300 else if (id = 2) then begin
\r
304 else if (id <> 5) then begin
\r
305 if (filesize(f) <> bpos(f)) then begin
\r
308 else sllut(5); {NG file error}
\r
314 if (menunr <> menuantal) then begin
\r
317 else sllut(6); {Incomplete file}
\r
321 function MakeName:Dos.PathStr;
\r
322 var fname:Dos.PathStr;
\r
325 str(Nfiles, fname);
\r
329 procedure OpenOutFile(n:word; s:Dos.PathStr);
\r
331 assign(outf[n], s); rewrite(outf[n]);
\r
332 SetTextBuf(outf[n], OutBuf[n]^, OutBufSize);
\r
335 procedure read_entry(level:byte; fp:longint); forward;
\r
337 procedure read_short_entry(level:byte);
\r
338 {Read short entry from file and wring some information out of it}
\r
339 var i, items: word;
\r
341 entrypos, subj_pos, p0, p : longint;
\r
344 items := read_word;
\r
347 subj_pos := p0 + longint(items) * 6;
\r
348 for i := 1 to items do begin
\r
350 entrypos := read_long;
\r
352 bseek(f, subj_pos);
\r
353 read_string( MaxLineLen, subject );
\r
354 subj_pos := bpos(f);
\r
355 write(outf[flevel], '!short:'); WriteString(subject);
\r
356 {} ShowShort(subject);
\r
357 read_entry(level+1, entrypos);
\r
362 procedure read_long_entry;
\r
363 {Read long entry information}
\r
364 const MaxSeeAlso = 20;
\r
365 var i, linens, dlength, seealso_num : word;
\r
369 linens := read_word;
\r
370 dlength := read_word;
\r
371 {} ShowLong(linens);
\r
372 bskip(f, 18); { 10 + links to prev/next entry (long's) }
\r
373 for i := 1 to linens do begin
\r
374 read_string( MaxLineLen, s );
\r
378 if dlength <> 0 then begin {If there are seealso entries, read them}
\r
379 seealso_num := read_word;
\r
380 { skip the offsets for the SeeAlso-items; }
\r
381 bskip(f, seealso_num * 4);
\r
382 { read the items; }
\r
383 for i := 1 to seealso_num do begin
\r
384 if i <= MaxSeeAlso then begin
\r
385 read_string( MaxLineLen, s );
\r
386 writeln(outf[flevel], '!seealso: "', s, '"');
\r
393 procedure read_entry(level:byte; fp:longint); {Read some kind of file entry}
\r
394 var id:word; fname:dos.pathstr;
\r
396 inc(numentries); ShowCount(numentries);
\r
401 if (level > 0) then begin
\r
403 writeln(outf[flevel], '!file: ',fname+'.NGO');
\r
406 assign(outf[flevel], 'CON'); rewrite(outf[flevel]);
\r
408 OpenOutFile(flevel, fname+'.DAT');
\r
410 read_short_entry(level);
\r
411 close(outf[flevel]);
\r
415 read_short_entry(level);
\r
420 if (level > 0) and (not odd(level)) then begin
\r
422 writeln(outf[flevel], '!long: ',fname+'.NGO');
\r
425 assign(outf[flevel], 'CON'); rewrite(outf[flevel]);
\r
427 OpenOutFile(flevel, fname+'.DAT');
\r
430 close(outf[flevel]);
\r
447 fname : Dos.PathStr;
\r
451 { create Menu Link Control File; }
\r
452 assign(linkf, 'GUIDE.LCF'); rewrite(linkf);
\r
453 writeln(linkf, '!name:'^i, guidename);
\r
456 for i := 0 to menuantal-1 do begin
\r
457 writeln(linkf, '!menu:'^i, mennu[i,0].name);
\r
458 ShowMenu(mennu[i,0].name);
\r
459 for j := 1 to itemlist[i]-1 do begin
\r
460 close(outf[flevel]);
\r
462 OpenOutFile(flevel, fname+'.dat');
\r
463 ShowMenu(mennu[i,j].name);
\r
464 writeln(linkf, ^i, mennu[i,j].name, ^i, fname+'.ngo');
\r
465 read_entry( 0, mennu[i,j].filptr );
\r
472 { write a makefile; }
\r
473 assign(linkf, 'MAKEGUID'); rewrite(linkf);
\r
474 writeln(linkf, '.dat.ngo:');
\r
475 writeln(linkf, ^i'ngc $<');
\r
477 write(linkf, 'OBJECTS=');
\r
479 for i := 1 to Nfiles do begin
\r
481 fname := fname + '.ngo ';
\r
482 write(linkf, fname);
\r
483 inc(j, length(fname));
\r
484 if (j > 65) then begin
\r
485 write(linkf, '\'^m^j^i);
\r
491 writeln(linkf, 'guide.ng: $(OBJECTS)');
\r
492 writeln(linkf, ^i'ngml guide.lcf');
\r
497 begin {Main loop and command-line parser}
\r
500 for i := 1 to MaxLevel do begin
\r
505 assign(outf[flevel], 'CON');
\r
507 assign(outf[flevel], 'GUIDE.DAT');
\r
509 rewrite(outf[flevel]);
\r
510 SetTextBuf(outf[flevel], OutBuf[flevel]^, OutBufSize);
\r
512 writeln(progname,' ',version,'. ',copyright,'.');
\r
513 initvars; {Initialize global variables}
\r
515 if ((paramstr(1)='/?') or (paramstr(1)='/h') or (paramstr(1)='/H')) then begin
\r
519 if (ParamCount <> 1) then begin
\r
523 streng := paramstr(1);
\r
525 if pos('.',streng)=0
\r
526 then streng := streng+'.NG'; {Expand file name}
\r
531 if ioresult<>0 then slutlort(3); {If file does not exist, terminate and write cause of death}
\r
536 ShowMenu('reading menu-info...');
\r
542 close(outf[flevel]);
\r