Frozen Fish 1: Amiga/FrozenFish-Apr94.iso/bbs/alib/d9xx/d923/rawinsert.lha/RawInsert/RawInsert.mod

Text File | 1993-10-07 | 5KB | 175 lines

(* --------------------------------------------------------------------------
  :Program.       RawInsert.mod
  :Contents.      Inserts text or other input events into the input stream
  :Author.        Franz Schwarz
  :Copyright.     Public Domain
  :Language.      Oberon-2
  :Translator.    Amiga Oberon 3.00
  :History.       v1.0 25-Jul-93 fSchwarz
  :Address.       Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
  :Address.       uucp: [e-mail]; Fido: 2:241/7506.18
  :Support.       CxLib (replacement for Commodore's cx.lib), BlackMagic
  :Remark.        Amiga-Oberon 3.00 checks string pointers to be even if
  :Remark.        OddChk is enabled; thus don't compile with OddChk.
  :Usage.         "DELAY=MILLISECS=MS/K/N,DESCR=D/S,FROM=FILE/K,TEXT/F"
-------------------------------------------------------------------------- *)

MODULE RawInsert;

IMPORT
  I: Intuition, inpe: InputEvent, co: Commodities, d: Dos, e: Exec,
  t: Timer, cx: CxLib, a: ASCII, o: OberonLib, y: SYSTEM, b: BlackMagic;

CONST

  defaultMicros = 2 * 1000;

  chkStep = LONGSET{0..9};

  verTag = "\000$VER: RawInsert 1.0 (25.7.93) (w) [e-mail] - PD";

  templ = "DELAY=MILLISECS=MS/K/N,DESCR=D/S,FROM=FILE/K,TEXT/F";

TYPE
  ArgsT = STRUCT
    delay: UNTRACED POINTER TO LONGINT;
    descr: LONGINT;
    from : b.LStrPtr;
    text : b.LStrPtr;
  END;

VAR
  mp     : e.MsgPortPtr;
  tr     : t.TimeRequestPtr;
  iep    : inpe.InputEventPtr;
  rda    : d.RDArgsPtr;
  Args   : ArgsT;
  fh,fh1 : d.FileHandlePtr;
  i,lc   : LONGINT;
  micros : LONGINT;
  devopn : BOOLEAN;
  cb     : ARRAY 2 OF CHAR;
  ds     : b.DynStrPtr;
  ls     : b.LStrPtr;
  chkstep: LONGSET;

PROCEDURE CleanUp();
BEGIN
  cx.FreeIEvents (iep);
  IF ds # NIL THEN DISPOSE (ds); END;
  IF fh1 # NIL THEN d.OldClose (fh1); END;
  IF rda # NIL THEN d.FreeArgs (rda); END;
  IF devopn THEN e.CloseDevice (tr); END;
  IF tr # NIL THEN e.DeleteIORequest (tr); END;
  IF mp # NIL THEN e.DeleteMsgPort (mp); END;
  IF o.Result > d.warn THEN
    IF o.wbStarted OR (d.dos.lib.version < 37) THEN
      I.DisplayBeep (NIL);
    ELSE
      d.PrintF ("%s failed!\n", y.ADR (verTag [7]));
    END;
  END;
END CleanUp;

PROCEDURE Halt ();
BEGIN
  o.HaltProc();
END Halt;

PROCEDURE PutIEvents (ie: inpe.InputEventPtr);
VAR
  ie1: inpe.InputEventPtr;
BEGIN
  WHILE ie # NIL DO
    IF d.ctrlC IN d.CheckSignal (LONGSET{d.ctrlC}) THEN
      y.SETREG (0, d.SetIoErr (d.break)); o.Result := d.fail; Halt();
    END;
    ie1 := ie.nextEvent;
    ie.nextEvent := NIL;
    co.AddIEvents (ie);
    ie.nextEvent := ie1;
    tr.time.secs := 0; tr.time.micro := micros;
    tr.node.command := t.addRequest; e.OldDoIO (tr);
    ie := ie.nextEvent;
  END;
END PutIEvents;

PROCEDURE PutCh (ch: LONGINT);
BEGIN
  cb[0] := CHR (ch);
  iep := cx.InvertStringForwd (cb, NIL);
  IF iep = NIL THEN o.Result := d.warn; END;
  PutIEvents (iep);
  cx.FreeIEvents (iep);
END PutCh;

BEGIN
  o.Result := d.fail; micros := defaultMicros;
  IF (co.base = NIL) OR (d.dos.lib.version < 37) OR o.wbStarted THEN Halt(); END;
  mp := e.CreateMsgPort();
  tr := e.CreateIORequest (mp, SIZE (tr^));
  IF tr = NIL THEN Halt(); END;
  devopn := e.OpenDevice (t.timerName, t.microHz, tr, LONGSET{}) = 0;
  IF ~devopn THEN Halt(); END;
  rda := d.ReadArgs (templ, Args, NIL);
  IF rda = NIL THEN Halt(); END;
  IF (Args.text # NIL) & (Args.from # NIL) THEN
    y.SETREG (0, d.SetIoErr (d.tooManyArgs)); Halt();
  END;
  IF (Args.delay # NIL) THEN
    IF (Args.delay^ < 0) OR (Args.delay^ > 999) THEN
       y.SETREG (0, d.SetIoErr (d.badNumber)); Halt();
    END;
    micros := Args.delay^ * 1000;
  END;
  IF micros < 0 THEN Halt(); END;

  IF Args.text # NIL THEN
    ls := Args.text;
  ELSE
    IF Args.from # NIL THEN
      fh1 := d.Open (Args.from^, d.oldFile); fh := fh1;
    ELSE
      fh := d.Input();
    END;
    IF fh = NIL THEN Halt(); END;
    IF d.IsInteractive (fh) THEN chkstep := LONGSET {}; ELSE chkstep := chkStep; END;
    i := 0;
    REPEAT
      IF y.VAL (LONGSET, i) * chkstep = LONGSET {} THEN
        b.SetDynamicExtra (i+512);
        IF d.ctrlC IN d.CheckSignal (LONGSET{d.ctrlC}) THEN
          y.SETREG (0, d.SetIoErr (d.break)); Halt();
        END;
      END;
      IF ~b.DynExpand (ds, i) THEN Halt(); END;
      lc := d.FGetC (fh);
      IF lc > 0 THEN
        ds[i] := CHR (lc);
        INC (i);
      END;
    UNTIL lc < 0;
    ds[i] := '\000';
    IF d.IoErr() # 0 THEN Halt(); END;
    ls := b.StrIndex (ds^, 0);
  END;

  IF Args.descr # 0 THEN
    iep := cx.InvertStringForwd (ls^, NIL);
    IF iep = NIL THEN Halt() END;
    PutIEvents (iep);
    o.Result := d.ok;
  ELSE
    o.Result := d.ok; i := 0;
    WHILE ls[i] # a.nul DO
      PutCh (ORD (ls[i]));
      INC (i);
    END;
  END;

CLOSE
  CleanUp();

END RawInsert.