{$X+}

program tarzan;
{ Utility per estrarre dati dalla Bibbia (un'evoluzione di CITA) }

uses
  Dos, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg, MsgBox, App,
  Gadgets,ucita,  FViewer;

const cmFOpen        = 200;    hcFOpen      = 1200;
      cmPasso        = 201;    hcPasso      = 1201;
      cmSetFormat    = 202;    hcSetFormat  = 1202;
      cmAbout        = 203;    hcAbout      = 1203;
      cmSetOutput    = 204;    hcSetOutput  = 1204;
      cmEstrai       = 205;    hcEstrai     = 1205;
      cmChDir        = 206;    hcChDir      = 1206;
      cmView         = 207;    hcView       = 1207;
                               hcQuit       = cmQuit + 1000;


type PCitaStatusLine = ^TCitaStatusLine;
     TCitaStatusLine = object(TStatusLine)
       function hint(Ahelpctx : word) : string; virtual;
       end;

     TCita = object(TApplication)
       libro,outfile : pathstr;
       passo : TPasso;
       modo : word;
       clock : PClockView;
       constructor init;
       procedure FileOpen(WildCard: PathStr; Aname : string; var Selected : pathstr);
       procedure HandleEvent(var Event: TEvent); virtual;
       procedure idle; virtual;
       procedure initmenubar; virtual;
       procedure initstatusline; virtual;
       procedure About;
       end;


constructor TCita.Init;
var  R: TRect;
begin
TApplication.Init;
RegisterObjects;
RegisterViews;
RegisterMenus;
RegisterDialogs;
RegisterApp;

GetExtent(R);
R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
Clock := New(PClockView, Init(R));
Insert(Clock);
modo := mtesto;
outfile := 'tarzan.txt';
with passo do begin
  vi := '1';
  vf := '1';
  ci := '1';
  cf := '1';
  end;
About;
end;

procedure TCita.FileOpen(WildCard: PathStr; Aname : string; var Selected : pathstr);
var
  D: PFileDialog;
begin
  D := New(PFileDialog, Init(WildCard, Aname,
    '~N~ome', fdOpenButton, 100));
  D^.HelpCtx := hcNoContext;
  if ValidView(D) <> nil then
  begin
    if Desktop^.ExecView(D) <> cmCancel then D^.GetFileName(Selected);
    Dispose(D, Done);
  end;
end;

procedure Tcita.About;
var
  D: PDialog;
  Control: PView;
  R: TRect;
begin
  R.Assign(0, 0, 40, 11);
  D := New(PDialog, Init(R, 'Questo Programma'));
  with D^ do
  begin
    Options := Options or ofCentered;

    R.Grow(-1, -1);
    Dec(R.B.Y, 3);
    Insert(New(PStaticText, Init(R,
      #13 +
      ^C'CASASOFT Tarzan 1.00'#13 +
      #13 +
      ^C'Copyright (c) 1991,1992'#13 +
      #13 +
      ^C'Roberto Ceccarelli')));

    R.Assign(15, 8, 25, 10);
    Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  end;
  if ValidView(D) <> nil then
  begin
    Desktop^.ExecView(D);
    Dispose(D, Done);
  end;
end;

procedure TCita.HandleEvent(var Event: TEvent);

  procedure ChangeDir;
  var D: PChDirDialog;
  begin
  D := New(PChDirDialog, Init(cdNormal, 101));
  if ValidView(D) <> nil then begin
    DeskTop^.ExecView(D);
    Dispose(D, Done);
    end;
  end;

  procedure ModoOut;
  var d : PDialog;
      r : TRect;
      b : PCluster;
      control : word;
  begin
    R.Assign(0, 0, 40, 11);
    D := New(PDialog, Init(R, 'Modalit� di output'));
    with D^ do
    begin
      Options := Options or ofCentered;

      r.assign(5,3,35,6);
      b := new(PRadioButtons,init(r,
        newsitem('~A~SCII - IBM',
        newsitem('~V~entura Publisher',
        newsitem('~W~ordstar', nil)))
        ));
      insert(b);
      r.assign(5,2,35,3);
      insert(new(PLabel,init(r,'Formati Output',b)));

      R.Assign(27, 8, 37, 10);
      Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
      R.Assign(15, 8, 25, 10);
      Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
    end;
    if ValidView(D) <> nil then
    begin
      d^.setdata(modo);
      control := Desktop^.ExecView(D);
      if control <> cmCancel then d^.getdata(modo);
      Dispose(D, Done);
    end;
  end;

  procedure Versetti;
  var d : PDialog;
      r : TRect;
      b : PInputLine;
      control : word;
  begin
    R.Assign(0, 0, 39, 10);
    D := New(PDialog, Init(R, 'Selezione passo'));
    with D^ do
    begin
      Options := Options or ofCentered;

      r.assign(13,2,18,3);
      b := new(PInputLine,init(r,3));
      insert(b);
      r.assign(2,2,12,3);
      insert(new(PLabel,init(r,'~C~ap. In.',b)));

      r.assign(31,2,36,3);
      b := new(PInputLine,init(r,3));
      insert(b);
      r.assign(20,2,30,3);
      insert(new(PLabel,init(r,'Ver. ~I~n.',b)));

      r.assign(13,4,18,5);
      b := new(PInputLine,init(r,3));
      insert(b);
      r.assign(2,4,12,5);
      insert(new(PLabel,init(r,'Cap. ~F~in.',b)));

      r.assign(31,4,36,5);
      b := new(PInputLine,init(r,3));
      insert(b);
      r.assign(20,4,30,5);
      insert(new(PLabel,init(r,'~V~er. Fin.',b)));

      R.Assign(25, 7, 35, 9);
      Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
      R.Assign(13, 7, 23, 9);
      Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
    end;
    if ValidView(D) <> nil then
    begin
      d^.setdata(passo);
      control := Desktop^.ExecView(D);
      if control <> cmCancel then d^.getdata(passo);
      Dispose(D, Done);
    end;
  end;

  procedure Estrai;
  var  R : TRect;
       D : PDialog;
  begin
  R.Assign(0, 0, 50, 11);
  d := new(PDialog,Init(R, 'Estrazione del passo'));
  d^.Options := d^.Options or ofCentered;

  R.Grow(-2, -2);
  R.B.Y := R.A.Y + 1;
  d^.Insert(New(PStaticText, Init(R,'Libro : '+libro)));
  R.move(0,1);
  with passo do
    d^.Insert(New(PStaticText, Init(R,'Da '+ci+'.'+vi+' a '+cf+'.'+vf)));
  R.move(0,2);
  d^.Insert(New(PStaticText, Init(R,'Destinazione : '+outfile)));
  R.move(0,1);
  Case modo of
    mVentura : d^.Insert(New(PStaticText, Init(R,'Modalit�     : Ventura')));
    mWordstar : d^.Insert(New(PStaticText, Init(R,'Modalit�     : Wordstar')));
    mTesto : d^.Insert(New(PStaticText, Init(R,'Modalit�     : ASCII')));
    end;
  R.Assign(35, 8, 45, 10);
  d^.Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  R.move(-12,0);
  d^.Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
  if ValidView(D) <> nil then begin
    case Desktop^.ExecView(D) of
      cmOK,cmDefault : cercapasso(libro,Outfile,passo,modo);
      end;
    Dispose(D, Done);
    end;
  end;

  procedure ViewFile;
  var W: PWindow;
      filename : PathStr;
  begin
  filename := '';
  FileOpen('*.*','File da visionare',filename);
  if filename = '' then exit;
  W := New(PFileWindow,Init(FileName));
  if ValidView(W) <> nil then
    Desktop^.Insert(W);
  end;

begin
  TApplication.HandleEvent(Event);
  case Event.What of
    evCommand:
      begin
        case Event.Command of
          cmFOpen: FileOpen('*.doc','Scelta del Libro',libro);
          cmAbout: About;
          cmSetFormat : ModoOut;
          cmPasso  : Versetti;
          cmSetOutput : FileOpen('*.txt','File di uscita',outfile);
          cmEstrai : Estrai;
          cmChDir : ChangeDir;
          cmView : ViewFile;
          else Exit;
        end;
        ClearEvent(Event);
      end;
  end;
end;

procedure TCita.Idle;

begin
  TApplication.Idle;
  Clock^.Update;
end;

procedure TCita.InitMenuBar;
var
  R: TRect;
begin
  GetExtent(R);
  R.B.Y := R.A.Y+1;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewSubMenu('~'#240'~', hcNoContext, NewMenu(
      NewItem('~Q~uesto programma', '', kbNoKey, cmAbout, hcAbout,nil)),
    NewSubMenu('~F~ile', hcNoContext, NewMenu(
      NewItem('~C~ambio directory', '', kbNoKey, cmChDir, hcChDir,
      NewItem('~V~edi file', '', kbNoKey, cmView, hcView,
      NewLine(
      NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcQuit, nil))))),
    NewSubMenu('~R~icerca', hcNoContext, NewMenu(
      NewItem('~L~ibro...', 'Alt-L', kbAltL, cmFOpen, hcFOpen,
      NewItem('~P~asso...', 'Alt-P', kbAltP, cmPasso, hcPasso, nil))),
    NewSubMenu('~O~pzioni', hcNoContext, NewMenu(
      NewItem('~F~ormato...', '', kbNoKey, cmSetFormat, hcSetFormat,
      NewItem('~O~utput...', '', kbNoKey, cmSetOutput, hcSetOutput,
      NewLine(
      NewItem('~E~strazione', 'Alt-E', kbAltE, cmEstrai, hcEstrai,nil))))),
    nil))))
  )));
