MODULE CBText;

IMPORT ClipBoard,
       Exec,
       ExecSupport,
       Dos,
       OberonLib,
       str := Strings,
       sys := SYSTEM;

VAR
  cbIO: ClipBoard.IOClipReqPtr;
  cbMP: Exec.MsgPortPtr;
  cbOpen: BOOLEAN;


(* ------  Cut Text:  ------ *)


PROCEDURE Cut*(from: ARRAY OF CHAR; length: LONGINT): BOOLEAN;
(* writes length bytes of text from to the console. Adds that IFF-Stuff
 * automatically.
 * result = success
 *)

VAR
  init: STRUCT
          form: ARRAY 4 OF CHAR;
          len1: LONGINT;
          ftxtchrs: ARRAY 8 OF CHAR;
          len2: LONGINT;
        END;

  odd: LONGINT;

  PROCEDURE Write(from: Exec.APTR; length: LONGINT): BOOLEAN;
  BEGIN
    cbIO.command := Exec.write;
    cbIO.data := from;
    cbIO.length := length;
    Exec.OldDoIO(cbIO);
    RETURN cbIO.error=0;
  END Write;

(* $CopyArrays- *)

BEGIN

  IF cbOpen AND (length>0) THEN

    odd := 0;
    IF ODD(length) THEN odd := 1 END;

    cbIO.offset := 0;
    cbIO.clipID := 0;

    init.form := "FORM";
    init.ftxtchrs := "FTXTCHRS";
    init.len1 := length + 12 + odd;
    init.len2 := length + odd;
    IF Write(sys.ADR(init),SIZE(init)) AND Write(sys.ADR(from),length) AND
       ((odd=0) OR Write(sys.ADR("\o"),1)) THEN
      cbIO.command := Exec.update;
      Exec.OldDoIO(cbIO);
      RETURN cbIO.error=0;
    END;

  END;

  RETURN FALSE;

END Cut;


(* ------  Paste Text:  ------ *)


PROCEDURE Paste*(VAR len: LONGINT; VAR buffer: Exec.APTR): BOOLEAN;         (* $CopyArrays- *)
(* Reads Text from console. Allocates buffer to store the text. You'll have
 * to free that buffer using DISPOSE().
 * len will become the length of the read text.
 * all that IFF-Stuff is removed automatically.
 * result = success.
 *)

VAR
  string: ARRAY 256 OF CHAR;

  PROCEDURE Read(to: Exec.APTR; length: LONGINT): LONGINT;
  BEGIN
    cbIO.command := Exec.read;
    cbIO.data    := to;
    cbIO.length  := length;
    IF Exec.DoIO(cbIO)=0 THEN
      RETURN cbIO.actual;
    ELSE
      RETURN 0
    END;
  END Read;

BEGIN

  IF ~ cbOpen THEN RETURN FALSE END;

  cbIO.clipID := 0;
  cbIO.offset := 0;
  buffer := NIL;

  string[5] := 0X;

  IF (Read(sys.ADR(string),4)=4) AND (string="FORM") AND
     (Read(sys.ADR(string),4)=4) AND
     (Read(sys.ADR(string),4)=4) AND (string="FTXT") THEN

    LOOP

      IF (Read(sys.ADR(string),4)#4) OR
         (Read(sys.ADR(len   ),4)#4) THEN EXIT END;

      IF string="CHRS" THEN

        OberonLib.New(buffer,len);
        IF buffer=NIL THEN EXIT END;
        len := Read(buffer,len);
        IF len<=0 THEN DISPOSE(buffer) END;

        EXIT;

      ELSE

        IF Read(NIL,len)#len THEN EXIT END;

      END;

    END;

  END;

  REPEAT UNTIL Read(sys.ADR(string),254)=0;   (* tell clipboard we are done *)

  RETURN buffer#NIL;

END Paste;


BEGIN

  NEW(cbIO);
  cbMP := ExecSupport.CreatePort("",0);

  IF (cbIO#NIL) AND (cbMP#NIL) AND
     (Exec.OpenDevice(ClipBoard.clipboardName,ClipBoard.primaryClip,cbIO,LONGSET{})=0) THEN
    cbIO.message.replyPort := cbMP;
    cbOpen := TRUE;
  END;

CLOSE

  IF cbOpen   THEN Exec.CloseDevice(cbIO)       END;
  IF cbMP#NIL THEN ExecSupport.DeletePort(cbMP) END;

END CBText.