Syntax20b.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
Syntax20i.Scn.Fnt
FoldElems
(* AMIGA *)
MODULE Clipboard; (* Ralf Degner 8.08.1995 *)
IMPORT
	SYSTEM, i:=AmigaIFFParse, a:=AmigaIFF, Texts, TextFrames, PictureFrames, Oberon, Display,
	 MenuViewers, Viewers, Fonts, Pictures, Amiga, Kernel;
	Unit: LONGINT; (* global Clipboard-Unit *)
	Handler: i.IFFHandlePtr;
	ClipHan: i.ClipboardHandlePtr;
	ClipOpen: BOOLEAN;
	W: Texts.Writer;
(* NEVER leave an open Clipboard *)
(* If a PROCEDURE opens the Clipboard, it MUST close the Clipboard before it ends *)
(* Close Clipboard *)
PROCEDURE CloseClip();
BEGIN
	IF ClipOpen THEN i.CloseIFF(Handler); Handler:=NIL; END;
	IF ClipHan#NIL THEN i.CloseClipboard(ClipHan); ClipHan:=NIL; END;
	IF Handler#NIL THEN i.FreeIFF(Handler); Handler:=NIL END;
	ClipOpen:=FALSE;
END CloseClip;
(* Open CLipboard *)
PROCEDURE OpenClip(mode: SET; Unit: LONGINT);
BEGIN
	Handler:=NIL;ClipHan:=NIL;ClipOpen:=FALSE;
	Handler:=i.AllocIFF();
	IF Handler#NIL THEN
		ClipHan:=i.OpenClipboard(Unit);
		IF ClipHan#NIL THEN
			Handler.stream:=SYSTEM.VAL(LONGINT, ClipHan);
			i.InitIFFasClip(Handler);
			IF i.OpenIFF(Handler, mode)=0 THEN ClipOpen:=TRUE END
		END
	END;
	IF ~ClipOpen THEN CloseClip()END
END OpenClip;
(* Insert Writer to Caret *)
PROCEDURE WriterToCaret();
		f: Display.Frame;
		v: Viewers.Viewer;
		newPos: LONGINT;
BEGIN
	v:=Oberon.FocusViewer;
	IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
		f:=v.dsc.next;
		WITH f: TextFrames.Frame DO
			IF f.hasCar THEN
				newPos:=f.carloc.pos+W.buf.len;
				Texts.Insert(f.text, f.carloc.pos, W.buf);
				TextFrames.SetCaret(f, newPos)
			END
		ELSE
		END
END WriterToCaret;
(* Open new Text-Frame *)
PROCEDURE OpenViewer(text: Texts.Text);
	VAR x, y: INTEGER; v: Viewers.Viewer; cf: TextFrames.Frame;
BEGIN
	Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
	cf := TextFrames.NewText(text, 0);
	v := MenuViewers.New(TextFrames.NewMenu("Clipboard.Show", "^Edit.Menu.Text"), cf, TextFrames.menuH, x, y)
END OpenViewer;
(* Get selected Frame *)
PROCEDURE GetFrame(VAR f: Display.Frame): BOOLEAN;
	VAR v: Viewers.Viewer;
