path: root/app/conversion/1.0/src/ASKCNVRS.PAC

PACKET asksam conversion DEFINES append asksam field,
                                 append asksam record,
                                 convert to asksam :
LET card prefix = " +--",
    bo field    = "[ ",
    eo field    = " ]",
    eo line     = ""13""10"",
    eo record   = ""0"",
    eo doc      = ""0""0"",
    dummy fn    = "@";
LET max fields  = 50;
TEXT VAR in l, out l, appended l, asksam record, buffer;
INT VAR card no, in line no, out line no, last named field,
        start pos, end pos, card lines, first line;
FILE VAR f in, f out;
THESAURUS VAR field names;
ROW max fields BOOL VAR complex fields,
                        to be copied;
PROC convert to asksam (TEXT CONST input file) :
  IF NOT exists (input file) THEN errorstop ("") FI;
  TEXT CONST output file := dos file name (input file, "sam");
  forget (output file);
  f out := sequential file (output, output file);
  field names := empty thesaurus;
  IF input is eudas
     THEN convert eudas to asksam (input file)
  ELIF input is cardbox
     THEN convert cardbox to asksam
  ELSE stop process
  FI
.
input is eudas :
  type (old (input file)) = 3243
.
input is cardbox :
  IF type (old (input file)) = 1003
     THEN f in := sequential file (modify, input file);
          toline (f in, 1);
          down (f in, ""26""26"");
          pattern found
     ELSE FALSE
  FI
.
stop process :
  forget (output file, quiet);
  errorstop ("Konversion nur f"219"r EUDAS- und Cardbox-Dateien m"218"glich.")
END PROC convert to asksam;
PROC convert eudas to asksam (TEXT CONST file name) :
  oeffne (file name, FALSE);
  get field names;
  WHILE NOT dateiende REP
    transfer one record;
    weiter (1)
  PER;
  dateien loeschen (FALSE)
.
get field names :
  asksam record := "";
  last named field := anzahl felder;
  auf satz (1);
  FOR in line no FROM 1 UPTO last named field REP
    feld lesen (in line no, in l);
    IF in l <> ""
       THEN to be copied [in line no] := TRUE;
            complex fields [in line no] := is complex field;
            append field name (in l);
            feldnamen lesen (in line no, in l);
            append asksam field (in l)
       ELSE to be copied [in line no] := FALSE;
            append field name (dummy fn)
    FI
  PER;
  append asksam record;
  weiter (1)
.
is complex field :
  end pos := pos (in l, "{");
  IF end pos <> 0
     THEN end pos DECR 1;
          WHILE (in l SUB end pos) = " " REP
            end pos DECR 1
          PER;
          in l := subtext (in l, 1, end pos);
          TRUE
     ELSE FALSE
  FI
.
transfer one record :
  cout (satznummer);
  asksam record := "";
  out line no := 0;
  transfer fields;
  append asksam record
.
transfer fields :
  FOR in line no FROM 1 UPTO last named field REP
    IF to be copied [in line no] 
       THEN feld lesen (in line no, in l);
            IF in l <> ""
               THEN IF complex fields [in line no]
                       THEN transfer complex field (in l)
                       ELSE append asksam field (in l)
                    FI
            FI
    FI
  PER
END PROC convert eudas to asksam;
PROC transfer complex field (TEXT CONST l) :
  TEXT VAR transfer buffer;
  start pos := 1;
  REP
    start pos INCR 1;
    end pos := pos (l, "{", start pos + 1);
    IF end pos = 0
       THEN end pos := LENGTH l
       ELSE end pos DECR 1
    FI;
    WHILE (l SUB end pos) = " " REP
      end pos DECR 1
    PER;
    transfer buffer := subtext (l, start pos, end pos);
    change (transfer buffer, "}", "");
    append asksam field (transfer buffer);
    start pos := pos (l, "{", end pos)
  UNTIL start pos = 0 PER
END PROC transfer complex field;
PROC convert cardbox to asksam :
  BOOL VAR line end;
  ascertain number lines per card;
  convert file;
.
ascertain number lines per card :
  toline (f in, 1);
  col (f in, 1);
  downety (f in, card prefix);
  first line := line no (f in);
  down (f in, card prefix);
  card lines := line no (f in) - first line
.
convert file :
  line;
  input (f in);
  get field names;
  card no := 0;
  WHILE NOT eof (f in) REP
    transfer one card
  UNTIL asksam record = "" PER
.
get field names :
  last named field := 0;
  getline (f in, in l);
  get names from first lines;
  get names from bulk;
.
get names from first lines :
  FOR in line no FROM 1 UPTO card lines - 2 REP
    get cardbox line (in l);
    in l := compress (in l);
    IF in l > ""
       THEN append field name (in l);
            last named field := in line no
       ELSE append field name (dummy fn)
    FI
  PER;
.
get names from bulk :
  in line no := card lines - 2;
  get cardbox line (in l);
  end pos := 0;
  REP
    get card line (appended l, line end);
    IF line end
       THEN LEAVE get names from bulk
    ELIF appended l <> ""
       THEN in line no INCR 1;
            append field name (compress (appended l));
            last named field INCR 1
    FI;
  PER
