home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon-a / source / eagui / textfield.mod < prev   
Encoding:
Text File  |  1995-06-29  |  5.1 KB  |  160 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: TextField.mod $
  4.   Description: Port of the EAGUI TextField.c
  5.  
  6.     Ported by: fjc (Frank Copeland)
  7.     $Revision: 1.2 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:19:58 $
  10.  
  11.   Oberon-A Port Copyright © 1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. **************************************************************************
  16. *                                                                        *
  17. * TextField.c - A simple example source that demonstrates how to         *
  18. * implement custom images in EAGUI.                                      *
  19. *                                                                        *
  20. *************************************************************************)
  21.  
  22. <* STANDARD- *>
  23. <*$ StackChk- *>
  24. <*$ LongVars+ *>
  25.  
  26. MODULE TextField;
  27.  
  28. IMPORT
  29.   SYS := SYSTEM, Kernel, s := Sets, e := Exec, u := Utility,
  30.   gfx := Graphics, i := Intuition, ea := EAGUI;
  31.  
  32. CONST
  33.  
  34. (* Alternative alignment flags. If these aren't specified, the default is
  35.  * to center the textfield both horizontally and vertically.
  36.  *)
  37.  
  38.   CITF_ALIGNLEFT *   = 0;
  39.   CITF_ALIGNRIGHT *  = 1;
  40.   CITF_ALIGNTOP *    = 2;
  41.   CITF_ALIGNBOTTOM * = 3;
  42.  
  43. TYPE
  44.  
  45. (* Information that is needed by this object, but that isn't maintained
  46.  * by EAGUI itself.
  47.  *)
  48.  
  49.   ci_TextFieldPtr * = POINTER [2] TO ci_TextField;
  50.   ci_TextField * = RECORD [2]
  51.     tf_string_ptr * : e.LSTRPTR;          (* string that is displayed *)
  52.     tf_textattr_ptr * : gfx.TextAttrPtr;  (* font that is used *)
  53.     tf_flags * : s.SET32;                 (* different flags *)
  54.     tf_frontpen * : e.UBYTE;              (* front pen to use *)
  55.   END;
  56.  
  57. VAR
  58.  
  59.   itext : i.IntuiText;
  60.  
  61.  
  62. (*************************************************************************
  63. *                                                                        *
  64. * MinSize Method                                                         *
  65. *                                                                        *
  66. *************************************************************************)
  67.  
  68. PROCEDURE MinSize*
  69.   ( hook_ptr : u.HookPtr;
  70.     obj_ptr  : ea.OPTR;
  71.     msg_ptr  : e.APTR )
  72.   : e.ULONG;
  73.  
  74.   VAR
  75.     minwidth, minheight, ignore : LONGINT;
  76.     tf_ptr : ci_TextFieldPtr;
  77.  
  78. BEGIN (* MinSize *)
  79.   (* get a pointer to our structure, and check if we actually got it *)
  80.   tf_ptr := SYS.VAL (ci_TextFieldPtr, ea.GetAttr (obj_ptr, ea.UserData));
  81.   IF tf_ptr # NIL THEN
  82.     (* now, we use the library to determine the dimensions of the string *)
  83.     minwidth :=
  84.       ea.TextLengthPtr (tf_ptr.tf_textattr_ptr, tf_ptr.tf_string_ptr, 0X);
  85.     minheight :=
  86.       ea.TextHeightPtr (tf_ptr.tf_textattr_ptr);
  87.  
  88.     (* and finally, we set these values *)
  89.     ignore := ea.SetAttr (obj_ptr, ea.MinWidth, minwidth);
  90.     ignore := ea.SetAttr (obj_ptr, ea.MinHeight, minheight);
  91.   END;
  92.   (* we always return success *)
  93.   RETURN 0
  94. END MinSize;
  95.  
  96. (*************************************************************************
  97. *                                                                        *
  98. * Render Method                                                          *
  99. *                                                                        *
  100. *************************************************************************)
  101.  
  102. PROCEDURE Render*
  103.   ( hook_ptr : u.HookPtr;
  104.     obj_ptr  : ea.OPTR;
  105.     rm_ptr   : ea.RenderMessagePtr )
  106.   : e.ULONG;
  107.  
  108.   VAR
  109.     tf_ptr : ci_TextFieldPtr;
  110.     minwidth, minheight, width, height, left, top, ignore : e.ULONG;
  111.  
  112. BEGIN (* Render *)
  113.   (* get a pointer to our structure, and check if we actually got it *)
  114.   tf_ptr := SYS.VAL (ci_TextFieldPtr, ea.GetAttr (obj_ptr, ea.UserData));
  115.   IF tf_ptr # NIL THEN
  116.     (* get sizes of the object *)
  117.     ignore := ea.GetAttrs ( obj_ptr,
  118.                             ea.MinWidth,  SYS.ADR (minwidth),
  119.                             ea.MinHeight, SYS.ADR (minheight),
  120.                             ea.Width,     SYS.ADR (width),
  121.                             ea.Height,    SYS.ADR (height),
  122.                             u.done );
  123.  
  124.     (* get offsets of object relative to root (window) *)
  125.     left := ea.GetObjectLeft (rm_ptr.root_ptr, obj_ptr);
  126.     top := ea.GetObjectTop (rm_ptr.root_ptr, obj_ptr);
  127.  
  128.     (* now align the object *)
  129.     IF (CITF_ALIGNRIGHT IN tf_ptr.tf_flags) THEN
  130.       INC (left, (width - minwidth));
  131.     ELSIF (~(CITF_ALIGNLEFT IN tf_ptr.tf_flags)) THEN
  132.       INC (left, (width - minwidth) DIV 2);
  133.     END;
  134.     IF (CITF_ALIGNBOTTOM IN tf_ptr.tf_flags) THEN
  135.       INC (top, (height - minheight))
  136.     ELSIF (~(CITF_ALIGNTOP IN tf_ptr.tf_flags)) THEN
  137.       INC (top, (height - minheight) DIV 2);
  138.     END;
  139.  
  140.     (* and finally render it *)
  141.     itext.iTextFont := tf_ptr.tf_textattr_ptr;
  142.     itext.iText := tf_ptr.tf_string_ptr;
  143.     itext.frontPen := tf_ptr.tf_frontpen;
  144.     i.PrintIText (rm_ptr.rastport_ptr, itext, left, top);
  145.   END;
  146.   (* return success *)
  147.   RETURN 0
  148. END Render;
  149.  
  150.  
  151. PROCEDURE Init;
  152. BEGIN (* Init *)
  153.   (* Assuming uninitialised fields are zeroed... *)
  154.   itext.frontPen := 1; itext.drawMode := gfx.jam1
  155. END Init;
  156.  
  157. BEGIN
  158.   Init
  159. END TextField.
  160.