BEGIN
	IF Oberon.Par.frame=Oberon.Par.vwr.dsc THEN
		IF (Oberon.Par.frame # NIL) THEN
			f:=Oberon.Par.frame.next;
			RETURN TRUE
		END
	ELSE
		v:=Oberon.MarkedViewer();
		IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
			f:=v.dsc.next;
			RETURN TRUE
		END
	END;
	RETURN FALSE;
END GetFrame;
(* Get Integer only direct after Command *)
PROCEDURE GetUnitDirect(): LONGINT;
		S: Texts.Scanner;
BEGIN
	Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
	Texts.Scan(S);
	IF (S.class=Texts.Int) & (S.i>=0) & (S.i<256) THEN
		RETURN S.i
	ELSE
		RETURN -1
END GetUnitDirect;
(* Get Integer *)
PROCEDURE GetUnit(): LONGINT;
		S: Texts.Scanner;
		text: Texts.Text;
		beg, end, time: LONGINT;
BEGIN
	Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
	Texts.Scan(S);
	IF S.class=Texts.Char THEN
		IF S.c="^" THEN
			Oberon.GetSelection(text, beg, end, time);
			IF time=-1 THEN RETURN -1; END;
			Texts.OpenScanner(S, text, beg);
			Texts.Scan(S)
		ELSE
			RETURN -1
		END
	END;
	IF (S.class=Texts.Int) & (S.i>=0) & (S.i<256) THEN
		RETURN S.i
	ELSE
		RETURN -1
END GetUnit;
(* Do copy to Clipboard, called by Cut and Copy *)
PROCEDURE CopyToClip(VAR t: Texts.Text; beg, end: LONGINT);
		ClipUnit, error, Count, bufcount: LONGINT;
		r: Texts.Reader;
		buffer: ARRAY 256 OF CHAR;
		ch: CHAR;
		col, offset: SHORTINT;
		font: Fonts.Font;
		Pusched: BOOLEAN;
	PROCEDURE PushBuffer(Close: BOOLEAN);
	BEGIN
		IF bufcount#0 THEN
			IF ~Pusched THEN error:=i.PushChunk(Handler, 0, a.CHRS, i.sizeUnknown); Pusched:=TRUE; END;
			error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), bufcount);
			bufcount:=0;
		END;
		IF Close & Pusched THEN error:=i.PopChunk(Handler); Pusched:=FALSE END
	END PushBuffer;
	PROCEDURE PushStyle();
	BEGIN
		IF i.PushChunk(Handler, 0, a.OBRO, i.sizeUnknown)=0 THEN
			COPY(font.name, buffer); (* FOR n:=0 TO 31 DO buffer[n]:=font.name[n] END; *)
			buffer[32]:=SYSTEM.VAL(CHAR, col);
			buffer[33]:=SYSTEM.VAL(CHAR, offset);
			error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), 34);
			error:=i.PopChunk(Handler)
		END
	END PushStyle;
BEGIN
	ClipUnit:=GetUnitDirect();
	IF ClipUnit<0 THEN ClipUnit:=Unit END;
	font:=NIL; col:=-1; offset:=0; Pusched:=FALSE;
	OpenClip(i.write, ClipUnit);
	IF ClipOpen THEN
		IF i.PushChunk(Handler, a.FTXT, a.FORM, i.sizeUnknown)=0 THEN
			Texts.OpenReader(r, t, beg);bufcount:=0;
			FOR Count:=0 TO end-beg-1 DO
				Texts.Read(r, ch);
				ch:=Amiga.ConvOtoA(ch);
				IF ch#CHR(0) THEN
					IF (r.fnt#font) OR (r.col#col) OR (r.voff#offset) THEN
						PushBuffer(TRUE);
						font:=r.fnt; col:=r.col; offset:=r.voff;
						PushStyle();
					END;
					buffer[bufcount]:=ch; INC(bufcount); IF bufcount=256 THEN PushBuffer(FALSE) END
				END
			END;
			PushBuffer(TRUE);
			error:=i.PopChunk(Handler);
		END;
		CloseClip()
END CopyToClip;
(* Do copy to Clipboard, called by Cut and Copy *)
PROCEDURE CopyToClipNoStyle(VAR t: Texts.Text; beg, end: LONGINT);
		ClipUnit, error, Count, bufcount: LONGINT;
		r: Texts.Reader;
		buffer: ARRAY 256 OF CHAR;
		ch: CHAR;
BEGIN
	ClipUnit:=GetUnitDirect();
	IF ClipUnit<0 THEN ClipUnit:=Unit END;
	OpenClip(i.write, ClipUnit);
	IF ClipOpen THEN
		IF i.PushChunk(Handler, a.FTXT, a.FORM, i.sizeUnknown)=0 THEN
			Texts.OpenReader(r, t, beg);bufcount:=0;
			IF i.PushChunk(Handler, 0, a.CHRS, i.sizeUnknown)=0 THEN
				bufcount:=0;
				FOR Count:=0 TO end-beg-1 DO
					Texts.Read(r, ch);
					ch:=Amiga.ConvOtoA(ch);
					IF ch#CHR(0) THEN
						buffer[bufcount]:=ch; INC(bufcount);
						IF bufcount=256 THEN
							error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), 256);
							bufcount:=0
						END
					END
				END;
				IF bufcount#0 THEN
					error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), bufcount);
				END;
				error:=i.PopChunk(Handler);
				error:=i.PopChunk(Handler)
			END
		END;
		CloseClip()
