home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Oberon0 / Viewers0.Mod < prev   
Encoding:
Text File  |  1995-04-15  |  5.3 KB  |  169 lines
  1. MODULE Viewers0;  (*HM Mar-25-92*)
  2. IMPORT OS;
  3.  
  4. (*
  5. CONST
  6.   barH = 14; (*default height of title bar*)
  7.   minH = barH + 2; (*minimal height of a viewer*)
  8. *)
  9.  
  10. TYPE
  11.   Frame* = POINTER TO FrameDesc;
  12.   FrameDesc* = RECORD (OS.ObjectDesc)
  13.     x*, y*: INTEGER; (*left bottom corner in pixels relative to left bottom corner of screen*)
  14.     w*, h*: INTEGER (*width, height in pixels*)
  15.   END;
  16.   Viewer* = POINTER TO ViewerDesc;
  17.   ViewerDesc* = RECORD (FrameDesc)
  18.     menu-, cont-: Frame;
  19.     next-: Viewer;
  20.   END;
  21.  
  22. VAR
  23.   focus-: Frame; (*the frame that gets the keyboard input*)
  24.   viewers: Viewer; (*bottom viewer on the screen*)
  25.  
  26. (*Frame methods*)
  27.  
  28. PROCEDURE (f: Frame) Draw*; END Draw;
  29. PROCEDURE (f: Frame) Modify* (dy: INTEGER); BEGIN INC(f.y, dy); DEC(f.h, dy) END Modify;
  30. PROCEDURE (f: Frame) Move* (dy: INTEGER); BEGIN INC(f.y, dy) END Move;
  31. PROCEDURE (f: Frame) Copy* (): Frame; END Copy;
  32. PROCEDURE (f: Frame) HandleMouse* (x, y: INTEGER; buttons: SET); END HandleMouse;
  33. PROCEDURE (f: Frame) HandleKey* (ch: CHAR); END HandleKey;
  34. PROCEDURE (f: Frame) Handle* (VAR m: OS.Message); END Handle;
  35. PROCEDURE (f: Frame) Defocus*; BEGIN focus := NIL END Defocus;
  36. PROCEDURE (f: Frame) SetFocus*; BEGIN IF focus # NIL THEN focus.Defocus END; focus := f END SetFocus;
  37. PROCEDURE (f: Frame) Neutralize*; END Neutralize;
  38.  
  39.  
  40. (*Viewer methods*)
  41.  
  42. PROCEDURE (v: Viewer) Erase (h: INTEGER);
  43. BEGIN
  44.   IF h > 0 THEN
  45.     OS.EraseBlock(v.x, v.y, v.w, h); (*clear bottom block of viewer*)
  46.     OS.FillBlock(v.x, v.y, 1, h); (*draw left border*)
  47.     OS.FillBlock(v.x+v.w-1, v.y, 1, h) (*draw right border*)
  48.   END;
  49.   OS.FillBlock(v.x, v.y, OS.screenW, 1) (*draw bottom border*)
  50. END Erase;
  51.  
  52. PROCEDURE (v: Viewer) FlipTitleBar;
  53. BEGIN OS.InvertBlock(v.x+1, v.y + v.h - OS.barH, OS.screenW-2, OS.barH)
  54. END FlipTitleBar;
  55.  
  56. PROCEDURE (v: Viewer) Neutralize*;
  57. BEGIN v.menu.Neutralize; v.cont.Neutralize
  58. END Neutralize;
  59.  
  60. PROCEDURE (v: Viewer) Modify* (dy: INTEGER);
  61. BEGIN v.Neutralize; v.Modify^ (dy); v.Erase(-dy+1); v.cont.Modify(dy)
  62. END Modify;
  63.  
  64. PROCEDURE (v: Viewer) Move* (dy: INTEGER);
  65. BEGIN v.Neutralize; v.menu.Move(dy); v.cont.Move(dy);
  66.   OS.CopyBlock(v.x, v.y+1, v.w, v.h-1, v.x, v.y+dy+1);
  67.   INC(v.y, dy)
  68. END Move;
  69.  
  70. PROCEDURE (v: Viewer) Draw*;
  71. BEGIN OS.FadeCursor;
  72.   v.Erase(v.h); v.menu.Draw; v.cont.Draw; v.FlipTitleBar
  73. END Draw;
  74.  
  75. PROCEDURE (v: Viewer) HandleMouse* (x, y: INTEGER; buttons: SET);
  76.   VAR b: SET; x1, y1: INTEGER; dy, maxUp, maxDown: INTEGER;
  77. BEGIN OS.DrawCursor(x, y);
  78.   IF y > v.menu.y THEN (*click in menu bar => resize viewer*)
  79.     IF OS.left IN buttons THEN v.FlipTitleBar;
  80.       REPEAT OS.GetMouse(b, x1, y1); OS.DrawCursor(x1, y1) UNTIL b = {};
  81.       v.FlipTitleBar; OS.FadeCursor; v.Neutralize;
  82.       dy := y1 - y; maxDown := v.h - OS.minH;
  83.       IF v.next = NIL THEN maxUp := OS.screenH - v.y - v.h ELSE maxUp := v.next.h - OS.minH; v.next.Neutralize END;
  84.       IF dy < - maxDown THEN dy := - maxDown ELSIF dy > maxUp THEN dy := maxUp END;
  85.       IF dy < 0 THEN (*down*) v.Modify(-dy); v.Move(dy) ELSE (*up*) v.Move(dy); v.Modify(-dy) END;
  86.       IF v.next # NIL THEN v.next.Modify(dy)
  87.       ELSE OS.EraseBlock(v.x, v.y+v.h, v.w, OS.screenH-v.y-v.h)
  88.       END
  89.     ELSE v.menu.HandleMouse(x, y, buttons)
  90.     END
  91.   ELSE v.cont.HandleMouse(x, y, buttons)
  92.   END
  93. END HandleMouse;
  94.  
  95. PROCEDURE (v: Viewer) Handle* (VAR m: OS.Message);
  96. BEGIN
  97.   v.menu.Handle(m); v.cont.Handle(m)
  98. END Handle;
  99.  
  100. PROCEDURE (v: Viewer) Close*;
  101.   VAR x: Viewer;
  102. BEGIN OS.FadeCursor; v.Neutralize;
  103.   IF v.next # NIL THEN v.next.Modify(-v.h)
  104.   ELSE OS.EraseBlock(v.x, v.y, v.w, v.h)
  105.   END;
  106.   IF viewers = v THEN viewers := v.next
  107.   ELSE x := viewers; WHILE x.next # v DO x := x.next END;
  108.     x.next := v.next
  109.   END
  110. END Close;
  111.  
  112.  
  113. (*external procedures*)
  114.  
  115. PROCEDURE ViewerAt*(y: INTEGER): Viewer;
  116.   VAR v: Viewer;
  117. BEGIN v := viewers;
  118.   WHILE (v # NIL) & (y > v.y + v.h) DO v := v.next END;
  119.   RETURN v
  120. END ViewerAt;
  121.  
  122. PROCEDURE New* (menu, cont: Frame): Viewer;
  123.   VAR below, above, v, w: Viewer; top: INTEGER;
  124. BEGIN
  125.   (*----- compute position of new viewer*)
  126.   IF ViewerAt(OS.screenH) = NIL THEN top := OS.screenH
  127.   ELSE w := viewers; v := viewers.next;
  128.     WHILE v # NIL DO
  129.       IF v.h > w.h THEN w := v END;
  130.       v := v.next
  131.     END;
  132.     top := w.y + w.h DIV 2
  133.   END;
  134.   (*----- generate new viewer and link it into viewer list*)
  135.   above := viewers; below := NIL;
  136.   WHILE (above # NIL) & (top > above.y + above.h) DO below := above; above := above.next END;
  137.   NEW(v); v.x := 0; v.w := OS.screenW; v.next := above;
  138.   IF below = NIL THEN v.y := 0; v.h := top ELSE v.y := below.y + below.h; v.h := top - v.y END;
  139.   IF v.h < OS.minH THEN RETURN NIL END;
  140.   v.menu := menu; menu.x := v.x+1; menu.y := v.y + v.h - OS.barH; menu.w := v.w-2; menu.h := OS.barH-1;
  141.   v.cont := cont; cont.x := v.x+1; cont.y := v.y+1; cont.w := v.w-2; cont.h := menu.y - v.y-1;
  142.   IF below = NIL THEN viewers := v ELSE below.next := v END;
  143.   IF above # NIL THEN above.Modify(v.h) END;
  144.   v.Draw;
  145.   RETURN v
  146. END New;
  147.  
  148. PROCEDURE Broadcast* (VAR m: OS.Message);
  149.   VAR v: Viewer;
  150. BEGIN v := viewers; WHILE v # NIL DO v.Handle(m); v := v.next END
  151. END Broadcast;
  152.  
  153. (*commands*)
  154.  
  155. PROCEDURE Close*;
  156.   VAR x, y: INTEGER; buttons: SET; v: Viewer;
  157. BEGIN OS.GetMouse(buttons, x, y); v := ViewerAt(y); v.Close
  158. END Close;
  159.  
  160. PROCEDURE Copy*;
  161.   VAR v: Viewer; x, y: INTEGER; buttons: SET;
  162. BEGIN OS.GetMouse(buttons, x, y); v := ViewerAt(y);
  163.   v := New(v.menu.Copy(), v.cont.Copy())
  164. END Copy;
  165.  
  166. BEGIN
  167.   viewers := NIL; focus := NIL
  168. END Viewers0.
  169.