home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / clipboard.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  13KB  |  402 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. Syntax20i.Scn.Fnt
  8. FoldElems
  9. (* AMIGA *)
  10. MODULE Clipboard; (* Ralf Degner 8.08.1995 *)
  11. IMPORT
  12.     SYSTEM, i:=AmigaIFFParse, a:=AmigaIFF, Texts, TextFrames, PictureFrames, Oberon, Display,
  13.      MenuViewers, Viewers, Fonts, Pictures, Amiga, Kernel;
  14.     Unit: LONGINT; (* global Clipboard-Unit *)
  15.     Handler: i.IFFHandlePtr;
  16.     ClipHan: i.ClipboardHandlePtr;
  17.     ClipOpen: BOOLEAN;
  18.     W: Texts.Writer;
  19. (* NEVER leave an open Clipboard *)
  20. (* If a PROCEDURE opens the Clipboard, it MUST close the Clipboard before it ends *)
  21. (* Close Clipboard *)
  22. PROCEDURE CloseClip();
  23. BEGIN
  24.     IF ClipOpen THEN i.CloseIFF(Handler); Handler:=NIL; END;
  25.     IF ClipHan#NIL THEN i.CloseClipboard(ClipHan); ClipHan:=NIL; END;
  26.     IF Handler#NIL THEN i.FreeIFF(Handler); Handler:=NIL END;
  27.     ClipOpen:=FALSE;
  28. END CloseClip;
  29. (* Open CLipboard *)
  30. PROCEDURE OpenClip(mode: SET; Unit: LONGINT);
  31. BEGIN
  32.     Handler:=NIL;ClipHan:=NIL;ClipOpen:=FALSE;
  33.     Handler:=i.AllocIFF();
  34.     IF Handler#NIL THEN
  35.         ClipHan:=i.OpenClipboard(Unit);
  36.         IF ClipHan#NIL THEN
  37.             Handler.stream:=SYSTEM.VAL(LONGINT, ClipHan);
  38.             i.InitIFFasClip(Handler);
  39.             IF i.OpenIFF(Handler, mode)=0 THEN ClipOpen:=TRUE END
  40.         END
  41.     END;
  42.     IF ~ClipOpen THEN CloseClip()END
  43. END OpenClip;
  44. (* Insert Writer to Caret *)
  45. PROCEDURE WriterToCaret();
  46.         f: Display.Frame;
  47.         v: Viewers.Viewer;
  48.         newPos: LONGINT;
  49. BEGIN
  50.     v:=Oberon.FocusViewer;
  51.     IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
  52.         f:=v.dsc.next;
  53.         WITH f: TextFrames.Frame DO
  54.             IF f.hasCar THEN
  55.                 newPos:=f.carloc.pos+W.buf.len;
  56.                 Texts.Insert(f.text, f.carloc.pos, W.buf);
  57.                 TextFrames.SetCaret(f, newPos)
  58.             END
  59.         ELSE
  60.         END
  61. END WriterToCaret;
  62. (* Open new Text-Frame *)
  63. PROCEDURE OpenViewer(text: Texts.Text);
  64.     VAR x, y: INTEGER; v: Viewers.Viewer; cf: TextFrames.Frame;
  65. BEGIN
  66.     Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  67.     cf := TextFrames.NewText(text, 0);
  68.     v := MenuViewers.New(TextFrames.NewMenu("Clipboard.Show", "^Edit.Menu.Text"), cf, TextFrames.menuH, x, y)
  69. END OpenViewer;
  70. (* Get selected Frame *)
  71. PROCEDURE GetFrame(VAR f: Display.Frame): BOOLEAN;
  72.     VAR v: Viewers.Viewer;
  73. BEGIN
  74.     IF Oberon.Par.frame=Oberon.Par.vwr.dsc THEN
  75.         IF (Oberon.Par.frame # NIL) THEN
  76.             f:=Oberon.Par.frame.next;
  77.             RETURN TRUE
  78.         END
  79.     ELSE
  80.         v:=Oberon.MarkedViewer();
  81.         IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
  82.             f:=v.dsc.next;
  83.             RETURN TRUE
  84.         END
  85.     END;
  86.     RETURN FALSE;
  87. END GetFrame;
  88. (* Get Integer only direct after Command *)
  89. PROCEDURE GetUnitDirect(): LONGINT;
  90.         S: Texts.Scanner;
  91. BEGIN
  92.     Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  93.     Texts.Scan(S);
  94.     IF (S.class=Texts.Int) & (S.i>=0) & (S.i<256) THEN
  95.         RETURN S.i
  96.     ELSE
  97.         RETURN -1
  98. END GetUnitDirect;
  99. (* Get Integer *)
  100. PROCEDURE GetUnit(): LONGINT;
  101.         S: Texts.Scanner;
  102.         text: Texts.Text;
  103.         beg, end, time: LONGINT;
  104. BEGIN
  105.     Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  106.     Texts.Scan(S);
  107.     IF S.class=Texts.Char THEN
  108.         IF S.c="^" THEN
  109.             Oberon.GetSelection(text, beg, end, time);
  110.             IF time=-1 THEN RETURN -1; END;
  111.             Texts.OpenScanner(S, text, beg);
  112.             Texts.Scan(S)
  113.         ELSE
  114.             RETURN -1
  115.         END
  116.     END;
  117.     IF (S.class=Texts.Int) & (S.i>=0) & (S.i<256) THEN
  118.         RETURN S.i
  119.     ELSE
  120.         RETURN -1
  121. END GetUnit;
  122. (* Do copy to Clipboard, called by Cut and Copy *)
  123. PROCEDURE CopyToClip(VAR t: Texts.Text; beg, end: LONGINT);
  124.         ClipUnit, error, Count, bufcount: LONGINT;
  125.         r: Texts.Reader;
  126.         buffer: ARRAY 256 OF CHAR;
  127.         ch: CHAR;
  128.         col, offset: SHORTINT;
  129.         font: Fonts.Font;
  130.         Pusched: BOOLEAN;
  131.     PROCEDURE PushBuffer(Close: BOOLEAN);
  132.     BEGIN
  133.         IF bufcount#0 THEN
  134.             IF ~Pusched THEN error:=i.PushChunk(Handler, 0, a.CHRS, i.sizeUnknown); Pusched:=TRUE; END;
  135.             error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), bufcount);
  136.             bufcount:=0;
  137.         END;
  138.         IF Close & Pusched THEN error:=i.PopChunk(Handler); Pusched:=FALSE END
  139.     END PushBuffer;
  140.     PROCEDURE PushStyle();
  141.     BEGIN
  142.         IF i.PushChunk(Handler, 0, a.OBRO, i.sizeUnknown)=0 THEN
  143.             COPY(font.name, buffer); (* FOR n:=0 TO 31 DO buffer[n]:=font.name[n] END; *)
  144.             buffer[32]:=SYSTEM.VAL(CHAR, col);
  145.             buffer[33]:=SYSTEM.VAL(CHAR, offset);
  146.             error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), 34);
  147.             error:=i.PopChunk(Handler)
  148.         END
  149.     END PushStyle;
  150. BEGIN
  151.     ClipUnit:=GetUnitDirect();
  152.     IF ClipUnit<0 THEN ClipUnit:=Unit END;
  153.     font:=NIL; col:=-1; offset:=0; Pusched:=FALSE;
  154.     OpenClip(i.write, ClipUnit);
  155.     IF ClipOpen THEN
  156.         IF i.PushChunk(Handler, a.FTXT, a.FORM, i.sizeUnknown)=0 THEN
  157.             Texts.OpenReader(r, t, beg);bufcount:=0;
  158.             FOR Count:=0 TO end-beg-1 DO
  159.                 Texts.Read(r, ch);
  160.                 ch:=Amiga.ConvOtoA(ch);
  161.                 IF ch#CHR(0) THEN
  162.                     IF (r.fnt#font) OR (r.col#col) OR (r.voff#offset) THEN
  163.                         PushBuffer(TRUE);
  164.                         font:=r.fnt; col:=r.col; offset:=r.voff;
  165.                         PushStyle();
  166.                     END;
  167.                     buffer[bufcount]:=ch; INC(bufcount); IF bufcount=256 THEN PushBuffer(FALSE) END
  168.                 END
  169.             END;
  170.             PushBuffer(TRUE);
  171.             error:=i.PopChunk(Handler);
  172.         END;
  173.         CloseClip()
  174. END CopyToClip;
  175. (* Do copy to Clipboard, called by Cut and Copy *)
  176. PROCEDURE CopyToClipNoStyle(VAR t: Texts.Text; beg, end: LONGINT);
  177.         ClipUnit, error, Count, bufcount: LONGINT;
  178.         r: Texts.Reader;
  179.         buffer: ARRAY 256 OF CHAR;
  180.         ch: CHAR;
  181. BEGIN
  182.     ClipUnit:=GetUnitDirect();
  183.     IF ClipUnit<0 THEN ClipUnit:=Unit END;
  184.     OpenClip(i.write, ClipUnit);
  185.     IF ClipOpen THEN
  186.         IF i.PushChunk(Handler, a.FTXT, a.FORM, i.sizeUnknown)=0 THEN
  187.             Texts.OpenReader(r, t, beg);bufcount:=0;
  188.             IF i.PushChunk(Handler, 0, a.CHRS, i.sizeUnknown)=0 THEN
  189.                 bufcount:=0;
  190.                 FOR Count:=0 TO end-beg-1 DO
  191.                     Texts.Read(r, ch);
  192.                     ch:=Amiga.ConvOtoA(ch);
  193.                     IF ch#CHR(0) THEN
  194.                         buffer[bufcount]:=ch; INC(bufcount);
  195.                         IF bufcount=256 THEN
  196.                             error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), 256);
  197.                             bufcount:=0
  198.                         END
  199.                     END
  200.                 END;
  201.                 IF bufcount#0 THEN
  202.                     error:=i.WriteChunkBytes(Handler, SYSTEM.ADR(buffer), bufcount);
  203.                 END;
  204.                 error:=i.PopChunk(Handler);
  205.                 error:=i.PopChunk(Handler)
  206.             END
  207.         END;
  208.         CloseClip()
  209. END CopyToClipNoStyle;
  210. (* Copy Picture to Clipboard *)
  211. PROCEDURE CopyPictToClip(f: PictureFrames.Frame);
  212.     VAR ClipUnit: LONGINT;
  213. BEGIN
  214.     ClipUnit:=GetUnitDirect();
  215.     IF ClipUnit<0 THEN ClipUnit:=Unit END;
  216.     OpenClip(i.write, ClipUnit);
  217.     IF ClipOpen THEN
  218.         a.StorePictAsILBM(Handler, f.pict);
  219.         CloseClip()
  220. END CopyPictToClip;
  221. (* Copy Clip FTXT to Writer *)
  222. PROCEDURE ClipToWriter();
  223.         ch: CHAR;
  224.         len, Count, n: LONGINT;
  225.         cn: i.ContextNodePtr;
  226.         buffer: ARRAY 256 OF CHAR;
  227. BEGIN
  228.     WHILE i.ParseIFF(Handler, i.parseScan)=0 DO  (* read Text from Clip to Writer *)
  229.         cn:=i.CurrentChunk(Handler);
  230.         IF cn.id=a.CHRS THEN
  231.             FOR n:=0 TO (cn.size DIV 256) DO
  232.                 len:=i.ReadChunkBytes(Handler, SYSTEM.ADR(buffer), 256);
  233.                 FOR Count:=0 TO len-1 DO
  234.                     ch:=Amiga.ConvAtoO(buffer[Count]);
  235.                     IF ch#CHR(0) THEN Texts.Write(W, ch) END
  236.                 END
  237.             END
  238.         ELSIF cn.id=a.OBRO THEN
  239.             len:=i.ReadChunkBytes(Handler, SYSTEM.ADR(buffer), 34);
  240.             Texts.SetFont(W, Fonts.This(buffer));
  241.             Texts.SetColor(W, SYSTEM.VAL(SHORTINT, buffer[32]));
  242.             Texts.SetOffset(W, SYSTEM.VAL(SHORTINT, buffer[32]))
  243.         END
  244.     END;
  245. END ClipToWriter;
  246. (* Copy Selection to Clipboard *)
  247. PROCEDURE Copy*;
  248.         t: Texts.Text;
  249.         beg, end, time: LONGINT;
  250. BEGIN
  251.     Oberon.GetSelection(t, beg, end, time);
  252.     IF (time>=0) & (end>beg) THEN
  253.         CopyToClip(t, beg, end)
  254. END Copy;
  255. (* Copy Selection to Clipboard without Font and Color Info *)
  256. PROCEDURE CopyNoStyle*;
  257.         t: Texts.Text;
  258.         beg, end, time: LONGINT;
  259. BEGIN
  260.     Oberon.GetSelection(t, beg, end, time);
  261.     IF (time>=0) & (end>beg) THEN
  262.         CopyToClipNoStyle(t, beg, end)
  263. END CopyNoStyle;
  264. (* Copy Contents of Frame to Clipboard, if Frame is TextFrame*)
  265. PROCEDURE CopyFrame*;
  266.         f, g: Display.Frame;
  267. BEGIN
  268.     IF GetFrame(g) THEN
  269.         f:=g;
  270.         WITH f: TextFrames.Frame DO
  271.             IF f.text.len>0 THEN CopyToClip(f.text, 0, f.text.len) END
  272.         | f: PictureFrames.Frame DO
  273.             CopyPictToClip(f);
  274.         ELSE
  275.         END
  276. END CopyFrame;
  277. (* Copy Contents of Frame to Clipboard, if Frame is TextFrame (without Font and Color Info) *)
  278. PROCEDURE CopyFrameNoStyle*;
  279.         f, g: Display.Frame;
  280. BEGIN
  281.     IF GetFrame(g) THEN
  282.         f:=g;
  283.         WITH f: TextFrames.Frame DO
  284.             IF f.text.len>0 THEN CopyToClipNoStyle(f.text, 0, f.text.len) END
  285.         | f: PictureFrames.Frame DO
  286.             CopyPictToClip(f);
  287.         ELSE
  288.         END
  289. END CopyFrameNoStyle;
  290. (* Copy Selection to Clipboard and delete it *)
  291. PROCEDURE Cut*;
  292.         t: Texts.Text;
  293.         beg, end, time: LONGINT;
  294. BEGIN
  295.     Oberon.GetSelection(t, beg, end, time);
  296.     IF (time>=0) & (end>beg) THEN
  297.         CopyToClip(t, beg, end);
  298.         Texts.Delete(t, beg, end)
  299. END Cut;
  300. (* Copy Selection to Clipboard without Font and Color Info and delete it *)
  301. PROCEDURE CutNoStyle*;
  302.         t: Texts.Text;
  303.         beg, end, time: LONGINT;
  304. BEGIN
  305.     Oberon.GetSelection(t, beg, end, time);
  306.     IF (time>=0) & (end>beg) THEN
  307.         CopyToClipNoStyle(t, beg, end);
  308.         Texts.Delete(t, beg, end)
  309. END CutNoStyle;
  310. (* Paste Clipboard at Caret *)
  311. PROCEDURE Paste*;
  312.     VAR ClipUnit: LONGINT;
  313. BEGIN
  314.     ClipUnit:=GetUnitDirect();
  315.     IF ClipUnit<0 THEN ClipUnit:=Unit END;
  316.     OpenClip(i.read, ClipUnit);
  317.     IF ClipOpen THEN
  318.         IF (i.StopChunk(Handler, a.FTXT, a.CHRS)=0) & (i.StopChunk(Handler, a.FTXT, a.OBRO)=0) THEN
  319.             ClipToWriter();
  320.             CloseClip();
  321.             WriterToCaret()
  322.         ELSE
  323.             CloseClip()
  324.         END
  325. END Paste;
  326. (* Make Screen-SnapShot *)
  327. PROCEDURE SnapShot*;
  328.     VAR ClipUnit: LONGINT;
  329. BEGIN
  330.     ClipUnit:=GetUnitDirect();
  331.     IF ClipUnit<0 THEN ClipUnit:=Unit END;
  332.     OpenClip(i.write, ClipUnit);
  333.     IF ClipOpen THEN
  334.         a.StoreDisplayAsILBM(Handler);
  335.         CloseClip()
  336. END SnapShot;
  337. (* Select global Clipboard-Unit *)
  338. PROCEDURE Select*;
  339.     VAR ClipUnit: LONGINT;
  340. BEGIN
  341.     ClipUnit:=GetUnit();
  342.     IF ClipUnit>=0 THEN Unit:=ClipUnit END
  343. END Select;
  344. (* Show Contents Clipboard in new Frame *)
  345. PROCEDURE Show*;
  346.         id, ClipUnit: LONGINT;
  347.         cn: i.ContextNodePtr;
  348.         text: Texts.Text;
  349.         F: PictureFrames.Frame;
  350.         P: Pictures.Picture;
  351.         V: Viewers.Viewer;
  352.         X, Y :  INTEGER;
  353. BEGIN
  354.     ClipUnit:=GetUnitDirect();
  355.     IF ClipUnit<0 THEN ClipUnit:=Unit END;
  356.     OpenClip(i.read, ClipUnit);
  357.     IF ClipOpen THEN
  358.         IF (i.StopChunk(Handler, a.FTXT, a.CHRS)=0) & (i.StopChunk(Handler, a.ILBM, a.BODY)=0) THEN
  359.             IF i.ParseIFF(Handler, i.parseScan)=0 THEN
  360.                 cn:=i.CurrentChunk(Handler);
  361.                 id:=cn.id;
  362.                 CloseClip();
  363.                 OpenClip(i.read, ClipUnit);
  364.                 IF ClipOpen THEN
  365.                     IF id=a.CHRS THEN
  366.                         IF (i.StopChunk(Handler, a.FTXT, a.CHRS)=0) & (i.StopChunk(Handler, a.FTXT, a.OBRO)=0) THEN
  367.                             ClipToWriter();
  368.                             CloseClip();
  369.                             text:=TextFrames.Text("");
  370.                             Texts.Append(text, W.buf);
  371.                             OpenViewer(text);
  372.                         ELSE
  373.                             CloseClip();
  374.                         END
  375.                     ELSIF id=a.BODY THEN
  376.                         P:=a.LoadILBMToPict(Handler);
  377.                         CloseClip();
  378.                         IF P#NIL THEN
  379.                             F:=PictureFrames.NewPicture(P);
  380.                             Oberon.AllocateUserViewer(Oberon.Mouse.X,X,Y);
  381.                             V := MenuViewers.New(TextFrames.NewMenu("Clipboard.Show", "^Paint.Menu.Text"), F, TextFrames.menuH, X, Y);
  382.                         END;
  383.                     ELSE
  384.                         CloseClip();
  385.                     END;
  386.                 END;
  387.             ELSE
  388.                 CloseClip();
  389.                 text:=TextFrames.Text("");
  390.                 OpenViewer(text);
  391.             END;
  392.         ELSE
  393.             CloseClip()
  394.         END
  395. END Show;
  396. BEGIN
  397.     Unit:=0;Handler:=NIL;ClipHan:=NIL;ClipOpen:=FALSE;
  398.     Texts.OpenWriter(W);
  399.     Kernel.FKey[12]:=Cut; Kernel.FKey[13]:=Copy; Kernel.FKey[14]:=Paste
  400. END Clipboard.
  401. System.Free Clipboard ~
  402.