END CopyToClipNoStyle;
(* Copy Picture to Clipboard *)
PROCEDURE CopyPictToClip(f: PictureFrames.Frame);
	VAR ClipUnit: LONGINT;
BEGIN
	ClipUnit:=GetUnitDirect();
	IF ClipUnit<0 THEN ClipUnit:=Unit END;
	OpenClip(i.write, ClipUnit);
	IF ClipOpen THEN
		a.StorePictAsILBM(Handler, f.pict);
		CloseClip()
END CopyPictToClip;
(* Copy Clip FTXT to Writer *)
PROCEDURE ClipToWriter();
		ch: CHAR;
		len, Count, n: LONGINT;
		cn: i.ContextNodePtr;
		buffer: ARRAY 256 OF CHAR;
BEGIN
	WHILE i.ParseIFF(Handler, i.parseScan)=0 DO  (* read Text from Clip to Writer *)
		cn:=i.CurrentChunk(Handler);
		IF cn.id=a.CHRS THEN
			FOR n:=0 TO (cn.size DIV 256) DO
				len:=i.ReadChunkBytes(Handler, SYSTEM.ADR(buffer), 256);
				FOR Count:=0 TO len-1 DO
					ch:=Amiga.ConvAtoO(buffer[Count]);
					IF ch#CHR(0) THEN Texts.Write(W, ch) END
				END
			END
		ELSIF cn.id=a.OBRO THEN
			len:=i.ReadChunkBytes(Handler, SYSTEM.ADR(buffer), 34);
			Texts.SetFont(W, Fonts.This(buffer));
			Texts.SetColor(W, SYSTEM.VAL(SHORTINT, buffer[32]));
			Texts.SetOffset(W, SYSTEM.VAL(SHORTINT, buffer[32]))
		END
	END;
END ClipToWriter;
(* Copy Selection to Clipboard *)
PROCEDURE Copy*;
		t: Texts.Text;
		beg, end, time: LONGINT;
BEGIN
	Oberon.GetSelection(t, beg, end, time);
	IF (time>=0) & (end>beg) THEN
		CopyToClip(t, beg, end)
END Copy;
(* Copy Selection to Clipboard without Font and Color Info *)
PROCEDURE CopyNoStyle*;
		t: Texts.Text;
		beg, end, time: LONGINT;
BEGIN
	Oberon.GetSelection(t, beg, end, time);
	IF (time>=0) & (end>beg) THEN
		CopyToClipNoStyle(t, beg, end)
END CopyNoStyle;
(* Copy Contents of Frame to Clipboard, if Frame is TextFrame*)
PROCEDURE CopyFrame*;
		f, g: Display.Frame;
BEGIN
	IF GetFrame(g) THEN
		f:=g;
		WITH f: TextFrames.Frame DO
			IF f.text.len>0 THEN CopyToClip(f.text, 0, f.text.len) END
		| f: PictureFrames.Frame DO
			CopyPictToClip(f);
		ELSE
		END
END CopyFrame;
(* Copy Contents of Frame to Clipboard, if Frame is TextFrame (without Font and Color Info) *)
PROCEDURE CopyFrameNoStyle*;
		f, g: Display.Frame;
BEGIN
	IF GetFrame(g) THEN
		f:=g;
		WITH f: TextFrames.Frame DO
			IF f.text.len>0 THEN CopyToClipNoStyle(f.text, 0, f.text.len) END
		| f: PictureFrames.Frame DO
			CopyPictToClip(f);
		ELSE
		END
END CopyFrameNoStyle;
(* Copy Selection to Clipboard and delete it *)
PROCEDURE Cut*;
		t: Texts.Text;
		beg, end, time: LONGINT;
BEGIN
	Oberon.GetSelection(t, beg, end, time);
	IF (time>=0) & (end>beg) THEN
		CopyToClip(t, beg, end);
		Texts.Delete(t, beg, end)
