PreviousUpNext

15.4.1469  src/lib/x-kit/xclient/pkg/window/draw-types.pkg

## draw-types.pkg
#
# Types of chunks that can be drawn on (or are pixel sources).

# Compiled by:
#     src/lib/x-kit/xclient/xclient-internals.sublib






###                    "The Universe is a grand book which cannot be read
###                     until one first learns to comprehend the language
###                     and become familiar with the characters in which
###                     it is composed.  It is written in the language of
###                     mathematics..."
###
###                                             -- Galilei Galileo  



stipulate
    include threadkit;                          # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package xg =  xgeometry;                    # xgeometry             is from   src/lib/std/2d/xgeometry.pkg
    package xt =  xtypes;                       # xtypes                is from   src/lib/x-kit/xclient/pkg/wire/xtypes.pkg
    package sn =  xsession;                     # xsession              is from   src/lib/x-kit/xclient/pkg/window/xsession.pkg
    package di =  draw_imp;                     # draw_imp              is from   src/lib/x-kit/xclient/pkg/window/draw-imp.pkg
    package pg =  pen_guts;                     # pen_guts              is from   src/lib/x-kit/xclient/pkg/window/pen-guts.pkg
herein

    package   draw_types
    : (weak)  Draw_Types                        # Draw_Types            is from   src/lib/x-kit/xclient/pkg/window/draw-types.api
    {
        # This basically does
        #
        #     Window = sn::Window;
        #
        package x: api {
                       Window
                           =
                           WINDOW
                             {
                               window_id:                       xt::Window_Id,
                               screen:                          sn::Screen,
                               screen_pen_and_draw_imps:        sn::Screen_Pen_And_Draw_Imps,
                               to_topwindow_drawimp:            di::d::Draw_Op -> Void
                             };
                   } = xsession;
        include xsession;    


        #  An off-screen rectangular pixel array on X server:
        #
        Rw_Pixmap
            =
            RW_PIXMAP
              {  
                pixmap_id:                      xt::Pixmap_Id,
                screen:                         sn::Screen,
                size:                           xg::Size,
                screen_pen_and_draw_imps:       sn::Screen_Pen_And_Draw_Imps
              };

        # Immutable pixmaps 
        #
        Ro_Pixmap = RO_PIXMAP  Rw_Pixmap;

        #  identity tests 

        same_window = sn::same_window;

        fun same_rw_pixmap
            (
              RW_PIXMAP { pixmap_id=>id1, screen=>s1, ... }, 
              RW_PIXMAP { pixmap_id=>id2, screen=>s2, ... }
            )
            =
            (id1 == id2) and sn::same_screen (s1, s2);

        fun same_ro_pixmap
            (  RO_PIXMAP p1,
               RO_PIXMAP p2
            )
            =
            same_rw_pixmap (p1, p2);

        # Sources for bitblt operations:
        #
        Draw_From
          = FROM_WINDOW          Window
          | FROM_RW_PIXMAP    Rw_Pixmap
          | FROM_RO_PIXMAP    Ro_Pixmap
          ;

        fun depth_of_window                   (WINDOW { screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } )  = depth;
        fun depth_of_rw_pixmap             (RW_PIXMAP { screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } )  = depth;
        fun depth_of_ro_pixmap  (RO_PIXMAP (RW_PIXMAP { screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } )) = depth;

        fun id_of_window                   (WINDOW { window_id => xt::XID u, ... } )  =  unt::to_int u;
        fun id_of_rw_pixmap             (RW_PIXMAP { pixmap_id => xt::XID u, ... } )  =  unt::to_int u;
        fun id_of_ro_pixmap  (RO_PIXMAP (RW_PIXMAP { pixmap_id => xt::XID u, ... } )) =  unt::to_int u;

        fun depth_of_draw_src (FROM_WINDOW    w) =>  depth_of_window     w;
            depth_of_draw_src (FROM_RW_PIXMAP w) =>  depth_of_rw_pixmap  w;
            depth_of_draw_src (FROM_RO_PIXMAP w) =>  depth_of_ro_pixmap  w;
        end;

        fun shape_of_window (WINDOW { window_id, screen=>sn::SCREEN { xsession, ... }, ... } )
            =
            {   include value_to_wire;                                  # value_to_wire is from   src/lib/x-kit/xclient/pkg/wire/value-to-wire.pkg
                include wire_to_value;                                  # wire_to_value is from   src/lib/x-kit/xclient/pkg/wire/wire-to-value.pkg

                reply = do_mailop
                            (sn::send_xrequest_and_read_reply
                                xsession
                                (encode_get_geometry { drawable=>window_id } )
                            );

                my { depth, geometry=>xg::WINDOW_SITE { upperleft, size, border_thickness }, ... }
                    =
                    decode_get_geometry_reply reply;

                { upperleft, size, depth, border_thickness };
            };

        fun shape_of_rw_pixmap (RW_PIXMAP { size, screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { depth, ... }, ... } )
            =
            { upperleft => xg::point::zero,
              size,
              depth,
              border_thickness => 0
            };

        fun shape_of_ro_pixmap (RO_PIXMAP pm)
            =
            shape_of_rw_pixmap  pm;

        fun shape_of_draw_src (FROM_WINDOW w)                 =>  shape_of_window     w;
            shape_of_draw_src (FROM_RW_PIXMAP pm)             =>  shape_of_rw_pixmap  pm;
            shape_of_draw_src (FROM_RO_PIXMAP (RO_PIXMAP pm)) =>  shape_of_rw_pixmap  pm;
        end;


        fun size_of_window window
            =
            {   my { size, ... }
                    =
                    shape_of_window window;

                size;
            };


        fun size_of_rw_pixmap (RW_PIXMAP { size, ... } )
            =
            size;


        fun size_of_ro_pixmap (RO_PIXMAP pm)
            =
            size_of_rw_pixmap  pm;


        fun flush_drawimp  to_drawimp
            =
            {   done_flush_oneshot = make_oneshot_maildrop ();
                #
                to_drawimp (di::d::FLUSH done_flush_oneshot);
                #
                get done_flush_oneshot;
            };  

        fun drawimp_thread_id_of  to_drawimp
            =
            {   thread_id_oneshot = make_oneshot_maildrop ();
                #
                to_drawimp (di::d::THREAD_ID thread_id_oneshot);
                #
                get thread_id_oneshot;
            };  

        # drawables **
        #
        # these are abstract views of drawable chunks (e.g., windows or pixmaps).
        #
        package r {
            #
            Window_Or_Pixmap
              #
              = WINDOW  Window
              | PIXMAP  Rw_Pixmap
              ;
        };
        #
        Drawable
            =
            DRAWABLE
              {
                root:           r::Window_Or_Pixmap,
                to_drawimp:     di::d::Draw_Op -> Void
              };

        # Make a drawable from a window 
        #
        fun drawable_of_window (w as WINDOW { to_topwindow_drawimp => to_drawimp, ... } )
            =
            DRAWABLE { root => r::WINDOW w, to_drawimp };


        # Make a drawable from a rw_pixmap 
        #
        fun drawable_of_rw_pixmap (pm as RW_PIXMAP { size, screen_pen_and_draw_imps => sn::SCREEN_PEN_AND_DRAW_IMPS { to_screen_drawimp, ... }, ... } )
            =
            DRAWABLE { root => r::PIXMAP pm, to_drawimp=>draw_command' }
            where 

                fun draw_command' (di::d::DRAW { to, pen, op => di::o::CLEAR_AREA (xg::BOX { col, row, wide, high } ) } )
                        =>
                        {   fun clip (z, 0, max) =>   max - z;
                                clip (z, w, max) =>   if  ( (z + w) > max   )   max - z;   else   w;   fi;
                            end;

                            my xg::SIZE { wide => pm_wide,
                                         high => pm_high
                                       }
                                =
                                size;

                            to_box
                                =
                                xg::BOX
                                  { col,
                                    row,
                                    wide => clip (col, wide, pm_wide),
                                    high => clip (row, high, pm_high)
                                  };

                            to_screen_drawimp (di::d::DRAW {
                                  to,
                                  pen => pg::default_pen,
                                  op  => di::o::POLY_FILL_BOX [ to_box ]
                                } );

                            # The following is needed to
                            # avoid race between updating
                            # the rw_pixmap and using it as
                            # the source of a blt:
                            #
                            flush_drawimp  to_screen_drawimp;
                        };

                    draw_command' dmsg
                        =>
                        to_screen_drawimp  dmsg;
                end;
            end;

        fun depth_of_drawable (DRAWABLE { root => r::WINDOW w,  ... } ) =>   depth_of_window      w;
            depth_of_drawable (DRAWABLE { root => r::PIXMAP pm, ... } ) =>   depth_of_rw_pixmap  pm;
        end;

        # An unbuffered drawable is used to provide immediate
        # graphical response to user interaction.  Currently
        # this is implemented by transparently adding a flush
        # command after each draw command. There is probably
        # a better way.
        #
        # This call is used in many of the src/lib/x-kit/tut
        # programs, for an example in:
        #
        #     src/lib/x-kit/widget/fancy/graphviz/get-mouse-selection.pkg
        #
        fun make_unbuffered_drawable (DRAWABLE { root as r::WINDOW w, to_drawimp } )
                =>
                DRAWABLE
                  {
                    root,
                    to_drawimp =>   fn msg =  {   to_drawimp  msg;
                                                  flush_drawimp  to_drawimp;
                                              }
                  };

            make_unbuffered_drawable d
                =>
                d;
        end;

        # The following exception is raised
        # if an attempt is made to use a stale
        # overlay drawable (i.e., one that has been released).
        #
        exception STALE_OVERLAY;


        # Create a locked version of the given window.
        # This provides exclusive access to its drawing
        # surface (and that of its descendents) during
        # OP_XOR rubber-banding.  Usually used in conjunction
        # with unbuffered drawing (below).      
        # 
        # The first result is the locked window on which to draw,
        # the second is the unlock operation for the drawable.
        # By convention, the overlay drawable is unbuffered.
        #
        #
        # This call appears to be unused at present, but see
        # much related-looking "overlay" code in
        #     src/lib/x-kit/xclient/pkg/window/draw-imp.pkg
        # this may be a half-implemented idea.
        #
        fun make_locked_window w
            =
            {   release_1shot =  make_oneshot_maildrop ();

                new_draw_slot =  make_mailslot ();

                # The draw command for the overlay.
                # It raises STALE_OVERLAY if called
                # after the overlay is released.

                error_mailop
                    =
                    get'  release_1shot
                        ==>
                        .{   raise exception STALE_OVERLAY;   };

                fun draw_fn msg
                    =
                    select [
                        give'  (new_draw_slot,  msg),
                        error_mailop
                    ];

                fun draw_and_flush  msg
                    =
                    {   draw_fn  msg;

                        flush_done_oneshot = make_oneshot_maildrop ();
                        draw_fn  (di::d::FLUSH flush_done_oneshot);
                        get flush_done_oneshot;
                    };

                # The function used to release the overlay.
                # Multiple calls are allowed,
                # so we must handle WriteTwice.
                #
                fun release_fn ()
                    =
                    set (release_1shot, ())
                    except
                        _ = ();

                draw_fn (
                    di::d::LOCK_WINDOW_FOR_RUBBERBANDING
                     {
                       draw_slot => new_draw_slot,
                       release'  => get' release_1shot
                     }
                );

                { drawable =>   DRAWABLE { root => r::WINDOW w, to_drawimp => draw_and_flush },
                  release  =>   release_fn
                };
            };

    };  #  draw_types 
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext