(* CVT.PAS -- access converted GEOS files
** Copyright (c) 1995,1996 Jochen Metzinger
**
** This program is free software; you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation; either version 2, or (at your option)
** any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

UNIT cvt;

INTERFACE

USES global, geos, errors, coding;

CONST
 CVT_EXT    = '.CVT'; (* default file extension *)
 MAX_BUFFER = 256*245-1; (* 256 blocks   254 bytes *)

TYPE
 BUFFER_PTR  = ^BUFFER_TYPE;
 BUFFER_TYPE = ARRAY [0..MAX_BUFFER] OF BYTE;

PROCEDURE cvt_open(fname: STRING);
(* open .cvt file *)

PROCEDURE cvt_close;
(* close it *)

PROCEDURE cvt_info(VAR i: InfoRec);
(* get info record *)

PROCEDURE cvt_class_version(VAR base: STRING; VAR version: BYTE);
(* get base class and version *)

PROCEDURE cvt_dir(VAR d: DirRec);
(* get directory entry *)

FUNCTION cvt_name: STRING;
(* return file name in directory entry [PC] *)

PROCEDURE cvt_vlir(VAR block: InfoRec);
(* get ``VLIR'' record *)

FUNCTION cvt_size(nr: BYTE): LongInt;
(* return chain length or -1 *)

PROCEDURE cvt_chain(nr: BYTE);
(* select a chain *)

FUNCTION cvt_buffer: BUFFER_PTR;
(* return pointer to chain buffer *)

PROCEDURE cvt_seek(pos: WORD);
(* set position in chain *)

FUNCTION cvt_pos: WORD;
(* get position in chain *)

PROCEDURE cvt_resize(len: LongInt);
(* resize current chain *)

PROCEDURE cvt_read(VAR buf; count: WORD; VAR result: WORD);
(* read from chain like BlockRead *)

FUNCTION cvt_eof: BOOLEAN;
(* end of chain? *)

FUNCTION cvt_getch(VAR ch: CHAR): BOOLEAN;
(* read a single char from chain, return success *)

IMPLEMENTATION

CONST
 BLOCK_SIZE = 254; (* size of a data block *)

TYPE
 CVT_BLOCK = ARRAY [0..BLOCK_SIZE-1] OF BYTE;

VAR
 (* the file *)
 cvt_file: FILE;
 dir: DirRec;
 info: InfoRec;
 chain_pos: ARRAY [0..126] OF RECORD off, len: LongInt; END;
 (* the chain and its buffer *)
 chain_nr: BYTE;
 position, soft_length, hard_length: LongInt;
 buffer: BUFFER_PTR;

PROCEDURE cvt_open(fname: STRING);
 VAR block: CVT_BLOCK; result: WORD;
  magic: STRING;
  chain: INTEGER; block_pos: LongInt;
  trk, sec, sec_last: BYTE;
BEGIN
 (* open file *)
 (*$I-*)
 Assign(cvt_file, AddExt(fname, CVT_EXT));
 FileMode := FileMode_RO;
 Reset(cvt_file,1);
 FileMode := FileMode_RW;
 IF IOResult <> 0 THEN FATAL('unable to open file');
 (*$I+*)
 (* handle header *)
 BlockRead(cvt_file, block, SizeOf(block), result);
 IF result <> SizeOf(block) THEN FATAL('not a converted file [size]');
 magic := GetString(block[30], 28);
 IF magic <> 'SEQ formatted GEOS file V1.0' THEN
  IF magic <> 'PRG formatted GEOS file V1.0' THEN
   FATAL('not a coverted file [magic]');
 Move(block[0], dir, SizeOf(dir));
 (* handle info record *)
 BlockRead(cvt_file, info, SizeOf(info), result);
 IF result <> SizeOf(info) THEN FATAL('corrupted converted file [size]');
 (* set up chain_pos[] *)
 FOR chain := 0 TO 126 DO
  WITH chain_pos[chain] DO BEGIN
   off := -1;
   len := -1;
  END; (* with *)
 IF dir.struct = 0 THEN
  (* Sequential structure *)
  WITH chain_pos[0] DO BEGIN
   off := 2*BLOCK_SIZE; (* after header/info *)
   len := FileSize(cvt_file) - off;
  END (* with *)
 ELSE
  (* chain_pos structure *)
  BEGIN
   BlockRead(cvt_file, block, SizeOf(block), result);
   IF result <> SizeOf(block) THEN FATAL('corrupted converted file [size]');
   block_pos := 3; sec_last := 1; (* after header/info/vlir *)
   FOR chain := 0 TO 126 DO BEGIN
    trk := block[2*chain]; sec := block[2*chain+1];
    IF trk > 0 THEN
     WITH chain_pos[chain] DO BEGIN
      off := BLOCK_SIZE*block_pos;
      len := BLOCK_SIZE*(trk-1) + (sec-1);
      Inc(block_pos, trk);
      sec_last := sec;
     END; (* with *)
   END; (* for *)
   IF FileSize(cvt_file) < BLOCK_SIZE*(block_pos-1) + (sec_last-1) THEN
    FATAL('corrupted converted file [size]');
  END; (* else *)
 chain_nr := $FF;
 position :=  0;
 soft_length := -1;
 hard_length := -1;
END; (* cvt_open *)

PROCEDURE cvt_close;
BEGIN
 chain_nr := $FF;
 position :=  0;
 soft_length := -1;
 hard_length := -1;
 Close(cvt_file);
END; (* cvt_close *)

PROCEDURE cvt_info(VAR i: InfoRec);
BEGIN
 i := info;
END; (* cvt_info *)

PROCEDURE cvt_class_version(VAR base: STRING; VAR version: BYTE);
 VAR pos: INTEGER;
BEGIN
 (* raw results *)
 base := TermString(info.class, #0);
 version := 0;
 (* ending with ' [0-9].[0-9]' *)
 pos := Length(base) - 4;
 IF pos <= 0 THEN EXIT;
 IF base[pos+0] <> ' ' THEN EXIT;
 IF base[pos+1] <> 'V' THEN EXIT;
 IF base[pos+2] <  '0' THEN EXIT;
 IF base[pos+2]  > '9' THEN EXIT;
 IF base[pos+3] <> '.' THEN EXIT;
 IF base[pos+4] <  '0' THEN EXIT;
 IF base[pos+4]  > '9' THEN EXIT;
 (* calculate 10 times version *)
 version := 10*(BYTE(base[pos+2])-BYTE('0'))+BYTE(base[pos+4])-BYTE('0');
 (* remove this and ending spaces *)
 REPEAT
  DEC(pos);
 UNTIL base[pos] <> ' ';
 Delete(base, pos+1, $FF);
END; (* cvt_class_version *)

PROCEDURE cvt_dir(VAR d: DirRec);
BEGIN
 d := dir;
END; (* cvt_dir *)

FUNCTION cvt_name: STRING;
BEGIN
 cvt_name := TransStr(TermString(dir.name, #$A0));
END; (* cvt_name *)

PROCEDURE cvt_vlir(VAR block: InfoRec);
 VAR result: WORD;
BEGIN
 IF dir.struct = 0 THEN
  FillChar(block, SizeOf(block), 0)
 ELSE BEGIN
  Seek(cvt_file, 2*BLOCK_SIZE);
  BlockRead(cvt_file, block, SizeOf(block), result);
  IF result <> SizeOf(block) THEN FATAL('read');
 END; (* else *)
END; (* cvt_vlir *)

FUNCTION cvt_size(nr: BYTE): LongInt;
BEGIN
 IF nr > 126
  THEN cvt_size := -1
  ELSE cvt_size := chain_pos[nr].len;
END; (* cvt_size *)

PROCEDURE cvt_chain(nr: BYTE);
 VAR result: WORD;
BEGIN
 position :=  0;
 hard_length := cvt_size(nr);
 IF hard_length < 0 THEN
  chain_nr := $FF
 ELSE BEGIN
  chain_nr := nr;
  (*$I-*)
  Seek(cvt_file, chain_pos[chain_nr].off);
  IF IOResult <> 0 THEN FATAL('seek');
  (*$I+*)
  BlockRead(cvt_file, buffer^, hard_length, result);
  IF result <> hard_length THEN FATAL('read');
  position := 0;
 END; (* else *)
 soft_length := hard_length;
END; (* cvt_chain *)

FUNCTION cvt_buffer: BUFFER_PTR;
BEGIN
 cvt_buffer := buffer;
END; (* cvt_buffer *)

FUNCTION cvt_pos: WORD;
BEGIN
 cvt_pos := position;
END; (* cvt_pos *)

PROCEDURE cvt_seek(pos: WORD);
BEGIN
 position := pos;
END; (* cvt_seek *)

PROCEDURE cvt_resize(len: LongInt);
BEGIN
 IF len < 0           THEN len := 0;
 IF len > hard_length THEN len := hard_length;
 soft_length := len;
END; (* cvt_resize *)

PROCEDURE cvt_read(VAR buf; count: WORD; VAR result: WORD);
 VAR max_count: LongInt;
BEGIN
 max_count := soft_length - position;
 IF max_count <= 0 THEN
  result := 0
 ELSE BEGIN
  IF count > max_count THEN
   count := max_count;
  Move(buffer^[position], buf, count);
  Inc(position, count);
  result := count;
 END; (* else *)
END; (* cvt_read *)

FUNCTION cvt_eof: BOOLEAN;
BEGIN
 cvt_eof := (position >= soft_length);
END; (* cvt_eof *)

FUNCTION cvt_getch(VAR ch: CHAR): BOOLEAN;
 VAR result: WORD;
BEGIN
 IF position >= soft_length THEN
  cvt_getch := FALSE
 ELSE BEGIN
  ch := CHAR(buffer^[position]);
  INC(position);
  cvt_getch := TRUE;
 END; (* else *)
END; (* cvt_getch *)

BEGIN
 New(buffer);
END. (* cvt *)