END PROC convert cardbox to asksam;
PROC transfer one card :
  BOOL VAR line end;
  card no INCR 1;
  cout (card no);
  asksam record := "";
  transfer first lines;
  transfer bulk line;
  append asksam record
.
transfer first lines :
  getline (f in, in l);
  IF pos (in l, card prefix) <> 2
     THEN errorstop ("Programmfehler 1")
  ELIF pos (in l, "LAST CARD") <> 0
     THEN LEAVE transfer one card
  FI;
  out line no := 0;
  FOR in line no FROM 1 UPTO card lines - 2 REP
    get cardbox line (in l);
    IF pos (in l, ""25""25"") = 1
       THEN process hypertext
       ELSE append asksam field (in l)
    FI;
  PER
.
process hypertext :
  asksam record CAT ":"13""10""9"";
  end pos := pos (in l, ".card") - 1;
  appended l := subtext (in l, 55, end pos);
  asksam record CAT appended l;
  asksam record CAT ""255""13""10""13""10"";
  asksam record CAT "(Datei zum Thema `";
  asksam record CAT appended l;
  asksam record CAT "')"13""10"";
  out line no := 4
.
transfer bulk line :
  get cardbox line (in l);
  end pos := 0;
  first line := 0;
  in line no DECR 1;
  REP
    get card line (appended l, line end);
    IF line end
       THEN LEAVE transfer bulk line
    FI;
    in line no INCR 1;
    cout (in line no);
    append asksam field (appended l)
  PER
END PROC transfer one card;
PROC get cardbox line (TEXT VAR t) :
  getline (f in, t);
  start pos := pos (t, "|");
  IF start pos = 0
     THEN errorstop ("Programmfehler 2")
  FI;
  t := subtext (t, start pos + 1)
END PROC get cardbox line;
PROC get card line (TEXT VAR t, BOOL VAR end) :
  start pos := pos (in l, ""32"", ""255"", endpos + 1);
  IF start pos = 0
     THEN end := TRUE;
          LEAVE get card line
  FI;
  end pos := pos (in l, ""26"", start pos);
  IF end pos = 0     
     THEN end := TRUE;
          LEAVE get card line
  FI;
  end pos DECR 1;
  t := subtext (in l, start pos, end pos);
  end := FALSE
END PROC get card line;
PROC append asksam line (TEXT CONST t) :
  asksam record CAT t;
  out line no INCR 1;
  IF out line no MOD 20 = 0
     THEN asksam record CAT eo record
     ELSE asksam record CAT eo line
  FI
END PROC append asksam line;
PROC append asksam field (TEXT CONST t) :
  BOOL VAR named field;
  INT VAR s pos, e pos, length l;
  IF t > " " CAND in line no <= last named field
     THEN get field name (in line no, out l);
          IF out l <> dummy fn
             THEN out l CAT bo field;
                  named field := TRUE
             ELSE out l := "";
                  named field := FALSE
          FI
     ELSE out l := "";
          named field := FALSE
  FI;
  buffer := t;
  prepare line for asksam (buffer);
  out l CAT buffer;
  transfer line
.
transfer line :
  length l := LENGTH out l;
  e pos := -1;
  REP
    s pos := e pos + 2;
    IF (length l - s pos) > 79
       THEN determine e pos;
            transfer chunk
       ELSE transfer rest
    FI
  PER
.
determine e pos :
  e pos := s pos + 79;
  move before last blank
.
move before last blank :
  WHILE (out l SUB e pos) <> " " REP
    e pos DECR 1
  UNTIL e pos = s pos PER;
  IF e pos = s pos
     THEN e pos := s pos + 79
     ELSE e pos DECR 1
  FI
.
transfer chunk :
  append asksam line (subtext (out l, s pos, e pos));
.
transfer rest :
  buffer := subtext (out l, s pos);
  IF named field
     THEN buffer CAT eo field
  FI;
  append asksam line (buffer);
  LEAVE transfer line
END PROC append asksam field;
PROC append asksam record :
  IF was eo record
     THEN asksam record CAT eo record
     ELSE buffer := subtext (asksam record, 1, LENGTH asksam record - 2);
          buffer CAT eo doc;
          asksam record := buffer
  FI;
  putline (f out, asksam record)
.
was eo record :
  out line no MOD 20 = 0
END PROC append asksam record;
PROC prepare line for asksam (TEXT VAR t) :
  IF (t SUB LENGTH t) = " "
     THEN t := subtext (t, 1, LENGTH t - 1)
  FI;
  replace eumel special characters (t);
  change all (t, "[", ""174"");
  change all (t, "]", ""175"");
  change all (t, "#on(""i"")#", "<I>");
  change all (t, "#off(""i"")#", "<i>")
END PROC prepare line for asksam;
PROC append field name (TEXT CONST fn) :
  INT VAR index;
  buffer := fn;
  prepare line for asksam (buffer);
  insert (field names, buffer, index)
END PROC append field name;
PROC get field name (INT CONST index, TEXT VAR fn) :
  fn := name (field names, index)
END PROC get field name;
END PACKET asksam conversion;