end;

procedure TCita.InitStatusLine;
var
  R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PCitaStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu,
      NewStatusKey('~Alt-X~ Uscita', kbAltX, cmQuit, nil)), nil)));
end;


function TCitaStatusLine.hint(AHelpCtx : word) : string;
begin
hint := '';
case AHelpCtx of
  hcFOpen      : hint := 'Selezionare il file con il libro desiderato';
  hcPasso      : hint := 'Selezionare il passo richiesto';
  hcSetFormat  : hint := 'Scelta del formato di uscita';
  hcAbout      : hint := 'Importanti notizie su questo programma';
  hcSetOutput  : hint := 'Nome del file di uscita';
  hcEstrai     : hint := 'Estrazione del passo richiesto';
  hcQuit       : hint := 'Uscita dal programma';
  hcChDir      : hint := 'Seleziona directory di default';
  hcView       : hint := 'Per vedere il contenuto di un file';
  end;
end;

var tz : TCita;

begin
tz.init;
tz.run;
tz.done;
end.

unit ucita;
{ Unit contenente le routines del programma cita }

interface

const mtesto = 0;
      mventura = 1;
      mwordstar = 2;

type TPasso = record
       ci,vi,cf,vf : string[3];
       end;

procedure cercapasso(filein,fileout : string; passo : TPasso; mode : word);