END Cut;
(* Copy Selection to Clipboard without Font and Color Info and delete it *)
PROCEDURE CutNoStyle*;
		t: Texts.Text;
		beg, end, time: LONGINT;
BEGIN
	Oberon.GetSelection(t, beg, end, time);
	IF (time>=0) & (end>beg) THEN
		CopyToClipNoStyle(t, beg, end);
		Texts.Delete(t, beg, end)
END CutNoStyle;
(* Paste Clipboard at Caret *)
PROCEDURE Paste*;
	VAR ClipUnit: LONGINT;
BEGIN
	ClipUnit:=GetUnitDirect();
	IF ClipUnit<0 THEN ClipUnit:=Unit END;
	OpenClip(i.read, ClipUnit);
	IF ClipOpen THEN
		IF (i.StopChunk(Handler, a.FTXT, a.CHRS)=0) & (i.StopChunk(Handler, a.FTXT, a.OBRO)=0) THEN
			ClipToWriter();
			CloseClip();
			WriterToCaret()
		ELSE
			CloseClip()
		END
END Paste;
(* Make Screen-SnapShot *)
PROCEDURE SnapShot*;
	VAR ClipUnit: LONGINT;
BEGIN
	ClipUnit:=GetUnitDirect();
	IF ClipUnit<0 THEN ClipUnit:=Unit END;
	OpenClip(i.write, ClipUnit);
	IF ClipOpen THEN
		a.StoreDisplayAsILBM(Handler);
		CloseClip()
END SnapShot;
(* Select global Clipboard-Unit *)
PROCEDURE Select*;
	VAR ClipUnit: LONGINT;
BEGIN
	ClipUnit:=GetUnit();
	IF ClipUnit>=0 THEN Unit:=ClipUnit END
END Select;
(* Show Contents Clipboard in new Frame *)
PROCEDURE Show*;
		id, ClipUnit: LONGINT;
		cn: i.ContextNodePtr;
		text: Texts.Text;
		F: PictureFrames.Frame;
		P: Pictures.Picture;
		V: Viewers.Viewer;
		X, Y :  INTEGER;
BEGIN
	ClipUnit:=GetUnitDirect();
	IF ClipUnit<0 THEN ClipUnit:=Unit END;
	OpenClip(i.read, ClipUnit);
	IF ClipOpen THEN
		IF (i.StopChunk(Handler, a.FTXT, a.CHRS)=0) & (i.StopChunk(Handler, a.ILBM, a.BODY)=0) THEN
			IF i.ParseIFF(Handler, i.parseScan)=0 THEN
				cn:=i.CurrentChunk(Handler);
				id:=cn.id;
				CloseClip();
				OpenClip(i.read, ClipUnit);
				IF ClipOpen THEN
					IF id=a.CHRS THEN
						IF (i.StopChunk(Handler, a.FTXT, a.CHRS)=0) & (i.StopChunk(Handler, a.FTXT, a.OBRO)=0) THEN
							ClipToWriter();
							CloseClip();
							text:=TextFrames.Text("");
							Texts.Append(text, W.buf);
							OpenViewer(text);
						ELSE
							CloseClip();
						END
					ELSIF id=a.BODY THEN
						P:=a.LoadILBMToPict(Handler);
						CloseClip();
						IF P#NIL THEN
							F:=PictureFrames.NewPicture(P);
							Oberon.AllocateUserViewer(Oberon.Mouse.X,X,Y);
							V := MenuViewers.New(TextFrames.NewMenu("Clipboard.Show", "^Paint.Menu.Text"), F, TextFrames.menuH, X, Y);
						END;
					ELSE
						CloseClip();
					END;
				END;
			ELSE
				CloseClip();
				text:=TextFrames.Text("");
				OpenViewer(text);
			END;
		ELSE
			CloseClip()
		END
END Show;
BEGIN
	Unit:=0;Handler:=NIL;ClipHan:=NIL;ClipOpen:=FALSE;
	Texts.OpenWriter(W);
	Kernel.FKey[12]:=Cut; Kernel.FKey[13]:=Copy; Kernel.FKey[14]:=Paste
END Clipboard.
System.Free Clipboard ~