implementation

uses objects,crt;

type TOutText = object(TBufStream)
       outmode : word;
       constructor init(Aname : string; Amode : word);
       procedure scrivi(c : char);
       end;

var ins : TBufStream;
    out : TOutText;
    c : char;
    pp : boolean;
    p : byte;


constructor TOutText.init(Aname : string; Amode : word);
begin
TBufStream.init(Aname,stCreate,2048);
TBufStream.done;
TBufStream.init(Aname,stOpenWrite,2048);
outmode := Amode;
end;

procedure TOutText.scrivi(c : char);
var s : string;
begin
if ord(c) > 127 then case outmode of
  mwordstar : s := #$1b+c+#$1c;
  mventura  : begin
              str(byte(c),s);
              s := '<'+s+'>';
              end;
  else s := c;
  end
else s := c;
write(s[1],length(s));
end;

function findmarker : string;
var s : string;
begin
s := '';
repeat
  ins.read(c,sizeof(char));
  if pp then out.scrivi(c);
  until (c = ^Z) or (c = '[' );
if c <> ^Z then repeat
  ins.read(c,sizeof(char));
  if pp then out.scrivi(c);
  s := s + c;
  until (c = ^Z) or (c = ']' );
dec(s[0]);
findmarker := s;
end;

procedure chapter(s : string);
begin
repeat until (findmarker = 'CC'+ copy('00'+s,length(s),255)) or (c = ^Z);
end;

procedure findversetto(n : word);
var test : word;
    err : integer;
begin
repeat
  val(findmarker,test,err);
  if err <> 0 then exit;
  until test = n;
end;

procedure versetto(s : string);
var n : word;
    err : integer;
begin
val(s,n,err);
findversetto(n);
end;

procedure lastversetto(s : string);
var n : word;
    err : integer;
begin
val(s,n,err);
findversetto(n+1);
end;

procedure PrintPasso(ic,iv,fc,fv : string);
begin
chapter(ic);
versetto(iv);
pp := true;
if ic <> fc then chapter(fc);
lastversetto(fv);
pp := false;
writeln;
end;

procedure cercapasso(filein,fileout : string; passo : TPasso; mode : word);
begin
ins.init(filein,stOpenRead,32000);
if ins.status <> stOk then exit;
out.init(fileout,mode);
pp := false;
with passo do PrintPasso(ci,vi,cf,vf);
out.done;
ins.done;
end;

end.