Prima-1.28/0000755000175100017510000000000011150770061010272 5ustar dkdkPrima-1.28/File.c0000644000175100017510000001244411150770061011322 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: File.c,v 1.24 2007/08/09 13:03:06 dk Exp $ */ #include "apricot.h" #ifdef PerlIO typedef PerlIO *FileStream; #else #define PERLIO_IS_STDIO 1 typedef FILE *FileStream; #define PerlIO_fileno(f) fileno(f) #endif #include "File.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CComponent #define my ((( PFile) self)-> self) #define var (( PFile) self) static void File_reset_notifications( Handle self); void File_init( Handle self, HV * profile) { dPROFILE; var-> fd = -1; inherited-> init( self, profile); my-> set_mask( self, pget_i( mask)); var-> eventMask2 = ( query_method( self, "on_read", 0) ? feRead : 0) | ( query_method( self, "on_write", 0) ? feWrite : 0) | ( query_method( self, "on_exception", 0) ? feException : 0); File_reset_notifications( self); my-> set_file( self, pget_sv( file)); CORE_INIT_TRANSIENT(File); } void File_cleanup( Handle self) { my-> set_file( self, nilSV); inherited-> cleanup( self); } Bool File_is_active( Handle self, Bool autoDetach) { if (!var-> file || SvTYPE( var-> file) != SVt_NULL) return false; if ( !IoIFP( sv_2io( var-> file))) { if ( autoDetach) my-> set_file( self, nilSV); return false; } return true; } void File_handle_event( Handle self, PEvent event) { inherited-> handle_event ( self, event); if ( var-> stage > csNormal) return; switch ( event-> cmd) { case cmFileRead: my-> notify( self, " file ? var-> file : nilSV); break; case cmFileWrite: my-> notify( self, " file ? var-> file : nilSV); break; case cmFileException: my-> notify( self, " file ? var-> file : nilSV); break; } } SV * File_file( Handle self, Bool set, SV * file) { if ( !set) return var-> file ? newSVsv( var-> file) : nilSV; if ( var-> file) { apc_file_detach( self); sv_free( var-> file); } var-> file = nil; var-> fd = -1; if ( file && ( SvTYPE( file) != SVt_NULL)) { FileStream f = IoIFP(sv_2io(file)); if (!f) { warn("RTC0A0: Not a IO reference passed to File::set_file"); } else { var-> file = newSVsv( file); var-> fd = PerlIO_fileno( f); if ( !apc_file_attach( self)) { sv_free( var-> file); var-> file = nil; var-> fd = -1; } } } return nilSV; } SV * File_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08x", var-> fd); return newSVpv( buf, 0); } int File_mask( Handle self, Bool set, int mask) { if ( !set) return var-> userMask; var-> userMask = mask; File_reset_notifications( self); return mask; } long File_add_notification( Handle self, char * name, SV * subroutine, Handle referer, int index) { long id = inherited-> add_notification( self, name, subroutine, referer, index); if ( id != 0) File_reset_notifications( self); return id; } void File_remove_notification( Handle self, long id) { inherited-> remove_notification( self, id); File_reset_notifications( self); } static void File_reset_notifications( Handle self) { int i, mask = var-> eventMask2; PList list; void * ret[ 3]; int cmd[ 3] = { feRead, feWrite, feException}; if ( var-> eventIDs == nil) { var-> eventMask = var-> eventMask2 & var-> userMask; return; } ret[0] = hash_fetch( var-> eventIDs, "Read", 4); ret[1] = hash_fetch( var-> eventIDs, "Write", 5); ret[2] = hash_fetch( var-> eventIDs, "Exception", 9); for ( i = 0; i < 3; i++) { if ( ret[i] == nil) continue; list = var-> events + PTR2IV( ret[i]) - 1; if ( list-> count > 0) mask |= cmd[ i]; } mask &= var-> userMask; if ( var-> eventMask != mask) { var-> eventMask = mask; if ( var-> file) apc_file_change_mask( self); } } #ifdef __cplusplus } #endif Prima-1.28/AccelTable.cls0000644000175100017510000000311011150770061012747 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: AccelTable.cls,v 1.8 2002/05/14 13:22:16 dk Exp $ object Prima::AccelTable( Prima::AbstractMenu) { property Bool selected; method void init( HV * profile); method void set_items( SV * menuItems); } Prima-1.28/Window.cls0000644000175100017510000000670411150770061012253 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Window.cls,v 1.22 2004/12/14 11:13:09 dk Exp $ object Prima::Window( Prima::Widget) { Handle menu; Font menuFont; ColorSet menuColor; int modal; int modalResult; property int borderIcons; property int borderStyle; property Bool focused; property Point frameOrigin; property Point frameSize; property Handle icon; property Handle menu; property Color menuColorIndex( int index); property SV * menuItems; property Bool modalHorizon; property int modalResult; property Bool onTop; property Point origin; property Bool ownerIcon; property Rect rect; property Bool selected; property Point size; property Bool taskListed; property SV * text; property Bool transparent; property int windowState; method void cancel(); method void cleanup(); method void end_modal(); method int execute( Handle insertBefore = nilHandle); method Bool execute_shared( Handle insertBefore = nilHandle); static Font get_default_menu_font( char * dummy = ""); method Handle get_horizon(); method Font get_menu_font(); method int get_modal(); method Handle get_modal_window( int modalFlag = mtExclusive, Bool next = true); c_only void handle_event ( PEvent event); method void init( HV * profile); import SV * notification_types(); method void ok(); c_only Bool process_accel( int key); import SV * profile_default (); method void set( HV * profile); method void set_menu_font( Font font); c_only void update_sys_handle( HV * profile); c_only Bool validate_owner( Handle * newOwner, HV * profile); # private Handle nextExclModal; Handle prevExclModal; Handle nextSharedModal; Handle prevSharedModal; Handle topSharedModal; c_only void exec_enter_proc( Bool sharedExec, Handle insertBefore); c_only void exec_leave_proc(); c_only void cancel_children(); } Prima-1.28/test.pl0000644000175100017510000000004311150770061011603 0ustar dkdkdo 'test/Tester.pl'; die $@ if $@; Prima-1.28/Image.c0000644000175100017510000013262411150770061011470 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: Image.c,v 1.134 2008/09/02 10:21:54 dk Exp $ */ #include "img.h" #include #include #include #include #include "apricot.h" #include "Image.h" #include "img_conv.h" #include #include "Clipboard.h" #ifdef PerlIO typedef PerlIO *FileStream; #else #define PERLIO_IS_STDIO 1 typedef FILE *FileStream; #define PerlIO_fileno(f) fileno(f) #endif #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CDrawable-> #define my ((( PImage) self)-> self) #define var (( PImage) self) static Bool Image_set_extended_data( Handle self, HV * profile); static void Image_reset_notifications( Handle self); void Image_init( Handle self, HV * profile) { dPROFILE; inherited init( self, profile); var-> eventMask1 = ( query_method( self, "on_headerready", 0) ? IMG_EVENTS_HEADER_READY : 0) | ( query_method( self, "on_dataready", 0) ? IMG_EVENTS_DATA_READY : 0); Image_reset_notifications( self); var->w = pget_i( width); var->h = pget_i( height); var->conversion = pget_i( conversion); opt_assign( optHScaling, pget_B( hScaling)); opt_assign( optVScaling, pget_B( vScaling)); if ( !itype_supported( var-> type = pget_i( type))) if ( !itype_importable( var-> type, &var-> type, nil, nil)) { warn( "Image::init: cannot set type %08x", var-> type); var-> type = imBW; } var->lineSize = (( var->w * ( var->type & imBPP) + 31) / 32) * 4; var->dataSize = ( var->lineSize) * var->h; if ( var-> dataSize > 0) { var->data = allocb( var->dataSize); memset( var-> data, 0, var-> dataSize); if ( var-> data == nil) { my-> make_empty( self); croak("Image::init: cannot allocate %d bytes", var-> dataSize); } } else var-> data = nil; var->palette = allocn( RGBColor, 256); if ( var-> palette == nil) { free( var-> data); var-> data = nil; croak("Image::init: cannot allocate %d bytes", 768); } if ( !Image_set_extended_data( self, profile)) my-> set_data( self, pget_sv( data)); opt_assign( optPreserveType, pget_B( preserveType)); var->palSize = (1 << (var->type & imBPP)) & 0x1ff; if (!( var->type & imGrayScale) && pexist( palette)) { /* palette might be killed by set_extended_data() */ int ps = apc_img_read_palette( var->palette, pget_sv( palette), true); if ( ps) var-> palSize = ps; } { Point set; prima_read_point( pget_sv( resolution), (int*)&set, 2, "RTC0109: Array panic on 'resolution'"); my-> set_resolution( self, set); } if ( var->type & imGrayScale) switch ( var->type & imBPP) { case imbpp1: memcpy( var->palette, stdmono_palette, sizeof( stdmono_palette)); break; case imbpp4: memcpy( var->palette, std16gray_palette, sizeof( std16gray_palette)); break; case imbpp8: memcpy( var->palette, std256gray_palette, sizeof( std256gray_palette)); break; } apc_image_create( self); my->update_change( self); CORE_INIT_TRANSIENT(Image); } void Image_handle_event( Handle self, PEvent event) { inherited handle_event ( self, event); if ( var-> stage > csNormal) return; switch ( event-> cmd) { case cmImageHeaderReady: my-> notify( self, " update_change( self); my-> notify( self, " gen. R. left, event-> gen. R. bottom, event-> gen. R. right - event-> gen. R. left + 1, event-> gen. R. top - event-> gen. R. bottom + 1); break; } } void Image_reset( Handle self, int new_type, RGBColor * palette, int palSize) { Bool want_palette; RGBColor new_palette[256]; Byte * new_data = nil; int new_pal_size = 0, new_line_size, new_data_size, want_only_palette_colors = 0; if ( var->stage > csFrozen) return; want_palette = (!( new_type & imGrayScale)) && ( new_type != imRGB) && (palSize > 0); if ( want_palette) { new_pal_size = palSize; if ( new_pal_size == 0) want_palette = false; if ( new_pal_size > ( 1 << ( new_type & imBPP))) new_pal_size = 1 << ( new_type & imBPP); if ( new_pal_size > 256) new_pal_size = 256; if ( palette != nil) memcpy( new_palette, palette, new_pal_size * 3); else want_only_palette_colors = 1; } if ( !want_palette && ( ((var->type == (imbpp8|imGrayScale)) && (new_type == imbpp8)) || ((var->type == (imbpp4|imGrayScale)) && (new_type == imbpp4)) || ((var->type == (imbpp1|imGrayScale)) && (new_type == imbpp1)) )) { var->type = new_type; return; } if ( var-> type == new_type && ( ((new_type != imbpp8 && new_type != imbpp4 && new_type != imbpp1) || !want_palette) )) return; new_line_size = (( var-> w * ( new_type & imBPP) + 31) / 32) * 4; new_data_size = new_line_size * var-> h; if ( new_data_size > 0) { if ( !( new_data = allocb( new_data_size))) { my-> make_empty( self); croak("Image::reset: cannot allocate %d bytes", new_data_size); } memset( new_data, 0, new_data_size); if ( new_pal_size != 1) ic_type_convert( self, new_data, new_palette, new_type, &new_pal_size, want_only_palette_colors); } if ( new_pal_size > 0) { var-> palSize = new_pal_size; memcpy( var-> palette, new_palette, new_pal_size * 3); } free( var-> data); var-> type = new_type; var-> data = new_data; var-> lineSize = new_line_size; var-> dataSize = new_data_size; my-> update_change( self); } void Image_stretch( Handle self, int width, int height) { Byte * newData = nil; int lineSize; if ( var->stage > csFrozen) return; if ( width > 65535) width = 65535; if ( height > 65535) height = 65535; if ( width < -65535) width = -65535; if ( height < -65535) height = -65535; if (( width == var->w) && ( height == var->h)) return; if ( width == 0 || height == 0) { my->create_empty( self, 0, 0, var->type); return; } lineSize = (( abs( width) * ( var->type & imBPP) + 31) / 32) * 4; newData = allocb( lineSize * abs( height)); if ( newData == nil) croak("Image::stretch: cannot allocate %d bytes", lineSize * abs( height)); memset( newData, 0, lineSize * abs( height)); if ( var-> data) ic_stretch( var-> type, var-> data, var-> w, var-> h, newData, width, height, is_opt( optHScaling), is_opt( optVScaling)); free( var->data); var->data = newData; var->lineSize = lineSize; var->dataSize = lineSize * abs( height); var->w = abs( width); var->h = abs( height); my->update_change( self); } static void Image_reset_sv( Handle self, int new_type, SV * palette, Bool triplets) { int colors; RGBColor pal_buf[256], *pal_ptr; if ( !palette || palette == nilSV) { pal_ptr = nil; colors = 0; } else if ( SvROK( palette) && ( SvTYPE( SvRV( palette)) == SVt_PVAV)) { colors = apc_img_read_palette( pal_ptr = pal_buf, palette, triplets); } else { pal_ptr = nil; colors = SvIV( palette); } my-> reset( self, new_type, pal_ptr, colors); } void Image_set( Handle self, HV * profile) { dPROFILE; if ( pexist( conversion)) { my-> set_conversion( self, pget_i( conversion)); pdelete( conversion); } if ( pexist( hScaling)) { my->set_hScaling( self, pget_B( hScaling)); pdelete( hScaling); } if ( pexist( vScaling)) { my->set_vScaling( self, pget_B( vScaling)); pdelete( vScaling); } if ( Image_set_extended_data( self, profile)) pdelete( data); if ( pexist( type)) { int newType = pget_i( type); if ( !itype_supported( newType)) warn("RTC0100: Invalid image type requested (%08x) in Image::set_type", newType); else if ( !opt_InPaint) { SV * palette; Bool triplets; if ( pexist( palette)) { palette = pget_sv(palette); triplets = true; } else if ( pexist( colormap)) { palette = pget_sv(colormap); triplets = false; } else { palette = nilSV; triplets = false; } Image_reset_sv( self, newType, palette, triplets); } pdelete( colormap); pdelete( palette); pdelete( type); } if ( pexist( resolution)) { Point set; prima_read_point( pget_sv( resolution), (int*)&set, 2, "RTC0109: Array panic on 'resolution'"); my-> set_resolution( self, set); pdelete( resolution); } inherited set ( self, profile); } void Image_done( Handle self) { apc_image_destroy( self); my->make_empty( self); inherited done( self); } void Image_make_empty( Handle self) { free( var->data); free( var->palette); var->w = 0; var->h = 0; var->type = 0; var->palSize = 0; var->lineSize = 0; var->dataSize = 0; var->data = nil; var->palette = nil; my->update_change( self); } Bool Image_hScaling( Handle self, Bool set, Bool scaling) { if ( !set) return is_opt( optHScaling); opt_assign( optHScaling, scaling); return false; } Bool Image_vScaling( Handle self, Bool set, Bool scaling) { if ( !set) return is_opt( optVScaling); opt_assign( optVScaling, scaling); return false; } Point Image_resolution( Handle self, Bool set, Point resolution) { if ( !set) return var-> resolution; if ( resolution. x <= 0 || resolution. y <= 0) resolution = apc_gp_get_resolution( application); var-> resolution = resolution; return resolution; } Point Image_size( Handle self, Bool set, Point size) { if ( !set) return inherited size( self, set, size); CImage( self)-> stretch( self, size.x, size.y); return size; } SV * Image_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", apc_image_get_handle( self)); return newSVpv( buf, 0); } Color Image_get_nearest_color( Handle self, Color color) { Byte pal; RGBColor rgb, *pcolor; if ( is_opt( optInDrawInfo) || is_opt( optInDraw)) return inherited get_nearest_color( self, color); switch ( var-> type & imCategory) { case imColor: if (( var-> type & imBPP) > 8) return color; rgb. b = color & 0xFF; rgb. g = (color >> 8) & 0xFF; rgb. r = (color >> 16) & 0xFF; break; case imGrayScale: rgb. r = rgb. g = rgb. b = ( (color & 0xFF) + ((color >> 8) & 0xFF) + ((color >> 16) & 0xFF) ) / 3; break; default: return clInvalid; /* what else? */ } pal = cm_nearest_color( rgb, var-> palSize, var-> palette); pcolor = var->palette + pal; return ARGB( pcolor-> r, pcolor-> g, pcolor-> b); } SV * Image_data( Handle self, Bool set, SV * svdata) { void *data; STRLEN dataSize; if ( var->stage > csFrozen) return nilSV; if ( !set) return newSVpvn(( char *) var-> data, var-> dataSize); data = SvPV( svdata, dataSize); if ( is_opt( optInDraw) || dataSize <= 0) return nilSV; memcpy( var->data, data, dataSize > var->dataSize ? var->dataSize : dataSize); my-> update_change( self); return nilSV; } /* Routine sets image data almost as Image::set_data, but taking into account 'lineSize', 'type', and 'reverse' fields. To be called from bunch routines, line ::init or ::set. Returns true if relevant fields were found and data extracted and set, and false if user data should be set throught ::set_data. Image itself may undergo conversion during the routine; in that case 'palette' property may be used also. All these fields, if used, or meant to be used but erroneously set, will be deleted regardless of routine success. */ Bool Image_set_extended_data( Handle self, HV * profile) { dPROFILE; void *data, *proc; STRLEN dataSize; int lineSize = 0, newType = var-> type, fixType, oldType = -1; Bool pexistType, pexistLine, pexistReverse, supp, reverse = false; if ( !pexist( data)) { if ( pexist( lineSize)) { warn( "Image: lineSize supplied without data property."); pdelete( lineSize); } return false; } data = SvPV( pget_sv( data), dataSize); /* parameters check */ pexistType = pexist( type) && ( newType = pget_i( type)) != var-> type; pexistLine = pexist( lineSize) && ( lineSize = pget_i( lineSize)) != var-> lineSize; pexistReverse = pexist( reverse) && ( reverse = pget_B( reverse)); pdelete( lineSize); pdelete( type); pdelete( reverse); if ( !pexistLine && !pexistType && !pexistReverse) return false; if ( is_opt( optInDraw) || dataSize <= 0) goto GOOD_RETURN; /* determine line size, if any */ if ( pexistLine) { if ( lineSize <= 0) { warn( "Image::set_data: invalid lineSize:%d passed", lineSize); goto GOOD_RETURN; } if ( !pexistType) { /* plain repadding */ ibc_repad(( Byte*) data, var-> data, lineSize, var-> lineSize, dataSize, var-> dataSize, 1, 1, nil, reverse); my-> update_change( self); goto GOOD_RETURN; } } /* pre-fetch auto conversion, if set in same clause */ if ( pexist( preserveType)) opt_assign( optPreserveType, pget_B( preserveType)); if ( is_opt( optPreserveType)) oldType = var-> type; /* getting closest type */ if (( supp = itype_supported( newType))) { fixType = newType; proc = nil; } else if ( !itype_importable( newType, &fixType, &proc, nil)) { warn( "Image::set_data: invalid image type %08x", newType); goto GOOD_RETURN; } /* fixing image and maybe palette - for known type it's same code as in ::set, */ /* but here's no sense calling it, just doing what we need. */ if ( fixType != var-> type || pexist( palette) || pexist( colormap)) { SV * palette; Bool triplets; if ( pexist( palette)) { palette = pget_sv( palette); triplets = true; } else if ( pexist( colormap)) { palette = pget_sv( colormap); triplets = false; } else { palette = nilSV; triplets = false; } Image_reset_sv( self, fixType, palette, triplets); pdelete( palette); pdelete( colormap); } /* copying user data */ if ( supp && lineSize == 0 && !reverse) /* same code as in ::set_data */ memcpy( var->data, data, dataSize > var->dataSize ? var->dataSize : dataSize); else { /* if no explicit lineSize set, assuming x4 padding */ if ( lineSize == 0) lineSize = (( var-> w * ( newType & imBPP) + 31) / 32) * 4; /* copying using repadding routine */ ibc_repad(( Byte*) data, var-> data, lineSize, var-> lineSize, dataSize, var-> dataSize, ( newType & imBPP) / 8, ( var-> type & imBPP) / 8, proc, reverse ); } my-> update_change( self); /* if want to keep original type, restoring */ if ( is_opt( optPreserveType)) my-> set_type( self, oldType); GOOD_RETURN: pdelete(data); return true; } static size_t img_perlio_read( void * f, size_t bufsize, void * buffer) { #ifdef PerlIO return PerlIO_read(( FileStream) f, buffer, bufsize); #else return fread( buffer, 1, bufsize, ( FileStream) f); #endif } static size_t img_perlio_write( void * f, size_t bufsize, void * buffer) { #ifdef PerlIO return PerlIO_write( ( FileStream) f, buffer, bufsize); #else return fwrite( buffer, 1, bufsize, ( FileStream) f); #endif } static int img_perlio_seek( void * f, long offset, int whence) { #ifdef PerlIO return PerlIO_seek( ( FileStream) f, offset, whence); #else return fseek( ( FileStream) f, offset, whence); #endif } static long img_perlio_tell( void * f) { #ifdef PerlIO return PerlIO_tell( ( FileStream) f); #else return ftell( ( FileStream) f); #endif } static int img_perlio_flush( void * f) { #ifdef PerlIO return PerlIO_flush( ( FileStream) f); #else return fflush( ( FileStream) f); #endif } static int img_perlio_error( void * f) { #ifdef PerlIO return PerlIO_error( ( FileStream) f); #else return ferror( ( FileStream) f); #endif } XS( Image_load_FROMPERL) { dXSARGS; Handle self; SV * sv; HV *profile; char *fn; PList ret; Bool err = false; FileStream f = NULL; ImgIORequest ioreq, *pioreq; char error[256]; if (( items < 2) || (( items % 2) != 0)) croak("Invalid usage of Prima::Image::load"); self = gimme_the_mate( ST( 0)); sv = ST(1); if ( SvROK(sv) && SvTYPE( SvRV( sv)) == SVt_PVGV) f = IoIFP(sv_2io(ST(1))); if ( f != NULL) { pioreq = &ioreq; ioreq. handle = f; ioreq. read = img_perlio_read; ioreq. write = img_perlio_write; ioreq. seek = img_perlio_seek; ioreq. tell = img_perlio_tell; ioreq. flush = img_perlio_flush; ioreq. error = img_perlio_error; fn = NULL; } else { fn = ( char *) SvPV_nolen( ST( 1)); pioreq = NULL; } profile = parse_hv( ax, sp, items, mark, 2, "Image::load"); if ( !pexist( className)) pset_c( className, self ? my-> className : ( char*) SvPV_nolen( ST( 0))); pset_i( eventMask, self ? var-> eventMask2 : 0); ret = apc_img_load( self, fn, pioreq, profile, error); sv_free(( SV *) profile); SPAGAIN; SP -= items; if ( ret) { int i; for ( i = 0; i < ret-> count; i++) { PAnyObject o = ( PAnyObject) ret-> items[i]; if ( o && o-> mate && o-> mate != nilSV) { XPUSHs( sv_mortalcopy( o-> mate)); if (( Handle) o != self) --SvREFCNT( SvRV( o-> mate)); } else { XPUSHs( &sv_undef); err = true; } } plist_destroy( ret); } else { XPUSHs( &sv_undef); err = true; } /* This code breaks exception propagation chain since it uses $@ for its own needs */ if ( err) sv_setpv( GvSV( errgv), error); else sv_setsv( GvSV( errgv), nilSV); PUTBACK; return; } int Image_lineSize( Handle self, Bool set, int dummy) { if ( set) croak("Image::lineSize: attempt to write read-only property"); return var-> lineSize; } PList Image_load_REDEFINED( SV * who, char *filename, HV * profile) { return nil; } PList Image_load( SV * who, char *filename, HV * profile) { PList ret; Handle self = gimme_the_mate( who); char error[ 256]; if ( !pexist( className)) pset_c( className, self ? my-> className : ( char*) SvPV_nolen( who)); ret = apc_img_load( self, filename, NULL, profile, error); return ret; } XS( Image_save_FROMPERL) { dXSARGS; Handle self; HV *profile; char *fn; int ret; char error[256]; FileStream f = NULL; SV * sv; ImgIORequest ioreq, *pioreq; if (( items < 2) || (( items % 2) != 0)) croak("Invalid usage of Prima::Image::save"); self = gimme_the_mate( ST( 0)); sv = ST(1); if ( SvROK(sv) && SvTYPE( SvRV( sv)) == SVt_PVGV) f = IoIFP(sv_2io(ST(1))); if ( f != NULL) { pioreq = &ioreq; ioreq. handle = f; ioreq. read = img_perlio_read; ioreq. write = img_perlio_write; ioreq. seek = img_perlio_seek; ioreq. tell = img_perlio_tell; ioreq. flush = img_perlio_flush; ioreq. error = img_perlio_error; fn = NULL; } else { fn = ( char *) SvPV_nolen( ST( 1)); pioreq = NULL; } profile = parse_hv( ax, sp, items, mark, 2, "Image::save"); ret = apc_img_save( self, fn, pioreq, profile, error); sv_free(( SV *) profile); SPAGAIN; SP -= items; XPUSHs( sv_2mortal( newSViv(( ret > 0) ? ret : -ret))); /* This code breaks exception propagation chain since it uses $@ for its own needs */ if ( ret <= 0) sv_setpv( GvSV( errgv), error); else sv_setsv( GvSV( errgv), nilSV); PUTBACK; return; } int Image_save_REDEFINED( SV * who, char *filename, HV * profile) { return 0; } int Image_save( SV * who, char *filename, HV * profile) { Handle self = gimme_the_mate( who); char error[ 256]; if ( !pexist( className)) pset_c( className, self ? my-> className : ( char*) SvPV_nolen( who)); return apc_img_save( self, filename, NULL, profile, error); } int Image_type( Handle self, Bool set, int type) { HV * profile; if ( !set) return var->type; profile = newHV(); pset_i( type, type); my-> set( self, profile); sv_free(( SV *) profile); return nilHandle; } int Image_get_bpp( Handle self) { return var->type & imBPP; } Bool Image_begin_paint( Handle self) { Bool ok; if ( !inherited begin_paint( self)) return false; if ( !( ok = apc_image_begin_paint( self))) { inherited end_paint( self); perl_error(); } return ok; } Bool Image_begin_paint_info( Handle self) { Bool ok; if ( is_opt( optInDraw)) return true; if ( !inherited begin_paint_info( self)) return false; if ( !( ok = apc_image_begin_paint_info( self))) { inherited end_paint_info( self); perl_error(); } return ok; } void Image_end_paint( Handle self) { int oldType = var->type; if ( !is_opt( optInDraw)) return; apc_image_end_paint( self); inherited end_paint( self); if ( is_opt( optPreserveType) && var->type != oldType) { my->reset( self, oldType, nil, 0); } else { switch( var->type) { case imbpp1: if ( var-> palSize == 2 && memcmp( var->palette, stdmono_palette, sizeof( stdmono_palette)) == 0) var->type |= imGrayScale; break; case imbpp4: if ( var-> palSize == 16 && memcmp( var->palette, std16gray_palette, sizeof( std16gray_palette)) == 0) var->type |= imGrayScale; break; case imbpp8: if ( var-> palSize == 256 && memcmp( var->palette, std256gray_palette, sizeof( std256gray_palette)) == 0) var->type |= imGrayScale; break; } my->update_change( self); } } void Image_end_paint_info( Handle self) { if ( !is_opt( optInDrawInfo)) return; apc_image_end_paint_info( self); inherited end_paint_info( self); } void Image_update_change( Handle self) { if ( var-> stage <= csNormal) apc_image_update_change( self); var->statsCache = 0; } double Image_stats( Handle self, Bool set, int index, double value) { if ( index < 0 || index > isMaxIndex) return 0; if ( set) { var-> stats[ index] = value; var-> statsCache |= 1 << index; return 0; } else { #define gather_stats(TYP) if ( var->data) { \ TYP *src = (TYP*)var->data, *stop, *s; \ maxv = minv = *src; \ for ( y = 0; y < var->h; y++) { \ s = src; stop = s + var->w; \ while (s != stop) { \ v = (double)*s; \ sum += v; \ sum2 += v*v; \ if ( minv > v) minv = v; \ if ( maxv < v) maxv = v; \ s++; \ } \ src = (TYP*)(((Byte *)src) + var->lineSize); \ } \ } int y; double sum = 0.0, sum2 = 0.0, minv = 0.0, maxv = 0.0, v; if ( var->statsCache & ( 1 << index)) return var->stats[ index]; /* calculate image stats */ switch ( var->type) { case imByte: gather_stats(uint8_t);break; case imShort: gather_stats(int16_t); break; case imLong: gather_stats(int32_t); break; case imFloat: gather_stats(float); break; case imDouble: gather_stats(double); break; default: return 0; } if ( var->w * var->h > 0) { var->stats[ isSum] = sum; var->stats[ isSum2] = sum2; sum /= var->w * var->h; sum2 /= var->w * var->h; sum2 = sum2 - sum*sum; var->stats[ isMean] = sum; var->stats[ isVariance] = sum2; var->stats[ isStdDev] = sqrt(sum2); var->stats[ isRangeLo] = minv; var->stats[ isRangeHi] = maxv; } else { for ( y = 0; y <= isMaxIndex; y++) var->stats[ y] = 0; } var->statsCache = (1 << (isMaxIndex + 1)) - 1; } return var->stats[ index]; } void Image_resample( Handle self, double srcLo, double srcHi, double dstLo, double dstHi) { #define RSPARMS self, var->data, var->type, srcLo, srcHi, dstLo, dstHi switch ( var->type) { case imByte: rs_Byte_Byte ( RSPARMS); break; case imShort: rs_Short_Short ( RSPARMS); break; case imLong: rs_Long_Long ( RSPARMS); break; case imFloat: rs_float_float ( RSPARMS); break; case imDouble: rs_double_double ( RSPARMS); break; default: return; } my->update_change( self); } SV * Image_palette( Handle self, Bool set, SV * palette) { if ( var->stage > csFrozen) return nilSV; if ( set) { int ps; if ( var->type & imGrayScale) return nilSV; if ( !var->palette) return nilSV; ps = apc_img_read_palette( var->palette, palette, true); if ( ps) var-> palSize = ps; else warn("RTC0107: Invalid array reference passed to Image::palette"); my-> update_change( self); } else { int i; AV * av = newAV(); int colors = ( 1 << ( var->type & imBPP)) & 0x1ff; Byte * pal = ( Byte*) var->palette; if (( var->type & imGrayScale) && (( var->type & imBPP) > imbpp8)) colors = 256; if ( var-> palSize < colors) colors = var-> palSize; for ( i = 0; i < colors*3; i++) av_push( av, newSViv( pal[ i])); return newRV_noinc(( SV *) av); } return nilSV; } int Image_conversion( Handle self, Bool set, int conversion) { if ( !set) return var-> conversion; return var-> conversion = conversion; } void Image_create_empty( Handle self, int width, int height, int type) { free( var->data); var->w = width; var->h = height; var->type = type; var->lineSize = (( var->w * ( var->type & imBPP) + 31) / 32) * 4; var->dataSize = var->lineSize * var->h; var->palSize = (1 << (var->type & imBPP)) & 0x1ff; if ( var->dataSize > 0) { var->data = allocb( var->dataSize); if ( var-> data == nil) { int sz = var-> dataSize; my-> make_empty( self); croak("Image::create_empty: cannot allocate %d bytes", sz); } memset( var->data, 0, var->dataSize); } else var->data = nil; if ( var->type & imGrayScale) switch ( var->type & imBPP) { case imbpp1: memcpy( var->palette, stdmono_palette, sizeof( stdmono_palette)); break; case imbpp4: memcpy( var->palette, std16gray_palette, sizeof( std16gray_palette)); break; case imbpp8: memcpy( var->palette, std256gray_palette, sizeof( std256gray_palette)); break; } } Bool Image_preserveType( Handle self, Bool set, Bool preserveType) { if ( !set) return is_opt( optPreserveType); opt_assign( optPreserveType, preserveType); return false; } SV * Image_pixel( Handle self, Bool set, int x, int y, SV * pixel) { #define BGRto32(pal) ((var->palette[pal].r<<16) | (var->palette[pal].g<<8) | (var->palette[pal].b)) if (!set) { if ( opt_InPaint) return inherited pixel(self,false,x,y,pixel); if ((x>=var->w) || (x<0) || (y>=var->h) || (y<0)) return newSViv( clInvalid); if ( var-> type & (imComplexNumber|imTrigComplexNumber)) { AV * av = newAV(); switch ( var-> type) { case imComplex: case imTrigComplex: { float * f = (float*)(var->data + (var->lineSize*y+x*2*sizeof(float))); av_push( av, newSVnv( *(f++))); av_push( av, newSVnv( *f)); break; } case imDComplex: case imTrigDComplex: { double * f = (double*)(var->data + (var->lineSize*y+x*2*sizeof(double))); av_push( av, newSVnv( *(f++))); av_push( av, newSVnv( *f)); break; } } return newRV_noinc(( SV*) av); } else if ( var-> type & imRealNumber) { switch ( var-> type) { case imFloat: return newSVnv(*(float*)(var->data + (var->lineSize*y+x*sizeof(float)))); case imDouble: return newSVnv(*(double*)(var->data + (var->lineSize*y+x*sizeof(double)))); default: return nilSV; }} else switch (var->type & imBPP) { case imbpp1: { Byte p=var->data[var->lineSize*y+(x>>3)]; p=(p >> (7-(x & 7))) & 1; return newSViv(((var->type & imGrayScale) ? (p ? 255 : 0) : BGRto32(p))); } case imbpp4: { Byte p=var->data[var->lineSize*y+(x>>1)]; p=(x&1) ? p & 0x0f : p>>4; return newSViv(((var->type & imGrayScale) ? (p*255L)/15 : BGRto32(p))); } case imbpp8: { Byte p=var->data[var->lineSize*y+x]; return newSViv(((var->type & imGrayScale) ? p : BGRto32(p))); } case imbpp16: { return newSViv(*(Short*)(var->data + (var->lineSize*y+x*2))); } case imbpp24: { RGBColor p=*(PRGBColor)(var->data + (var->lineSize*y+x*3)); return newSViv((p.r<<16) | (p.g<<8) | p.b); } case imbpp32: return newSViv(*(Long*)(var->data + (var->lineSize*y+x*4))); default: return newSViv(clInvalid); } #undef BGRto32 } else { Color color; RGBColor rgb; #define LONGtoBGR(lv,clr) ((clr).b=(lv)&0xff,(clr).g=((lv)>>8)&0xff,(clr).r=((lv)>>16)&0xff,(clr)) if ( is_opt( optInDraw)) return inherited pixel(self,true,x,y,pixel); if ((x>=var->w) || (x<0) || (y>=var->h) || (y<0)) return nilSV; if ( var-> type & (imComplexNumber|imTrigComplexNumber)) { if ( !SvROK( pixel) || ( SvTYPE( SvRV( pixel)) != SVt_PVAV)) { switch ( var-> type) { case imComplex: case imTrigComplex: *(float*)(var->data+(var->lineSize*y+x*2*sizeof(float)))=SvNV(pixel); break; case imDComplex: case imTrigDComplex: *(double*)(var->data+(var->lineSize*y+x*2*sizeof(double)))=SvNV(pixel); break; default: return nilSV; } } else { AV * av = (AV *) SvRV( pixel); SV **sv[2]; sv[0] = av_fetch( av, 0, 0); sv[1] = av_fetch( av, 1, 0); switch ( var-> type) { case imComplex: case imTrigComplex: if ( sv[0]) *(float*)(var->data+(var->lineSize*y+x*2*sizeof(float)))=SvNV(*(sv[0])); if ( sv[1]) *(float*)(var->data+(var->lineSize*y+(x*2+1)*sizeof(float)))=SvNV(*(sv[1])); break; case imDComplex: case imTrigDComplex: if ( sv[0]) *(double*)(var->data+(var->lineSize*y+x*2*sizeof(double)))=SvNV(*(sv[0])); if ( sv[1]) *(double*)(var->data+(var->lineSize*y+(x*2+1)*sizeof(double)))=SvNV(*(sv[1])); break; default: return nilSV; } } } else if ( var-> type & imRealNumber) { switch ( var-> type) { case imFloat: *(float*)(var->data+(var->lineSize*y+x*sizeof(float)))=SvNV(pixel); break; case imDouble: *(double*)(var->data+(var->lineSize*y+x*sizeof(double)))=SvNV(pixel); break; default: return nilSV; } my->update_change( self); return nilSV; } color = SvIV( pixel); switch (var->type & imBPP) { case imbpp1 : { int x1=7-(x&7); Byte p=(((var->type & imGrayScale) ? color/255 : cm_nearest_color(LONGtoBGR(color,rgb),var->palSize,var->palette)) & 1); Byte *pd=var->data+(var->lineSize*y+(x>>3)); *pd&=~(1 << x1); *pd|=(p << x1); } break; case imbpp4 : { Byte p=((var->type & imGrayScale) ? (color*15)/255 : cm_nearest_color(LONGtoBGR(color,rgb),var->palSize,var->palette)); Byte *pd=var->data+(var->lineSize*y+(x>>1)); if (x&1) { *pd&=0xf0; } else { p<<=4; *pd&=0x0f; } *pd|=p; } break; case imbpp8: { if (var->type & imGrayScale) { var->data[(var->lineSize)*y+x]=color; } else { var->data[(var->lineSize)*y+x]=cm_nearest_color(LONGtoBGR(color,rgb),(var->palSize),(var->palette)); } } break; case imbpp16 : *(Short*)(var->data+(var->lineSize*y+(x<<1)))=color; break; case imbpp24 : LONGtoBGR(color,rgb); memcpy((var->data + (var->lineSize*y+x*3)),&rgb,sizeof(RGBColor)); break; case imbpp32 : *(Long*)(var->data+(var->lineSize*y+(x<<2)))=color; break; default: return nilSV; } my->update_change( self); #undef LONGtoBGR return nilSV; } } Handle Image_bitmap( Handle self) { Handle h; Point s; HV * profile = newHV(); pset_H( owner, var->owner); pset_i( width, var->w); pset_i( height, var->h); pset_sv_noinc( palette, my->get_palette( self)); pset_i( monochrome, (var-> type & imBPP) == 1); h = Object_create( "Prima::DeviceBitmap", profile); sv_free(( SV *) profile); s = CDrawable( h)-> get_size( h); CDrawable( h)-> put_image_indirect( h, self, 0, 0, 0, 0, s.x, s.y, s.x, s.y, ropCopyPut); --SvREFCNT( SvRV( PDrawable( h)-> mate)); return h; } Handle Image_dup( Handle self) { Handle h; PImage i; HV * profile = newHV(); pset_H( owner, var->owner); pset_i( width, var->w); pset_i( height, var->h); pset_i( type, var->type); pset_i( conversion, var->conversion); pset_i( hScaling, is_opt( optHScaling)); pset_i( vScaling, is_opt( optVScaling)); pset_i( preserveType, is_opt( optPreserveType)); h = Object_create( var->self-> className, profile); sv_free(( SV *) profile); i = ( PImage) h; memcpy( i-> palette, var->palette, 768); i-> palSize = var-> palSize; if ( i-> type != var->type) croak("RTC0108: Image::dup consistency failed"); else memcpy( i-> data, var->data, var->dataSize); memcpy( i-> stats, var->stats, sizeof( var->stats)); i-> statsCache = var->statsCache; if ( hv_exists(( HV*)SvRV( var-> mate), "extras", 6)) { SV ** sv = hv_fetch(( HV*)SvRV( var-> mate), "extras", 6, 0); if ( sv && SvOK( *sv) && SvROK( *sv) && SvTYPE( SvRV( *sv)) == SVt_PVHV) (void) hv_store(( HV*)SvRV( i-> mate), "extras", 6, newSVsv( *sv), 0); } --SvREFCNT( SvRV( i-> mate)); return h; } Handle Image_extract( Handle self, int x, int y, int width, int height) { Handle h; PImage i; HV * profile; unsigned char * data = var->data; int ls = var->lineSize; if ( var->w == 0 || var->h == 0) return my->dup( self); if ( x < 0) x = 0; if ( y < 0) y = 0; if ( x >= var->w) x = var->w - 1; if ( y >= var->h) y = var->h - 1; if ( width + x > var->w) width = var->w - x; if ( height + y > var->h) height = var->h - y; if ( width <= 0 || height <= 0) return my->dup( self); profile = newHV(); pset_H( owner, var->owner); pset_i( width, width); pset_i( height, height); pset_i( type, var->type); pset_i( conversion, var->conversion); pset_i( hScaling, is_opt( optHScaling)); pset_i( vScaling, is_opt( optVScaling)); pset_i( preserveType, is_opt( optPreserveType)); h = Object_create( var->self-> className, profile); sv_free(( SV *) profile); i = ( PImage) h; memcpy( i-> palette, var->palette, 768); i-> palSize = var-> palSize; if (( var->type & imBPP) >= 8) { int pixelSize = ( var->type & imBPP) / 8; while ( height > 0) { height--; memcpy( i-> data + height * i-> lineSize, data + ( y + height) * ls + pixelSize * x, pixelSize * width); } } else if (( var->type & imBPP) == 4) { while ( height > 0) { height--; bc_nibble_copy( data + ( y + height) * ls, i-> data + height * i-> lineSize, x, width); } } else if (( var->type & imBPP) == 1) { while ( height > 0) { height--; bc_mono_copy( data + ( y + height) * ls, i-> data + height * i-> lineSize, x, width); } } --SvREFCNT( SvRV( i-> mate)); return h; } /* divide the pixels, by whether they match color or not on two groups, F and B. Both are converted correspondingly to the settings of color/backColor and rop/rop2. Possible variations: rop == rop::NoOper, pixel value remains ths same rop == rop::CopyPut, use the color value rop == rop::Blackness, use black pixel rop == rop::Whiteness, use white pixel rop == rop::AndPut , result is dest & color value etc... */ void Image_map( Handle self, Color color) { Byte * d, b[2]; RGBColor c; int type = var-> type, height = var-> h, i, ls; int rop[2]; RGBColor r[2]; int bc = 0; if ( var-> data == nil) return; rop[0] = my-> get_rop( self); rop[1] = my-> get_rop2( self); if ( rop[0] == ropNoOper && rop[1] == ropNoOper) return; for ( i = 0; i < 2; i++) { int not = 0; switch( rop[i]) { case ropBlackness: r[i]. r = r[i]. g = r[i]. b = 0; rop[i] = ropCopyPut; break; case ropWhiteness: r[i]. r = r[i]. g = r[i]. b = 0xff; rop[i] = ropCopyPut; break; case ropNoOper: r[i]. r = r[i]. g = r[i]. b = 0; break; default: { Color c = i ? my-> get_backColor( self) : my-> get_color( self); r[i]. r = ( c >> 16) & 0xff; r[i]. g = ( c >> 8) & 0xff; r[i]. b = c & 0xff; }} if (( type & imBPP) <= 8) { b[i] = cm_nearest_color( r[i], var-> palSize, var-> palette); } switch ( rop[i]) { case ropNotPut: rop[i] = ropCopyPut; not = 1; break; case ropNotSrcXor: /* same as ropNotDestXor and ropNotXor */ rop[i] = ropXorPut; not = 1; break; case ropNotSrcAnd: rop[i] = ropAndPut; not = 1; break; case ropNotSrcOr: rop[i] = ropOrPut; not = 1; break; } if ( not) { r[i]. r = ~ r[i]. r; r[i]. g = ~ r[i]. g; r[i]. b = ~ r[i]. b; b[i] = ~ b[i]; } } c. r = ( color >> 16) & 0xff; c. g = ( color >> 8) & 0xff; c. b = color & 0xff; if (( type & imBPP) <= 8) { Color cc; bc = cm_nearest_color( c, var-> palSize, var-> palette); cc = ARGB( var->palette[bc].r, var->palette[bc].g, var->palette[bc].b); if ( cc != color) bc = 0xffff; /* no exact color found */ } if ( (( type & imBPP) < 8) || ( ( type != imRGB) && ( type != (imRGB | imGrayScale)) ) ) { if ( type & imGrayScale) my-> set_type( self, imbpp8 | imGrayScale); else my-> set_type( self, imbpp8); } d = ( Byte * ) var-> data; ls = var-> lineSize; while ( height--) { if (( type & imBPP) == 24) { PRGBColor data = ( PRGBColor) d; for ( i = 0; i < var-> w; i++) { int z = ( data-> r == c.r && data-> g == c.g && data-> b == c.b) ? 0 : 1; switch( rop[z]) { case ropAndPut: data-> r &= r[z]. r; data-> g &= r[z]. g; data-> b &= r[z]. b; break; case ropXorPut: data-> r ^= r[z]. r; data-> g ^= r[z]. g; data-> b ^= r[z]. b; break; case ropOrPut: data-> r |= r[z]. r; data-> g |= r[z]. g; data-> b |= r[z]. b; break; case ropNotDestAnd: data-> r = ( ~data-> r) & r[z].r; data-> g = ( ~data-> g) & r[z].g; data-> b = ( ~data-> b) & r[z].b; break; case ropNotDestOr: data-> r = ( ~data-> r) | r[z].r; data-> g = ( ~data-> g) | r[z].g; data-> b = ( ~data-> b) | r[z].b; break; case ropNotAnd: data-> r = ~(data-> r & r[z].r); data-> g = ~(data-> g & r[z].g); data-> b = ~(data-> b & r[z].b); break; case ropNotOr: data-> r = ~(data-> r | r[z].r); data-> g = ~(data-> g | r[z].g); data-> b = ~(data-> b | r[z].b); break; case ropNoOper: break; case ropInvert: data-> r = ~data-> r; data-> g = ~data-> g; data-> b = ~data-> b; break; default: data-> r = r[z]. r; data-> g = r[z]. g; data-> b = r[z]. b; } data++; } d += ls; } else { Byte * data = d; for ( i = 0; i < var-> w; i++) { int z = ( *data == bc) ? 0 : 1; switch( rop[z]) { case ropAndPut: *data &= b[z]; break; case ropXorPut: *data ^= b[z]; break; case ropOrPut: *data |= b[z]; break; case ropNotDestAnd: *data = (~(*data)) & b[z]; break; case ropNotDestOr: *data = (~(*data)) | b[z]; break; case ropNotAnd: *data = ~(*data & b[z]); break; case ropNotOr: *data = ~(*data | b[z]); break; case ropNoOper: break; case ropInvert: *data = ~(*data); break; default: *data = b[z]; break; } data++; } d += ls; } } if ( is_opt( optPreserveType) && var->type != type) my-> set_type( self, type); else my-> update_change( self); } SV * Image_codecs( SV * dummy) { int i; AV * av = newAV(); PList p = plist_create( 16, 16); apc_img_codecs( p); for ( i = 0; i < p-> count; i++) { PImgCodec c = ( PImgCodec ) p-> items[ i]; HV * profile = apc_img_info2hash( c); pset_i( codecID, i); av_push( av, newRV_noinc(( SV *) profile)); } plist_destroy( p); return newRV_noinc(( SV *) av); } Bool Image_put_image_indirect( Handle self, Handle image, int x, int y, int xFrom, int yFrom, int xDestLen, int yDestLen, int xLen, int yLen, int rop) { Bool ret; if ( is_opt( optInDrawInfo)) return false; if ( image == nilHandle) return false; if ( is_opt( optInDraw)) return inherited put_image_indirect( self, image, x, y, xFrom, yFrom, xDestLen, yDestLen, xLen, yLen, rop); if ( !kind_of( image, CImage)) return false; ret = img_put( self, image, x, y, xFrom, yFrom, xDestLen, yDestLen, xLen, yLen, rop); my-> update_change( self); return ret; } long Image_add_notification( Handle self, char * name, SV * subroutine, Handle referer, int index) { long id = inherited add_notification( self, name, subroutine, referer, index); if ( id != 0) Image_reset_notifications( self); return id; } void Image_remove_notification( Handle self, long id) { inherited remove_notification( self, id); Image_reset_notifications( self); } static void Image_reset_notifications( Handle self) { int i; PList list; void * ret[ 2]; int cmd[ 2] = { IMG_EVENTS_HEADER_READY, IMG_EVENTS_DATA_READY }; var-> eventMask2 = var-> eventMask1; if ( var-> eventIDs == nil) return; ret[0] = hash_fetch( var-> eventIDs, "HeaderReady", 11); ret[1] = hash_fetch( var-> eventIDs, "DataReady", 9); for ( i = 0; i < 2; i++) { if ( ret[i] == nil) continue; list = var-> events + PTR2IV( ret[i]) - 1; if ( list-> count > 0) var-> eventMask2 |= cmd[ i]; } } #ifdef __cplusplus } #endif Prima-1.28/AbstractMenu.c0000644000175100017510000007254311150770061013041 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: AbstractMenu.c,v 1.60 2007/11/11 12:48:07 dk Exp $ */ #include "apricot.h" #include "AbstractMenu.h" #include "Image.h" #include "Menu.h" #include "Widget.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CComponent-> #define my ((( PAbstractMenu) self)-> self) #define var (( PAbstractMenu) self) typedef Bool MenuProc ( Handle self, PMenuItemReg m, void * params); typedef MenuProc *PMenuProc; static int key_normalize( const char * key) { /* * Valid keys: * keycode as a string representing decimal number; * any combination of ^, @, # (Control, Alt, Shift) plus * exactly one character - lowercase and get ascii code of this * fN - function key, N is a number from 1 to 16 inclusive * All other combinations will result in kbNoKey returned */ int r = 0, r1; for (;;) { if (*key == '^') r |= kmCtrl; else if (*key == '@') r |= kmAlt; else if (*key == '#') r |= kmShift; else break; key++; } if (!*key) return kbNoKey; /* #, ^, @ alone are not allowed */ if (!key[1]) { return (r&kmCtrl) && isalpha(*key) ? r | (toupper(*key)-'@') : r | tolower(*key); } else { char *e; if (isdigit(*key)) { if (r) return kbNoKey; r = strtol( key, &e, 10); if (*e) return kbNoKey; if ( !( r & kmCtrl)) return r; return ( isalpha( r & kbCharMask)) ? ( r & kbModMask) | ( toupper( r & kbCharMask)-'@') : r; } else if (tolower(*key) != 'f') return kbNoKey; key++; r1 = strtol( key, &e, 10); if (*e || r1 < 1 || r1 > 16) return kbNoKey; return r | (kbF1 + ((r1-1) << 8)); } } static int is_var_id_name( char * name) { int ret; char * e; if ( !name || *(name++) != '#') return 0; ret = strtol( name, &e, 10); if ( *e || ret < 0) return 0; return ret; } void AbstractMenu_dispose_menu( Handle self, void * menu) { PMenuItemReg m = ( PMenuItemReg) menu; if ( m == nil) return; free( m-> text); free( m-> accel); free( m-> variable); free( m-> perlSub); if ( m-> code) sv_free( m-> code); if ( m-> data) sv_free( m-> data); if ( m-> bitmap) { if ( PObject( m-> bitmap)-> stage < csDead) SvREFCNT_dec( SvRV(( PObject( m-> bitmap))-> mate)); unprotect_object( m-> bitmap); } my-> dispose_menu( self, m-> next); my-> dispose_menu( self, m-> down); free( m); } /* #define log_write debug_write */ void * AbstractMenu_new_menu( Handle self, SV * sv, int level) { AV * av; int i, count; int n; PMenuItemReg m = nil; PMenuItemReg curr = nil; Bool rightAdjust = false; /* char buf [ 200]; memset( buf, ' ', 200); buf[ level * 3] = '\0'; */ if ( level == 0) { if ( SvTYPE( sv) == SVt_NULL) return nil; /* null menu */ } if ( !SvROK( sv) || ( SvTYPE( SvRV( sv)) != SVt_PVAV)) { warn("RTC0034: menu build error: menu is not an array"); return nil; } av = (AV *) SvRV( sv); n = av_len( av); if ( n == -1) { if ( level == 0) return nil; /* null menu */ warn("RTC003E: menu build error: empty array passed"); return nil; } /* log_write("%s(%d){", buf, n+1); */ /* cycling the list of items */ for ( i = 0; i <= n; i++) { SV **itemHolder = av_fetch( av, i, 0); AV *item; SV *subItem; PMenuItemReg r; SV **holder; int l_var = -1; int l_text = -1; int l_sub = -1; int l_accel = -1; int l_key = -1; int l_data = -1; if ( itemHolder == nil) { warn("RTC0035: menu build error: array panic"); my-> dispose_menu( self, m); return nil; } if ( !SvROK( *itemHolder) || ( SvTYPE( SvRV( *itemHolder)) != SVt_PVAV)) { warn("RTC0036: menu build error: submenu is not an array"); my-> dispose_menu( self, m); return nil; } /* entering item description */ item = ( AV *) SvRV( *itemHolder); count = av_len( item) + 1; if ( count > 6) { warn("RTC0032: menu build error: extra declaration"); count = 5; } if ( !( r = alloc1z( MenuItemReg))) { warn( "Not enough memory"); my-> dispose_menu( self, m); return nil; } r-> key = kbNoKey; /* log_write("%sNo: %d, count: %d", buf, i, count); */ if ( count < 2) { /* empty or 1 means line divisor, no matter of text */ r-> flags. divider = true; rightAdjust = (( level == 0) && ( var-> anchored)); if ( count == 1) l_var = 0; } else if ( count == 2) { l_text = 0; l_sub = 1; } else if ( count == 3) { l_var = 0; l_text = 1; l_sub = 2; } else if ( count == 4) { l_text = 0; l_accel = 1; l_key = 2; l_sub = 3; } else if ( count == 5) { l_var = 0; l_text = 1; l_accel = 2; l_key = 3; l_sub = 4; } else { l_var = 0; l_text = 1; l_accel = 2; l_key = 3; l_sub = 4; l_data = 5; } if ( m) curr = curr-> next = r; else curr = m = r; /* adding to list */ r-> flags. rightAdjust = rightAdjust ? 1 : 0; r-> id = ++(var-> autoEnum); #define a_get( l_, fl_, num) if ( num >= 0 ) { \ holder = av_fetch( item, num, 0); \ if ( holder) { \ if ( SvTYPE(*holder) != SVt_NULL) { \ l_ = duplicate_string( SvPV_nolen( *holder)); \ fl_ = SvUTF8(*holder) ? 1 : 0; \ } \ } else { \ warn("RTC003A: menu build error: array panic"); \ my-> dispose_menu( self, m); \ return nil; \ } \ } a_get( r-> accel , r-> flags. utf8_accel, l_accel); a_get( r-> variable, r-> flags. utf8_variable, l_var); if ( l_key >= 0) { holder = av_fetch( item, l_key, 0); if ( !holder) { warn("RTC003B: menu build error: array panic"); my-> dispose_menu( self, m); return nil; } r-> key = key_normalize( SvPV_nolen( *holder)); } if ( r-> variable) { #define s r-> variable int i, decr = 0; for ( i = 0; i < 2; i++) { switch ( s[i]) { case '-': r-> flags. disabled = 1; decr++; break; case '*': r-> flags. checked = 1; decr++; break; default: break; } } if ( decr) memmove( s, s + decr, strlen( s) + 1 - decr); if ( strlen( s) == 0 || is_var_id_name( s) != 0) { free( r-> variable); r-> variable = nil; } #undef s } /* parsing text */ if ( l_text >= 0) { holder = av_fetch( item, l_text, 0); if ( !holder) { warn("RTC003C: menu build error: array panic"); my-> dispose_menu( self, m); return nil; } subItem = *holder; if ( SvROK( subItem)) { Handle c_object = gimme_the_mate( subItem); if (( c_object == nilHandle) || !( kind_of( c_object, CImage))) { warn("RTC0033: menu build error: not an image passed"); goto TEXT; } /* log_write("%sbmp: %s %d", buf, ((PComponent)c_object)->name, kind_of( c_object, CImage)); */ if (((( PImage) c_object)-> w == 0) || ((( PImage) c_object)-> h == 0)) { warn("RTC0037: menu build error: invalid image passed"); goto TEXT; } protect_object( r-> bitmap = c_object); SvREFCNT_inc( SvRV(( PObject( r-> bitmap))-> mate)); } else { TEXT: r-> text = duplicate_string( SvPV_nolen( subItem)); r-> flags. utf8_text = SvUTF8( subItem) ? 1 : 0; } } /* parsing sub */ if ( l_sub >= 0) { holder = av_fetch( item, l_sub, 0); if ( !holder) { warn("RTC003D: menu build error: array panic"); my-> dispose_menu( self, m); return nil; } subItem = *holder; if ( SvROK( subItem)) { if ( SvTYPE( SvRV( subItem)) == SVt_PVCV) { r-> code = newSVsv( subItem); } else { r-> down = ( PMenuItemReg) my-> new_menu( self, subItem, level + 1); if ( r-> down == nil) { /* seems error was occured inside this call */ my-> dispose_menu( self, m); return nil; } } } else { if ( SvPOK( subItem)) { r-> perlSub = duplicate_string( SvPV_nolen( subItem)); r-> flags. utf8_perlSub = SvUTF8( subItem) ? 1 : 0; } else { warn("RTC0038: menu build error: invalid sub name passed"); } } } /* parsing data */ if ( l_data >= 0) { holder = av_fetch( item, l_data, 0); if ( !holder) { warn("RTC003D: menu build error: array panic"); my-> dispose_menu( self, m); return nil; } r-> data = newSVsv( *holder); } } /* log_write("%s}", buf); */ /* log_write("adda bunch:"); { PMenuItemReg x = m; while ( x) { log_write( x-> variable); x = x-> next; } } log_write("end."); */ return m; } void AbstractMenu_init( Handle self, HV * profile) { dPROFILE; inherited init( self, profile); var-> anchored = kind_of( self, CMenu); my-> update_sys_handle( self, profile); my-> set_items( self, pget_sv( items)); if ( var-> system) apc_menu_update( self, nil, var-> tree); if ( pget_B( selected)) my-> set_selected( self, true); CORE_INIT_TRANSIENT(AbstractMenu); } void AbstractMenu_done( Handle self) { if ( var-> system) apc_menu_destroy( self); my-> dispose_menu( self, var-> tree); var-> tree = nil; inherited done( self); } Bool AbstractMenu_validate_owner( Handle self, Handle * owner, HV * profile) { dPROFILE; *owner = pget_H( owner); if ( !kind_of( *owner, CWidget)) return false; return inherited validate_owner( self, owner, profile); } void AbstractMenu_cleanup( Handle self) { if ( my-> get_selected( self)) my-> set_selected( self, false); inherited cleanup( self); } void AbstractMenu_set( Handle self, HV * profile) { dPROFILE; Bool select = false; if ( pexist( owner)) { select = pexist( selected) ? pget_B( selected) : my-> get_selected( self); pdelete( selected); } inherited set( self, profile); if ( select) my-> set_selected( self, true); } static SV * new_av( PMenuItemReg m, int level) { AV * glo; if ( m == nil) return nilSV; glo = newAV(); while ( m) { AV * loc = newAV(); if ( !m-> flags. divider) { if ( m-> variable) { /* has name */ SV * sv; int shift = ( m-> flags. checked ? 1 : 0) + ( m-> flags. disabled ? 1 : 0); if ( shift > 0) { /* has flags */ int len = strlen( m-> variable); char * name = allocs( len + shift); if ( name) { int slen = len + shift; memcpy( name + shift, m-> variable, len); if ( m-> flags. checked) name[ --shift] = '*'; if ( m-> flags. disabled) name[ --shift] = '-'; sv = newSVpv( name, slen); } else sv = newSVpv( m-> variable, len); } else /* has name but no flags */ sv = newSVpv( m-> variable, 0); if ( m-> flags. utf8_variable) SvUTF8_on( sv); av_push( loc, sv); } else { /* has flags but no name - autogenerate */ int len; char buffer[20]; len = sprintf( buffer, "%s%s#%d", m-> flags. disabled ? "-" : "", m-> flags. checked ? "*" : "", m-> id); av_push( loc, newSVpv( buffer, ( STRLEN) len)); } if ( m-> bitmap) { if ( PObject( m-> bitmap)-> stage < csDead) av_push( loc, newRV( SvRV((( PObject)( m-> bitmap))-> mate))); else av_push( loc, newSVpv( "", 0)); } else { SV * sv = newSVpv( m-> text, 0); if ( m-> flags. utf8_text) SvUTF8_on( sv); av_push( loc, sv); } if ( m-> accel) { SV * sv = newSVpv( m-> accel, 0); av_push( loc, sv); if ( m-> flags. utf8_accel) SvUTF8_on( sv); } else { av_push( loc, newSVpv( "", 0)); } av_push( loc, newSViv( m-> key)); if ( m-> down) { av_push( loc, new_av( m-> down, level + 1)); } else if ( m-> code) { av_push( loc, newSVsv( m-> code)); } else if ( m-> perlSub) { SV * sv = newSVpv( m-> perlSub, 0); if ( m-> flags. utf8_perlSub) SvUTF8_on( sv); av_push( loc, sv); } else { av_push( loc, newSVpv( "", 0)); } if ( m-> data) av_push( loc, newSVsv( m-> data)); } else { /* divider */ if ( m-> variable) { SV * sv = newSVpv( m-> variable, 0); if ( m-> flags. utf8_perlSub) SvUTF8_on( sv); av_push( loc, sv); } else { int len; char buffer[20]; len = sprintf( buffer, "#%d", m-> id); av_push( loc, newSVpv( buffer, ( STRLEN) len)); } } av_push( glo, newRV_noinc(( SV *) loc)); m = m-> next; } return newRV_noinc(( SV *) glo); } static Bool var_match( Handle self, PMenuItemReg m, void * params) { if ( m-> variable == nil) return false; return ( strcmp( m-> variable, ( char *) params) == 0); } static Bool id_match( Handle self, PMenuItemReg m, void * params) { return m-> id == *(( int*) params); } static Bool key_match( Handle self, PMenuItemReg m, void * params) { return (( m-> key == *(( int*) params)) && ( m-> key != kbNoKey) && !( m-> flags. disabled)); } static PMenuItemReg find_menuitem( Handle self, char * var_name, Bool match_disabled) { int num; if ( !var_name) return nil; /* match special case /^#\d+$/ */ if (( num = is_var_id_name( var_name)) != 0) return ( PMenuItemReg) my-> first_that( self, (void*)id_match, &num, match_disabled); else return ( PMenuItemReg) my-> first_that( self, (void*)var_match, var_name, match_disabled); } char * AbstractMenu_make_var_context( Handle self, PMenuItemReg m, char * buffer) { if ( !m) return ""; if ( m-> variable) return m-> variable; sprintf( buffer, "#%d", m-> id); return buffer; } char * AbstractMenu_make_id_context( Handle self, int id, char * buffer) { return my-> make_var_context( self, my-> first_that( self, (void*)id_match, &id, true), buffer); } SV * AbstractMenu_get_items( Handle self, char * varName) { if ( var-> stage > csFrozen) return nilSV; if ( strlen( varName)) { PMenuItemReg m = find_menuitem( self, varName, true); if ( m && m-> down) { return new_av( m-> down, 1); } else if ( m) { return newRV_noinc(( SV *) newAV()); } else { return nilSV; } } else { return var-> tree ? new_av( var-> tree, 0) : newRV_noinc(( SV *) newAV()); } } void AbstractMenu_set_items( Handle self, SV * items) { PMenuItemReg oldBranch = var-> tree; if ( var-> stage > csFrozen) return; var-> tree = ( PMenuItemReg) my-> new_menu( self, items, 0); if ( var-> stage <= csNormal && var-> system) apc_menu_update( self, oldBranch, var-> tree); my-> dispose_menu( self, oldBranch); } static PMenuItemReg do_link( Handle self, PMenuItemReg m, PMenuProc p, void * params, Bool useDisabled) { while( m) { if ( !m-> flags. disabled || useDisabled) { if ( m-> down) { PMenuItemReg i = do_link( self, m-> down, p, params, useDisabled); if ( i) return i; } if ( p( self, m, params)) return m; } m = m-> next; } return nil; } void * AbstractMenu_first_that( Handle self, void * actionProc, void * params, Bool useDisabled) { return actionProc ? do_link( self, var-> tree, ( PMenuProc) actionProc, params, useDisabled) : nil; } Bool AbstractMenu_has_item( Handle self, char * varName) { return find_menuitem( self, varName, true) != nil; } SV * AbstractMenu_accel( Handle self, Bool set, char * varName, SV * accel) { PMenuItemReg m; if ( var-> stage > csFrozen) return nilSV; m = find_menuitem( self, varName, true); if ( !m) return nilSV; if ( !set) { SV * sv = newSVpv( m-> accel ? m-> accel : "", 0); if ( m-> flags. utf8_accel) SvUTF8_on( sv); return sv; } if ( m-> text == nil) return nilSV; free( m-> accel); m-> accel = duplicate_string( SvPV_nolen( accel)); m-> flags. utf8_accel = SvUTF8( accel) ? 1 : 0; if ( m-> id > 0) if ( var-> stage <= csNormal && var-> system) apc_menu_item_set_accel( self, m); return nilSV; } SV * AbstractMenu_action( Handle self, Bool set, char * varName, SV * action) { PMenuItemReg m; if ( var-> stage > csFrozen) return nilSV; m = find_menuitem( self, varName, true); if ( !m) return nilSV; if ( !set) { if ( m-> code) return newSVsv( m-> code); if ( m-> perlSub) { SV * sv = newSVpv( m-> perlSub, 0); if ( m-> flags. utf8_perlSub) SvUTF8_on( sv); return sv; } return nilSV; } if ( m-> flags. divider || m-> down) return nilSV; if ( SvROK( action)) { if ( m-> code) sv_free( m-> code); m-> code = nil; if ( SvTYPE( SvRV( action)) == SVt_PVCV) { m-> code = newSVsv( action); free( m-> perlSub); m-> perlSub = nil; } m-> flags. utf8_perlSub = 0; } else { char * line = ( char *) SvPV_nolen( action); free( m-> perlSub); if ( m-> code) sv_free( m-> code); m-> code = nil; m-> perlSub = duplicate_string( line); m-> flags. utf8_perlSub = SvUTF8( action) ? 1 : 0; } return nilSV; } Bool AbstractMenu_checked( Handle self, Bool set, char * varName, Bool checked) { PMenuItemReg m; if ( var-> stage > csFrozen) return false; m = find_menuitem( self, varName, true); if ( m == nil) return false; if ( !set) return m ? m-> flags. checked : false; if ( m-> flags. divider || m-> down) return false; m-> flags. checked = checked ? 1 : 0; if ( m-> id > 0) if ( var-> stage <= csNormal && var-> system) apc_menu_item_set_check( self, m); return checked; } SV * AbstractMenu_data( Handle self, Bool set, char * varName, SV * data) { PMenuItemReg m; if ( var-> stage > csFrozen) return nilSV; m = find_menuitem( self, varName, true); if ( m == nil) return nilSV; if ( !set) return m-> data ? newSVsv( m-> data) : nilSV; sv_free( m-> data); m-> data = newSVsv( data); return nilSV; } Bool AbstractMenu_enabled( Handle self, Bool set, char * varName, Bool enabled) { PMenuItemReg m; if ( var-> stage > csFrozen) return false; m = find_menuitem( self, varName, true); if ( m == nil) return false; if ( !set) return m ? !m-> flags. disabled : false; if (m-> flags. divider) return false; m-> flags. disabled = ( enabled ? 0 : 1 ) ; if ( m-> id > 0) if ( var-> stage <= csNormal && var-> system) apc_menu_item_set_enabled( self, m); return enabled; } Handle AbstractMenu_image( Handle self, Bool set, char * varName, Handle image) { PMenuItemReg m; PImage i = ( PImage) image; if ( var-> stage > csFrozen) return nilHandle; m = find_menuitem( self, varName, true); if ( m == nil) return nilHandle; if ( !m-> bitmap) return nilHandle; if ( !set) { if ( PObject( m-> bitmap)-> stage == csDead) return nilHandle; return m-> bitmap; } if (( image == nilHandle) || !( kind_of( image, CImage))) { warn("RTC0039: invalid object passed to ::image"); return nilHandle; } if ( i-> w == 0 || i-> h == 0) { warn("RTC0039: invalid object passed to ::image"); return nilHandle; } SvREFCNT_inc( SvRV(( PObject( image))-> mate)); protect_object( image); if ( PObject( m-> bitmap)-> stage < csDead) SvREFCNT_dec( SvRV(( PObject( m-> bitmap))-> mate)); unprotect_object( m-> bitmap); m-> bitmap = image; if ( m-> id > 0) if ( var-> stage <= csNormal && var-> system) apc_menu_item_set_image( self, m); return nilHandle; } SV * AbstractMenu_text( Handle self, Bool set, char * varName, SV * text) { PMenuItemReg m; if ( var-> stage > csFrozen) return nilSV; m = find_menuitem( self, varName, true); if ( m == nil) return nilSV; if ( m-> text == nil) return nilSV; if ( !set) { SV * sv = newSVpv( m-> text ? m-> text : "", 0); if ( m-> flags. utf8_text) SvUTF8_on( sv); return sv; } free( m-> text); m-> text = duplicate_string( SvPV_nolen( text)); m-> flags. utf8_accel = SvUTF8( text) ? 1 : 0; if ( m-> id > 0) if ( var-> stage <= csNormal && var-> system) apc_menu_item_set_text( self, m); return nilSV; } SV * AbstractMenu_key( Handle self, Bool set, char * varName, SV * key) { PMenuItemReg m; if ( var-> stage > csFrozen) return nilSV; m = find_menuitem( self, varName, true); if ( m == nil) return nilSV; if ( m-> flags. divider || m-> down) return nilSV; if ( !set) return newSViv( m-> key); m-> key = key_normalize( SvPV_nolen( key)); if ( m-> id > 0) if ( var-> stage <= csNormal && var-> system) apc_menu_item_set_key( self, m); return nilSV; } void AbstractMenu_set_variable( Handle self, char * varName, SV * newName) { PMenuItemReg m; if ( var-> stage > csFrozen) return; m = find_menuitem( self, varName, true); if ( m == nil) return; free( m-> variable); if ( SvTYPE(newName) != SVt_NULL) { STRLEN len; char * v; v = SvPV( newName, len); if ( len > 0) { m-> variable = duplicate_string( v); m-> flags. utf8_variable = SvUTF8( newName) ? 1 : 0; return; } } m-> variable = nil; m-> flags. utf8_variable = 0; } Bool AbstractMenu_sub_call( Handle self, PMenuItemReg m) { char buffer[16], *context; if ( m == nil) return false; context = AbstractMenu_make_var_context( self, m, buffer); if ( m-> code) { if ( m-> flags. utf8_variable) { SV * sv = newSVpv( context, 0); SvUTF8_on( sv); cv_call_perl((( PComponent) var-> owner)-> mate, SvRV( m-> code), "S", sv); sv_free( sv); } else cv_call_perl((( PComponent) var-> owner)-> mate, SvRV( m-> code), "s", context); } else if ( m-> perlSub) { if ( m-> flags. utf8_variable) { SV * sv = newSVpv( context, 0); SvUTF8_on( sv); call_perl( var-> owner, m-> perlSub, "S", sv); sv_free( sv); } else call_perl( var-> owner, m-> perlSub, "s", context); } return true; } Bool AbstractMenu_sub_call_id( Handle self, int sysId) { return my-> sub_call( self, ( PMenuItemReg) my-> first_that( self, (void*)id_match, &sysId, false)); } #define keyRealize( key) if ((( key & 0xFF) >= 'A') && (( key & 0xFF) <= 'z')) \ key = tolower( key & 0xFF) | \ (( key & ( kmCtrl | kmAlt)) ? \ ( key & ( kmCtrl | kmAlt | kmShift)) \ : 0) Bool AbstractMenu_sub_call_key ( Handle self, int key) { keyRealize( key); return my-> sub_call( self, ( PMenuItemReg) my-> first_that( self, (void*)key_match, &key, false)); } typedef struct _Kmcc { int key; Bool enabled; } Kmcc, *PKmcc; static Bool kmcc ( Handle self, PMenuItemReg m, void * params) { if ((( PKmcc) params)-> key == m-> key) { m-> flags. disabled = ((( PKmcc) params)-> enabled ? 0 : 1); if ( m-> id > 0) if ( var-> stage <= csNormal && var-> system) apc_menu_item_set_enabled( self, m); } return false; } void AbstractMenu_set_command( Handle self, char * key, Bool enabled) { Kmcc mcc; mcc. key = key_normalize( key); mcc. enabled = enabled; if ( var-> stage > csFrozen) return; my-> first_that( self, (void*)kmcc, &mcc, true); } Bool AbstractMenu_selected( Handle self, Bool set, Bool selected) { return false; } SV * AbstractMenu_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", var-> system ? apc_menu_get_handle( self) : self); return newSVpv( buf, 0); } int AbstractMenu_translate_accel( Handle self, char * accel) { if ( !accel) return 0; while ( *accel) { if ( *(accel++) == '~') { switch ( *accel) { case '~' : accel++; break; case 0: return 0; default: return isalnum( *accel) ? *accel : tolower( *accel); } } } return 0; } int AbstractMenu_translate_key( Handle self, int code, int key, int mod) { mod &= kmAlt | kmShift | kmCtrl; key = ( key != kbNoKey ? key : code) | mod; keyRealize( key); return key; } int AbstractMenu_translate_shortcut( Handle self, char * key) { return key_normalize( key); } static Bool up_match ( Handle self, PMenuItemReg m, void * params) { return m-> down == params; } static Bool prev_match ( Handle self, PMenuItemReg m, void * params) { return m-> next == params; } void AbstractMenu_remove( Handle self, char * varName) { PMenuItemReg up, prev, m; if ( var-> stage > csFrozen) return; m = find_menuitem( self, varName, true); if ( m == nil) return; if ( var-> stage <= csNormal && var-> system) apc_menu_item_delete( self, m); up = ( PMenuItemReg) my-> first_that( self, (void*)up_match, m, true); prev = ( PMenuItemReg) my-> first_that( self, (void*)prev_match, m, true); if ( up) up -> down = m-> next; if ( prev) prev-> next = m-> next; if ( m == var-> tree) var-> tree = m-> next; m-> next = nil; my-> dispose_menu( self, m); } void AbstractMenu_insert( Handle self, SV * menuItems, char * rootName, int index) { int level; PMenuItemReg *up, m, addFirst, addLast, branch; if ( var-> stage > csFrozen) return; if ( SvTYPE( menuItems) == SVt_NULL) return; if ( strlen( rootName) == 0) { if ( var-> tree == nil) { var-> tree = ( PMenuItemReg) my-> new_menu( self, menuItems, 0); if ( var-> stage <= csNormal && var-> system) apc_menu_update( self, nil, var-> tree); return; } branch = m = var-> tree; up = &var-> tree; level = 0; } else { branch = m = find_menuitem( self, rootName, true); if ( m == nil) return; if ( m-> down) index = 0; up = &m-> down; m = m-> down; level = 1; } /* the level is 0 or 1 for the sake of rightAdjust */ addFirst = ( PMenuItemReg) my-> new_menu( self, menuItems, level); if ( !addFirst) return; /* error in menuItems */ addLast = addFirst; while ( addLast-> next) addLast = addLast-> next; if ( index == 0) { addLast-> next = *up; *up = addFirst; } else { int i = 1; while ( m-> next) { if ( i++ == index) break; m = m-> next; } addLast-> next = m-> next; m-> next = addFirst; } if ( m && m-> flags. rightAdjust) { while ( addFirst != addLast-> next) { addFirst-> flags. rightAdjust = true; addFirst = addFirst-> next; } } if ( var-> stage <= csNormal && var-> system) apc_menu_update( self, branch, branch); } #ifdef __cplusplus } #endif Prima-1.28/include/0000755000175100017510000000000011150770061011715 5ustar dkdkPrima-1.28/include/gbm.h0000644000175100017510000001562211150770061012641 0ustar dkdk/* gbm.h - Generalised Bitmap Module Data is stored as an array of lines. Lines are stored with bottom line first, moving upwards. Each line is an array of pixels, leftmost first. Lines are padded to be a multiple of a dword long. Palettised pixels are either a 1 bit, 4 bit, or 8 bit indices. Alternately a B, G, R triple in that order is stored. This format exactly matches the format used by OS/2 and Windows bitmaps. One notable point: a 1 in a 1bpp image denotes colour 1, as found by looking at palette entry 1. Data is not inversed when passed to and from GBM. This interface file provides access to routines for reading and writing bitmaps in a variety of image file formats. Normally file I/O is done using lseek,read and write. Occasionally GBM needs to access additional files, and it uses open and close to do this. Sometimes it needs to create a new file, and GBM uses create and close for this. The 'create' function is an invokation of open with O_CREAT|O_TRUNC combined with the mode flags it is passed, and S_IREAD|S_IWRITE passed as the additional optional parameter. You can trick GBM into using your own versions of open, create, close, lseek, read and write routines, by calling gbm_io_setup. One example use of this is that the file descriptor could then be an index into a array of pointers to C++ iostreams, thus allowing GBM to read and write file data to and from memory. On some platforms, the GBM file I/O library may be provided in DLL form. Therefore it can have its own C run time library, and on some platforms file descriptors obtained by an executable do not make sense to the C run time which is a part of the DLL. Hence GBM will be unable to use the file descriptor. One solution is to use gbm_io_setup to get the GBM library to call back into the calling application and use its C run time. Another solution is to have the application use the GBM libraries C run time to open the file - this is made possible via the gbm_io_ routines. This is the easier solution, and is used by the sample GBM programs. The particular offending platform is Visual C++ on Windows NT, everything works fine for VisualAge C++ on OS/2. gbm_read_header shall seek to the start of the stream indentified by the file descriptor argument and then shall invoke the bitmap header reader routine identified by the format type variable. gbm_read_palette may only be legally invoked after an immediately preceeding gbm_read_header. gbm_read_data may only be legally invoked after an immediately preceeding gbm_read_palette. In the case of a 24bpp file (which therefore has no palette), gbm_read_data is additionally allowed to follow a gbm_read_header. $Id: gbm.h,v 1.6 2003/06/04 11:18:41 dk Exp $ */ #ifndef GBM_H #define GBM_H #ifdef __cplusplus extern "C" { #endif #ifndef BOOLEAN_DEFINED #define BOOLEAN_DEFINED #ifndef TRUE #define TRUE 1 #endif #ifndef FALSE #define FALSE 0 #endif #endif #ifndef BASICTYPES_DEFINED #define BASICTYPES_DEFINED typedef unsigned char byte; typedef unsigned short word; typedef unsigned long dword; #endif typedef int GBM_ERR; #define GBM_ERR_OK ((GBM_ERR) 0) #define GBM_ERR_MEM ((GBM_ERR) 1) #define GBM_ERR_NOT_SUPP ((GBM_ERR) 2) #define GBM_ERR_BAD_OPTION ((GBM_ERR) 3) #define GBM_ERR_NOT_FOUND ((GBM_ERR) 4) #define GBM_ERR_BAD_MAGIC ((GBM_ERR) 5) #define GBM_ERR_BAD_SIZE ((GBM_ERR) 6) #define GBM_ERR_READ ((GBM_ERR) 7) #define GBM_ERR_WRITE ((GBM_ERR) 8) #define GBM_ERR_BAD_ARG ((GBM_ERR) 9) #define GBM_FT_R1 0x0001 #define GBM_FT_R4 0x0002 #define GBM_FT_R8 0x0004 #define GBM_FT_R24 0x0008 #define GBM_FT_W1 0x0010 #define GBM_FT_W4 0x0020 #define GBM_FT_W8 0x0040 #define GBM_FT_W24 0x0080 typedef struct { char *short_name; /* Eg: "Targa" */ char *long_name; /* Eg: "Truevision Targa / Vista" */ char *extensions; /* Eg: "TGA VST" */ int flags; /* What functionality exists */ } GBMFT; typedef struct { byte r, g, b; } GBMRGB; #define PRIV_SIZE 2000 typedef struct { int w, h, bpp; /* Bitmap dimensions */ byte priv[PRIV_SIZE]; /* Private internal buffer */ } GBM; #ifndef _GBM_ #if defined(OS2) #define GBMEXPORT #ifdef __EMX__ #define GBMENTRY #else #define GBMENTRY _Optlink #endif #elif defined(WIN32) //#define GBMEXPORT __declspec(dllexport) //#define GBMENTRY __stdcall #define GBMEXPORT #define GBMENTRY #else #define GBMEXPORT #define GBMENTRY #endif GBMEXPORT GBM_ERR GBMENTRY gbm_init(void); GBMEXPORT GBM_ERR GBMENTRY gbm_deinit(void); GBMEXPORT GBM_ERR GBMENTRY gbm_io_setup( int (*open )(const char *fn, int mode), int (*create)(const char *fn, int mode), void (*close )(int fd), long (*lseek )(int fd, long pos, int whence), int (*read )(int fd, void *buf, int len), int (*write )(int fd, const void *buf, int len) ); GBMEXPORT int GBMENTRY gbm_io_open (const char *fn, int mode); GBMEXPORT int GBMENTRY gbm_io_create(const char *fn, int mode); GBMEXPORT void GBMENTRY gbm_io_close (int fd); GBMEXPORT long GBMENTRY gbm_io_lseek (int fd, long pos, int whence); GBMEXPORT int GBMENTRY gbm_io_read (int fd, void *buf, int len); GBMEXPORT int GBMENTRY gbm_io_write (int fd, const void *buf, int len); GBMEXPORT GBM_ERR GBMENTRY gbm_query_n_filetypes(int *n_ft); GBMEXPORT GBM_ERR GBMENTRY gbm_query_filetype(int ft, GBMFT *gbmft); GBMEXPORT GBM_ERR GBMENTRY gbm_guess_filetype(const char *fn, int *ft); GBMEXPORT GBM_ERR GBMENTRY gbm_read_header(const char *fn, int fd, int ft, GBM *gbm, const char *opt); GBMEXPORT GBM_ERR GBMENTRY gbm_read_palette(int fd, int ft, GBM *gbm, GBMRGB *gbmrgb); GBMEXPORT GBM_ERR GBMENTRY gbm_read_data(int fd, int ft, GBM *gbm, byte *data); GBMEXPORT GBM_ERR GBMENTRY gbm_write(const char *fn, int fd, int ft, const GBM *gbm, const GBMRGB *gbmrgb, const byte *data, const char *opt); GBMEXPORT const char * GBMENTRY gbm_err(GBM_ERR rc); GBMEXPORT int GBMENTRY gbm_version(void); #if defined(OS2) && !defined(__EMX__) /*...s_System entrypoints:0:*/ /* For GBM.DLL to be callable from IBM Smalltalk under OS/2, the entrypoints must be of _System calling convention. These veneers help out here. I can't just change the usual entrypoints because people depend on them. For portability, avoid these entrypoints, use the gbm_ ones. */ GBM_ERR _System Gbm_init(void); GBM_ERR _System Gbm_deinit(void); GBM_ERR _System Gbm_query_n_filetypes(int *n_ft); GBM_ERR _System Gbm_guess_filetype(const char *fn, int *ft); GBM_ERR _System Gbm_query_filetype(int ft, GBMFT *gbmft); GBM_ERR _System Gbm_read_header(const char *fn, int fd, int ft, GBM *gbm, const char *opt); GBM_ERR _System Gbm_read_palette(int fd, int ft, GBM *gbm, GBMRGB *gbmrgb); GBM_ERR _System Gbm_read_data(int fd, int ft, GBM *gbm, byte *data); GBM_ERR _System Gbm_write(const char *fn, int fd, int ft, const GBM *gbm, const GBMRGB *gbmrgb, const byte *data, const char *opt); const char * _System Gbm_err(GBM_ERR rc); int _System Gbm_version(void); /*...e*/ #endif #endif #ifdef __cplusplus } #endif #endif Prima-1.28/include/guts.h0000644000175100017510000000640411150770061013054 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* $Id: guts.h,v 1.18 2004/05/07 10:03:24 dk Exp $ */ #ifndef _GUTS_H_ #define _GUTS_H_ #ifndef _APRICOT_H_ #include "apricot.h" #endif #ifdef __cplusplus extern "C" { #endif extern Bool dolbug; extern Bool waitBeforeQuit; #define dPUB_ARGS int rc = recursiveCall #define PUB_CHECK rc = recursiveCall #define DOLBUG if(dolbug)debug_write #define dG_EVAL_ARGS SV * errSave = nil #define OPEN_G_EVAL \ errSave = SvTRUE( GvSV( errgv)) ? newSVsv( GvSV( errgv)) : nil;\ sv_setsv( GvSV( errgv), nilSV) #define CLOSE_G_EVAL \ if ( errSave) sv_catsv( GvSV( errgv), errSave);\ if ( errSave) sv_free( errSave) extern long apcError; extern List postDestroys; extern int recursiveCall; extern PHash primaObjects; extern SV * eventHook; #define CORE_INIT_TRANSIENT(cls) ((PObject)self)->transient_class = (void*)C##cls extern Bool window_subsystem_init( char * error_buf); extern Bool window_subsystem_set_option( char * option, char * value); extern Bool window_subsystem_get_options( int * argc, char *** argv); extern void window_subsystem_cleanup( void); extern void window_subsystem_done( void); extern void build_static_vmt( void *vmt); extern void kill_zombies( void); extern void prima_init_image_subsystem( void); extern void prima_cleanup_image_subsystem( void); extern Handle gimme_the_real_mate( SV *perlObject); /* kernel exports */ extern XS( Component_set_notification_FROMPERL); extern PRGBColor read_palette( int * palSize, SV * palette); extern Bool prima_read_point( SV *rvav, int * pt, int number, char * error); extern Bool accel_notify ( Handle group, Handle self, PEvent event); extern Bool font_notify ( Handle self, Handle child, void * font); extern Bool find_accel( Handle self, Handle item, int * key); extern Bool single_color_notify ( Handle self, Handle child, void * color); extern Bool kill_all( Handle self, Handle child, void * dummy); #ifdef __cplusplus } #endif #endif Prima-1.28/include/apricot.h0000644000175100017510000025771311150770061013546 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* $Id: apricot.h,v 1.193 2008/11/06 10:54:37 dk Exp $ */ #ifndef _APRICOT_H_ #define _APRICOT_H_ #define PRIMA_CORE 1 #ifdef PRIMA_CORE #define POLLUTE_NAME_SPACE 1 #endif #if defined( HAVE_CONFIG_H) #include "generic/config.h" #endif #if (PERL_PATCHLEVEL < 4 || (( PERL_PATCHLEVEL == 4) && ( PERL_SUBVERSION <= 4))) #error "Prima require at least perl 5.005" #endif /* #define PARANOID_MALLOC */ #ifdef _MSC_VER #define BROKEN_COMPILER 1 #define BROKEN_PERL_PLATFORM 1 #define snprintf _snprintf #define vsnprintf _vsnprintf #define stricmp _stricmp #define strnicmp _strnicmp #define HAVE_SNPRINTF 1 #define HAVE_STRICMP 1 #define HAVE_STRNICMP 1 #elif defined( __BORLANDC__) #define BROKEN_PERL_PLATFORM 1 #define BROKEN_COMPILER 1 #elif defined(WIN32) #define BROKEN_PERL_PLATFORM 1 #endif #ifdef WORD #error "Reconsider the order in which you #include files" #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_BITYPES_H #include #endif #ifdef HAVE_SYS_INTTYPES_H #include #endif #ifdef HAVE_STDINT_H #include #endif #define __XSlock_h__ 28 #include #include #ifdef REMOVE_dTHR_FROM_dSP #undef dSP #define dSP djSP #endif #include #ifdef PERL_OBJECT #define XS_STARTPARAMS CV* cv, CPerlObj* pPerl #define XS_CALLPARAMS cv, pPerl #else #define XS_STARTPARAMS CV* cv #define XS_CALLPARAMS cv #endif #if defined(_MSC_VER) && defined(PERL_OBJECT) class XSLockManager { public: XSLockManager() { InitializeCriticalSection(&cs); }; ~XSLockManager() { DeleteCriticalSection(&cs); }; void Enter(void) { EnterCriticalSection(&cs); }; void Leave(void) { LeaveCriticalSection(&cs); }; protected: CRITICAL_SECTION cs; }; extern XSLockManager g_XSLock; extern CPerlObj* pPerl; class XSLock { public: XSLock(CPerlObj *p) { g_XSLock.Enter(); ::pPerl = p; }; ~XSLock() { g_XSLock.Leave(); }; }; /* PERL_CAPI does its own locking in xs_handler() */ #if defined(PERL_OBJECT) && !defined(PERL_CAPI) #undef dXSARGS #define dXSARGS \ XSLock localLock(pPerl); \ dSP; dMARK; \ I32 ax = mark - PL_stack_base + 1; \ I32 items = sp - mark #endif /* PERL_OBJECT && !PERL_CAPI */ #endif #ifdef __cplusplus extern "C" { #endif /* #undef realloc #undef malloc #undef free */ #if defined (package) #undef mod #undef list #undef package #undef ref #endif #if defined(WORD) && (WORD==257) #undef WORD #endif #include #ifdef BROKEN_PERL_PLATFORM #undef open #undef fopen #undef vfprintf #undef fclose #undef feof #undef ferror #undef environ #undef strerror #undef fread #undef fwrite #undef fopen #undef fdopen #undef freopen #undef fclose #undef fputc #undef ungetc #undef getc #undef fileno #undef clearerr #undef fflush #undef ftell #undef fseek #undef fgetpos #undef fsetpos #undef rewind #undef tmpfile #undef abort #undef fstat #undef stat #undef rename #undef setmode #undef lseek #undef tell #undef dup #undef dup2 #undef open #undef close #undef eof #undef read #undef write #undef _open_osfhandle #undef _get_osfhandle #undef spawnvp #undef mkdir #undef rmdir #undef chdir #undef flock #undef execv #undef execvp #undef perror #undef setbuf #undef setvbuf #undef flushall #undef fcloseall #undef fgets #undef gets #undef fgetc #undef putc #undef puts #undef getchar #undef putchar #undef close #undef dup #ifdef win32_close #define close win32_close #define dup win32_dup #endif #ifdef PerlIO_stderr /* ActiveState quirks */ #if (PERL_VERSION == 8) /* broken stderr definition */ #undef stderr #define stderr PerlIO_stderr() #endif #if (PERL_VERSION >= 6) /* broken fprintf definition */ #define fprintf PerlIO_printf #else #endif #elif (PERL_VERSION == 7) #define fprintf PerlIO_printf #else #undef fprintf #ifdef win32_stderr #undef stderr #define stderr win32_stderr() #endif #endif #endif #ifdef PTRV #undef PTR2UV #define PTR2UV(x) ((UV)(PTRV)(x)) #undef PTR2IV #define PTR2IV(x) ((IV)(PTRV)(x)) #undef INT2PTR #define INT2PTR(type,x) ((type)((PTRV)x)) #endif #ifndef SvPV_nolen #define SvPV_nolen(_sv) SvPV(_sv,na) #endif #define PERL_CALL_SV_DIE_BUG_AWARE 1 #ifdef PERL_CALL_SV_DIE_BUG_AWARE #define PERL_CALL_METHOD clean_perl_call_method #define PERL_CALL_PV clean_perl_call_pv #else #define PERL_CALL_METHOD perl_call_method #define PERL_CALL_PV perl_call_pv #endif #ifndef HAVE_BZERO extern void bzero(void*,size_t); #endif #ifdef HAVE_STRICMP #ifndef HAVE_STRCASECMP #define strcasecmp(a,b) stricmp((a),(b)) #endif #else #ifdef HAVE_STRCASECMP #define stricmp(a,b) strcasecmp((a),(b)) #else #define strcasecmp(a,b) stricmp((a),(b)) #define PRIMA_NEED_OWN_STRICMP 1 extern int stricmp(const char *s1, const char *s2); #endif #ifdef HAVE_STRNICMP #ifndef HAVE_STRNCASECMP #define strncasecmp(a,b,c) strnicmp((a),(b),(c)) #endif #else #ifdef HAVE_STRNCASECMP #define strnicmp(a,b,c) strncasecmp((a),(b),(c)) #else #define strncasecmp(a,b) strnicmp((a),(b)) #define PRIMA_NEED_OWN_STRNICMP 1 extern int strnicmp(const char *s1, const char *s2, size_t count); #endif #endif #endif #ifndef HAVE_STRCASESTR char * strcasestr( const char * s, const char * find); #endif #ifndef HAVE_REALLOCF extern void * reallocf(void *ptr, size_t size); #endif #ifdef HAVE_STRINGS_H #include #endif #ifdef HAVE_PMPRINTF_H #define printf PmPrintf extern unsigned long PmPrintf(char *, ...); #endif #if ! ( defined( HAVE_SNPRINTF) || defined( HAVE__SNPRINTF)) extern int snprintf( char *, size_t, const char *, ...); extern int vsnprintf( char *, size_t, const char *, va_list); #endif #define alloc1(typ) ((typ*)malloc(sizeof(typ))) #define allocn(typ,n) ((typ*)malloc((n)*sizeof(typ))) #define allocs(n) ((char*)malloc(n)) #define allocb(n) ((Byte*)malloc(n)) #define alloc1z(typ) ((typ*)prima_mallocz(sizeof(typ))) #define allocnz(typ,n) ((typ*)prima_mallocz((n)*sizeof(typ))) extern void * prima_mallocz( size_t sz); typedef I32 Bool; #if PTRSIZE==LONGSIZE typedef unsigned long Handle; #elif PTRSIZE==INTSIZE typedef unsigned int Handle; #elif PTRSIZE==SHORTSIZE typedef unsigned short Handle; #else #error "Cannot find adequate integer type" #endif typedef Handle ApiHandle; #include "Types.h" #if !defined(HAVE_INT8_T) typedef I8 int8_t; #endif #if !defined(HAVE_INT16_T) typedef I16 int16_t; #endif #if !defined(HAVE_INT32_T) typedef I32 int32_t; #endif #if !defined(HAVE_UINT8_T) #if defined(HAVE_U_INT8_T) typedef u_int8_t uint8_t; #else typedef U8 uint8_t; #endif #endif #if !defined(HAVE_UINT16_T) #if defined(HAVE_U_INT16_T) typedef u_int16_t uint16_t; #else typedef U16 uint16_t; #endif #endif #if !defined(HAVE_UINT32_T) #if defined(HAVE_U_INT32_T) typedef u_int32_t uint32_t; #else typedef U32 uint32_t; #endif #endif #if !defined(HAVE_UINT64_T) #if defined(HAVE_U_INT64_T) typedef u_int64_t uint64_t; #elif defined U64 typedef U64 uint64_t; #else typedef unsigned long uint64_t; #endif #endif typedef uint32_t Color; typedef uint8_t Byte; typedef int16_t Short; typedef int32_t Long; #undef INT16_MIN #undef INT16_MAX #undef INT32_MIN #undef INT32_MAX #define INT16_MIN (-32768) #define INT16_MAX 32768 #define INT32_MIN (-2147483647L-1) #define INT32_MAX 2147483647L typedef struct _RGBColor { unsigned char b; unsigned char g; unsigned char r; } RGBColor, *PRGBColor; typedef struct { float re, im; } Complex; typedef struct { double re, im; } DComplex; typedef struct { float r, ph; } TrigComplex; typedef struct { double r, ph; } TrigDComplex; #ifdef __cplusplus #define nil NULL #else #define nil Null(void*) #endif #define nilHandle Null(Handle) #define nilSV &sv_undef #define true TRUE #define false FALSE /* Event structures */ #ifdef KeyEvent #undef KeyEvent #endif typedef struct _KeyEvent { int cmd; int subcmd; Handle source; int code; int key; int mod; int repeat; } KeyEvent, *PKeyEvent; #ifdef PositionalEvent #undef PositionalEvent #endif typedef struct _PositionalEvent { int cmd; int subcmd; Handle source; Point where; int button; int mod; Bool dblclk; } PositionalEvent, *PPositionalEvent; #ifdef GenericEvent #undef GenericEvent #endif typedef struct _GenericEvent { int cmd; int subcmd; Handle source; int i; long l; Bool B; Point P; Rect R; void* p; Handle H; } GenericEvent, *PGenericEvent; typedef union _Event { int cmd; GenericEvent gen; PositionalEvent pos; KeyEvent key; } Event, *PEvent; typedef struct _PostMsg { int msgId; Handle h; SV * info1; SV * info2; } PostMsg, *PPostMsg; /* hashes support */ /* It's a mere coincidence that hashes in Prima guts implemented */ /* by means of Perl hashes */ #ifdef POLLUTE_NAME_SPACE #define hash_create prima_hash_create #define hash_destroy prima_hash_destroy #define hash_fetch prima_hash_fetch #define hash_delete prima_hash_delete #define hash_store prima_hash_store #define hash_count prima_hash_count #define hash_first_that prima_hash_first_that #endif typedef HV *PHash; typedef Bool HashProc( void * item, int keyLen, void * key, void * params); typedef HashProc *PHashProc; extern PHash primaObjects; extern PHash prima_hash_create( void); extern void prima_hash_destroy( PHash self, Bool killAll); extern void* prima_hash_fetch( PHash self, const void *key, int keyLen); extern void* prima_hash_delete( PHash self, const void *key, int keyLen, Bool kill); extern Bool prima_hash_store( PHash self, const void *key, int keyLen, void *val); #define prima_hash_count(hash) (HvKEYS(( HV*) hash)) extern void* prima_hash_first_that( PHash self, void *action, void *params, int *pKeyLen, void **pKey); extern char * prima_normalize_resource_string( char *name, Bool isClass); /* tables of constants support */ #ifdef GENERATE_TABLE_GENERATOR #ifndef TABLE_GENERATOR_NEWSVSTRING #define TABLE_GENERATOR_NEWSVSTRING static SV* newSVstring( char *s) { return newSVpv( s, 0); } #endif #define START_TABLE(package,type) \ typedef struct { \ char *name; \ type value; \ } ConstTable_##package; \ ConstTable_##package Prima_Autoload_##package##_constants[] = { #define CONSTANT(package,const_name) \ { #const_name , package##const_name }, #define CONSTANT2(package,const_name,string_name) \ { #string_name , package##const_name }, #define END_TABLE4(package,type,suffix,conversion) \ }; /* end of table */ \ static SV* newSVstring( char *s); \ XS(prima_autoload_##package##_constant) \ { \ static PHash table = nil; \ dXSARGS; \ char *name; \ int i; \ type *r; \ \ if (!table) { \ table = hash_create(); \ if (!table) croak( #package "::constant: cannot create hash"); \ for ( i = 0; i < sizeof( Prima_Autoload_##package##_constants) \ / sizeof( ConstTable_##package); i++) \ hash_store( table, \ Prima_Autoload_##package##_constants[i]. name, \ strlen( Prima_Autoload_##package##_constants[i]. name), \ &Prima_Autoload_##package##_constants[i]. value); \ } \ \ if ( items != 1) croak( "invalid call to " #package "::constant"); \ name = SvPV_nolen( ST( 0)); \ SPAGAIN; \ SP -= items; \ r = (type *)hash_fetch( table, name, strlen( name)); \ if ( !r) croak( "invalid value: " #package "::%s", name); \ XPUSHs( sv_2mortal( newSV##suffix((conversion)*r))); \ PUTBACK; \ return; \ } \ void register_##package##_constants( void) { \ HV *unused_hv; \ GV *unused_gv; \ SV *sv; \ CV *cv; \ int i; \ \ newXS( #package "::constant", prima_autoload_##package##_constant, #package); \ sv = newSVpv("", 0); \ for ( i = 0; i < sizeof( Prima_Autoload_##package##_constants) \ / sizeof( ConstTable_##package); i++) { \ sv_setpvf( sv, "%s::%s", #package, Prima_Autoload_##package##_constants[i]. name); \ cv = sv_2cv(sv, &unused_hv, &unused_gv, true); \ sv_setpv((SV*)cv, ""); \ } \ sv_free( sv); \ } #else #define START_TABLE(package,type) \ typedef struct { \ char *name; \ type value; \ } ConstTable_##package; #define CONSTANT(package,const_name) /* nothing */ #define CONSTANT2(package,const_name,string_name) /* nothing */ #define END_TABLE4(package,type,suffix,conversion) /* nothing */ #endif #define END_TABLE(package,type) END_TABLE4(package,type,iv,IV) #define END_TABLE_CHAR(package,type) END_TABLE4(package,type,string,char*) /* Object life stages */ #define csDeadInInit -2 /* dead before any init() code */ #define csConstructing -1 /* before create() finished */ #define csNormal 0 /* normal during life stage */ #define csDestroying 1 /* destroy() started */ #define csFrozen 2 /* cleanup() started - no messages available at this point */ #define csFinalizing 3 /* done() started */ #define csDead 4 /* destroy() finished - no methods available at this point */ /* Notification types */ #define NT(const_name) CONSTANT(nt,const_name) START_TABLE(nt,UV) #define ntPrivateFirst 0x0 NT(PrivateFirst) #define ntCustomFirst 0x1 NT(CustomFirst) #define ntSingle 0x0 NT(Single) #define ntMultiple 0x2 NT(Multiple) #define ntEvent 0x4 NT(Event) #define ntFluxNormal 0x0 NT(FluxNormal) #define ntFluxReverse 0x8 NT(FluxReverse) #define ntSMASK ntMultiple | ntEvent NT(SMASK) #define ntDefault ntPrivateFirst | ntMultiple | ntFluxReverse NT(Default) #define ntProperty ntPrivateFirst | ntSingle | ntFluxNormal NT(Property) #define ntRequest ntPrivateFirst | ntEvent | ntFluxNormal NT(Request) #define ntNotification ntCustomFirst | ntMultiple | ntFluxReverse NT(Notification) #define ntAction ntCustomFirst | ntSingle | ntFluxReverse NT(Action) #define ntCommand ntCustomFirst | ntEvent | ntFluxReverse NT(Command) END_TABLE(nt,UV) #undef NT /* Modality types */ #define MT(const_name) CONSTANT(mt,const_name) START_TABLE(mt,UV) #define mtNone 0 MT(None) #define mtShared 1 MT(Shared) #define mtExclusive 2 MT(Exclusive) END_TABLE(mt,UV) #undef MT /* Command event types */ #define ctQueueMask 0x00070000 /* masks bits that defines behavior in !csNormal stages: */ #define ctCacheable 0x00000000 /* Command caches in the queue */ #define ctDiscardable 0x00010000 /* Command should be discarded */ #define ctPassThrough 0x00020000 /* Command passes as normal */ #define ctSingle 0x00040000 /* Command caches in the queue only once, then changes ct bits to */ #define ctSingleResponse 0x00050000 /* ctSingleResponse */ #define ctNoInhibit 0x00080000 /* Valid for csDestroying and csFrozen */ /* Apricot events */ /* commands */ #define CM(const_name) CONSTANT(cm,const_name) START_TABLE(cm,UV) #define cmClose (0x00000005|ctDiscardable) CM(Close) #define cmChangeOwner (0x00000006|ctDiscardable) CM(ChangeOwner) #define cmChildEnter (0x00000007|ctDiscardable) CM(ChildEnter) #define cmChildLeave (0x00000008|ctDiscardable) CM(ChildLeave) #define cmCreate (0x00000009|ctPassThrough) CM(Create) #define cmDestroy (0x0000000B|ctPassThrough|ctNoInhibit) CM(Destroy) #define cmHide (0x0000000C|ctDiscardable) /* visible flag aware */ CM(Hide) #define cmShow (0x0000000D|ctDiscardable) /* commands */ CM(Show) #define cmReceiveFocus (0x0000000E|ctDiscardable) /* focused flag aware */ CM(ReceiveFocus) #define cmReleaseFocus (0x0000000F|ctDiscardable) /* commands */ CM(ReleaseFocus) #define cmPaint (0x00000010|ctSingle) /* WM_PAINT analog */ CM(Paint) #define cmRepaint (0x00000010|ctSingleResponse) /* and it's response action */ CM(Repaint) #define cmSize (0x00000011|ctPassThrough) /* WM_SIZE analog */ CM(Size) #define cmMove (0x00000012|ctPassThrough) /* WM_MOVE analog */ CM(Move) #define cmColorChanged (0x00000013|ctDiscardable) /* generates when color changed */ CM(ColorChanged) #define cmZOrderChanged (0x00000014|ctDiscardable) /* z-order change command */ CM(ZOrderChanged) #define cmEnable (0x00000015|ctDiscardable) /* enabled flag aware */ CM(Enable) #define cmDisable (0x00000016|ctDiscardable) /* commands */ CM(Disable) #define cmActivate (0x00000017|ctDiscardable) /* commands for window */ CM(Activate) #define cmDeactivate (0x00000018|ctDiscardable) /* active stage change */ CM(Deactivate) #define cmFontChanged (0x00000019|ctDiscardable) /* generates when font changed */ CM(FontChanged) #define cmWindowState (0x0000001A|ctDiscardable) /* generates when window state changed */ CM(WindowState) #define cmTimer 0x0000001C /* WM_TIMER analog */ CM(Timer) #define cmClick 0x0000001D /* common click */ CM(Click) #define cmCalcBounds (0x0000001E|ctPassThrough) /* query on change size */ CM(CalcBounds) #define cmPost 0x0000001F /* posted message */ CM(Post) #define cmPopup 0x00000020 /* interactive popup request */ CM(Popup) #define cmExecute 0x00000021 /* dialog execution start */ CM(Execute) #define cmSetup 0x00000022 /* first message for alive and active widget */ CM(Setup) #define cmHint 0x00000023 /* hint show/hide message */ CM(Hint) #define cmDragDrop 0x00000024 /* Drag'n'drop aware */ CM(DragDrop) #define cmDragOver 0x00000025 /* constants */ CM(DragOver) #define cmEndDrag 0x00000026 /* * */ CM(EndDrag) #define cmMenu (0x00000027|ctDiscardable) /* send when menu going to be activated */ CM(Menu) #define cmEndModal 0x00000028 /* dialog execution end */ CM(EndModal) #define cmMenuCmd 0x00000050 /* interactive menu command */ CM(MenuCmd) #define cmKeyDown 0x00000051 /* generic key down handler cmd */ CM(KeyDown) #define cmKeyUp 0x00000052 /* generic key up handler cmd (rare used) */ CM(KeyUp) #define cmMouseDown 0x00000053 /* WM_BUTTONxDOWN & WM_BUTTONxDBLCLK analog */ CM(MouseDown) #define cmMouseUp 0x00000054 /* WM_BUTTONxUP analog */ CM(MouseUp) #define cmMouseMove 0x00000055 /* WM_MOUSEMOVE analog */ CM(MouseMove) #define cmMouseWheel 0x00000056 /* WM_MOUSEWHEEL analog */ CM(MouseWheel) #define cmMouseClick 0x00000057 /* click response command */ CM(MouseClick) #define cmMouseEnter 0x00000058 /* mouse entered window area */ CM(MouseEnter) #define cmMouseLeave 0x00000059 /* mouse left window area */ CM(MouseLeave) #define cmTranslateAccel 0x0000005A /* key event spred to non-focused windows */ CM(TranslateAccel) #define cmDelegateKey 0x0000005B /* reserved for key mapping */ CM(DelegateKey) #define cmFileRead 0x00000070 #define cmFileWrite 0x00000071 #define cmFileException 0x00000072 #define cmImageHeaderReady 0x00000073 #define cmImageDataReady 0x00000074 END_TABLE(cm,UV) #undef CM /* mouse buttons & message box constants */ #define MB(const_name) CONSTANT(mb,const_name) #define MB2(const_name,string_name) CONSTANT2(mb,const_name,string_name) START_TABLE(mb,UV) #define mb1 1 MB2(1,b1) #define mb2 2 MB2(2,b2) #define mb3 4 MB2(3,b3) #define mb4 8 MB2(4,b4) #define mb5 16 MB2(5,b5) #define mb6 32 MB2(6,b6) #define mb7 64 MB2(7,b7) #define mb8 128 MB2(8,b8) #define mbLeft mb1 MB(Left) #define mbRight mb3 MB(Right) #define mbMiddle mb2 MB(Middle) #define mbOK 0x0001 MB(OK) #define mbOk mbOK MB(Ok) #define mbYes 0x0002 MB(Yes) #define mbCancel 0x0004 MB(Cancel) #define mbNo 0x0008 MB(No) #define mbAbort 0x0010 MB(Abort) #define mbRetry 0x0020 MB(Retry) #define mbIgnore 0x0040 MB(Ignore) #define mbHelp 0x0080 MB(Help) #define mbOKCancel (mbOK|mbCancel) MB(OKCancel) #define mbOkCancel mbOKCancel MB(OkCancel) #define mbYesNo (mbYes|mbNo) MB(YesNo) #define mbYesNoCancel (mbYes|mbNo|mbCancel) MB(YesNoCancel) #ifdef Error #undef Error #endif #define mbError 0x0100 MB(Error) #define mbWarning 0x0200 MB(Warning) #define mbInformation 0x0400 MB(Information) #define mbQuestion 0x0800 MB(Question) #define mbNoSound 0x1000 MB(NoSound) END_TABLE(mb,UV) #undef MB #undef MB2 /* keyboard modifiers */ #define KM(const_name) CONSTANT(km,const_name) START_TABLE(km,UV) #define kmShift 0x01000000 KM(Shift) #define kmCtrl 0x04000000 KM(Ctrl) #define kmAlt 0x08000000 KM(Alt) #define kmKeyPad 0x40000000 KM(KeyPad) #define kmDeadKey 0x80000000 KM(DeadKey) END_TABLE(km,UV) #undef KM #define KB(const_name) CONSTANT(kb,const_name) START_TABLE(kb,UV) /* keyboard masks */ #define kbCharMask 0x000000ff KB(CharMask) #define kbCodeMask 0x00ffff00 KB(CodeMask) #define kbModMask 0xff000000 KB(ModMask) /* bad key or no key code */ #define kbNoKey 0x00FFFF00 KB(NoKey) /* virtual keys which are modifiers at the same time */ #define kbShiftL 0x00010100 KB(ShiftL) #define kbShiftR 0x00010200 KB(ShiftR) #define kbCtrlL 0x00010300 KB(CtrlL) #define kbCtrlR 0x00010400 KB(CtrlR) #define kbAltL 0x00010500 KB(AltL) #define kbAltR 0x00010600 KB(AltR) #define kbMetaL 0x00010700 KB(MetaL) #define kbMetaR 0x00010800 KB(MetaR) #define kbSuperL 0x00010900 KB(SuperL) #define kbSuperR 0x00010a00 KB(SuperR) #define kbHyperL 0x00010b00 KB(HyperL) #define kbHyperR 0x00010c00 KB(HyperR) #define kbCapsLock 0x00010d00 KB(CapsLock) #define kbNumLock 0x00010e00 KB(NumLock) #define kbScrollLock 0x00010f00 KB(ScrollLock) #define kbShiftLock 0x00011000 KB(ShiftLock) /* Virtual keys which have character code at the same time */ #define kbBackspace 0x00020800 KB(Backspace) #define kbTab 0x00020900 KB(Tab) #define kbKPTab (kmKeyPad | kbTab) /* C-only */ #define kbLinefeed 0x00020a00 KB(Linefeed) #define kbEnter 0x00020d00 KB(Enter) #define kbReturn kbEnter KB(Return) #define kbKPEnter (kmKeyPad | kbEnter) /* C-only */ #define kbKPReturn kbKPEnter /* C-only */ #define kbEscape 0x00021b00 KB(Escape) #define kbEsc kbEscape KB(Esc) #define kbSpace 0x00022000 KB(Space) #define kbKPSpace (kmKeyPad | kbSpace) /* C-only */ #define kbKPEqual (kmKeyPad | '=') /* C-only */ #define kbKPMultiply (kmKeyPad | '*') /* C-only */ #define kbKPAdd (kmKeyPad | '+') /* C-only */ #define kbKPSeparator (kmKeyPad | ',') /* C-only */ #define kbKPSubtract (kmKeyPad | '-') /* C-only */ #define kbKPDecimal (kmKeyPad | '.') /* C-only */ #define kbKPDivide (kmKeyPad | '/') /* C-only */ #define kbKP0 (kmKeyPad | '0') /* C-only */ #define kbKP1 (kmKeyPad | '1') /* C-only */ #define kbKP2 (kmKeyPad | '2') /* C-only */ #define kbKP3 (kmKeyPad | '3') /* C-only */ #define kbKP4 (kmKeyPad | '4') /* C-only */ #define kbKP5 (kmKeyPad | '5') /* C-only */ #define kbKP6 (kmKeyPad | '6') /* C-only */ #define kbKP7 (kmKeyPad | '7') /* C-only */ #define kbKP8 (kmKeyPad | '8') /* C-only */ #define kbKP9 (kmKeyPad | '9') /* C-only */ /* Other virtual keys */ #define kbClear 0x00040100 KB(Clear) #define kbPause 0x00040200 #ifdef Pause #undef Pause #endif KB(Pause) #define kbSysRq 0x00040300 KB(SysRq) #define kbSysReq kbSysRq KB(SysReq) #define kbDelete 0x00040400 KB(Delete) #define kbKPDelete (kmKeyPad | kbDelete) /* C-only */ #define kbHome 0x00040500 KB(Home) #define kbKPHome (kmKeyPad | kbHome) /* C-only */ #define kbLeft 0x00040600 KB(Left) #define kbKPLeft (kmKeyPad | kbLeft) /* C-only */ #define kbUp 0x00040700 KB(Up) #define kbKPUp (kmKeyPad | kbUp) /* C-only */ #define kbRight 0x00040800 KB(Right) #define kbKPRight (kmKeyPad | kbRight) /* C-only */ #define kbDown 0x00040900 KB(Down) #define kbKPDown (kmKeyPad | kbDown) /* C-only */ #define kbPgUp 0x00040a00 KB(PgUp) #define kbPrior kbPgUp KB(Prior) #define kbPageUp kbPgUp KB(PageUp) #define kbKPPgUp (kmKeyPad | kbPgUp) /* C-only */ #define kbKPPrior kbKPPgUp /* C-only */ #define kbKPPageUp kbKPPgUp /* C-only */ #define kbPgDn 0x00040b00 KB(PgDn) #define kbNext kbPgDn KB(Next) #define kbPageDown kbPgDn KB(PageDown) #define kbKPPgDn (kmKeyPad | kbPgDn) /* C-only */ #define kbKPNext kbKPPgDn /* C-only */ #define kbKPPageDown kbKPPgDn /* C-only */ #define kbEnd 0x00040c00 KB(End) #define kbKPEnd (kmKeyPad | kbEnd) /* C-only */ #define kbBegin 0x00040d00 KB(Begin) #define kbKPBegin (kmKeyPad | kbBegin) /* C-only */ #define kbSelect 0x00040e00 KB(Select) #define kbPrint 0x00040f00 KB(Print) #define kbPrintScr kbPrint KB(PrintScr) #define kbExecute 0x00041000 KB(Execute) #define kbInsert 0x00041100 KB(Insert) #define kbKPInsert (kmKeyPad | kbInsert) /* C-only */ #define kbUndo 0x00041200 KB(Undo) #define kbRedo 0x00041300 KB(Redo) #define kbMenu 0x00041400 KB(Menu) #define kbFind 0x00041500 KB(Find) #define kbCancel 0x00041600 KB(Cancel) #define kbHelp 0x00041700 KB(Help) #define kbBreak 0x00041800 KB(Break) #define kbBackTab 0x00041900 KB(BackTab) /* Virtual function keys */ #define kbF1 0x00080100 KB(F1) #define kbKPF1 (kmKeyPad | kbF1) /* C-only */ #define kbF2 0x00080200 KB(F2) #define kbKPF2 (kmKeyPad | kbF2) /* C-only */ #define kbF3 0x00080300 KB(F3) #define kbKPF3 (kmKeyPad | kbF3) /* C-only */ #define kbF4 0x00080400 KB(F4) #define kbKPF4 (kmKeyPad | kbF4) /* C-only */ #define kbF5 0x00080500 KB(F5) #define kbF6 0x00080600 KB(F6) #define kbF7 0x00080700 KB(F7) #define kbF8 0x00080800 KB(F8) #define kbF9 0x00080900 KB(F9) #define kbF10 0x00080a00 KB(F10) #define kbF11 0x00080b00 KB(F11) #define kbL1 kbF11 KB(L1) #define kbF12 0x00080c00 KB(F12) #define kbL2 kbF12 KB(L2) #define kbF13 0x00080d00 KB(F13) #define kbL3 kbF13 KB(L3) #define kbF14 0x00080e00 KB(F14) #define kbL4 kbF14 KB(L4) #define kbF15 0x00080f00 KB(F15) #define kbL5 kbF15 KB(L5) #define kbF16 0x00081000 KB(F16) #define kbL6 kbF16 KB(L6) #define kbF17 0x00081100 KB(F17) #define kbL7 kbF17 KB(L7) #define kbF18 0x00081200 KB(F18) #define kbL8 kbF18 KB(L8) #define kbF19 0x00081300 KB(F19) #define kbL9 kbF19 KB(L9) #define kbF20 0x00081400 KB(F20) #define kbL10 kbF20 KB(L10) #define kbF21 0x00081500 KB(F21) #define kbR1 kbF21 KB(R1) #define kbF22 0x00081600 KB(F22) #define kbR2 kbF22 KB(R2) #define kbF23 0x00081700 KB(F23) #define kbR3 kbF23 KB(R3) #define kbF24 0x00081800 KB(F24) #define kbR4 kbF24 KB(R4) #define kbF25 0x00081900 KB(F25) #define kbR5 kbF25 KB(R5) #define kbF26 0x00081a00 KB(F26) #define kbR6 kbF26 KB(R6) #define kbF27 0x00081b00 KB(F27) #define kbR7 kbF27 KB(R7) #define kbF28 0x00081c00 KB(F28) #define kbR8 kbF28 KB(R8) #define kbF29 0x00081d00 KB(F29) #define kbR9 kbF29 KB(R9) #define kbF30 0x00081e00 KB(F30) #define kbR10 kbF30 KB(R10) END_TABLE(kb,UV) #undef KB #define TA(const_name) CONSTANT(ta,const_name) START_TABLE(ta,UV) #define taLeft 1 TA(Left) #define taRight 2 TA(Right) #define taCenter 3 TA(Center) #define taTop 4 TA(Top) #define taBottom 8 TA(Bottom) #define taMiddle 12 TA(Middle) END_TABLE(ta,UV) #undef TA /* Please, please, PLEASE! Do not use directly! */ typedef struct _VmtPatch { void *vmtAddr; void *procAddr; char *name; } VmtPatch; typedef struct _VMT { /* Whatever VMT */ char *className; struct _VMT *super; struct _VMT *base; int instanceSize; VmtPatch *patch; int patchLength; int vmtSize; } VMT, *PVMT; typedef struct _AnyObject { /* Whatever Object */ PVMT self; PVMT *super; SV *mate; struct _AnyObject *killPtr; } AnyObject, *PAnyObject; extern FillPattern fillPatterns[]; /* gencls rtl support */ #define C_NUMERIC_UNDEF -90909090 #define C_STRING_UNDEF "__C_CHAR_UNDEF__" #define C_POINTER_UNDEF nilSV /* run-time class information functions */ extern Bool kind_of( Handle object, void *cls); /* debugging functions */ extern int debug_write( const char *format, ...); /* perl links */ #if (PERL_PATCHLEVEL < 5) /* ...(perl stinks)... */ #undef SvREFCNT_inc #define SvREFCNT_inc(sv) ((Sv = (SV*)(sv)), \ (void)(Sv && ++SvREFCNT(Sv)), \ (SV*)Sv) #endif #ifdef PERL_CALL_SV_DIE_BUG_AWARE extern I32 clean_perl_call_method( char* methname, I32 flags); extern I32 clean_perl_call_pv( char* subname, I32 flags); #endif extern void build_static_vmt( void *vmt); extern Bool build_dynamic_vmt( void *vmt, const char *ancestorName, int ancestorVmtSize); extern PVMT gimme_the_vmt( const char *className); extern Handle gimme_the_mate( SV *perlObject); extern Handle create_mate( SV *perlObject); extern SV* eval( char* string); extern CV* sv_query_method( SV * object, char *methodName, Bool cacheIt); extern CV* query_method( Handle object, char *methodName, Bool cacheIt); extern SV* call_perl_indirect( Handle self, char *subName, const char *format, Bool cdecl, Bool coderef, va_list params); extern SV* call_perl( Handle self, char *subName, const char *format, ...); extern SV* sv_call_perl( SV * mate, char *subName, const char *format, ...); extern SV* notify_perl( Handle self, char *methodName, const char *format, ...); extern SV* cv_call_perl( SV * mate, SV * coderef, const char *format, ...); extern Handle Object_create( char * className, HV * profile); extern void Object_destroy( Handle self); extern void protect_object( Handle obj); extern void unprotect_object( Handle obj); extern void kill_zombies( void); extern HV* parse_hv( I32 ax, SV **sp, I32 items, SV **mark, int expected, const char *methodName); extern void push_hv( I32 ax, SV **sp, I32 items, SV **mark, int callerReturns, HV *hv); extern SV** push_hv_for_REDEFINED( SV **sp, HV *hv); extern int pop_hv_for_REDEFINED( SV **sp, int count, HV *hv, int shouldBe); extern void perl_error(void); extern void* create_object( const char *objClass, const char *types, ...); #ifdef __GNUC__ #define SvBOOL(sv) ({ SV *svsv = sv; SvTRUE(svsv);}) #else __INLINE__ Bool SvBOOL( SV *sv) { return SvTRUE(sv); } #endif #define pexist( key) hv_exists( profile, # key, strlen( #key)) #define pdelete( key) (void) hv_delete( profile, # key, strlen( #key), G_DISCARD) #define dPROFILE SV ** temporary_prf_Sv #define pget_sv( key) ((( temporary_prf_Sv = hv_fetch( profile, # key, strlen( # key), 0)) == nil) ? croak( "Panic: bad profile key (``%s'') requested in ``%s'', line %d\n", # key, __FILE__, __LINE__ ), &sv_undef : *temporary_prf_Sv) #define pget_i( key) ( pget_sv( key), SvIV( *temporary_prf_Sv)) #define pget_f( key) ( pget_sv( key), SvNV( *temporary_prf_Sv)) #define pget_c( key) ( pget_sv( key), SvPV_nolen( *temporary_prf_Sv)) #define pget_H( key) gimme_the_mate( pget_sv( key)) #define pget_B( key) ( SvTRUE( pget_sv( key))) #define pset_sv_noinc( key, value) (void)hv_store( profile, # key, strlen( # key), value, 0) #define pset_sv( key, value) pset_sv_noinc( key, newSVsv( value)) #define pset_i( key, value) pset_sv_noinc( key, newSViv( value)) #define pset_f( key, value) pset_sv_noinc( key, newSVnv( value)) #define pset_c( key, value) pset_sv_noinc( key, newSVpv( value, 0)) #define pset_b( key, value, len) pset_sv_noinc( key, newSVpv( value, ( len))) #define pset_H( key, value) pset_sv_noinc( key, (value) ? newSVsv((( PAnyObject) (value))-> mate) : nilSV) #define create_instance( obj) ( \ temporary_prf_Sv = ( SV **) Object_create( obj, profile), \ ( temporary_prf_Sv ? \ --SvREFCNT( SvRV((( PAnyObject) temporary_prf_Sv)-> mate)) \ : 0), \ ( Handle) temporary_prf_Sv \ ) #ifdef POLLUTE_NAME_SPACE #define TransmogrifyHandle(c,h) ((P##c)(h)) #define PAbstractMenu(h) TransmogrifyHandle(AbstractMenu,(h)) #define CAbstractMenu(h) (PAbstractMenu(h)->self) #define PApplication(h) TransmogrifyHandle(Application,(h)) #define CApplication(h) (PApplication(h)-> self) #define PComponent(h) TransmogrifyHandle(Component,(h)) #define CComponent(h) (PComponent(h)-> self) #define PDrawable(h) TransmogrifyHandle(Drawable,(h)) #define CDrawable(h) (PDrawable(h)-> self) #define PFile(h) TransmogrifyHandle(File,(h)) #define CFile(h) (PFile(h)-> self) #define PIcon(h) TransmogrifyHandle(Icon,(h)) #define CIcon(h) (PIcon(h)-> self) #define PImage(h) TransmogrifyHandle(Image,(h)) #define CImage(h) (PImage(h)-> self) #define PObject(h) TransmogrifyHandle(Object,(h)) #define CObject(h) (PObject(h)-> self) #define PMenu(h) TransmogrifyHandle(Menu,(h)) #define CMenu(h) (PMenu(h)-> self) #define PPopup(h) TransmogrifyHandle(Popup,(h)) #define CPopup(h) (PPopup(h)-> self) #define PPrinter(h) TransmogrifyHandle(Printer,(h)) #define CPrinter(h) (PPrinter(h)-> self) #define PTimer(h) TransmogrifyHandle(Timer,(h)) #define CTimer(h) (PTimer(h)-> self) #define PWidget(h) TransmogrifyHandle(Widget,(h)) #define CWidget(h) (PWidget(h)-> self) #define PWindow(h) TransmogrifyHandle(Window,(h)) #define CWindow(h) (PWindow(h)-> self) #endif /* mapping functions */ #define endCtx 0x19740108 extern int ctx_remap_def ( int value, int * table, Bool direct, int default_value); #define ctx_remap_end(a,b,c) ctx_remap_def((a),(b),(c), endCtx) #define ctx_remap(a,b,c) ctx_remap_def((a),(b),(c), 0) /* utility functions */ extern char * duplicate_string( const char *); /* lists support */ typedef struct _List { Handle * items; int count; int size; int delta; } List, *PList; typedef Bool ListProc ( Handle item, void * params); typedef ListProc *PListProc; extern void list_create( PList self, int size, int delta); extern PList plist_create( int size, int delta); extern void list_destroy( PList self); extern void plist_destroy( PList self); extern int list_add( PList self, Handle item); extern int list_insert_at( PList self, Handle item, int pos); extern Handle list_at( PList self, int index); extern void list_delete( PList self, Handle item); extern void list_delete_at( PList self, int index); extern void list_delete_all( PList self, Bool kill); extern int list_first_that( PList self, void * action, void * params); extern int list_index_of( PList self, Handle item); /* utf8 */ #if PERL_PATCHLEVEL > 5 #define PERL_SUPPORTS_UTF8 1 #if (PERL_PATCHLEVEL == 6) #define utf8_to_uvchr utf8_to_uv_simple #define utf8_to_uvuni utf8_to_uv_simple #define uvchr_to_utf8 uv_to_utf8 #define uvuni_to_utf8 uv_to_utf8 #endif #else /* dummy utf8 functionality */ #undef utf8_hop #undef utf8_length #undef PERL_SUPPORTS_UTF8 #define IN_BYTES 1 #define DO_UTF8(sv) 0 #define SvUTF8(sv) 0 #define utf8_length(s,e) ((U8*)(e)-(U8*)(s)) #define utf8_hop(s,off) ((U8*)((s)+(off))) #define SvUTF8_on(sv) {} #define SvUTF8_off(sv) {} #define utf8_to_uvchr prima_utf8_to_uv #define utf8_to_uvuni prima_utf8_to_uv #define uvchr_to_utf8 prima_uv_to_utf8 #define uvuni_to_utf8 prima_uv_to_utf8 extern UV prima_utf8_to_uv( U8 * utf8, STRLEN * len); extern U8 * prima_uv_to_utf8( U8 * utf8, UV uv); #endif extern int prima_utf8_length( const char * utf8); /* OS types */ #define APC(const_name) CONSTANT(apc,const_name) START_TABLE(apc,UV) #define apcOs2 1 APC(Os2) #define apcWin32 2 APC(Win32) #define apcUnix 3 APC(Unix) END_TABLE(apc,UV) #undef APC /* GUI types */ #define GUI(const_name) CONSTANT(gui,const_name) START_TABLE(gui,UV) #define guiDefault 0 GUI(Default) #define guiPM 1 GUI(PM) #define guiWindows 2 GUI(Windows) #define guiXLib 3 GUI(XLib) #define guiGTK2 4 GUI(GTK2) END_TABLE(gui,UV) #undef GUI /* drives types (for platforms which have 'em) */ /* also, text justification constants for draw_text */ #define DT(const_name) CONSTANT(dt,const_name) START_TABLE(dt,UV) #define dtUnknown 0 DT(Unknown) #define dtNone 1 DT(None) #define dtFloppy 2 DT(Floppy) #define dtHDD 3 DT(HDD) #define dtNetwork 4 DT(Network) #define dtCDROM 5 DT(CDROM) #define dtMemory 6 DT(Memory) #define dtLeft 0x0000 DT(Left) #define dtRight 0x0001 DT(Right) #define dtCenter 0x0002 DT(Center) #define dtTop 0x0000 DT(Top) #define dtBottom 0x0004 DT(Bottom) #define dtVCenter 0x0008 DT(VCenter) #define dtDrawMnemonic 0x0010 DT(DrawMnemonic) #define dtDrawSingleChar 0x0020 DT(DrawSingleChar) #define dtDrawPartial 0x0040 DT(DrawPartial) #define dtNewLineBreak 0x0080 DT(NewLineBreak) #define dtSpaceBreak 0x0100 DT(SpaceBreak) #define dtWordBreak 0x0200 DT(WordBreak) #define dtExpandTabs 0x0400 DT(ExpandTabs) #define dtUseExternalLeading 0x0800 DT(UseExternalLeading) #define dtUseClip 0x1000 DT(UseClip) #define dtQueryHeight 0x2000 DT(QueryHeight) #define dtQueryLinesDrawn 0x0000 DT(QueryLinesDrawn) #define dtNoWordWrap 0x4000 DT(NoWordWrap) #define dtWordWrap 0x0000 DT(WordWrap) #define dtDefault (dtNewLineBreak|dtWordBreak|dtExpandTabs|dtUseExternalLeading) DT(Default) END_TABLE(dt,UV) #undef DT /* apc error constants */ #define errOk 0x0000 #define errApcError 0x0001 #define errInvObject 0x0002 #define errInvParams 0x0003 #define errInvWindowIcon 0x0100 #define errInvClipboardData 0x0101 #define errInvPrinter 0x0102 #define errNoPrinters 0x0103 #define errNoPrnSettableOptions 0x0103 #define errUserCancelled 0x0104 /* system-independent object option flags */ typedef struct _ObjectOptions_ { unsigned optInDestroyList : 1; /* Object */ unsigned optcmDestroy : 1; /* Component */ unsigned optUTF8_name : 1; unsigned optInDraw : 1; /* Drawable */ unsigned optInDrawInfo : 1; unsigned optTextOutBaseLine : 1; unsigned optAutoEnableChildren : 1; /* Widget */ unsigned optBriefKeys : 1; unsigned optBuffered : 1; unsigned optModalHorizon : 1; unsigned optOwnerBackColor : 1; unsigned optOwnerColor : 1; unsigned optOwnerFont : 1; unsigned optOwnerHint : 1; unsigned optOwnerShowHint : 1; unsigned optOwnerPalette : 1; unsigned optPackPropagate : 1; unsigned optSetupComplete : 1; unsigned optSelectable : 1; unsigned optShowHint : 1; unsigned optSystemSelectable : 1; unsigned optTabStop : 1; unsigned optScaleChildren : 1; unsigned optUTF8_helpContext : 1; unsigned optUTF8_hint : 1; unsigned optUTF8_text : 1; unsigned optPreserveType : 1; /* Image */ unsigned optVScaling : 1; unsigned optHScaling : 1; unsigned optAutoPopup : 1; /* Popup */ unsigned optActive : 1; /* Timer */ unsigned optOwnerIcon : 1; /* Window */ } ObjectOptions; #define opt_set( option) (PObject(self)-> options. option = 1) #define opt_clear( option) (PObject(self)-> options. option = 0) #define is_opt( option) (PObject(self)-> options. option) #define opt_assign( option, value) (PObject(self)->options. option = \ (value) ? 1 : 0) #define opt_InPaint ( is_opt( optInDraw) \ || is_opt( optInDrawInfo)) /* apc class constants */ #define WC(const_name) CONSTANT(wc,const_name) START_TABLE(wc,UV) #define wcUndef 0x0000000 WC(Undef) #define wcButton 0x0010000 WC(Button) #define wcCheckBox 0x0020000 WC(CheckBox) #define wcCombo 0x0030000 WC(Combo) #define wcDialog 0x0040000 WC(Dialog) #define wcEdit 0x0050000 WC(Edit) #define wcInputLine 0x0060000 WC(InputLine) #define wcLabel 0x0070000 WC(Label) #define wcListBox 0x0080000 WC(ListBox) #define wcMenu 0x0090000 WC(Menu) #define wcPopup 0x00A0000 WC(Popup) #define wcRadio 0x00B0000 WC(Radio) #define wcScrollBar 0x00C0000 WC(ScrollBar) #define wcSlider 0x00D0000 WC(Slider) #define wcWidget 0x00E0000 WC(Widget) #define wcCustom wcWidget WC(Custom) #define wcWindow 0x00F0000 WC(Window) #define wcApplication 0x0100000 WC(Application) #define wcMask 0xFFF0000 WC(Mask) END_TABLE(wc,UV) #undef WC /* geometry manager types */ #define GT(const_name) CONSTANT(gt,const_name) START_TABLE(gt,UV) #define gtDefault 0 GT(Default) #define gtGrowMode 0 GT(GrowMode) #define gtPack 1 GT(Pack) #define gtPlace 2 GT(Place) #define gtMax 2 GT(Max) END_TABLE(gt,UV) #undef GT /* widget grow constats */ #define GM(const_name) CONSTANT(gm,const_name) START_TABLE(gm,UV) #define gmGrowLoX 0x001 GM(GrowLoX) #define gmGrowLoY 0x002 GM(GrowLoY) #define gmGrowHiX 0x004 GM(GrowHiX) #define gmGrowHiY 0x008 GM(GrowHiY) #define gmGrowAll 0x00F GM(GrowAll) #define gmXCenter 0x010 GM(XCenter) #define gmYCenter 0x020 GM(YCenter) #define gmCenter (gmXCenter|gmYCenter) GM(Center) #define gmDontCare 0x040 GM(DontCare) /* shortcuts */ #define gmClient (gmGrowHiX|gmGrowHiY) GM(Client) #define gmRight (gmGrowLoX|gmGrowHiY) GM(Right) #define gmLeft gmGrowHiY GM(Left) #define gmFloor gmGrowHiX GM(Floor) #define gmCeiling (gmGrowHiX|gmGrowLoY) GM(Ceiling) END_TABLE(gm,UV) #undef GM /* border icons */ #define BI(const_name) CONSTANT(bi,const_name) START_TABLE(bi,UV) #define biSystemMenu 1 BI(SystemMenu) #define biMinimize 2 BI(Minimize) #define biMaximize 4 BI(Maximize) #define biTitleBar 8 BI(TitleBar) #define biAll (biSystemMenu|biMinimize|biMaximize|biTitleBar) BI(All) END_TABLE(bi,UV) #undef BI /* border styles */ #define BS(const_name) CONSTANT(bs,const_name) START_TABLE(bs,UV) #define bsNone 0 BS(None) #define bsSizeable 1 BS(Sizeable) #define bsSingle 2 BS(Single) #define bsDialog 3 BS(Dialog) END_TABLE(bs,UV) #undef BS /* window states */ #define WS(const_name) CONSTANT(ws,const_name) START_TABLE(ws,UV) #define wsNormal 0 WS(Normal) #define wsMinimized 1 WS(Minimized) #define wsMaximized 2 WS(Maximized) END_TABLE(ws,UV) #undef WS /* z-order query constants */ #define zoFirst 0 #define zoLast 1 #define zoNext 2 #define zoPrev 3 /* system values */ #define SV(const_name) CONSTANT(sv,const_name) START_TABLE(sv,UV) #define svYMenu 0 SV(YMenu) #define svYTitleBar 1 SV(YTitleBar) #define svXIcon 2 SV(XIcon) #define svYIcon 3 SV(YIcon) #define svXSmallIcon 4 SV(XSmallIcon) #define svYSmallIcon 5 SV(YSmallIcon) #define svXPointer 6 SV(XPointer) #define svYPointer 7 SV(YPointer) #define svXScrollbar 8 SV(XScrollbar) #define svYScrollbar 9 SV(YScrollbar) #define svXCursor 10 SV(XCursor) #define svAutoScrollFirst 11 SV(AutoScrollFirst) #define svAutoScrollNext 12 SV(AutoScrollNext) #define svInsertMode 13 SV(InsertMode) #define svXbsNone 14 SV(XbsNone) #define svYbsNone 15 SV(YbsNone) #define svXbsSizeable 16 SV(XbsSizeable) #define svYbsSizeable 17 SV(YbsSizeable) #define svXbsSingle 18 SV(XbsSingle) #define svYbsSingle 19 SV(YbsSingle) #define svXbsDialog 20 SV(XbsDialog) #define svYbsDialog 21 SV(YbsDialog) #define svMousePresent 22 SV(MousePresent) #define svMouseButtons 23 SV(MouseButtons) #define svWheelPresent 24 SV(WheelPresent) #define svSubmenuDelay 25 SV(SubmenuDelay) #define svFullDrag 26 SV(FullDrag) #define svDblClickDelay 27 SV(DblClickDelay) #define svShapeExtension 28 SV(ShapeExtension) #define svColorPointer 29 SV(ColorPointer) #define svCanUTF8_Input 30 SV(CanUTF8_Input) #define svCanUTF8_Output 31 SV(CanUTF8_Output) END_TABLE(sv,UV) #undef SV extern Handle application; extern long apcError; /* ***************** * apc functions * ***************** */ extern char * apc_last_error(); extern Handle apc_get_application(void); /* Application management */ extern Bool apc_application_begin_paint( Handle self); extern Bool apc_application_begin_paint_info( Handle self); extern Bool apc_application_create( Handle self); extern Bool apc_application_close( Handle self); extern Bool apc_application_destroy( Handle self); extern Bool apc_application_end_paint( Handle self); extern Bool apc_application_end_paint_info( Handle self); extern Bool apc_application_get_bitmap( Handle self, Handle image, int x, int y, int xLen, int yLen); extern int apc_application_get_gui_info( char * description, int len); extern Handle apc_application_get_widget_from_point( Handle self, Point point); extern Handle apc_application_get_handle( Handle self, ApiHandle apiHandle); extern Rect apc_application_get_indents( Handle self); extern int apc_application_get_os_info( char *system, int slen, char *release, int rlen, char *vendor, int vlen, char *arch, int alen); extern Point apc_application_get_size( Handle self); extern Bool apc_application_go( Handle self); extern Bool apc_application_lock( Handle self); extern Bool apc_application_sync( void); extern Bool apc_application_unlock( Handle self); extern Bool apc_application_yield( void); /* Component */ extern Bool apc_component_create( Handle self); extern Bool apc_component_destroy( Handle self); extern Bool apc_component_fullname_changed_notify( Handle self); /* Window */ extern Bool apc_window_create( Handle self, Handle owner, Bool syncPaint, int borderIcons, int borderStyle, Bool taskList, int windowState, int onTop, Bool useOrigin, Bool useSize); extern Bool apc_window_activate( Handle self); extern Bool apc_window_is_active( Handle self); extern Bool apc_window_close( Handle self); extern Handle apc_window_get_active( void); extern int apc_window_get_border_icons( Handle self); extern int apc_window_get_border_style( Handle self); extern Point apc_window_get_client_pos( Handle self); extern Point apc_window_get_client_size( Handle self); extern Bool apc_window_get_icon( Handle self, Handle icon); extern Bool apc_window_get_on_top( Handle self); extern int apc_window_get_window_state( Handle self); extern Bool apc_window_get_task_listed( Handle self); extern Bool apc_window_set_caption( Handle self, const char* caption, Bool utf8); extern Bool apc_window_set_client_pos( Handle self, int x, int y); extern Bool apc_window_set_client_rect( Handle self, int x, int y, int width, int height); extern Bool apc_window_set_client_size( Handle self, int x, int y); extern Bool apc_window_set_menu( Handle self, Handle menu); extern Bool apc_window_set_icon( Handle self, Handle icon); extern Bool apc_window_set_window_state( Handle self, int state); extern Bool apc_window_execute( Handle self, Handle insertBefore); extern Bool apc_window_execute_shared( Handle self, Handle insertBefore); extern Bool apc_window_end_modal( Handle self); /* Widget management */ typedef struct { /* common geometry fields */ Handle next; /* dynamically filled linked list of pack slaves */ Handle in; /* 'in' option */ /* pack */ Point pad; /* border padding */ Point ipad; /* size increaze */ Handle order; /* if non-nil, BEFORE or AFTER a widget */ /* place */ int x, y; float relX, relY; float relWidth, relHeight; /* bitwise fields */ /* common */ unsigned int anchorx : 2; /* 0 - left, 1 - center, 2 - right */ unsigned int anchory : 2; /* 0 - bottom, 1 - center, 2 - top */ /* pack */ unsigned int after : 1; /* 0 - order is BEFORE; 1 - order is AFTER */ unsigned int expand : 1; /* causes the allocation rectange to fill all remaining space */ unsigned int fillx : 1; /* fill horizontal extent */ unsigned int filly : 1; /* fill vertical extent */ unsigned int side : 2; /* 0 - left, 1 - bottom, 2 - right, 3 - top */ /* place */ unsigned int use_x : 1; unsigned int use_y : 1; unsigned int use_w : 1; unsigned int use_h : 1; unsigned int use_rx : 1; unsigned int use_ry : 1; unsigned int use_rw : 1; unsigned int use_rh : 1; } GeomInfo, *PGeomInfo; extern Bool apc_widget_create( Handle self, Handle owner, Bool syncPaint, Bool clipOwner, Bool transparent, ApiHandle parentHandle); extern Bool apc_widget_begin_paint( Handle self, Bool insideOnPaint); extern Bool apc_widget_begin_paint_info( Handle self); extern Bool apc_widget_destroy( Handle self); extern PFont apc_widget_default_font( PFont copyTo); extern Bool apc_widget_end_paint( Handle self); extern Bool apc_widget_end_paint_info( Handle self); extern Bool apc_widget_get_clip_owner( Handle self); extern Color apc_widget_get_color( Handle self, int index); extern Bool apc_widget_get_first_click( Handle self); extern Handle apc_widget_get_focused( void); extern ApiHandle apc_widget_get_handle( Handle self); extern Rect apc_widget_get_invalid_rect( Handle self); extern Handle apc_widget_get_z_order( Handle self, int zOrderId); extern ApiHandle apc_widget_get_parent_handle( Handle self); extern Point apc_widget_get_pos( Handle self); extern Bool apc_widget_get_shape( Handle self, Handle mask); extern Point apc_widget_get_size( Handle self); extern Bool apc_widget_get_sync_paint( Handle self); extern Bool apc_widget_get_transparent( Handle self); extern Bool apc_widget_is_captured( Handle self); extern Bool apc_widget_is_enabled( Handle self); extern Bool apc_widget_is_exposed( Handle self); extern Bool apc_widget_is_focused( Handle self); extern Bool apc_widget_is_responsive( Handle self); extern Bool apc_widget_is_showing( Handle self); extern Bool apc_widget_is_visible( Handle self); extern Bool apc_widget_invalidate_rect( Handle self, Rect * rect); extern Color apc_widget_map_color( Handle self, Color color); extern Bool apc_widget_map_points( Handle self, Bool toScreen, int count, Point * points); extern Bool apc_widget_scroll( Handle self, int horiz, int vert, Rect *confine, Rect *clip, Bool scrollChildren); extern Bool apc_widget_set_capture( Handle self, Bool capture, Handle confineTo); extern Bool apc_widget_set_color( Handle self, Color color, int index); extern Bool apc_widget_set_enabled( Handle self, Bool enable); extern Bool apc_widget_set_first_click( Handle self, Bool firstClick); extern Bool apc_widget_set_focused( Handle self); extern Bool apc_widget_set_font( Handle self, PFont font); extern Bool apc_widget_set_palette( Handle self); extern Bool apc_widget_set_pos( Handle self, int x, int y); extern Bool apc_widget_set_rect( Handle self, int x, int y, int width, int height); extern Bool apc_widget_set_shape( Handle self, Handle mask); extern Bool apc_widget_set_size( Handle self, int width, int height); extern Bool apc_widget_set_size_bounds( Handle self, Point min, Point max); extern Bool apc_widget_set_visible( Handle self, Bool show); extern Bool apc_widget_set_z_order( Handle self, Handle behind, Bool top); extern Bool apc_widget_update( Handle self); extern Bool apc_widget_validate_rect( Handle self, Rect rect); /* standard system pointers */ #define CR(const_name) CONSTANT(cr,const_name) START_TABLE(cr,IV) #define crDefault -1 CR(Default) #define crArrow 0 CR(Arrow) #define crText 1 CR(Text) #define crWait 2 CR(Wait) #define crSize 3 CR(Size) #define crMove 4 CR(Move) #define crSizeWest 5 CR(SizeWest) #define crSizeW crSizeWest CR(SizeW) #define crSizeEast 6 CR(SizeEast) #define crSizeE crSizeEast CR(SizeE) #define crSizeWE 7 CR(SizeWE) #define crSizeNorth 8 CR(SizeNorth) #define crSizeN crSizeNorth CR(SizeN) #define crSizeSouth 9 CR(SizeSouth) #define crSizeS crSizeSouth CR(SizeS) #define crSizeNS 10 CR(SizeNS) #define crSizeNW 11 CR(SizeNW) #define crSizeSE 12 CR(SizeSE) #define crSizeNE 13 CR(SizeNE) #define crSizeSW 14 CR(SizeSW) #define crInvalid 15 CR(Invalid) #define crUser 16 CR(User) END_TABLE(cr,UV) #undef CR /* Widget attributes */ extern Bool apc_cursor_set_pos( Handle self, int x, int y); extern Bool apc_cursor_set_size( Handle self, int x, int y); extern Bool apc_cursor_set_visible( Handle self, Bool visible); extern Point apc_cursor_get_pos( Handle self); extern Point apc_cursor_get_size( Handle self); extern Bool apc_cursor_get_visible( Handle self); extern Point apc_pointer_get_hot_spot( Handle self); extern Point apc_pointer_get_pos( Handle self); extern int apc_pointer_get_shape( Handle self); extern Point apc_pointer_get_size( Handle self); extern Bool apc_pointer_get_bitmap( Handle self, Handle icon); extern Bool apc_pointer_get_visible( Handle self); extern Bool apc_pointer_set_pos( Handle self, int x, int y); extern Bool apc_pointer_set_shape( Handle self, int sysPtrId); extern Bool apc_pointer_set_user( Handle self, Handle icon, Point hotSpot); extern Bool apc_pointer_set_visible( Handle self, Bool visible); extern int apc_pointer_get_state( Handle self); extern int apc_kbd_get_state( Handle self); /* Clipboard */ #define cfText 0 #define cfBitmap 1 #define cfImage cfBitmap #define cfUTF8 2 #define cfCustom 3 typedef struct { Handle image; Byte * data; STRLEN length; } ClipboardDataRec, *PClipboardDataRec; extern PList apc_get_standard_clipboards( void); extern Bool apc_clipboard_create( Handle self); extern Bool apc_clipboard_destroy( Handle self); extern Bool apc_clipboard_open( Handle self); extern Bool apc_clipboard_close( Handle self); extern Bool apc_clipboard_clear( Handle self); extern Bool apc_clipboard_has_format( Handle self, long id); extern Bool apc_clipboard_get_data( Handle self, long id, PClipboardDataRec c); extern ApiHandle apc_clipboard_get_handle( Handle self); extern Bool apc_clipboard_set_data( Handle self, long id, PClipboardDataRec c); extern long apc_clipboard_register_format( Handle self, const char *format); extern Bool apc_clipboard_deregister_format( Handle self, long id); /* Menus & popups */ typedef struct _MenuItemReg { /* Menu item registration record */ char * variable; /* perl variable name */ char * text; /* menu text */ char * accel; /* accelerator text */ int key; /* accelerator key, kbXXX */ int id; /* unique id */ char * perlSub; /* sub name */ Handle bitmap; /* bitmap if not nil */ SV * code; /* code if not nil */ SV * data; /* use data if not nil */ struct _MenuItemReg* down; /* pointer to submenu */ struct _MenuItemReg* next; /* pointer to next item */ struct { unsigned int checked : 1; /* true if item is checked */ unsigned int disabled : 1; /* true if item is disabled */ unsigned int rightAdjust : 1; /* true if right adjust ordered */ unsigned int divider : 1; /* true if it's line divider */ unsigned int utf8_variable : 1; unsigned int utf8_text : 1; unsigned int utf8_accel : 1; unsigned int utf8_perlSub : 1; } flags; } MenuItemReg, *PMenuItemReg; extern Bool apc_menu_create( Handle self, Handle owner); extern Bool apc_menu_update( Handle self, PMenuItemReg oldBranch, PMenuItemReg newBranch); extern Bool apc_menu_destroy( Handle self); extern PFont apc_menu_default_font( PFont font); extern Color apc_menu_get_color( Handle self, int index); extern PFont apc_menu_get_font( Handle self, PFont font); extern Bool apc_menu_set_color( Handle self, Color color, int index); extern Bool apc_menu_set_font( Handle self, PFont font); extern Bool apc_menu_item_delete( Handle self, PMenuItemReg m); extern Bool apc_menu_item_set_accel( Handle self, PMenuItemReg m); extern Bool apc_menu_item_set_check( Handle self, PMenuItemReg m); extern Bool apc_menu_item_set_enabled( Handle self, PMenuItemReg m); extern Bool apc_menu_item_set_image( Handle self, PMenuItemReg m); extern Bool apc_menu_item_set_key( Handle self, PMenuItemReg m); extern Bool apc_menu_item_set_text( Handle self, PMenuItemReg m); extern ApiHandle apc_menu_get_handle( Handle self); extern Bool apc_popup_create( Handle self, Handle owner); extern PFont apc_popup_default_font( PFont font); extern Bool apc_popup( Handle self, int x, int y, Rect * anchor); /* Timer */ extern Bool apc_timer_create( Handle self, Handle owner, int timeout); extern Bool apc_timer_destroy( Handle self); extern int apc_timer_get_timeout( Handle self); extern Bool apc_timer_set_timeout( Handle self, int timeout); extern Bool apc_timer_start( Handle self); extern Bool apc_timer_stop( Handle self); extern ApiHandle apc_timer_get_handle( Handle self); /* Messages */ #define mbError 0x0100 #define mbWarning 0x0200 #define mbInformation 0x0400 #define mbQuestion 0x0800 extern Bool apc_message( Handle self, PEvent ev, Bool post); extern Bool apc_show_message( const char* message, Bool utf8); /* graphics constants */ #define ARGB(r,g,b) ((uint32_t)(((unsigned char)(b)|((uint32_t)((unsigned char)(g))<<8))|(((uint32_t)((unsigned char)(r)))<<16))) /* colors */ #define CL(const_name) CONSTANT(cl,const_name) START_TABLE(cl,UV) #define clBlack ARGB(0,0,0) CL(Black) #define clBlue ARGB(0,0,128) CL(Blue) #define clGreen ARGB(0,128,0) CL(Green) #define clCyan ARGB(0,128,128) CL(Cyan) #define clRed ARGB(128,0,0) CL(Red) #define clMagenta ARGB(128,0,128) CL(Magenta) #define clBrown ARGB(128,128,0) CL(Brown) #define clLightGray ARGB(192,192,192) CL(LightGray) #define clDarkGray ARGB(63,63,63) CL(DarkGray) #define clLightBlue ARGB(0,0,255) CL(LightBlue) #define clLightGreen ARGB(0,255,0) CL(LightGreen) #define clLightCyan ARGB(0,255,255) CL(LightCyan) #define clLightRed ARGB(255,0,0) CL(LightRed) #define clLightMagenta ARGB(255,0,255) CL(LightMagenta) #define clYellow ARGB(255,255,0) CL(Yellow) #define clWhite ARGB(255,255,255) CL(White) #define clGray ARGB(128,128,128) CL(Gray) #define clSysFlag (uint32_t)(0x10000000) CL(SysFlag) #define clSysMask (uint32_t)(0xEFFFFFFF) CL(SysMask) #define clInvalid (uint32_t)(0x10000000) CL(Invalid) #define clNormalText (uint32_t)(0x10000001) CL(NormalText) #define clFore (uint32_t)(0x10000001) CL(Fore) #define clNormal (uint32_t)(0x10000002) CL(Normal) #define clBack (uint32_t)(0x10000002) CL(Back) #define clHiliteText (uint32_t)(0x10000003) CL(HiliteText) #define clHilite (uint32_t)(0x10000004) CL(Hilite) #define clDisabledText (uint32_t)(0x10000005) CL(DisabledText) #define clDisabled (uint32_t)(0x10000006) CL(Disabled) #define clLight3DColor (uint32_t)(0x10000007) CL(Light3DColor) #define clDark3DColor (uint32_t)(0x10000008) CL(Dark3DColor) #define clSet (uint32_t)(0x10000009) CL(Set) #define clClear (uint32_t)(0x1000000A) CL(Clear) #define clMaxSysColor (uint32_t)(0x1000000A) CL(MaxSysColor) END_TABLE(cl,UV) #undef CL /* color indices */ #define CI(const_name) CONSTANT(ci,const_name) START_TABLE(ci,UV) #define ciNormalText 0 CI(NormalText) #define ciFore 0 CI(Fore) #define ciNormal 1 CI(Normal) #define ciBack 1 CI(Back) #define ciHiliteText 2 CI(HiliteText) #define ciHilite 3 CI(Hilite) #define ciDisabledText 4 CI(DisabledText) #define ciDisabled 5 CI(Disabled) #define ciLight3DColor 6 CI(Light3DColor) #define ciDark3DColor 7 CI(Dark3DColor) #define ciMaxId 7 CI(MaxId) END_TABLE(ci,UV) #undef CI typedef Color ColorSet[ ciMaxId + 1]; /* raster operations */ typedef enum { ropCopyPut = 0, /* dest = src */ ropXorPut, /* dest ^= src */ ropAndPut, /* dest &= src */ ropOrPut, /* dest |= src */ ropNotPut, /* dest = !src */ ropInvert, /* dest = !dest*/ ropBlackness, /* dest = 0 */ ropNotDestAnd, /* dest = (!dest) & src */ ropNotDestOr, /* dest = (!dest) | src */ ropWhiteness, /* dest = 1 */ ropNotSrcAnd, /* dest &= !src */ ropNotSrcOr, /* dest |= !src */ ropNotXor, /* dest = !(src ^ dest) */ ropNotAnd, /* dest = !(src & dest) */ ropNotOr, /* dest = !(src | dest) */ ropNoOper /* dest = dest */ } ROP; #define ropNotSrcXor ropNotXor /* dest ^= !src */ #define ropNotDestXor ropNotXor /* dest = !dest ^ src */ #define ROP(const_name) CONSTANT(rop,const_name) START_TABLE(rop,UV) ROP(Blackness) ROP(NotOr) ROP(NotSrcAnd) ROP(NotPut) ROP(NotDestAnd) ROP(Invert) ROP(XorPut) ROP(NotAnd) ROP(AndPut) ROP(NotXor) ROP(NoOper) ROP(NotSrcOr) ROP(CopyPut) ROP(NotDestOr) ROP(OrPut) ROP(Whiteness) ROP(NotSrcXor) ROP(NotDestXor) END_TABLE(rop,UV) #undef ROP /* line ends */ #define LE(const_name) CONSTANT(le,const_name) START_TABLE(le,UV) #define leFlat 0 LE(Flat) #define leSquare 1 LE(Square) #define leRound 2 LE(Round) END_TABLE(le,UV) #undef LE /* line joins */ #define LJ(const_name) CONSTANT(lj,const_name) START_TABLE(lj,UV) #define ljRound 0 LJ(Round) #define ljBevel 1 LJ(Bevel) #define ljMiter 2 LJ(Miter) END_TABLE(lj,UV) #undef LJ /* line patterns */ #define LP(const_name) CONSTANT(lp,const_name) START_TABLE(lp,unsigned char*) #define lpNull (unsigned char*) "" /* */ LP(Null) #define lpSolid (unsigned char*) "\1" /* ___________ */ LP(Solid) #define lpDash (unsigned char*) "\x9\3" /* __ __ __ __ */ LP(Dash) #define lpLongDash (unsigned char*) "\x16\6" /* _____ _____ */ LP(LongDash) #define lpShortDash (unsigned char*) "\3\3" /* _ _ _ _ _ _ */ LP(ShortDash) #define lpDot (unsigned char*) "\1\3" /* . . . . . . */ LP(Dot) #define lpDotDot (unsigned char*) "\1\1" /* ............ */ LP(DotDot) #define lpDashDot (unsigned char*) "\x9\6\1\3" /* _._._._._._ */ LP(DashDot) #define lpDashDotDot (unsigned char*) "\x9\3\1\3\1\3" /* _.._.._.._.. */ LP(DashDotDot) END_TABLE_CHAR(lp,unsigned char*) #undef LP /* font styles */ #define FS(const_name) CONSTANT(fs,const_name) START_TABLE(fs,UV) #define fsNormal 0x0000 FS(Normal) #define fsBold 0x0001 FS(Bold) #define fsThin 0x0002 FS(Thin) #define fsItalic 0x0004 FS(Italic) #define fsUnderlined 0x0008 FS(Underlined) #define fsStruckOut 0x0010 FS(StruckOut) #define fsOutline 0x0020 FS(Outline) END_TABLE(fs,UV) #undef FS /* font pitches */ #define FP(const_name) CONSTANT(fp,const_name) START_TABLE(fp,UV) #define fpDefault 0x0000 FP(Default) #define fpVariable 0x0001 FP(Variable) #define fpFixed 0x0002 FP(Fixed) /* fill constants */ #define fpEmpty 0 /* Uses background color */ FP(Empty) #define fpSolid 1 /* Uses draw color fill */ FP(Solid) #define fpLine 2 /* --- */ FP(Line) #define fpLtSlash 3 /* /// */ FP(LtSlash) #define fpSlash 4 /* /// thick */ FP(Slash) #define fpBkSlash 5 /* \\\ thick */ FP(BkSlash) #define fpLtBkSlash 6 /* \\\ light */ FP(LtBkSlash) #define fpHatch 7 /* Light hatch */ FP(Hatch) #define fpXHatch 8 /* Heavy cross hatch */ FP(XHatch) #define fpInterleave 9 /* Interleaving line */ FP(Interleave) #define fpWideDot 10 /* Widely spaced dot */ FP(WideDot) #define fpCloseDot 11 /* Closely spaced dot */ FP(CloseDot) #define fpSimpleDots 12 /* . . . . . . . . . . */ FP(SimpleDots) #define fpBorland 13 /* #################### */ FP(Borland) #define fpParquet 14 /* \/\/\/\/\/\/\/\/\/\/ */ FP(Parquet) #define fpCritters 15 /* critters */ FP(Critters) #define fpMaxId 15 FP(MaxId) END_TABLE(fp,UV) #undef FP /* font weigths */ #define FW(const_name) CONSTANT(fw,const_name) START_TABLE(fw,UV) #define fwUltraLight 1 FW(UltraLight) #define fwExtraLight 2 FW(ExtraLight) #define fwLight 3 FW(Light) #define fwSemiLight 4 FW(SemiLight) #define fwMedium 5 FW(Medium) #define fwSemiBold 6 FW(SemiBold) #define fwBold 7 FW(Bold) #define fwExtraBold 8 FW(ExtraBold) #define fwUltraBold 9 FW(UltraBold) END_TABLE(fw,UV) #undef FW #define FONT_UTF8_NAME 0x001 #define FONT_UTF8_FAMILY 0x002 #define FONT_UTF8_ENCODING 0x004 #define IM(const_name) CONSTANT(im,const_name) START_TABLE(im,UV) #define imNone 0 IM(None) #define imbpp1 0x001 IM(bpp1) #define imbpp4 0x004 IM(bpp4) #define imbpp8 0x008 IM(bpp8) #define imbpp16 0x010 IM(bpp16) #define imbpp24 0x018 IM(bpp24) #define imbpp32 0x020 IM(bpp32) #define imbpp64 0x040 IM(bpp64) #define imbpp128 0x080 IM(bpp128) #define imBPP 0x0FF IM(BPP) #define imColor 0x0000 IM(Color) #define imGrayScale 0x1000 IM(GrayScale) #define imRealNumber 0x2000 IM(RealNumber) #define imComplexNumber 0x4000 IM(ComplexNumber) #define imTrigComplexNumber 0x8000 IM(TrigComplexNumber) #define imCategory 0xFF00 IM(Category) #define imFMT 0xFF0000 IM(FMT) /* imbpp24 subformats */ #define imfmtRGB 0x000000 IM(fmtRGB) #define imfmtBGR 0x010000 IM(fmtBGR) /* imbpp32 subformats */ #define imfmtRGBI 0x000000 IM(fmtRGBI) #define imfmtIRGB 0x010000 IM(fmtIRGB) #define imfmtBGRI 0x020000 IM(fmtBGRI) #define imfmtIBGR 0x030000 IM(fmtIBGR) /* Shortcuts and composites */ #define imMono imbpp1 IM(Mono) #define imBW (imMono|imGrayScale) IM(BW) #define im16 imbpp4 IM(16) #define imNibble im16 IM(Nibble) #define im256 imbpp8 IM(256) #define imRGB imbpp24 IM(RGB) #define imTriple imRGB IM(Triple) #define imByte (imbpp8|imGrayScale) IM(Byte) #define imShort (imbpp16|imGrayScale) IM(Short) #define imLong (imbpp32|imGrayScale) IM(Long) #define imFloat ((sizeof(float)*8)|imGrayScale|imRealNumber) IM(Float) #define imDouble ((sizeof(double)*8)|imGrayScale|imRealNumber) IM(Double) #define imComplex ((sizeof(float)*8*2)|imGrayScale|imComplexNumber) IM(Complex) #define imDComplex ((sizeof(double)*8*2)|imGrayScale|imComplexNumber) IM(DComplex) #define imTrigComplex ((sizeof(float)*8*2)|imGrayScale|imTrigComplexNumber) IM(TrigComplex) #define imTrigDComplex ((sizeof(double)*8*2)|imGrayScale|imTrigComplexNumber) IM(TrigDComplex) END_TABLE(im,UV) #undef IM /* Image statistics constants */ #define IS(const_name) CONSTANT(is,const_name) START_TABLE(is,UV) #define isRangeLo 0 IS(RangeLo) #define isRangeHi 1 IS(RangeHi) #define isMean 2 IS(Mean) #define isVariance 3 IS(Variance) #define isStdDev 4 IS(StdDev) #define isSum 5 IS(Sum) #define isSum2 6 IS(Sum2) #define isMaxIndex 6 IS(MaxIndex) END_TABLE(is,UV) #undef IS /* Image conversion types */ #define ICT(const_name) CONSTANT(ict,const_name) START_TABLE(ict,UV) #define ictNone 0 ICT(None) #define ictOrdered 1 ICT(Ordered) #define ictErrorDiffusion 2 ICT(ErrorDiffusion) #define ictOptimized 3 ICT(Optimized) END_TABLE(ict,UV) #undef ICT /* Icon auto masking types */ #define AM(const_name) CONSTANT(am,const_name) START_TABLE(am,UV) #define amNone 0 AM(None) #define amMaskColor 1 AM(MaskColor) #define amAuto 2 AM(Auto) #define amMaskIndex 3 AM(MaskIndex) END_TABLE(am,UV) #undef AM /* image & bitmaps */ extern Bool apc_image_create( Handle self); extern Bool apc_image_destroy( Handle self); extern Bool apc_image_begin_paint( Handle self); extern Bool apc_image_begin_paint_info( Handle self); extern Bool apc_image_end_paint( Handle self); extern Bool apc_image_end_paint_info( Handle self); extern Bool apc_image_update_change( Handle self); extern const char * apc_image_get_error_message( char *errorMsgBuf, int bufLen); extern ApiHandle apc_image_get_handle( Handle self); extern Bool apc_dbm_create( Handle self, Bool monochrome); extern Bool apc_dbm_destroy( Handle self); extern ApiHandle apc_dbm_get_handle( Handle self); /* text wrap options */ #define TW(const_name) CONSTANT(tw,const_name) START_TABLE(tw,UV) #define twCalcMnemonic 0x001 /* calculate first ~ entry */ TW(CalcMnemonic) #define twCalcTabs 0x002 /* calculate tabs */ TW(CalcTabs) #define twBreakSingle 0x004 /* return single empty line if text cannot be fitted in */ TW(BreakSingle) #define twNewLineBreak 0x008 /* break line at \n */ TW(NewLineBreak) #define twSpaceBreak 0x010 /* break line at spaces */ TW(SpaceBreak) #define twReturnLines 0x000 /* return wrapped lines */ TW(ReturnLines) #define twReturnChunks 0x020 /* return array of offsets & lengths */ TW(ReturnChunks) #define twWordBreak 0x040 /* break line at word boundary, if necessary */ TW(WordBreak) #define twExpandTabs 0x080 /* expand tabs */ TW(ExpandTabs) #define twCollapseTilde 0x100 /* remove ~ from line */ TW(CollapseTilde) #define twReturnFirstLineLength 0x220 TW(ReturnFirstLineLength) #define twDefault (twNewLineBreak|twCalcTabs|twExpandTabs|twReturnLines|twWordBreak) TW(Default) END_TABLE(tw,UV) #undef TW /* find/replace dialog scope type */ #define FDS(const_name) CONSTANT(fds,const_name) START_TABLE(fds,UV) #define fdsCursor 0 FDS(Cursor) #define fdsTop 1 FDS(Top) #define fdsBottom 2 FDS(Bottom) END_TABLE(fds,UV) #undef FDS /* find/replace dialog options */ #define FDO(const_name) CONSTANT(fdo,const_name) START_TABLE(fdo,UV) #define fdoMatchCase 0x01 FDO(MatchCase) #define fdoWordsOnly 0x02 FDO(WordsOnly) #define fdoRegularExpression 0x04 FDO(RegularExpression) #define fdoBackwardSearch 0x08 FDO(BackwardSearch) #define fdoReplacePrompt 0x10 FDO(ReplacePrompt) END_TABLE(fdo,UV) #undef FDO /* System bitmaps index */ #define SBMP(const_name) CONSTANT(sbmp,const_name) START_TABLE(sbmp,UV) #define sbmpLogo 0 SBMP(Logo) #define sbmpCheckBoxChecked 1 SBMP(CheckBoxChecked) #define sbmpCheckBoxCheckedPressed 2 SBMP(CheckBoxCheckedPressed) #define sbmpCheckBoxUnchecked 3 SBMP(CheckBoxUnchecked) #define sbmpCheckBoxUncheckedPressed 4 SBMP(CheckBoxUncheckedPressed) #define sbmpRadioChecked 5 SBMP(RadioChecked) #define sbmpRadioCheckedPressed 6 SBMP(RadioCheckedPressed) #define sbmpRadioUnchecked 7 SBMP(RadioUnchecked) #define sbmpRadioUncheckedPressed 8 SBMP(RadioUncheckedPressed) #define sbmpWarning 9 SBMP(Warning) #define sbmpInformation 10 SBMP(Information) #define sbmpQuestion 11 SBMP(Question) #define sbmpOutlineCollaps 12 SBMP(OutlineCollaps) #define sbmpOutlineExpand 13 SBMP(OutlineExpand) #define sbmpError 14 SBMP(Error) #define sbmpSysMenu 15 SBMP(SysMenu) #define sbmpSysMenuPressed 16 SBMP(SysMenuPressed) #define sbmpMax 17 SBMP(Max) #define sbmpMaxPressed 18 SBMP(MaxPressed) #define sbmpMin 19 SBMP(Min) #define sbmpMinPressed 20 SBMP(MinPressed) #define sbmpRestore 21 SBMP(Restore) #define sbmpRestorePressed 22 SBMP(RestorePressed) #define sbmpClose 23 SBMP(Close) #define sbmpClosePressed 24 SBMP(ClosePressed) #define sbmpHide 25 SBMP(Hide) #define sbmpHidePressed 26 SBMP(HidePressed) #define sbmpDriveUnknown 27 SBMP(DriveUnknown) #define sbmpDriveFloppy 28 SBMP(DriveFloppy) #define sbmpDriveHDD 29 SBMP(DriveHDD) #define sbmpDriveNetwork 30 SBMP(DriveNetwork) #define sbmpDriveCDROM 31 SBMP(DriveCDROM) #define sbmpDriveMemory 32 SBMP(DriveMemory) #define sbmpGlyphOK 33 SBMP(GlyphOK) #define sbmpGlyphCancel 34 SBMP(GlyphCancel) #define sbmpSFolderOpened 35 SBMP(SFolderOpened) #define sbmpSFolderClosed 36 SBMP(SFolderClosed) #define sbmpLast 36 SBMP(Last) END_TABLE(sbmp,UV) #undef SBMP typedef struct _FontABC { float a; float b; float c; } FontABC, *PFontABC; typedef struct _TextWrapRec { char * text; /* text to be wrapped */ Bool utf8_text; /* is utf8 */ int textLen; /* text length in bytes */ int utf8_textLen; /* text length in characters */ int width; /* width to wrap with */ int tabIndent; /* \t replace to tabIndent spaces */ int options; /* twXXX constants */ int count; /* count of lines returned */ int t_start; /* ~ starting point */ int t_end; /* ~ ending point */ int t_line; /* ~ line */ char * t_char; /* letter next to ~ */ PFontABC * ascii; /* eventual abc caches, to be freed after call. */ PList * unicode; /* NB - .ascii can be present in .unicode ! */ } TextWrapRec, *PTextWrapRec; /* gpi functions underplace */ extern Bool apc_gp_init( Handle self); extern Bool apc_gp_done( Handle self); extern Bool apc_gp_arc( Handle self, int x, int y, int dX, int dY, double angleStart, double angleEnd); extern Bool apc_gp_bar( Handle self, int x1, int y1, int x2, int y2); extern Bool apc_gp_clear( Handle self, int x1, int y1, int x2, int y2); extern Bool apc_gp_chord( Handle self, int x, int y, int dX, int dY, double angleStart, double angleEnd); extern Bool apc_gp_draw_poly( Handle self, int numPts, Point * points); extern Bool apc_gp_draw_poly2( Handle self, int numPts, Point * points); extern Bool apc_gp_ellipse( Handle self, int x, int y, int dX, int dY); extern Bool apc_gp_fill_chord( Handle self, int x, int y, int dX, int dY, double angleStart, double angleEnd); extern Bool apc_gp_fill_ellipse( Handle self, int x, int y, int dX, int dY); extern Bool apc_gp_fill_poly( Handle self, int numPts, Point * points); extern Bool apc_gp_fill_sector( Handle self, int x, int y, int dX, int dY, double angleStart, double angleEnd); extern Bool apc_gp_flood_fill( Handle self, int x, int y, Color borderColor, Bool singleBorder); extern Color apc_gp_get_pixel( Handle self, int x, int y); extern Bool apc_gp_line( Handle self, int x1, int y1, int x2, int y2); extern Bool apc_gp_put_image( Handle self, Handle image, int x, int y, int xFrom, int yFrom, int xLen, int yLen, int rop); extern Bool apc_gp_rectangle( Handle self, int x1, int y1, int x2, int y2); extern Bool apc_gp_sector( Handle self, int x, int y, int dX, int dY, double angleStart, double angleEnd); extern Bool apc_gp_set_pixel( Handle self, int x, int y, Color color); extern Bool apc_gp_stretch_image( Handle self, Handle image, int x, int y, int xFrom, int yFrom, int xDestLen, int yDestLen, int xLen, int yLen, int rop); extern Bool apc_gp_text_out( Handle self, const char * text, int x, int y, int len, Bool utf8); /* gpi settings */ extern Color apc_gp_get_back_color( Handle self); extern int apc_gp_get_bpp( Handle self); extern Color apc_gp_get_color( Handle self); extern Rect apc_gp_get_clip_rect( Handle self); extern PFontABC apc_gp_get_font_abc( Handle self, int firstChar, int lastChar, Bool unicode); extern unsigned long * apc_gp_get_font_ranges( Handle self, int * count); extern Bool apc_gp_get_fill_winding( Handle self); extern FillPattern * apc_gp_get_fill_pattern( Handle self); extern ApiHandle apc_gp_get_handle( Handle self); extern int apc_gp_get_line_end( Handle self); extern int apc_gp_get_line_join( Handle self); extern int apc_gp_get_line_width( Handle self); extern int apc_gp_get_line_pattern( Handle self, unsigned char * buffer); extern Color apc_gp_get_nearest_color( Handle self, Color color); extern PRGBColor apc_gp_get_physical_palette( Handle self, int * colors); extern Bool apc_gp_get_region( Handle self, Handle mask); extern Point apc_gp_get_resolution( Handle self); extern int apc_gp_get_rop( Handle self); extern int apc_gp_get_rop2( Handle self); extern Point* apc_gp_get_text_box( Handle self, const char * text, int len, Bool utf8); extern Bool apc_gp_get_text_opaque( Handle self); extern int apc_gp_get_text_width( Handle self, const char * text, int len, Bool addOverhang, Bool utf8); extern Bool apc_gp_get_text_out_baseline( Handle self); extern Point apc_gp_get_transform( Handle self); extern Bool apc_gp_set_back_color( Handle self, Color color); extern Bool apc_gp_set_clip_rect( Handle self, Rect clipRect); extern Bool apc_gp_set_color( Handle self, Color color); extern Bool apc_gp_set_fill_winding( Handle self, Bool fillWinding); extern Bool apc_gp_set_fill_pattern( Handle self, FillPattern pattern); extern Bool apc_gp_set_font( Handle self, PFont font); extern Bool apc_gp_set_line_end( Handle self, int lineEnd); extern Bool apc_gp_set_line_join( Handle self, int lineJoin); extern Bool apc_gp_set_line_width( Handle self, int lineWidth); extern Bool apc_gp_set_line_pattern( Handle self, unsigned char * pattern, int len); extern Bool apc_gp_set_palette( Handle self); extern Bool apc_gp_set_region( Handle self, Handle mask); extern Bool apc_gp_set_rop( Handle self, int rop); extern Bool apc_gp_set_rop2( Handle self, int rop); extern Bool apc_gp_set_transform( Handle self, int x, int y); extern Bool apc_gp_set_text_opaque( Handle self, Bool opaque); extern Bool apc_gp_set_text_out_baseline( Handle self, Bool baseline); /* printer */ extern Bool apc_prn_create( Handle self); extern Bool apc_prn_destroy( Handle self); extern PrinterInfo* apc_prn_enumerate( Handle self, int * count); extern Bool apc_prn_select( Handle self, const char* printer); extern ApiHandle apc_prn_get_handle( Handle self); extern char* apc_prn_get_selected( Handle self); extern Point apc_prn_get_size( Handle self); extern Point apc_prn_get_resolution( Handle self); extern char* apc_prn_get_default( Handle self); extern Bool apc_prn_setup( Handle self); extern Bool apc_prn_begin_doc( Handle self, const char* docName); extern Bool apc_prn_begin_paint_info( Handle self); extern Bool apc_prn_end_doc( Handle self); extern Bool apc_prn_end_paint_info( Handle self); extern Bool apc_prn_new_page( Handle self); extern Bool apc_prn_abort_doc( Handle self); extern Bool apc_prn_enum_options( Handle self, int * count, char *** options); extern Bool apc_prn_get_option( Handle self, char * option, char ** value); extern Bool apc_prn_set_option( Handle self, char * option, char * value); /* fonts */ extern PFont apc_font_default( PFont font); extern int apc_font_load( const char* filename); extern Bool apc_font_pick( Handle self, PFont source, PFont dest); extern PFont apc_fonts( Handle self, const char *facename, const char *encoding, int *retCount); extern PHash apc_font_encodings( Handle self); /* system metrics */ extern Bool apc_sys_get_insert_mode( void); extern PFont apc_sys_get_msg_font( PFont copyTo); extern PFont apc_sys_get_caption_font( PFont copyTo); extern int apc_sys_get_value( int sysValue); extern Bool apc_sys_set_insert_mode( Bool insMode); /* file */ #define FE(const_name) CONSTANT(fe,const_name) START_TABLE(fe,UV) #define feRead 1 FE(Read) #define feWrite 2 FE(Write) #define feException 4 FE(Exception) END_TABLE(fe,UV) #undef FE extern Bool apc_file_attach( Handle self); extern Bool apc_file_detach( Handle self); extern Bool apc_file_change_mask( Handle self); /* etc */ extern Bool apc_beep( int style); extern Bool apc_beep_tone( int freq, int duration); /* fetch resource constants */ #define FR(const_name) CONSTANT(fr,const_name) START_TABLE(fr,UV) #define frString 0 FR(String) #define frColor 1 FR(Color) #define frFont 2 FR(Font) END_TABLE(fr,UV) #undef FR extern Bool apc_fetch_resource( const char *className, const char *name, const char *resClass, const char *res, Handle owner, int resType, void *val); extern Color apc_lookup_color( const char *colorName); extern char * apc_system_action( const char *params); extern Bool apc_query_drives_map( const char *firstDrive, char *result, int len); extern int apc_query_drive_type( const char *drive); extern char* apc_get_user_name( void); extern PList apc_getdir( const char *dirname); extern Bool apc_dl_export(char *path); #define HOOK_EVENT_LOOP 0 typedef Bool PrimaHookProc( void * message); extern Bool apc_register_hook( int hookType, void * hookProc); extern Bool apc_deregister_hook( int hookType, void * hookProc); extern Bool apc_register_event( void * sysMessage); extern Bool apc_deregister_event( void * sysMessage); /* Memory bugs debugging tools */ #ifdef PARANOID_MALLOC extern void * _test_malloc( size_t size, int ln, char *fil, Handle self); extern void * _test_realloc( void * ptr, size_t size, int ln, char *fil, Handle self); extern void _test_free( void *ptr, int ln, char *fil, Handle self); #define plist_create( sz, delta) paranoid_plist_create( sz, delta, __FILE__, __LINE__) #define list_create( slf, sz, delta) paranoid_list_create( slf, sz, delta, __FILE__, __LINE__) extern PList paranoid_plist_create( int, int, char *, int); extern void paranoid_list_create( PList, int, int, char *, int); extern Handle self; #undef malloc #undef realloc #undef free #define realloc(ptr,sz) _test_realloc((ptr),(sz),__LINE__,__FILE__,self) #define malloc(sz) _test_malloc((sz),__LINE__,__FILE__,self) #define free(ptr) _test_free((ptr),__LINE__,__FILE__,self) #endif /* PARANOID_MALLOC */ #if defined( USE_GC) #if defined( HAVE_GC_H) #define GC_DEBUG 1 #include #undef malloc #undef free #undef realloc #define malloc( sz) GC_MALLOC( sz) #define free( p) GC_FREE( p) #define realloc( old, sz) GC_REALLOC( old, sz) #define CHECK_LEAKS GC_gcollect() #else #warning USE_GC requires presence of gc.h #define CHECK_LEAKS #endif /* HAVE_GC_H */ #else #define CHECK_LEAKS #endif /* USE_GC */ #ifdef __cplusplus } #endif #endif Prima-1.28/include/unix/0000755000175100017510000000000011150770061012700 5ustar dkdkPrima-1.28/include/unix/bsd/0000755000175100017510000000000011150770061013450 5ustar dkdkPrima-1.28/include/unix/bsd/queue.h0000644000175100017510000004050611150770061014752 0ustar dkdk/* * Copyright (c) 1991, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * */ /* * Slightly edited by tobez@plab.ku.dk, 26-Oct-1999 * The edits were: * - removed #ifdef KERNEL part; * - _SYS_QUEUE_H_ changed to _BSD_QUEUE_H_ everywhere. * * tobez@tobez.org, 23-Jun-2000: * - added large ifndef SLIST_FOREACH, in case one of the standard * system headers #include . * * The original version was taken from: * * @(#)queue.h 8.5 (Berkeley) 8/20/94 * $FreeBSD: src/sys/sys/queue.h,v 1.30 1999/10/05 20:35:32 n_hibma Exp $ */ #ifndef SLIST_FOREACH #ifndef _BSD_QUEUE_H_ #define _BSD_QUEUE_H_ /* * This file defines five types of data structures: singly-linked lists, * slingly-linked tail queues, lists, tail queues, and circular queues. * * A singly-linked list is headed by a single forward pointer. The elements * are singly linked for minimum space and pointer manipulation overhead at * the expense of O(n) removal for arbitrary elements. New elements can be * added to the list after an existing element or at the head of the list. * Elements being removed from the head of the list should use the explicit * macro for this purpose for optimum efficiency. A singly-linked list may * only be traversed in the forward direction. Singly-linked lists are ideal * for applications with large datasets and few or no removals or for * implementing a LIFO queue. * * A singly-linked tail queue is headed by a pair of pointers, one to the * head of the list and the other to the tail of the list. The elements are * singly linked for minimum space and pointer manipulation overhead at the * expense of O(n) removal for arbitrary elements. New elements can be added * to the list after an existing element, at the head of the list, or at the * end of the list. Elements being removed from the head of the tail queue * should use the explicit macro for this purpose for optimum efficiency. * A singly-linked tail queue may only be traversed in the forward direction. * Singly-linked tail queues are ideal for applications with large datasets * and few or no removals or for implementing a FIFO queue. * * A list is headed by a single forward pointer (or an array of forward * pointers for a hash table header). The elements are doubly linked * so that an arbitrary element can be removed without a need to * traverse the list. New elements can be added to the list before * or after an existing element or at the head of the list. A list * may only be traversed in the forward direction. * * A tail queue is headed by a pair of pointers, one to the head of the * list and the other to the tail of the list. The elements are doubly * linked so that an arbitrary element can be removed without a need to * traverse the list. New elements can be added to the list before or * after an existing element, at the head of the list, or at the end of * the list. A tail queue may only be traversed in the forward direction. * * A circle queue is headed by a pair of pointers, one to the head of the * list and the other to the tail of the list. The elements are doubly * linked so that an arbitrary element can be removed without a need to * traverse the list. New elements can be added to the list before or after * an existing element, at the head of the list, or at the end of the list. * A circle queue may be traversed in either direction, but has a more * complex end of list detection. * * For details on the use of these macros, see the queue(3) manual page. * * * SLIST LIST STAILQ TAILQ CIRCLEQ * _HEAD + + + + + * _ENTRY + + + + + * _INIT + + + + + * _EMPTY + + + + + * _FIRST + + + + + * _NEXT + + + + + * _PREV - - - + + * _LAST - - + + + * _FOREACH + + + + + * _INSERT_HEAD + + + + + * _INSERT_BEFORE - + - + + * _INSERT_AFTER + + + + + * _INSERT_TAIL - - + + + * _REMOVE_HEAD + - + - - * _REMOVE + + + + + * */ /* * Singly-linked List definitions. */ #define SLIST_HEAD(name, type) \ struct name { \ struct type *slh_first; /* first element */ \ } #define SLIST_HEAD_INITIALIZER(head) \ { NULL } #define SLIST_ENTRY(type) \ struct { \ struct type *sle_next; /* next element */ \ } /* * Singly-linked List functions. */ #define SLIST_EMPTY(head) ((head)->slh_first == NULL) #define SLIST_FIRST(head) ((head)->slh_first) #define SLIST_FOREACH(var, head, field) \ for((var) = (head)->slh_first; (var); (var) = (var)->field.sle_next) #define SLIST_INIT(head) { \ (head)->slh_first = NULL; \ } #define SLIST_INSERT_AFTER(slistelm, elm, field) do { \ (elm)->field.sle_next = (slistelm)->field.sle_next; \ (slistelm)->field.sle_next = (elm); \ } while (0) #define SLIST_INSERT_HEAD(head, elm, field) do { \ (elm)->field.sle_next = (head)->slh_first; \ (head)->slh_first = (elm); \ } while (0) #define SLIST_NEXT(elm, field) ((elm)->field.sle_next) #define SLIST_REMOVE_HEAD(head, field) do { \ (head)->slh_first = (head)->slh_first->field.sle_next; \ } while (0) #define SLIST_REMOVE(head, elm, type, field) do { \ if ((head)->slh_first == (elm)) { \ SLIST_REMOVE_HEAD((head), field); \ } \ else { \ struct type *curelm = (head)->slh_first; \ while( curelm->field.sle_next != (elm) ) \ curelm = curelm->field.sle_next; \ curelm->field.sle_next = \ curelm->field.sle_next->field.sle_next; \ } \ } while (0) /* * Singly-linked Tail queue definitions. */ #define STAILQ_HEAD(name, type) \ struct name { \ struct type *stqh_first;/* first element */ \ struct type **stqh_last;/* addr of last next element */ \ } #define STAILQ_HEAD_INITIALIZER(head) \ { NULL, &(head).stqh_first } #define STAILQ_ENTRY(type) \ struct { \ struct type *stqe_next; /* next element */ \ } /* * Singly-linked Tail queue functions. */ #define STAILQ_EMPTY(head) ((head)->stqh_first == NULL) #define STAILQ_INIT(head) do { \ (head)->stqh_first = NULL; \ (head)->stqh_last = &(head)->stqh_first; \ } while (0) #define STAILQ_FIRST(head) ((head)->stqh_first) #define STAILQ_LAST(head) (*(head)->stqh_last) #define STAILQ_FOREACH(var, head, field) \ for((var) = (head)->stqh_first; (var); (var) = (var)->field.stqe_next) #define STAILQ_INSERT_HEAD(head, elm, field) do { \ if (((elm)->field.stqe_next = (head)->stqh_first) == NULL) \ (head)->stqh_last = &(elm)->field.stqe_next; \ (head)->stqh_first = (elm); \ } while (0) #define STAILQ_INSERT_TAIL(head, elm, field) do { \ (elm)->field.stqe_next = NULL; \ *(head)->stqh_last = (elm); \ (head)->stqh_last = &(elm)->field.stqe_next; \ } while (0) #define STAILQ_INSERT_AFTER(head, tqelm, elm, field) do { \ if (((elm)->field.stqe_next = (tqelm)->field.stqe_next) == NULL)\ (head)->stqh_last = &(elm)->field.stqe_next; \ (tqelm)->field.stqe_next = (elm); \ } while (0) #define STAILQ_NEXT(elm, field) ((elm)->field.stqe_next) #define STAILQ_REMOVE_HEAD(head, field) do { \ if (((head)->stqh_first = \ (head)->stqh_first->field.stqe_next) == NULL) \ (head)->stqh_last = &(head)->stqh_first; \ } while (0) #define STAILQ_REMOVE(head, elm, type, field) do { \ if ((head)->stqh_first == (elm)) { \ STAILQ_REMOVE_HEAD(head, field); \ } \ else { \ struct type *curelm = (head)->stqh_first; \ while( curelm->field.stqe_next != (elm) ) \ curelm = curelm->field.stqe_next; \ if((curelm->field.stqe_next = \ curelm->field.stqe_next->field.stqe_next) == NULL) \ (head)->stqh_last = &(curelm)->field.stqe_next; \ } \ } while (0) /* * List definitions. */ #define LIST_HEAD(name, type) \ struct name { \ struct type *lh_first; /* first element */ \ } #define LIST_HEAD_INITIALIZER(head) \ { NULL } #define LIST_ENTRY(type) \ struct { \ struct type *le_next; /* next element */ \ struct type **le_prev; /* address of previous next element */ \ } /* * List functions. */ #define LIST_EMPTY(head) ((head)->lh_first == NULL) #define LIST_FIRST(head) ((head)->lh_first) #define LIST_FOREACH(var, head, field) \ for((var) = (head)->lh_first; (var); (var) = (var)->field.le_next) #define LIST_INIT(head) do { \ (head)->lh_first = NULL; \ } while (0) #define LIST_INSERT_AFTER(listelm, elm, field) do { \ if (((elm)->field.le_next = (listelm)->field.le_next) != NULL) \ (listelm)->field.le_next->field.le_prev = \ &(elm)->field.le_next; \ (listelm)->field.le_next = (elm); \ (elm)->field.le_prev = &(listelm)->field.le_next; \ } while (0) #define LIST_INSERT_BEFORE(listelm, elm, field) do { \ (elm)->field.le_prev = (listelm)->field.le_prev; \ (elm)->field.le_next = (listelm); \ *(listelm)->field.le_prev = (elm); \ (listelm)->field.le_prev = &(elm)->field.le_next; \ } while (0) #define LIST_INSERT_HEAD(head, elm, field) do { \ if (((elm)->field.le_next = (head)->lh_first) != NULL) \ (head)->lh_first->field.le_prev = &(elm)->field.le_next;\ (head)->lh_first = (elm); \ (elm)->field.le_prev = &(head)->lh_first; \ } while (0) #define LIST_NEXT(elm, field) ((elm)->field.le_next) #define LIST_REMOVE(elm, field) do { \ if ((elm)->field.le_next != NULL) \ (elm)->field.le_next->field.le_prev = \ (elm)->field.le_prev; \ *(elm)->field.le_prev = (elm)->field.le_next; \ } while (0) /* * Tail queue definitions. */ #define TAILQ_HEAD(name, type) \ struct name { \ struct type *tqh_first; /* first element */ \ struct type **tqh_last; /* addr of last next element */ \ } #define TAILQ_HEAD_INITIALIZER(head) \ { NULL, &(head).tqh_first } #define TAILQ_ENTRY(type) \ struct { \ struct type *tqe_next; /* next element */ \ struct type **tqe_prev; /* address of previous next element */ \ } /* * Tail queue functions. */ #define TAILQ_EMPTY(head) ((head)->tqh_first == NULL) #define TAILQ_FOREACH(var, head, field) \ for (var = TAILQ_FIRST(head); var; var = TAILQ_NEXT(var, field)) #define TAILQ_FIRST(head) ((head)->tqh_first) #define TAILQ_LAST(head, headname) \ (*(((struct headname *)((head)->tqh_last))->tqh_last)) #define TAILQ_NEXT(elm, field) ((elm)->field.tqe_next) #define TAILQ_PREV(elm, headname, field) \ (*(((struct headname *)((elm)->field.tqe_prev))->tqh_last)) #define TAILQ_INIT(head) do { \ (head)->tqh_first = NULL; \ (head)->tqh_last = &(head)->tqh_first; \ } while (0) #define TAILQ_INSERT_HEAD(head, elm, field) do { \ if (((elm)->field.tqe_next = (head)->tqh_first) != NULL) \ (head)->tqh_first->field.tqe_prev = \ &(elm)->field.tqe_next; \ else \ (head)->tqh_last = &(elm)->field.tqe_next; \ (head)->tqh_first = (elm); \ (elm)->field.tqe_prev = &(head)->tqh_first; \ } while (0) #define TAILQ_INSERT_TAIL(head, elm, field) do { \ (elm)->field.tqe_next = NULL; \ (elm)->field.tqe_prev = (head)->tqh_last; \ *(head)->tqh_last = (elm); \ (head)->tqh_last = &(elm)->field.tqe_next; \ } while (0) #define TAILQ_INSERT_AFTER(head, listelm, elm, field) do { \ if (((elm)->field.tqe_next = (listelm)->field.tqe_next) != NULL)\ (elm)->field.tqe_next->field.tqe_prev = \ &(elm)->field.tqe_next; \ else \ (head)->tqh_last = &(elm)->field.tqe_next; \ (listelm)->field.tqe_next = (elm); \ (elm)->field.tqe_prev = &(listelm)->field.tqe_next; \ } while (0) #define TAILQ_INSERT_BEFORE(listelm, elm, field) do { \ (elm)->field.tqe_prev = (listelm)->field.tqe_prev; \ (elm)->field.tqe_next = (listelm); \ *(listelm)->field.tqe_prev = (elm); \ (listelm)->field.tqe_prev = &(elm)->field.tqe_next; \ } while (0) #define TAILQ_REMOVE(head, elm, field) do { \ if (((elm)->field.tqe_next) != NULL) \ (elm)->field.tqe_next->field.tqe_prev = \ (elm)->field.tqe_prev; \ else \ (head)->tqh_last = (elm)->field.tqe_prev; \ *(elm)->field.tqe_prev = (elm)->field.tqe_next; \ } while (0) /* * Circular queue definitions. */ #define CIRCLEQ_HEAD(name, type) \ struct name { \ struct type *cqh_first; /* first element */ \ struct type *cqh_last; /* last element */ \ } #define CIRCLEQ_ENTRY(type) \ struct { \ struct type *cqe_next; /* next element */ \ struct type *cqe_prev; /* previous element */ \ } /* * Circular queue functions. */ #define CIRCLEQ_EMPTY(head) ((head)->cqh_first == (void *)(head)) #define CIRCLEQ_FIRST(head) ((head)->cqh_first) #define CIRCLEQ_FOREACH(var, head, field) \ for((var) = (head)->cqh_first; \ (var) != (void *)(head); \ (var) = (var)->field.cqe_next) #define CIRCLEQ_INIT(head) do { \ (head)->cqh_first = (void *)(head); \ (head)->cqh_last = (void *)(head); \ } while (0) #define CIRCLEQ_INSERT_AFTER(head, listelm, elm, field) do { \ (elm)->field.cqe_next = (listelm)->field.cqe_next; \ (elm)->field.cqe_prev = (listelm); \ if ((listelm)->field.cqe_next == (void *)(head)) \ (head)->cqh_last = (elm); \ else \ (listelm)->field.cqe_next->field.cqe_prev = (elm); \ (listelm)->field.cqe_next = (elm); \ } while (0) #define CIRCLEQ_INSERT_BEFORE(head, listelm, elm, field) do { \ (elm)->field.cqe_next = (listelm); \ (elm)->field.cqe_prev = (listelm)->field.cqe_prev; \ if ((listelm)->field.cqe_prev == (void *)(head)) \ (head)->cqh_first = (elm); \ else \ (listelm)->field.cqe_prev->field.cqe_next = (elm); \ (listelm)->field.cqe_prev = (elm); \ } while (0) #define CIRCLEQ_INSERT_HEAD(head, elm, field) do { \ (elm)->field.cqe_next = (head)->cqh_first; \ (elm)->field.cqe_prev = (void *)(head); \ if ((head)->cqh_last == (void *)(head)) \ (head)->cqh_last = (elm); \ else \ (head)->cqh_first->field.cqe_prev = (elm); \ (head)->cqh_first = (elm); \ } while (0) #define CIRCLEQ_INSERT_TAIL(head, elm, field) do { \ (elm)->field.cqe_next = (void *)(head); \ (elm)->field.cqe_prev = (head)->cqh_last; \ if ((head)->cqh_first == (void *)(head)) \ (head)->cqh_first = (elm); \ else \ (head)->cqh_last->field.cqe_next = (elm); \ (head)->cqh_last = (elm); \ } while (0) #define CIRCLEQ_LAST(head) ((head)->cqh_last) #define CIRCLEQ_NEXT(elm,field) ((elm)->field.cqe_next) #define CIRCLEQ_PREV(elm,field) ((elm)->field.cqe_prev) #define CIRCLEQ_REMOVE(head, elm, field) do { \ if ((elm)->field.cqe_next == (void *)(head)) \ (head)->cqh_last = (elm)->field.cqe_prev; \ else \ (elm)->field.cqe_next->field.cqe_prev = \ (elm)->field.cqe_prev; \ if ((elm)->field.cqe_prev == (void *)(head)) \ (head)->cqh_first = (elm)->field.cqe_next; \ else \ (elm)->field.cqe_prev->field.cqe_next = \ (elm)->field.cqe_next; \ } while (0) #endif /* !_BSD_QUEUE_H_ */ #endif /* !SLIST_FOREACH */ Prima-1.28/include/unix/guts.h0000644000175100017510000011422011150770061014033 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* $Id: guts.h,v 1.149 2008/04/24 15:15:10 dk Exp $ */ #ifndef _UNIX_GUTS_H_ #define _UNIX_GUTS_H_ #if defined(HAVE_CONFIG_H) #include "generic/config.h" #endif #define Drawable XDrawable #define Font XFont #define Window XWindow #undef Bool #include #include #include #include #include #include #ifdef HAVE_X11_EXTENSIONS_SHAPE_H #include #endif #if defined( HAVE_X11_EXTENSIONS_XSHM_H) && defined( HAVE_SYS_IPC_H) && defined( HAVE_SYS_SHM_H) #include #include #include #define USE_MITSHM 1 #endif #if defined(HAVE_X11_XFT_XFT_H) && defined(HAVE_FONTCONFIG_FONTCONFIG_H) && defined(HAVE_X11_EXTENSIONS_XRENDER_H) #include #include # if XFT_MAJOR > 1 && FC_MAJOR > 1 # define USE_XFT # endif # if XFT_VERSION < 20112 # define NEED_X11_EXTENSIONS_XRENDER_H # endif #endif #undef Font #undef Drawable #undef Bool #undef Window #define ComplexShape 0 #define XBool int #undef Complex #ifndef Button6 #define Button6 6 #endif #ifndef Button7 #define Button7 7 #endif #ifndef Button8 #define Button8 8 #endif #ifndef Button6Mask #define Button6Mask (1<<13) #endif #ifndef Button7Mask #define Button7Mask (1<<14) #endif #include #include #include #include #include "../guts.h" #include "bsd/queue.h" #include "Widget.h" #include "Image.h" #include "img_conv.h" #ifdef USE_MITSHM /* at least some versions of XShm.h do not prototype XShmGetEventBase() */ extern int XShmGetEventBase( Display*); #endif typedef struct _PrimaXImage { Bool shm; Bool can_free; int ref_cnt; void *data_alias; int bytes_per_line_alias; XImage *image; #ifdef USE_MITSHM XShmSegmentInfo xmem; #endif } PrimaXImage; #define CACHE_AUTODETECT 0 #define CACHE_BITMAP 1 #define CACHE_PIXMAP 2 #define CACHE_LOW_RES 3 typedef struct { int type; PrimaXImage *image; PrimaXImage *icon; } ImageCache; typedef struct _RequestInformation { unsigned long request; char *file; int line; } RequestInformation, *PRequestInformation; #define REQUEST_RING_SIZE 512 #define kbModKeyMask 0x00010000 #define kbCodeCharMask 0x00020000 #define kbVirtualMask 0x00040000 #define kbFunctionMask 0x00080000 typedef struct _FontFlags { unsigned height : 1; unsigned width : 1; unsigned style : 1; unsigned pitch : 1; unsigned direction : 1; unsigned resolution : 1; unsigned name : 1; unsigned encoding : 1; unsigned size : 1; unsigned codepage : 1; unsigned family : 1; unsigned vector : 1; unsigned ascent : 1; unsigned descent : 1; unsigned weight : 1; unsigned maximalWidth : 1; unsigned internalLeading : 1; unsigned externalLeading : 1; unsigned xDeviceRes : 1; unsigned yDeviceRes : 1; unsigned firstChar : 1; unsigned lastChar : 1; unsigned breakChar : 1; unsigned defaultChar : 1; /* extras */ unsigned bad_vector : 1; unsigned sloppy : 1; unsigned disabled : 1; unsigned funky : 1; unsigned heights_cache : 1; } FontFlags; typedef struct _FontInfo { FontFlags flags; Font font; char *vecname; char *xname; short int name_offset; short int info_offset; int heights_cache[2]; } FontInfo, *PFontInfo; typedef struct _RotatedFont { double direction; int first1; int first2; int height; int width; int length; PrimaXImage**map; Point shift; Point dimension; Point orgBox; Pixmap arena; GC arena_gc; Byte *arena_bits; int lineSize; int defaultChar1; int defaultChar2; Fixed sin, cos, sin2, cos2; struct RotatedFont *next; } RotatedFont, *PRotatedFont; typedef struct CachedFont { FontFlags flags; Font font; XFontStruct *fs; XFont id; PRotatedFont rotated; int underlinePos; int underlineThickness; int refCnt; #ifdef USE_XFT XftFont *xft; XftFont *xft_no_aa; XftFont *xft_base; #endif } CachedFont, *PCachedFont; typedef struct _FontKey { int height; int width; int style; int pitch; int direction; char name[ 256]; } FontKey, *PFontKey; #define MAX_HGS_SIZE 5 typedef struct { int sp; int locked; int target; int xlfd[MAX_HGS_SIZE]; int prima[MAX_HGS_SIZE]; } HeightGuessStack; union _unix_sys_data; #define FIRST_SYS_TIMER ((Handle)11) #define CURSOR_TIMER ((Handle)11) #define MENU_TIMER ((Handle)12) #define MENU_UNFOCUS_TIMER ((Handle)13) #define LAST_SYS_TIMER ((Handle)13) #if defined(sgi) && !defined(__GNUC__) /* multiple compilation and runtime errors otherwise. must be some alignment tricks */ #define COMPONENT_SYS_DATA_ALIGN unsigned dummy : 20; #else #define COMPONENT_SYS_DATA_ALIGN #endif #define COMPONENT_SYS_DATA \ Handle self; \ struct { \ unsigned application : 1; \ unsigned bitmap : 1; \ unsigned dbm : 1; \ unsigned drawable : 1; \ unsigned icon : 1; \ unsigned image : 1; \ unsigned menu : 1; \ unsigned pixmap : 1; \ unsigned popup : 1; \ unsigned timer : 1; \ unsigned widget : 1; \ unsigned window : 1; \ COMPONENT_SYS_DATA_ALIGN \ } type; \ XrmQuarkList q_class_name; \ XrmQuarkList q_instance_name; \ int n_class_name; \ int n_instance_name typedef struct _timer_sys_data { COMPONENT_SYS_DATA; int timeout; Handle who; struct _timer_sys_data *older; struct _timer_sys_data *younger; struct timeval when; } TimerSysData, *PTimerSysData; struct _drawable_sys_data; #define VIRGIN_GC_MASK ( GCBackground \ | GCCapStyle \ | GCClipMask \ | GCForeground \ | GCFunction \ | GCJoinStyle \ | GCFillRule \ | GCTileStipXOrigin \ | GCTileStipYOrigin \ | GCLineStyle \ | GCLineWidth \ | GCSubwindowMode ) typedef struct gc_list { GC gc; TAILQ_ENTRY(gc_list) gc_link; } GCList; TAILQ_HEAD(gc_head,gc_list); typedef struct pending_event { Handle recipient; Event event; TAILQ_ENTRY(pending_event) peventq_link; } PendingEvent; typedef struct configure_event_pair { TAILQ_ENTRY(configure_event_pair) link; int w, h, match; } ConfigureEventPair; #define COLOR_R(x) (((x)>>16)&0xFF) #define COLOR_G(x) (((x)>>8)&0xFF) #define COLOR_B(x) ((x)&0xFF) #define COLOR_R16(x) (((x)>>8)&0xFF00) #define COLOR_G16(x) ((x)&0xFF00) #define COLOR_B16(x) (((x)<<8)&0xFF00) #define LPAL_ADDR(i) (i)>>2 #define LPAL_MASK(i) (3<<(((i)&3)*2)) #define LPAL_SET(i,j) (((j)&3)<<(((i)&3)*2)) #define LPAL_GET(i,j) (((j)>>(((i)&3)*2))&3) extern int prima_lpal_get( Byte * palette, int index); extern void prima_lpal_set( Byte * palette, int index, int rank); #define wlpal_get(widget,index) prima_lpal_get(X(widget)->palette,index) #define wlpal_set(widget,index,rank) prima_lpal_set(X(widget)->palette,index,rank) /* Every color cell in guts.palette is assigned a rank. Its purpose is to maintain reasonable sharing of available system colors. See prima_palette_replace which preforms sharing. */ #define RANK_IMMUTABLE 4 /* Static color for 'cubic' filtering - or for Static visuals */ #define RANK_LOCKED 3 /* Colors used in Pixmaps - cannot participate in palette managing, therefore 'locked' */ #define RANK_PRIORITY 2 /* Colors explicitly set by Widget::set_palette */ #define RANK_NORMAL 1 /* Automatically allocated colors for drawing routines */ #define RANK_FREE 0 /* Colors not allocated by XAllocColor. Their values are not reliable */ #define RGB_COMPOSITE(R,G,B) ((((R)&0xFF)<<16)|(((G)&0xFF)<<8)|((B)&0xFF)) typedef struct { Byte r, g, b; Byte rank; Bool touched; long composite; List users; } MainColorEntry; typedef struct { unsigned long primary; unsigned long secondary; Color color; Byte balance; /* 0-63 */ } Brush; #define AI_FXA_RESOLUTION_X 0 #define AI_FXA_RESOLUTION_Y 1 #define AI_FXA_PIXEL_SIZE 2 #define AI_FXA_SPACING 3 #define AI_FXA_RELATIVE_WEIGHT 4 #define AI_FXA_FOUNDRY 5 #define AI_FXA_AVERAGE_WIDTH 6 #define AI_FXA_CHARSET_REGISTRY 7 #define AI_FXA_CHARSET_ENCODING 8 #define AI_CREATE_EVENT 9 #define AI_WM_DELETE_WINDOW 10 #define AI_WM_PROTOCOLS 11 #define AI_WM_TAKE_FOCUS 12 #define AI_NET_WM_STATE 13 #define AI_NET_WM_STATE_SKIP_TASKBAR 14 #define AI_NET_WM_STATE_MAXIMIZED_VERT 15 #define AI_NET_WM_STATE_MAXIMIZED_HORZ 16 #define AI_NET_WM_NAME 17 #define AI_NET_WM_ICON_NAME 18 #define AI_UTF8_STRING 19 #define AI_TARGETS 20 #define AI_INCR 21 #define AI_PIXEL 22 #define AI_FOREGROUND 23 #define AI_BACKGROUND 24 #define AI_MOTIF_WM_HINTS 25 #define AI_NET_WM_STATE_MODAL 26 #define AI_NET_SUPPORTED 27 #define AI_NET_WM_STATE_MAXIMIZED_HORIZ 28 #define AI_UTF8_MIME 29 #define AI_NET_WM_STATE_STAYS_ON_TOP 30 #define AI_NET_CURRENT_DESKTOP 31 #define AI_NET_WORKAREA 32 #define AI_NET_WM_STATE_ABOVE 33 #define AI_count 34 #define FXA_RESOLUTION_X guts. atoms[ AI_FXA_RESOLUTION_X] #define FXA_RESOLUTION_Y guts. atoms[ AI_FXA_RESOLUTION_Y] #define FXA_POINT_SIZE XA_POINT_SIZE #define FXA_PIXEL_SIZE guts. atoms[ AI_FXA_PIXEL_SIZE] #define FXA_SPACING guts. atoms[ AI_FXA_SPACING] #define FXA_WEIGHT XA_WEIGHT #define FXA_RELATIVE_WEIGHT guts. atoms[ AI_FXA_RELATIVE_WEIGHT] #define FXA_FOUNDRY guts. atoms[ AI_FXA_FOUNDRY] #define FXA_FAMILY_NAME XA_FAMILY_NAME #define FXA_AVERAGE_WIDTH guts. atoms[ AI_FXA_AVERAGE_WIDTH] #define FXA_CHARSET_REGISTRY guts. atoms[ AI_FXA_CHARSET_REGISTRY] #define FXA_CHARSET_ENCODING guts. atoms[ AI_FXA_CHARSET_ENCODING] #define FXA_CAP_HEIGHT XA_CAP_HEIGHT #define CREATE_EVENT guts. atoms[ AI_CREATE_EVENT] #define WM_DELETE_WINDOW guts. atoms[ AI_WM_DELETE_WINDOW] #define WM_PROTOCOLS guts. atoms[ AI_WM_PROTOCOLS] #define WM_TAKE_FOCUS guts. atoms[ AI_WM_TAKE_FOCUS] #define NET_WM_STATE guts. atoms[ AI_NET_WM_STATE] #define NET_WM_STATE_SKIP_TASKBAR guts. atoms[ AI_NET_WM_STATE_SKIP_TASKBAR] #define NET_WM_STATE_MAXIMIZED_VERT guts. atoms[ AI_NET_WM_STATE_MAXIMIZED_VERT] #define NET_WM_STATE_MAXIMIZED_HORZ guts. atoms[ (guts. net_wm_maximize_HORZ_vs_HORIZ > 0) ? guts. net_wm_maximize_HORZ_vs_HORIZ : AI_NET_WM_STATE_MAXIMIZED_HORZ] #define NET_WM_NAME guts. atoms[ AI_NET_WM_NAME] #define NET_WM_ICON_NAME guts. atoms[ AI_NET_WM_ICON_NAME] #define UTF8_STRING guts. atoms[ AI_UTF8_STRING] #define CF_TARGETS guts. atoms[ AI_TARGETS] #define XA_INCR guts. atoms[ AI_INCR] #define CF_PIXEL guts. atoms[ AI_PIXEL] #define CF_FOREGROUND guts. atoms[ AI_FOREGROUND] #define CF_BACKGROUND guts. atoms[ AI_BACKGROUND] #define XA_MOTIF_WM_HINTS guts. atoms[ AI_MOTIF_WM_HINTS] #define NET_WM_STATE_MODAL guts. atoms[ AI_NET_WM_STATE_MODAL] #define NET_SUPPORTED guts. atoms[ AI_NET_SUPPORTED] #define UTF8_MIME guts. atoms[ AI_UTF8_MIME] #define NET_WM_STATE_STAYS_ON_TOP guts. atoms[ AI_NET_WM_STATE_STAYS_ON_TOP] #define NET_CURRENT_DESKTOP guts. atoms[ AI_NET_CURRENT_DESKTOP] #define NET_WORKAREA guts. atoms[ AI_NET_WORKAREA] #define NET_WM_STATE_ABOVE guts. atoms[ AI_NET_WM_STATE_ABOVE] #define DEBUG_FONTS 0x01 #define DEBUG_CLIP 0x02 #define DEBUG_EVENT 0x04 #define DEBUG_MISC 0x08 #define DEBUG_COLOR 0x10 #define DEBUG_XRDB 0x20 #define DEBUG_ALL 0x3f #define _debug prima_debug extern int prima_debug( const char *format, ...); #define Fdebug if (guts.debug & DEBUG_FONTS) _debug #define Cdebug if (guts.debug & DEBUG_CLIP) _debug #define Edebug if (guts.debug & DEBUG_EVENT) _debug #define Mdebug if (guts.debug & DEBUG_MISC) _debug #define Pdebug if (guts.debug & DEBUG_COLOR) _debug #define Xdebug if (guts.debug & DEBUG_XRDB) _debug typedef struct _UnixGuts { /* Event management */ Time click_time_frame; Time double_click_time_frame; PHash clipboards; PHash clipboard_xfers; Atom * clipboard_formats; int clipboard_formats_count; long clipboard_event_timeout; fd_set excpt_set; PList files; long handled_events; XButtonEvent last_button_event; XButtonEvent last_click; Time last_time; int (* main_error_handler )(Display*,XErrorEvent*); int max_fd; int modal_count; TAILQ_HEAD(,pending_event) peventq; fd_set read_set; long total_events; long skipped_events; long unhandled_events; fd_set write_set; /* Graphics */ struct gc_head bitmap_gc_pool; struct gc_head screen_gc_pool; GC menugc; TAILQ_HEAD(,_drawable_sys_data) paintq; PHash ximages; /* Font management */ PHash font_hash; PFontInfo font_info; char **font_names; int n_fonts; XFontStruct *pointer_font; Bool default_font_ok; Font default_font; Font default_menu_font; Font default_widget_font; Font default_msg_font; Font default_caption_font; int no_scaled_fonts; /* Resource management */ XrmDatabase db; XrmQuark qBlinkinvisibletime; XrmQuark qblinkinvisibletime; XrmQuark qBlinkvisibletime; XrmQuark qblinkvisibletime; XrmQuark qClicktimeframe; XrmQuark qclicktimeframe; XrmQuark qDoubleclicktimeframe; XrmQuark qdoubleclicktimeframe; XrmQuark qString; XrmQuark qWheeldown; XrmQuark qwheeldown; XrmQuark qWheelup; XrmQuark qwheelup; XrmQuark qSubmenudelay; XrmQuark qsubmenudelay; XrmQuark qScrollfirst; XrmQuark qscrollfirst; XrmQuark qScrollnext; XrmQuark qscrollnext; /* Timers & cursors */ unsigned int cursor_height; Point cursor_pixmap_size; Pixmap cursor_save; Bool cursor_shown; unsigned int cursor_width; Pixmap cursor_xor; Bool insert; int invisible_timeout; struct _timer_sys_data *oldest; int visible_timeout; /* Window management */ Handle focused; PHash menu_windows; PHash windows; /* XServer info */ int bit_order; unsigned char buttons_map[256]; int byte_order; int connection; int depth; Display *display; int machine_byte_order; int idepth; /* image depth; can be 32 if depth == 24 */ int qdepth; /* image depth for querying */ struct { long XDrawArcs; long XDrawLines; long XDrawRectangles; long XDrawSegments; long XFillArcs; long XFillPolygon; long XFillRectangles; long request_length; } limits; Bool local_connection; Cursor null_pointer; int pointer_invisible_count; /* 0 is visible, > 0 is not, can't be <0 */ int mouse_buttons; int mouse_wheel_down; int mouse_wheel_up; Point resolution; RequestInformation ri[REQUEST_RING_SIZE]; int ri_head; int ri_tail; int screen_number; Bool shape_extension; int shape_event; int shape_error; Bool shared_image_extension; int shared_image_completion_event; Bool xshmattach_failed; int use_xft; Bool xft_priority; Bool xft_disable_large_fonts; int xft_xrender_major_opcode; Bool xft_no_antialias; struct MsgDlg *message_boxes; XWindow grab_redirect; Handle grab_widget; Point grab_translate_mouse; Handle grab_confine; int scroll_first; int scroll_next; Handle currentMenu; Time currentFocusTime; Handle unfocusedMenu; int menu_timeout; XWindow root; XVisualInfo visual; int visualClass; MainColorEntry * palette; int * mappingPlace; unsigned long monochromeMap[2]; int palSize; int localPalSize; int * systemColorMap; int systemColorMapSize; int colorCubeRib; Bool dynamicColors; Bool grayScale; Bool useDithering; Bool privateColormap; Colormap defaultColormap; FillPattern * ditherPatterns; Point displaySize; long wm_event_timeout; int red_shift, green_shift, blue_shift; int red_range, green_range, blue_range; Point ellipseDivergence; int appLock; XGCValues cursor_gcv; TimerSysData sys_timers[ LAST_SYS_TIMER - FIRST_SYS_TIMER + 1]; Bool applicationClose; char locale[32]; XFontStruct * font_abc_nil_hack; Atom atoms[AI_count]; XTextProperty hostname; unsigned int debug; Bool icccm_only; Bool net_wm_maximization; int net_wm_maximize_HORZ_vs_HORIZ; } UnixGuts; extern UnixGuts guts; #define XCHECKPOINT \ STMT_START { \ guts. ri[ guts. ri_head]. line = __LINE__; \ guts. ri[ guts. ri_head]. file = __FILE__; \ guts. ri[ guts. ri_head]. request = NextRequest(DISP); \ guts. ri_head++; \ if ( guts. ri_head >= REQUEST_RING_SIZE) \ guts. ri_head = 0; \ if ( guts. ri_tail == guts. ri_head) { \ guts. ri_tail++; \ if ( guts. ri_tail >= REQUEST_RING_SIZE) \ guts. ri_tail = 0; \ } \ } STMT_END #define APC_BAD_SIZE INT_MAX #define APC_BAD_ORIGIN INT_MAX #define XT_IS_APPLICATION(x) ((x)->type.application) #define XT_IS_BITMAP(x) ((x)->type.bitmap) #define XT_IS_DBM(x) ((x)->type.dbm) #define XT_IS_DRAWABLE(x) ((x)->type.drawable) #define XT_IS_ICON(x) ((x)->type.icon) #define XT_IS_IMAGE(x) ((x)->type.image) #define XT_IS_MENU(x) ((x)->type.menu) #define XT_IS_PIXMAP(x) ((x)->type.pixmap) #define XT_IS_POPUP(x) ((x)->type.popup) #define XT_IS_TIMER(x) ((x)->type.timer) #define XT_IS_WIDGET(x) ((x)->type.widget) #define XT_IS_WINDOW(x) ((x)->type.window) typedef struct _drawable_sys_data { COMPONENT_SYS_DATA; XDrawable udrawable; XDrawable gdrawable; XWindow parent; Point resolution; Point origin, size, bsize; Point transform, gtransform, btransform; Point ackOrigin, ackSize, ackFrameSize; int menuHeight; int menuColorImmunity; Point decorationSize; Handle owner; /* The real one */ XWindow real_parent; /* top levels */ XWindow parentHandle; /* top levels */ XWindow above; Rect zoomRect; XGCValues gcv; GC gc; GCList *gcl; Brush fore, back; Color saved_fore, saved_back; ColorSet colors; Region invalid_region, paint_region, current_region, cached_region; XRectangle clip_rect; FillPattern fill_pattern, saved_fill_pattern; Pixmap fp_pixmap; #if defined(sgi) && !defined(__GNUC__) /* multiple compilation and runtime errors otherwise. must be some alignment tricks */ char dummy_b_1[2]; #endif int rop, paint_rop; int rop2, paint_rop2; int line_style, line_width; unsigned char *dashes, *paint_dashes; int ndashes, paint_ndashes; Point clip_mask_extent, shape_extent, shape_offset; PCachedFont font; Font saved_font; Point cursor_pos; Point cursor_size; Point pointer_hot_spot; int pointer_id; Cursor actual_pointer; Cursor user_pointer; Pixmap user_p_source; Pixmap user_p_mask; void * recreateData; XWindow client; struct { unsigned base_line : 1; unsigned brush_fore : 1; unsigned brush_back : 1; unsigned brush_null_hatch : 1; unsigned clip_owner : 1; unsigned configured : 1; unsigned cursor_visible : 1; unsigned enabled : 1; unsigned exposed : 1; unsigned falsely_hidden : 1; unsigned first_click : 1; unsigned force_flush : 1; unsigned grab : 1; unsigned has_icon : 1; unsigned iconic : 1; unsigned mapped : 1; unsigned modal : 1; unsigned kill_current_region : 1; unsigned opaque : 1; unsigned paint : 1; unsigned paint_base_line : 1; unsigned paint_opaque : 1; unsigned paint_pending : 1; unsigned pointer_obscured : 1; unsigned position_determined : 1; unsigned reload_font : 1; unsigned sizeable : 1; unsigned sizemax_set : 1; unsigned suppress_cmMinimize : 1; unsigned sync_paint : 1; unsigned task_listed : 1; unsigned transparent : 1; unsigned transparent_busy : 1; unsigned want_visible : 1; unsigned withdrawn : 1; unsigned zoomed : 1; unsigned xft_clip : 1; } flags; ImageCache image_cache; Handle preexec_focus; TAILQ_ENTRY(_drawable_sys_data) paintq_link; TAILQ_HEAD(,configure_event_pair) configure_pairs; Byte * palette; int borderIcons; #ifdef USE_XFT XftDraw * xft_drawable; uint32_t * xft_map8; double xft_font_cos; double xft_font_sin; #endif } DrawableSysData, *PDrawableSysData; #define XF_ENABLED(x) ((x)->flags.enabled) #define XF_IN_PAINT(x) ((x)->flags.paint) #define XFLUSH if (XX->flags.force_flush) XFlush(DISP) #define MenuTimerMessage 1021 #define MENU_ITEM_GAP 4 typedef struct _menu_item { int x; int y; int width; int height; int accel_width; Pixmap pixmap; } UnixMenuItem, *PUnixMenuItem; typedef struct _menu_window { Handle self; XWindow w; Point sz; Point pos; PMenuItemReg m; int num; PUnixMenuItem um; struct _menu_window *next; struct _menu_window *prev; int selected; int right; int last; int first; } MenuWindow, *PMenuWindow; typedef struct _menu_sys_data { COMPONENT_SYS_DATA; Bool paint_pending; PMenuWindow w; MenuWindow wstatic; PCachedFont font; int guillemots; unsigned long c[ciMaxId+1]; Color rgb[ciMaxId+1]; XWindow focus; PMenuWindow focused; } MenuSysData, *PMenuSysData; #define cfTargets (cfCustom + 0) #define cfCOUNT (cfTargets + 1) /* XXX not implemented #define cfPalette (cfCustom + 1) #define cfForeground (cfCustom + 2) #define cfBackground (cfCustom + 3) #define cfCOUNT (cfCustom + 4) */ typedef struct { IV size; unsigned char * data; Atom name; } ClipboardDataItem, *PClipboardDataItem; typedef struct _clipboard_sys_data { COMPONENT_SYS_DATA; Atom selection; Atom target; Bool opened; Bool inside_event; Bool need_write; Handle selection_owner; PClipboardDataItem external; PClipboardDataItem internal; PList xfers; } ClipboardSysData, *PClipboardSysData; typedef struct { Handle self; unsigned char * data; unsigned long size; unsigned int blocks; unsigned int offset; Bool data_detached; Bool data_master; long id; XWindow requestor; Atom property; Atom target; int format; struct timeval time; unsigned long delay; } ClipboardXfer; typedef unsigned char ClipboardXferKey[sizeof(XWindow)+sizeof(Atom)]; #define CLIPBOARD_XFER_KEY(key,window,property) \ memcpy(key,&window,sizeof(XWindow));\ memcpy(((unsigned char*)key) + sizeof(XWindow),&property,sizeof(Atom)) typedef union _unix_sys_data { ClipboardSysData clipboard; struct { COMPONENT_SYS_DATA; } component; DrawableSysData drawable; MenuSysData menu; TimerSysData timer; } UnixSysData, *PUnixSysData; #define DISP (guts. display) #define SCREEN (guts. screen_number) #define VISUAL (guts. visual. visual) #define DRIN guts. display, guts. screen_number #define X_WINDOW (PComponent(self)-> handle) #define X(obj) ((PDrawableSysData)(PComponent((obj))-> sysData)) #define DEFXX PDrawableSysData selfxx = (self == nilHandle ? nil : X(self)) #define M(obj) ((PMenuSysData)(PComponent((obj))-> sysData)) #define DEFMM PMenuSysData selfxx = ((PMenuSysData)(PComponent((self))-> sysData)) #define C(obj) ((PClipboardSysData)(PComponent((obj))-> sysData)) #define DEFCC PClipboardSysData selfxx = C(self) #define XX selfxx #define WHEEL_DELTA 120 typedef U8 ColorComponent; extern Handle prima_xw2h( XWindow win); extern void prima_handle_event( XEvent *ev, XEvent *next_event); extern void prima_handle_menu_event( XEvent *ev, XWindow win, Handle self); extern void prima_handle_selection_event( XEvent *ev, XWindow win, Handle self); extern void prima_get_gc( PDrawableSysData); extern void prima_rebuild_watchers( void); extern void prima_release_gc( PDrawableSysData); extern Bool prima_init_clipboard_subsystem( char * error_buf); extern Bool prima_init_font_subsystem( char * error_buf); extern Bool prima_font_subsystem_set_option( char *, char *); extern Bool prima_init_color_subsystem( char * error_buf); extern Bool prima_color_subsystem_set_option( char *, char *); extern void prima_done_color_subsystem( void); extern int prima_color_find( Handle self, long color, int maxDiff, int * diff, int maxRank); extern Bool prima_palette_replace( Handle self, Bool fast); #define COLORHINT_NONE 0 #define COLORHINT_BLACK 1 #define COLORHINT_WHITE 2 #define LOGCOLOR_BLACK 0 #define LOGCOLOR_WHITE (guts.palSize?(guts.palSize-1):0xffffffff) extern Color prima_map_color( Color color, int * hint); extern unsigned long prima_allocate_color( Handle self, Color color, Brush * brush); extern void prima_palette_free( Handle self, Bool priority); extern Bool prima_palette_alloc( Handle self); extern Bool prima_color_add_ref( Handle self, int index, int rank); extern int prima_color_sync( void); extern Pixmap prima_get_hatch( FillPattern * fp); extern void prima_copy_xybitmap( unsigned char *data, const unsigned char *idata, int w, int h, int ls, int ils); extern void prima_mirror_bytes( unsigned char *data, int dataSize); extern Bool prima_create_icon_pixmaps( Handle bw_icon, Pixmap *xor, Pixmap *and); extern ImageCache* prima_create_image_cache( PImage img, Handle drawable, int type); void prima_put_ximage( XDrawable win, GC gc, PrimaXImage *i, int src_x, int src_y, int dst_x, int dst_y, int width, int height); Bool prima_query_image( Handle self, XImage * image); Bool prima_std_query_image( Handle self, Pixmap px); Pixmap prima_std_pixmap( Handle self, int type); extern void prima_cleanup_drawable_after_painting( Handle self); extern void prima_cleanup_font_subsystem( void); extern void prima_cursor_tick( void); extern void prima_no_cursor( Handle self); extern Cursor prima_null_pointer( void); extern Bool prima_one_loop_round( Bool wait, Bool careOfApplication); extern void prima_prepare_drawable_for_painting( Handle self, Bool inside_on_paint); extern Bool prima_simple_message( Handle self, int cmd, Bool is_post); extern void prima_update_cursor( Handle self); extern Bool prima_update_rotated_fonts( PCachedFont f, const char * text, int len, Bool wide, double direction, PRotatedFont *result, Bool * ok_to_not_rotate); extern void prima_free_rotated_entry( PCachedFont f); #define frUnix_int 1000 extern int unix_rm_get_int( Handle self, XrmQuark class_detail, XrmQuark name_detail, int default_value); extern void prima_rect_union( XRectangle *t, const XRectangle *s); extern void prima_rect_intersect( XRectangle *t, const XRectangle *s); extern void prima_send_create_event( XWindow win); extern void prima_gc_ximages( void); extern void prima_ximage_event( XEvent*); extern PrimaXImage* prima_prepare_ximage( int width, int height, Bool bitmap); extern Bool prima_free_ximage( PrimaXImage *i); extern int prima_rop_map( int rop); extern void prima_gp_get_clip_rect( Handle self, XRectangle *cr, Bool for_internal_paints); extern XWindow prima_find_frame_window( XWindow w); extern Bool prima_get_frame_info( Handle self, PRect r); extern void prima_send_cmSize( Handle self, Point oldSize); extern Bool prima_no_input( PDrawableSysData XX, Bool ignore_horizon, Bool beep); extern void process_transparents( Handle self); extern Bool apc_window_set_visible( Handle self, Bool show); extern void apc_SetWMNormalHints( Handle self, XSizeHints * hints); extern Bool prima_window_reset_menu( Handle self, int newMenuHeight); extern void prima_end_menu(void); extern int prima_handle_menu_shortcuts( Handle self, XEvent * ev, KeySym keysym); extern void prima_wm_sync( Handle self, int eventType); extern Bool prima_wm_net_state_read_maximization( XWindow window, Atom property); extern unsigned char * prima_get_window_property( XWindow window, Atom property, Atom req_type, Atom * actual_type, int * actual_format, unsigned long * nitems); extern PFontABC prima_xfont2abc( XFontStruct * fs, int firstChar, int lastChar); extern PCachedFont prima_find_known_font( PFont font, Bool refill, Bool bySize); extern void prima_font_pp2font( char * ppFontNameSize, PFont font); extern void prima_build_font_key( PFontKey key, PFont f, Bool bySize); extern Bool prima_core_font_pick( Handle self, Font * source, Font * dest); extern Bool prima_core_font_encoding( char * encoding); extern void prima_init_try_height( HeightGuessStack * p, int target, int firstMove ); extern int prima_try_height( HeightGuessStack * p, int height); extern void prima_utf8_to_wchar( const char * utf8, XChar2b * u16, int length); extern XChar2b * prima_alloc_utf8_to_wchar( const char * utf8, int length); extern void prima_wchar2char( char * dest, XChar2b * src, int lim); extern void prima_char2wchar( XChar2b * dest, char * src, int lim); extern XCharStruct * prima_char_struct( XFontStruct * xs, void * c, Bool wide); struct MsgDlg { struct MsgDlg * next; Font * font; Point btnPos; Point btnSz; Bool wide; char ** wrapped; int wrappedCount; int *widths, *lengths; int OKwidth; Point textPos; Bool active; Bool pressed; Bool grab; int fontId; Point winSz; GC gc; unsigned long fg, l3d, d3d; Brush bg; XWindow w; int focus_revertTo; XWindow focus; }; extern void prima_msgdlg_event( XEvent* ev, struct MsgDlg * md); typedef void (*RETSIGTYPE)(int); #undef XDestroyImage #define XDestroyImage prima_XDestroyImage extern void prima_XDestroyImage( XImage * x); typedef int (*XIfEventProcType)(Display*,XEvent*,XPointer); #endif extern void prima_xft_init( void); extern void prima_xft_done( void); extern Bool prima_xft_font_pick( Handle self, Font * source, Font * dest, double * size); extern Bool prima_xft_set_font( Handle self, PFont font); extern PFont prima_xft_fonts( PFont array, const char *facename, const char * encoding, int *retCount); extern void prima_xft_font_encodings( PHash hash); extern int prima_xft_get_text_width( PCachedFont self, const char * text, int len, Bool addOverhang, Bool utf8, uint32_t * map8, Point * overhangs); extern Point * prima_xft_get_text_box( Handle self, const char * text, int len, Bool utf8); extern Bool prima_xft_text_out( Handle self, const char * text, int x, int y, int len, Bool utf8); extern unsigned long * prima_xft_get_font_ranges( Handle self, int * count); extern PFontABC prima_xft_get_font_abc( Handle self, int firstChar, int lastChar, Bool unicode); extern PCachedFont prima_xft_get_cache( PFont font); extern uint32_t * prima_xft_map8( const char * encoding); extern Bool prima_xft_parse( char * ppFontNameSize, Font * font); extern void prima_xft_update_region( Handle self); #ifdef WITH_GTK2 Bool prima_gtk_init( void); Bool prima_gtk_done( void); char * prima_gtk_openfile( char * params); #endif Prima-1.28/include/os2/0000755000175100017510000000000011150770061012420 5ustar dkdkPrima-1.28/include/os2/os2guts.h0000644000175100017510000003633011150770061014204 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* $Id: os2guts.h,v 1.20 2005/08/23 14:00:03 dk Exp $ */ #ifndef _OS2GUTS_H_ #define _OS2GUTS_H_ #include "guts.h" #define INCL_WIN #define INCL_DOS #define INCL_SPL #define INCL_GPI #define INCL_SPLDOSPRINT #include #ifdef HAVE_PMPRINTF_H #define __PMPRINTF__ /* OS/2 logging facility */ #include #endif #define WM_PRIMA_CREATE ( WM_USER + 1) #define WM_MENUCOMMAND ( WM_USER + 2) #define WM_PRESPARAMMENU ( WM_USER + 3) #define WM_POSTAL ( WM_USER + 4) #define WM_MENUCOLORCHANGED ( WM_USER + 5) #define WM_DLGENTERMODAL ( WM_USER + 6) // #define WM_DLGPASSIVATE ( WM_USER + 7) // #define WM_DLGPOPUP ( WM_USER + 8) #define WM_MOUSEENTER ( WM_USER + 10) #define WM_MOUSELEAVE ( WM_USER + 11) #define WM_FONTCHANGED ( WM_USER + 12) #define WM_ACTIVATEMENU ( WM_USER + 13) #define WM_VIEWHELP ( WM_USER + 14) #define WM_FORCEFOCUS ( WM_USER + 15) #define WM_ZORDERSYNC ( WM_USER + 16) #define WM_REPAINT ( WM_USER + 17) #define WM_SOCKET ( WM_USER + 18) #define WM_CROAK ( WM_USER + 19) #define WM_SOCKET_REHASH ( WM_USER + 20) #define WM_TERMINATE ( WM_USER + 99) #define WM_FIRST_USER_MESSAGE ( WM_USER +100) #define WM_LAST_USER_MESSAGE ( WM_USER +900) // OS/2 defaults for apc #define DEFAULT_FONT_NAME "Helv" #define DEFAULT_FONT_SIZE 10 #define DEFAULT_FONT_FACE "10.Helv" #define DEFAULT_FIXED_FONT "Courier" #define DEFAULT_VARIABLE_FONT "Helv" #define DEFAULT_SYSTEM_FONT "System VIO" #define CTRL_ID_AUTOSTART 100 #define MENU_ID_AUTOSTART 1000 #define FONT_FONTSPECIFIC "fontspecific" #define csAxEvents csFrozen #define WC_CUSTOM ((PSZ)0) #define WC_APPLICATION ((PSZ)1) #define USE_GPIDRAWBITS typedef struct _ItemRegRec { int cmd; void *item; } ItemRegRec, *PItemRegRec; typedef struct _SingleColor { Color color; int index; } SingleColor, *PSingleColor; typedef struct _OS2Guts { HAB anchor; // program main ab HMQ queue; // message queue PID pid; // process ID HPS ps; // presentation space for runtime needs SIZEF defFontBox; // default font box int* bmf; // bitmap memory formats list int bmfCount; // count of bmf entries Point displayResolution; // display resolution ( PPI) Font sysDefFont; // system default font ( usually 10.System Proportional) Bool monoBitsOk; // false if mono bitmaps inverse output should be performed List transp; // transparent controls list List winPsList; // list of cached presentation spaces List psList; // list of presentation spaces got thru WinBeginPaint void *fontHash; // 2nd level font hash (for guts. ps) int fontId; int appLock; // application lock count int pointerLock; // pointer lock count Bool pointerInvisible; // pointer visibility state; ULONG codePage; // current system codepage Bool focSysDisabled; // focus system disabled Bool focSysGranted; // WinSetFocus() was called inside apc_widget_set_focused Bool appTypePM; // startup check, whether our application is PM List eventHooks; // event hook list Byte msgMask[100]; // 800 user-defined messages allowed int socketThread; // the socket thread ID HMTX socketMutex; // mutex for the socket thread Bool socketPostSync; // post-message flag for the socket thread List files; // files, participating in select() } OS2Guts; extern OS2Guts guts; extern int ctx_kb2VK[]; extern ERRORID rc; extern int ctx_cr2SPTR[]; extern Bool appDead; extern Handle lastMouseOver; #if PRIMA_DEBUG #define apiErr { \ rc = WinGetLastError( guts. anchor); \ apcError = errApcError; \ printf("OS2_%03lx at line %d, file %s\n", rc, __LINE__, __FILE__); \ } #define apcErr( err) { \ apcError = err; \ printf("APC_%03x at line %d, file %s\n", err, __LINE__, __FILE__);\ } #define apiAltErr( err) { \ apcError = errApcError; \ rc = err; \ printf("OS2_%03x at line %d, file %s\n", (int)rc, __LINE__, __FILE__); \ } #else #define apiErr { rc = WinGetLastError( guts. anchor); apcError = errApcError; } #define apcErr( err) apcError = err; #define apiAltErr( err) { apcError = errApcError; rc = err; } #endif #define apiErrRet { apiErr; return (Bool)false; } #define apiErrCheckRet { apiErrCheck; if ( rc) return (Bool)false; } #define apcErrRet(err) { apcErr(err); return (Bool)false; } #define apcErrClear { apcError = errOk; } #define objCheck if ( var stage == csDead) return #define dobjCheck(handle) if ((( PObject)handle)-> stage == csDead) return #define aptWM_PAINT 0x00000001 // true if inside WM_PAINT #define aptWinPS 0x00000002 // window PS was passed to paint #define aptCompatiblePS 0x00000004 // PS is screen-compatible #define aptCursorVis 0x00000010 // cursor visible flag #define aptFocused 0x00000040 // set if control if focused #define aptFirstClick 0x00000080 // set if control can process WM_BUTTONXDOWN without pre-activation #define aptClipOwner 0x00000100 // if set, parent of this window is HWND_DESKTOP #define aptLockVisState 0x00000200 // visible/locked flag #define aptTransparent 0x00000400 // transparency flag #define aptSyncPaint 0x00000800 // WS_SYNCPAINT analog #define aptVisible 0x00001000 // visibility flag #define aptTaskList 0x00002000 // Window flag - set if in task list #define aptDeviceBitmap 0x00004000 // == kind_of( CDeviceBitmap) #define aptExtraFont 0x00008000 // extra font styles ( angle, shear) has been applied #define aptEnabled 0x00010000 // set if view is enabled #define aptTextOpaque 0x00020000 // set if text_out is opaque #define aptTextOutBaseline 0x00040000 // set if text_out y ref.point is baseline #define apt_set( option) (sys options |= option) #define apt_clear( option) (sys options &= ~option) #define is_apt( option) ((sys options & option)?1:0) #define apt_assign( option, value) ((value)?apt_set(option):apt_clear(option)) #define cbNoBitmap 0 #define cbScreen 1 #define cbMonoScreen 2 #define cbImage 3 #define psDot "\3\3" #define psDash "\x16\6" #define psDashDot "\x9\6\3\6" #define psDashDotDot "\x9\3\3\3\3\3" #define GRAD 572.9577951 typedef struct _WindowData { int borderIcons; int borderStyle; Point hiddenPos; Point hiddenSize; int state; int modalResult; Point lastClientSize; Point lastFrameSize; Handle oldFoc; HWND oldActive; } WindowData; typedef struct _TimerData { int timeout; } TimerData; typedef struct _PrinterData { PRQINFO3 ppi; SIZEL size; char * defaultPrn; } PrinterData; typedef struct _PaintSaveData { Color lbs[2]; Bool fillWinding; int lineWidth; int lineEnd; int lineJoin; unsigned char *linePattern; int linePatternLen; FillPattern fillPattern; int rop; int rop2; Point transform; Font font; Bool textOpaque; Bool textOutB; } PaintSaveData, *PPaintSaveData; typedef struct _DrawableData { HPS ps; HPS ps2; unsigned long options; // aptXXX options HBITMAP bm; // cached bitmap char * bmRaw; // cached raw bitmap PBITMAPINFO2 bmInfo; // raw bitmap info Font font; // cached font metric void * fontHash; int fontId; HDC dc; // cached HDC HDC dc2; // cached HDC int bpp; // HPS data Color lbs[2]; Bool fillWinding; int lineWidth; int lineEnd; int lineJoin; unsigned char * linePattern; int linePatternLen; FillPattern fillPattern; FillPattern fillPattern2; int rop; int rop2; Point transform; Point transform2; Point res; HBITMAP fillBitmap; // HWND data ApiHandle handle2; // auxillary handler HWND parent; // window parent HWND owner; // window owner HWND parentHandle; Point cursorPos; // cursor position Point cursorSize; // cursor size HPOINTER pointer; // pointer data HPOINTER pointer2; // user pointer data int pointerId; // pointer id PSZ className; // WC_XXXXXXXXXX int timeDefsCount; // count of timers attached. PItemRegRec timeDefs; // timer list Color l3dc; // light 3d color Color d3dc; // dark 3d color PPaintSaveData psd; void * recreateData; // ViewProfile custom area int sizeLockLevel; // redirector flag for var-> virtualSize union { TimerData timer; WindowData window; PrinterData prn; int file; HRGN imgCachedRegion; // Image specific field } s; } DrawableData, *PDrawableData; typedef struct _MenuWndData { PFNWP fnwp; Handle menu; int id; } MenuWndData, *PMenuWndData; typedef struct _ParentHandleRec { HWND hwnd; int refcnt; PFNWP proc; } ParentHandleRec, *PParentHandleRec; typedef struct _BInfo { unsigned long structLength; unsigned long w; unsigned long h; unsigned short planes; // always 1 unsigned short bpp; RGB2 palette[ 0]; } BInfo, *PBInfo; typedef struct _BInfo2 { unsigned long structLength; unsigned long w; unsigned long h; unsigned short planes; // always 1 unsigned short bpp; RGB2 palette[ 0x100]; } BInfo2, *PBInfo2; MRESULT EXPENTRY generic_view_handler ( HWND win, ULONG msg, MPARAM mp1, MPARAM mp2); MRESULT EXPENTRY generic_frame_handler ( HWND win, ULONG msg, MPARAM mp1, MPARAM mp2); MRESULT EXPENTRY generic_menu_handler ( HWND win, ULONG msg, MPARAM mp1, MPARAM mp2); extern PFont gp_get_font ( HPS ps, PFont font, Point resolution); extern PFont view_get_font ( Handle view, PFont font); extern Point frame2client( Handle self, Point p, Bool f2c); extern Handle cmono_enscreen( Handle image); extern Bool cursor_update( Handle self); extern void bitmap_make_cache( Handle from, Handle self); extern HBITMAP bitmap_make_ps( Handle img, HPS * hps, HDC * hdc, PBITMAPINFO2 * bm, int createBitmap); extern Handle bitmap_make_handle( Handle img); extern Handle enscreen( Handle image); extern PBITMAPINFO2 get_binfo( Handle self); extern PBITMAPINFO2 get_screen_binfo( void); extern Bool hwnd_check_limits( int x, int y, Bool uint); extern void hwnd_enter_paint( Handle self); extern Handle hwnd_frame_top_level( Handle self); extern void hwnd_leave_paint( Handle self); extern Handle hwnd_to_view( HWND win); extern Handle hwnd_top_level( Handle self); extern Bool image_begin_query( int primType, int * typeToConvert); extern void image_query( Handle self, HPS ps); extern void image_set_cache( Handle from, Handle self); extern HPOINTER pointer_make_handle( Handle self, Handle icon, Point hotSpot); extern FIXED float2fixed( double f); extern double fixed2float( FIXED f); extern int font_font2gp( PFont font, Point res, Bool forceSize); extern void font_pp2gp( char * ppFontNameSize, PFont font); extern void font_gp2pp( PFont font, char * buf); extern int font_style( PFONTMETRICS fm); extern void font_fontmetrics2font( PFONTMETRICS m, PFont f, Bool readonly); extern long remap_color( HPS ps, long clr, Bool toSystem); extern Bool screenable( Handle image); extern HRGN region_create( Handle self, Handle mask); extern Bool create_font_hash ( void); extern Bool destroy_font_hash ( void); extern Bool add_font_to_hash ( const PFont key, const PFont font, int vectored, PFONTMETRICS fm, Bool addSizeEntry); extern Bool get_font_from_hash ( PFont font, int *vectored, PFONTMETRICS fm, Bool bySize); extern void *create_fontid_hash ( void); extern void destroy_fontid_hash ( void *hash); extern int get_fontid_from_hash ( void *hash, const PFont font, SIZEF *sz, int *vectored); extern void add_fontid_to_hash ( void *hash, int id, const PFont font, const SIZEF *sz, int vectored); extern USHORT font_enc2cp( const char * encoding); extern char * font_cp2enc( USHORT codepage); extern void socket_rehash ( void); #endif Prima-1.28/include/win32/0000755000175100017510000000000011150770061012657 5ustar dkdkPrima-1.28/include/win32/win32guts.h0000644000175100017510000005641611150770061014711 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* $Id: win32guts.h,v 1.66 2008/04/24 21:30:15 dk Exp $ */ #ifndef _WIN32_H_ #define _WIN32_H_ #undef _WIN32_WINNT #define _WIN32_WINNT 0x400 #include #include #include "apricot.h" #ifdef __cplusplus extern "C" { #endif #define SEVERE_DEBUG typedef HANDLE WINHANDLE; #ifdef __CYGWIN__ typedef int SOCKETHANDLE; #else typedef HANDLE SOCKETHANDLE; #endif #define IS_NT (BOOL)( guts. version < 0x80000000) #define IS_WIN32S (BOOL)(!(IS_NT) && (LOBYTE(LOWORD(guts. version))<4)) #define IS_WIN95 (BOOL)(!(IS_NT) && !(IS_WIN32S)) #define IS_WIN98 (BOOL)( guts. is98) #define HAS_WCHAR IS_NT #undef HWND_DESKTOP #define HWND_DESKTOP guts. desktopWindow #ifdef UNICODE #error This version of apc_Win32 does not support Unicode #endif #define DEFAULT_SYSTEM_FONT "System" #define DEFAULT_WIDGET_FONT "MS Shell Dlg" #define DEFAULT_WIDGET_FONT_SIZE 8 #define COLOR_TOLERANCE 4 #define HASMATE_MAGIC 0xDEAF0CE1 #define MENU_ID_AUTOSTART 100 #define TID_USERMAX 32767 #define REG_STORAGE "SOFTWARE\\Perl\\Prima" #define MAXREGLEN 1024 #define WM_WRITE_TO_LOG ( WM_USER + 0) #define WM_PRIMA_CREATE ( WM_USER + 1) #define WM_POSTAL ( WM_USER + 2) #define WM_DLGENTERMODAL ( WM_USER + 3) #define WM_ZORDERSYNC ( WM_USER + 4) #define WM_MOUSEENTER ( WM_USER + 6) #define WM_MOUSEEXIT ( WM_USER + 7) #define WM_SETVISIBLE ( WM_USER + 8) #define WM_KEYPACKET ( WM_USER + 9) #define WM_LMOUSECLICK ( WM_USER + 10) #define WM_MMOUSECLICK ( WM_USER + 11) #define WM_RMOUSECLICK ( WM_USER + 12) #define WM_FORCEFOCUS ( WM_USER + 13) #define WM_SYNCMOVE ( WM_USER + 14) #define WM_SOCKET ( WM_USER + 15) #define WM_SOCKET_REHASH ( WM_USER + 16) #define WM_EXTERNAL ( WM_USER + 17) #define WM_HASMATE ( WM_USER + 18) #define WM_FILE ( WM_USER + 19) #define WM_CROAK ( WM_USER + 20) #define WM_TERMINATE ( WM_USER + 99) #define WM_FIRST_USER_MESSAGE ( WM_USER +100) #define WM_LAST_USER_MESSAGE ( WM_USER +900) #define WC_CUSTOM 0 #define WC_DLG 1 #define WC_APPLICATION 2 #define WC_FRAME 3 #define WC_MENU 4 #define WC_POPUP 5 #define exsLinePattern 1 #define exsLineEnd 2 #define exsLineJoin 4 #define stbPen 1 #define stbBrush 2 #define stbText 4 #define stbBacking 8 #define SOCKETS_NONE ( guts. socket_version == -1) #define SOCKETS_AS_HANDLES ( guts. socket_version == 1) #define SOCKETS_NATIVE ( guts. socket_version == 2) #define FHT_SOCKET 1 #define FHT_PIPE 2 #define FHT_OTHER 3 #if PRIMA_DEBUG #define apcWarn warn( "win32 error %d: '%s' at line %d in %s\n", (int)rc,\ err_msg( rc, nil), __LINE__, __FILE__) #else #define apcWarn err_msg( rc, nil) #endif #define apcErr( err) apcError = err #define apiErr { \ rc = GetLastError(); \ apcError = errApcError; \ apcWarn; \ } #define apiAltErr( err) { \ apcError = errApcError; \ rc = err; \ apcWarn; \ } #define apiErrRet { apiErr; return false; } #define apiErrCheckRet { apiErrCheck; if ( rc) return false; } #define apcErrRet(err) { apcErr(err); return false; } #define apcErrClear { apcError = errOk; } #define objCheck if ( var stage == csDead) return #define dobjCheck(handle) if ((( PObject)handle)-> stage == csDead) return typedef struct _HandleOptions_ { unsigned aptWM_PAINT : 1; // true if inside WM_PAINT unsigned aptWinPS : 1; // window PS was passed to paint unsigned aptCompatiblePS : 1; // PS is screen-compatible unsigned aptFontExists : 1; // font is selected on HPS unsigned aptCursorVis : 1; // cursor visible flag unsigned aptFocused : 1; // set if control if focused unsigned aptFirstClick : 1; // set if control can process WM_BUTTONXDOWN without pre-activation unsigned aptClipOwner : 1; // if set, parent of this window is HWND_DESKTOP unsigned aptLockVisState : 1; // visible/locked flag unsigned aptTransparent : 1; // transparency flag unsigned aptSyncPaint : 1; // WS_SYNCPAINT analog unsigned aptVisible : 1; // visibility flag unsigned aptTaskList : 1; // Window flag - set if in task list unsigned aptDeviceBitmap : 1; // == kind_of( CDeviceBitmap) unsigned aptBitmap : 1; // == kind_of( CImage) unsigned aptExtraFont : 1; // extra font styles ( angle, shear) has been applied unsigned aptDCChangeLock : 1; // locks SelectObject() calls unsigned aptEnabled : 1; // enabled flag unsigned aptTextOpaque : 1; // gp text drawing flag unsigned aptTextOutBaseline : 1; // gp text drawing flag unsigned aptWinPosDetermined : 1; // 0 when size is set, but position is not unsigned aptOnTop : 1; // HWND_TOPMOST is set } HandleOptions; typedef struct _WinGuts { HINSTANCE instance; // application instance int cmdShow; // run command state int appLock; // application lock count int pointerLock; // pointer lock count DWORD mainThreadId; // Id of main thread Point displayResolution; // screen resolution in ppi char defaultFixedFont [ 256]; char defaultVariableFont [ 256]; char defaultSystemFont [ 256]; Font windowFont; // window default font Font menuFont; // menu default font Font msgFont; // message default font Font capFont; // caption default font BITMAPINFO displayBMInfo; // display bpp & size HWND desktopWindow; // GetDesktopWindow() result Bool insertMode; // fake insert mode Point iconSizeLarge; Point iconSizeSmall; Point pointerSize; BYTE keyState[ 256]; // application key buffer state BYTE emptyKeyState[ 256];// just zeros BYTE *currentKeyState; // current virtual key buffer state HKL keyLayout; // key layout, most likely latin for Ctrl+Key mapping NONCLIENTMETRICS ncmData; // windows system data List transp; // transparent controls list int topWindows; // count of top-level windows in app Bool focSysDisabled; // focus system disabled Bool focSysGranted; // SetFocus() was called inside apc_widget_set_focused Bool focSysDialog; // system dialog is in action UINT errorMode; // SetErrorMode() result DWORD version; // GetVersion() cached result Point smDblClk; // cached SM_CxDOUBLECLK values Bool is98; // is win98 int socket_version; // socket behavior type List files; // List of active File objects int mouseTimer; // is mouse timer started Bool popupActive; // flag to avoid double popup activation Bool pointerInvisible; HWND console; // win32-bound console window List eventHooks; // event hook list Byte msgMask[100]; // 800 user-defined messages allowed // socket variables List sockets; // List of watchable sockets HANDLE socketMutex; // thread semaphore HANDLE socketThread; // thread id Bool socketPostSync; // semaphore Bool dont_xlate_message; // one-time stopper to TranslateMessage() call } WinGuts, *PWinGuts; typedef struct _WindowData { int borderIcons; int borderStyle; Point hiddenPos; Point hiddenSize; int state; Handle oldFoc; HWND oldActive; } WindowData; typedef struct _TimerData { int timeout; } TimerData; typedef struct _FileData { SOCKETHANDLE object; int type; } FileData; typedef struct _PrinterData { PRINTER_INFO_2 ppi; char defPrnBuf[ 256]; char *device; char *driver; char *port; } PrinterData; typedef struct _PaintSaveData { Color lbs[2]; Bool fillWinding; int lineWidth; int lineEnd; int lineJoin; unsigned char * linePattern; int linePatternLen; FillPattern fillPattern; int rop; int rop2; Point transform; Font font; Bool textOpaque; Bool textOutB; } PaintSaveData, *PPaintSaveData; typedef struct _PatResource { DWORD dotsCount; DWORD* dotsPtr; DWORD dots[ 1]; } PatResource, *PPatResource; typedef struct _EXTPEN { Bool actual; DWORD style; DWORD lineEnd; DWORD lineJoin; PatResource * patResource; } EXTPEN, *PEXTPEN; typedef struct _EXTLOGBRUSH { LOGBRUSH lb; COLORREF backColor; FillPattern pattern; } EXTLOGBRUSH, *PEXTLOGBRUSH; typedef struct _DIBMONOBRUSH { BITMAPINFOHEADER bmiHeader; RGBQUAD bmiColors[2]; unsigned char bmiData[32]; } DIBMONOBRUSH, *PDIBMONOBRUSH; typedef struct _Stylus { LOGPEN pen; EXTLOGBRUSH brush; EXTPEN extPen; } Stylus, *PStylus; typedef struct _DCStylus { Stylus s; int refcnt; HPEN hpen; HBRUSH hbrush; } DCStylus, *PDCStylus; typedef struct _DCFont { Font font; int refcnt; HFONT hfont; } DCFont, *PDCFont; typedef struct _XLOGPALETTE { WORD palVersion; WORD palNumEntries; PALETTEENTRY palPalEntry[ 256]; } XLOGPALETTE, *PXLOGPALETTE; typedef struct _XBITMAPINFO { BITMAPINFOHEADER bmiHeader; RGBQUAD bmiColors[ 256]; } XBITMAPINFO, *PXBITMAPINFO; typedef struct _ItemRegRec { int cmd; void *item; } ItemRegRec, *PItemRegRec; typedef struct _DrawableData { /* Drawable basic data*/ HDC ps; // general HDC PAINTSTRUCT paintStruc; // HDC counterpart HBITMAP bm; // cached bitmap HPALETTE pal; // cached palette /* stylus and font hash management fields */ PDCStylus stylusResource; // current stylus pointer int stylusFlags; // stylus resource cache( stbXXXX) Stylus stylus; // widgets stylus record PDCFont fontResource; // font resource pointer /* Stock objects of HDC - to be restored after paint mode */ HPEN stockPen; HBRUSH stockBrush; HFONT stockFont; HBITMAP stockBM; HPALETTE stockPalette; /* HDC info fields */ int bpp; // bits per pixel Point res; // resolution /* cached gp_GetCharABCWidthsFloat results */ BYTE tmPitchAndFamily; LONG tmOverhang; /* HDC attributes storage outside paint mode */ Color lbs[2]; Bool fillWinding; int lineWidth; int lineEnd; int lineJoin; unsigned char *linePattern; int linePatternLen; unsigned char *linePattern2; int linePatternLen2; FillPattern fillPattern; FillPattern fillPattern2; int rop; int rop2; Point transform; PPaintSaveData psd; // Their values durind paint saved in sys psd /* Basic widget fields */ HWND handle; // Windows handle of a widget HWND owner; // Windows owner of a widget HWND parent; // Windows parent of a widget HWND parentHandle; int className; // class name ( WC_XXX) /* Widget properties */ HandleOptions options; // apt_XXX settings ColorSet viewColors; // widget color palette PXLOGPALETTE p256; // cached squeezed palette void * recreateData; // ViewProfile custom area /* Custom data for widget paint in optBuffered state */ HDC ps2; // original HDC HPALETTE pal2; // original palette Point transform2; // necessary additional transposition /* Positioning support fields */ Point lastSize; // last actual size int sizeLockLevel; // size locking flag int yOverride; // special cached height value. Used in WM_SIZE<->WM_MOVE interactions /* Widget attributes - timers, cursor, pointers, menu, shape */ int timeDefsCount; // count of timers attached. PItemRegRec timeDefs; // timer list Point cursorPos; // cursor position Point cursorSize; // cursor size HCURSOR pointer; // pointer handle HCURSOR pointer2; // user pointer data int pointerId; // pointer id Handle lastMenu; // last menu activated by WM_INITMENU or WM_INITMENUPOPUP Point extraBounds; // used in region calculations Point extraPos; // used in region calculations /* Other class-specific data */ union { TimerData timer; WindowData window; PrinterData prn; FileData file; HRGN imgCachedRegion; // Image specific field } s; } DrawableData, *PDrawableData; typedef struct _MenuWndData { Handle menu; int id; } MenuWndData, *PMenuWndData; typedef struct _KeyPacket { HWND wnd; UINT msg; WPARAM mp1; LPARAM mp2; int mod; } KeyPacket, *PKeyPacket; typedef struct _MusClkRec { Bool pending; UINT emsg; MSG msg; } MusClkRec; #define STYLUS_USE_PEN( __ps) \ if ( !( sys stylusFlags & stbPen)) { \ if ( __ps) \ SelectObject( __ps, sys stylusResource-> hpen); \ sys stylusFlags |= stbPen; \ } #define STYLUS_USE_BRUSH( __ps) \ if ( !( sys stylusFlags & stbBrush)) { \ if ( __ps) \ SelectObject( __ps, sys stylusResource-> hbrush); \ sys stylusFlags |= stbBrush; \ } #define STYLUS_USE_TEXT( __ps) \ if ( !( sys stylusFlags & stbText)) { \ if ( __ps) \ SetTextColor( __ps, sys stylus. pen. lopnColor); \ sys stylusFlags |= stbText; \ } #define STYLUS_USE_BACKING( __ps) \ if ( !( sys stylusFlags & stbBacking)) { \ if ( __ps) \ SetBkColor( __ps, sys stylus. brush. backColor); \ sys stylusFlags |= stbBacking; \ } #define psDot "\3\3" #define psDash "\x16\6" #define psDashDot "\x9\6\3\6" #define psDashDotDot "\x9\3\3\3\3\3" #define csAxEvents csFrozen #define apt_set( option) ( sys options. option = 1) #define apt_clear( option) ( sys options. option = 0) #define is_apt( option) ( sys options. option) #define apt_assign( option, value) ( sys options. option = (value)?1:0) #define is_declipped( handle) ( \ handle && ( dsys(handle) className != WC_FRAME ) && \ ( !dsys(handle)options.aptClipOwner || ((( PWidget)handle)-> owner == application)) \ ) #define is_declipped_child( handle) ( \ handle && ( dsys(handle) className != WC_FRAME ) && \ !dsys(handle)options.aptClipOwner \ ) #define palette_create image_make_bitmap_palette extern Bool appDead; extern DIBMONOBRUSH bmiHatch; extern PHash fontMan; extern int FONTSTRUCSIZE; extern WinGuts guts; extern PHash imageMan; extern PHash menuMan; extern MusClkRec musClk; extern PHash patMan; extern DWORD rc; extern PHash stylusMan; extern HBRUSH hBrushHollow; extern PatResource hPatHollow; extern HPEN hPenHollow; extern PHash regnodeMan; extern Handle lastMouseOver; LRESULT CALLBACK generic_app_handler ( HWND win, UINT msg, WPARAM mp1, LPARAM mp2); LRESULT CALLBACK generic_frame_handler ( HWND win, UINT msg, WPARAM mp1, LPARAM mp2); LRESULT CALLBACK generic_view_handler ( HWND win, UINT msg, WPARAM mp1, LPARAM mp2); extern int arc_completion( double * angleStart, double * angleEnd, int * needFigure); extern Bool add_font_to_hash( const PFont key, const PFont font, int vectored, Bool addSizeEntry); extern void adjust_line_end( int x1, int y1, int * x2, int * y2, Bool forth); extern void cm_squeeze_palette( PRGBColor source, int srcColors, PRGBColor dest, int destColors); extern Bool create_font_hash( void); extern Bool cursor_update( Handle self); extern HDC dc_alloc( void); extern void dc_free( void); extern HDC dc_compat_alloc( HDC compatDC); extern void dc_compat_free( void); extern void dbm_recreate( Handle self); extern Bool destroy_font_hash( void); extern char * err_msg( DWORD errId, char * buffer); extern Bool erratic_line( Handle self); extern PDCFont font_alloc( Font * data, Point * resolution); extern void font_change( Handle self, Font * font); extern void font_clean( void); extern void font_font2logfont( Font * font, LOGFONT * lf); extern void font_free( PDCFont res, Bool permanent); extern void font_logfont2font( LOGFONT * lf, Font * font, Point * resolution); extern void font_pp2font( char * presParam, Font * font); extern void font_textmetric2font( TEXTMETRICW * tm, Font * fm, Bool readOnly); extern Bool get_font_from_hash( PFont font, int *vectored, Bool bySize); extern Point get_window_borders( int borderStyle); extern int gp_arc( Handle self, int x, int y, int dX, int dY, double angleStart, double angleEnd, int drawState); extern int gp_line( Handle self, int x1, int y1, int x2, int y2, int draw); extern Bool hwnd_check_limits( int x, int y, Bool uint); extern void hwnd_enter_paint( Handle self); extern Handle hwnd_frame_top_level( Handle self); extern void hwnd_leave_paint( Handle self); extern Handle hwnd_to_view( HWND win); extern Handle hwnd_top_level( Handle self); extern void image_destroy_cache( Handle self); extern Handle image_enscreen( Handle image, Handle screen); extern BITMAPINFO * image_get_binfo( Handle img, XBITMAPINFO * bi); extern HBITMAP image_make_bitmap_handle( Handle img, HPALETTE palette); extern HPALETTE image_make_bitmap_palette( Handle img); extern HICON image_make_icon_handle( Handle img, Point size, Point * hotSpot, Bool forPointer); extern void image_query_bits( Handle self, Bool forceNewImage); extern Bool image_screenable( Handle image, Handle screen, int * bitCount); extern Bool image_set_cache( Handle from, Handle self); extern void mod_free( BYTE * modState); extern BYTE * mod_select( int mod); extern Bool palette_change( Handle self); extern long palette_match( Handle self, long color); extern int palette_match_color( XLOGPALETTE * lp, long clr, int * diffFactor); extern PPatResource patres_fetch( unsigned char * pattern, int len); extern UINT patres_user( unsigned char * pattern, int len); extern void process_transparents( Handle self); extern long remap_color( long clr, Bool toSystem); extern void socket_rehash( void); extern PDCStylus stylus_alloc( PStylus data); extern void stylus_change( Handle self); extern void stylus_clean( void); extern Bool stylus_complex( PStylus stylus, HDC dc); extern Bool stylus_extpenned( PStylus stylus, int excludeFlags); extern void stylus_free( PDCStylus res, Bool permanent); extern DWORD stylus_get_extpen_style( PStylus s); extern HRGN region_create( Handle mask); extern void utf8_to_wchar( const char * utf8, WCHAR * u16, int length); extern WCHAR * alloc_utf8_to_wchar( const char * utf8, int length); extern void wchar2char( char * dest, WCHAR * src, int lim); extern void char2wchar( WCHAR * dest, char * src, int lim); extern BOOL gp_GetTextMetrics( HDC dc, LPTEXTMETRICW tm); extern void textmetric_c2w( LPTEXTMETRICA from, LPTEXTMETRICW to); #ifdef __cplusplus } #endif #endif Prima-1.28/include/img_conv.h0000644000175100017510000004015611150770061013675 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: img_conv.h,v 1.25 2007/03/19 08:41:50 dk Exp $ */ #include "Image.h" #include #include #ifdef HAVE_UNISTD_H #include #else #include #include #endif #ifdef __cplusplus extern "C" { #endif /* initializer routine */ extern void init_image_support(void); /* image basic routines */ extern void ic_stretch( int type, Byte * srcData, int srcW, int srcH, Byte * dstData, int w, int h, Bool xStretch, Bool yStretch); extern void ic_type_convert( Handle self, Byte * dstData, PRGBColor dstPal, int dstType, int * palSize, Bool palSize_only); extern Bool itype_supported( int type); extern Bool itype_importable( int type, int *newtype, void **from_proc, void **to_proc); /* palette routines */ extern void cm_init_colormap( void); extern void cm_reverse_palette( PRGBColor source, PRGBColor dest, int colors); extern void cm_squeeze_palette( PRGBColor source, int srcColors, PRGBColor dest, int destColors); extern Byte cm_nearest_color( RGBColor color, int palSize, PRGBColor palette); extern void cm_fill_colorref( PRGBColor fromPalette, int fromColorCount, PRGBColor toPalette, int toColorCount, Byte * colorref); extern U16* cm_study_palette( RGBColor * palette, int pal_size); extern Bool cm_optimized_palette( Byte * data, int lineSize, int width, int height, RGBColor * palette, int * max_pal_size); /* bitstroke conversion routines */ extern void bc_mono_nibble( register Byte * source, register Byte * dest, register int count); extern void bc_mono_nibble_cr( register Byte * source, register Byte * dest, register int count, register Byte * colorref); extern void bc_mono_byte( register Byte * source, register Byte * dest, register int count); extern void bc_mono_byte_cr( register Byte * source, register Byte * dest, register int count, register Byte * colorref); extern void bc_mono_graybyte( register Byte * source, register Byte * dest, register int count, register PRGBColor palette); extern void bc_mono_rgb( register Byte * source, Byte * dest, register int count, register PRGBColor palette); extern void bc_nibble_mono_cr( register Byte * source, register Byte * dest, register int count, register Byte * colorref); extern void bc_nibble_mono_ht( register Byte * source, register Byte * dest, register int count, register PRGBColor palette, int lineSeqNo); extern void bc_nibble_mono_ed( Byte * source, Byte * dest, int count, PRGBColor palette, int * err_buf); extern void bc_nibble_cr( register Byte * source, register Byte * dest, register int count, register Byte * colorref); extern void bc_nibble_byte( register Byte * source, register Byte * dest, register int count); extern void bc_nibble_graybyte( register Byte * source, register Byte * dest, register int count, register PRGBColor palette); extern void bc_nibble_byte_cr( register Byte * source, register Byte * dest, register int count, register Byte * colorref); extern void bc_nibble_rgb( register Byte * source, Byte * dest, register int count, register PRGBColor palette); extern void bc_byte_mono_cr( register Byte * source, Byte * dest, register int count, register Byte * colorref); extern void bc_byte_mono_ht( register Byte * source, register Byte * dest, register int count, PRGBColor palette, int lineSeqNo); extern void bc_byte_mono_ed( Byte * source, Byte * dest, int count, PRGBColor palette, int * err_buf); extern void bc_byte_nibble_cr( register Byte * source, Byte * dest, register int count, register Byte * colorref); extern void bc_byte_nibble_ht( register Byte * source, Byte * dest, register int count, register PRGBColor palette, int lineSeqNo); extern void bc_byte_nibble_ed( Byte * source, Byte * dest, int count, PRGBColor palette, int * err_buf); extern void bc_byte_cr( register Byte * source, register Byte * dest, register int count, register Byte * colorref); extern void bc_byte_op( Byte * source, Byte * dest, int count, U16 * tree, PRGBColor src_palette, PRGBColor dst_palette, int * err_buf); extern void bc_byte_graybyte( register Byte * source, register Byte * dest, register int count, register PRGBColor palette); extern void bc_byte_rgb( register Byte * source, Byte * dest, register int count, register PRGBColor palette); extern void bc_graybyte_mono_ht( register Byte * source, register Byte * dest, register int count, int lineSeqNo); extern void bc_graybyte_nibble_ht( register Byte * source, Byte * dest, register int count, int lineSeqNo); extern void bc_graybyte_nibble_ed( Byte * source, Byte * dest, int count, int * err_buf); extern void bc_graybyte_rgb( register Byte * source, Byte * dest, register int count); extern void bc_rgb_mono_ht( register Byte * source, register Byte * dest, register int count, int lineSeqNo); extern void bc_rgb_mono_ed( Byte * source, Byte * dest, int count, int * err_buf); extern Byte rgb_color_to_16( register Byte b, register Byte g, register Byte r); extern void bc_rgb_nibble( register Byte *source, Byte *dest, int count); extern void bc_rgb_nibble_ht( register Byte * source, Byte * dest, register int count, int lineSeqNo); extern void bc_rgb_nibble_ed( Byte * source, Byte * dest, int count, int * err_buf); extern void bc_rgb_byte( Byte * source, register Byte * dest, register int count); extern void bc_rgb_byte_ht( Byte * source, register Byte * dest, register int count, int lineSeqNo); extern void bc_rgb_byte_ed( Byte * source, Byte * dest, int count, int * err_buf); extern void bc_rgb_byte_op( RGBColor * src, Byte * dest, int count, U16 * tree, RGBColor * palette, int * err_buf); extern void bc_rgb_graybyte( Byte * source, register Byte * dest, register int count); /* bitstroke stretching types */ typedef void StretchProc( void * srcData, void * dstData, int w, int x, int absx, long step); typedef StretchProc *PStretchProc; #if !defined(sgi) || defined(__GNUC__) #pragma pack(1) #endif typedef union _Fixed { int32_t l; #if (BYTEORDER==0x4321) || (BYTEORDER==0x87654321) struct { int16_t i; uint16_t f; } i; #else struct { uint16_t f; int16_t i; } i; #endif } Fixed; #if !defined(sgi) || defined(__GNUC__) #pragma pack() #endif #define UINT16_PRECISION (1L<<(8*sizeof(uint16_t))) /* bitstroke stretching routines */ extern void bs_mono_in( uint8_t * srcData, uint8_t * dstData, int w, int x, int absx, long step); extern void bs_nibble_in( uint8_t * srcData, uint8_t * dstData, int w, int x, int absx, long step); extern void bs_uint8_t_in( uint8_t * srcData, uint8_t * dstData, int w, int x, int absx, long step); extern void bs_int16_t_in( int16_t * srcData, int16_t * dstData, int w, int x, int absx, long step); extern void bs_RGBColor_in( RGBColor * srcData, RGBColor * dstData, int w, int x, int absx, long step); extern void bs_int32_t_in( int32_t * srcData, int32_t * dstData, int w, int x, int absx, long step); extern void bs_float_in( float * srcData, float * dstData, int w, int x, int absx, long step); extern void bs_double_in( double * srcData, double * dstData, int w, int x, int absx, long step); extern void bs_Complex_in( Complex * srcData, Complex * dstData, int w, int x, int absx, long step); extern void bs_DComplex_in( DComplex * srcData, DComplex * dstData, int w, int x, int absx, long step); extern void bs_mono_out( uint8_t * srcData, uint8_t * dstData, int w, int x, int absx, long step); extern void bs_nibble_out( uint8_t * srcData, uint8_t * dstData, int w, int x, int absx, long step); extern void bs_uint8_t_out( uint8_t * srcData, uint8_t * dstData, int w, int x, int absx, long step); extern void bs_int16_t_out( int16_t * srcData, int16_t * dstData, int w, int x, int absx, long step); extern void bs_RGBColor_out( RGBColor * srcData, RGBColor * dstData, int w, int x, int absx, long step); extern void bs_int32_t_out( int32_t * srcData, int32_t * dstData, int w, int x, int absx, long step); extern void bs_float_out( float * srcData, float * dstData, int w, int x, int absx, long step); extern void bs_double_out( double * srcData, double * dstData, int w, int x, int absx, long step); extern void bs_Complex_out( Complex * srcData, Complex * dstData, int w, int x, int absx, long step); extern void bs_DComplex_out( DComplex * srcData, DComplex * dstData, int w, int x, int absx, long step); /* bitstroke copy routines */ extern void bc_nibble_copy( Byte * source, Byte * dest, unsigned int from, unsigned int width); extern void bc_mono_copy( Byte * source, Byte * dest, unsigned int from, unsigned int width); /* image conversion routines */ #define BC(from,to,conv) void ic_##from##_##to##_ict##conv( Handle self, Byte * dstData, PRGBColor dstPal, int dstType, int * dstPalSize, Bool palSize_only) #define BC2(from,to) void ic_##from##_##to( Handle self, Byte * dstData, PRGBColor dstPal, int dstType, int * dstPalSize, Bool palSize_only) extern BC(mono,mono,None); extern BC(mono,mono,Optimized); extern BC(mono,nibble,None); extern BC(mono,byte,None); extern BC(mono,graybyte,None); extern BC(mono,rgb,None); extern BC(nibble,mono,None); extern BC(nibble,mono,Ordered); extern BC(nibble,mono,ErrorDiffusion); extern BC(nibble,mono,Optimized); extern BC(nibble,nibble,None); extern BC(nibble,nibble,Optimized); extern BC(nibble,byte,None); extern BC(nibble,graybyte,None); extern BC(nibble,rgb,None); extern BC(byte,mono,None); extern BC(byte,mono,Ordered); extern BC(byte,mono,ErrorDiffusion); extern BC(byte,mono,Optimized); extern BC(byte,nibble,None); extern BC(byte,nibble,Ordered); extern BC(byte,nibble,ErrorDiffusion); extern BC(byte,nibble,Optimized); extern BC(byte,byte,None); extern BC(byte,graybyte,None); extern BC(byte,rgb,None); extern BC(graybyte,mono,Ordered); extern BC(graybyte,mono,ErrorDiffusion); extern BC(graybyte,nibble,Ordered); extern BC(graybyte,nibble,ErrorDiffusion); extern BC(graybyte,rgb,None); extern BC(rgb,mono,None); extern BC(rgb,mono,Ordered); extern BC(rgb,mono,ErrorDiffusion); extern BC(rgb,mono,Optimized); extern BC(rgb,nibble,None); extern BC(rgb,nibble,Ordered); extern BC(rgb,nibble,ErrorDiffusion); extern BC(rgb,nibble,Optimized); extern BC(rgb,byte,None); extern BC(rgb,byte,Ordered); extern BC(rgb,byte,ErrorDiffusion); extern BC(rgb,byte,Optimized); extern BC(rgb,graybyte,None); extern BC(byte,byte,Optimized); extern BC(nibble,nibble,Optimized); extern BC2(Byte,Short); extern BC2(Byte,Long); extern BC2(Byte,float); extern BC2(Byte,double); extern BC2(Short,Byte); extern BC2(Short,Long); extern BC2(Short,float); extern BC2(Short,double); extern BC2(Long,Byte); extern BC2(Long,Short); extern BC2(Long,float); extern BC2(Long,double); extern BC2(float,Byte); extern BC2(float,Short); extern BC2(float,Long); extern BC2(float,double); extern BC2(double,Byte); extern BC2(double,Short); extern BC2(double,Long); extern BC2(double,float); extern BC2(Byte,float_complex); extern BC2(Byte,double_complex); extern BC2(Short,float_complex); extern BC2(Short,double_complex); extern BC2(Long,float_complex); extern BC2(Long,double_complex); extern BC2(float,float_complex); extern BC2(float,double_complex); extern BC2(double,float_complex); extern BC2(double,double_complex); extern BC2(double_complex,double); extern BC2(double_complex,float); extern BC2(double_complex,Long); extern BC2(double_complex,Short); extern BC2(double_complex,Byte); extern BC2(float_complex,double); extern BC2(float_complex,float); extern BC2(float_complex,Long); extern BC2(float_complex,Short); extern BC2(float_complex,Byte); /* image resampling routines */ extern void rs_Byte_Byte( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_Short_Short( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_Long_Long( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_float_float( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_double_double( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_Short_Byte( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_Long_Byte( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_float_Byte( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); extern void rs_double_Byte( Handle self, Byte * dstData, int dstType, double srcLo, double srcHi, double dstLo, double dstHi); /* extra convertors */ extern void bc_irgb_rgb( Byte * source, Byte * dest, int count); extern void bc_ibgr_rgb( Byte * source, Byte * dest, int count); extern void bc_bgri_rgb( Byte * source, Byte * dest, int count); extern void bc_rgbi_rgb( Byte * source, Byte * dest, int count); extern void bc_rgb_irgb( Byte * source, Byte * dest, int count); extern void bc_rgb_rgbi( Byte * source, Byte * dest, int count); extern void bc_rgb_ibgr( Byte * source, Byte * dest, int count); extern void bc_rgb_bgri( Byte * source, Byte * dest, int count); /* misc */ typedef void SimpleConvProc( Byte * srcData, Byte * dstData, int count); typedef SimpleConvProc *PSimpleConvProc; extern void ibc_repad( Byte * source, Byte * dest, int srcLineSize, int dstLineSize, int srcDataSize, int dstDataSize, int srcBPP, int dstBPP, void * bit_conv_proc, Bool reverse); extern Bool img_put( Handle dest, Handle src, int dstX, int dstY, int srcX, int srcY, int dstW, int dstH, int srcW, int srcH, int rop); /* internal maps */ extern Byte map_stdcolorref [ 256]; extern Byte div51 [ 256]; extern Byte div17 [ 256]; extern Byte mod51 [ 256]; extern Byte mod17mul3 [ 256]; extern RGBColor cubic_palette [ 256]; extern RGBColor cubic_palette8 [ 8]; extern RGBColor cubic_palette16 [ 16]; extern RGBColor stdmono_palette [ 2]; extern RGBColor std16gray_palette [ 16]; extern RGBColor std256gray_palette [ 256]; extern Byte map_halftone8x8_51 [ 64]; extern Byte map_halftone8x8_64 [ 64]; /* internal macros */ #define dBCARGS \ int i; \ int width = var->w, height = var->h; \ int srcType = var->type; \ int srcLine = (( width * ( srcType & imBPP) + 31) / 32) * 4; \ int dstLine = (( width * ( dstType & imBPP) + 31) / 32) * 4; \ Byte * srcData = var->data; \ Byte colorref[ 256] #if defined (__BORLANDC__) #define BCWARN #else #define BCWARN \ (void)srcType; (void)srcLine; (void)dstLine; \ (void)srcData; (void)colorref; (void)i; #endif #define BCCONV srcData, dstData, width #define map_RGB_gray ((Byte*)std256gray_palette) #define PAL_FREE 0x8000 #define PAL_REF 0x4000 #define CELL_SIZE 64 #ifdef __cplusplus } #endif Prima-1.28/include/img.h0000644000175100017510000002131011150770061012637 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: img.h,v 1.14 2008/10/25 07:44:48 dk Exp $ */ /* Created by Dmitry Karasik */ #ifndef _IMG_IMG_H_ #define _IMG_IMG_H_ #ifndef _APRICOT_H_ #include #endif #ifdef __cplusplus extern "C" { #endif typedef struct _ImgIORequest { size_t (*read) ( void * handle, size_t busize, void * buffer); size_t (*write) ( void * handle, size_t busize, void * buffer); int (*seek) ( void * handle, long offset, int whence); long (*tell) ( void * handle); int (*flush) ( void * handle); int (*error) ( void * handle); void * handle; } ImgIORequest, *PImgIORequest; #define req_read(req,size,buf) ((req)->read(((req)->handle),(size),(buf))) #define req_write(req,size,buf) ((req)->write(((req)->handle),(size),(buf))) #define req_seek(req,offset,whence) ((req)->seek(((req)->handle),(offset),(whence))) #define req_tell(req) ((req)->tell((req)->handle)) #define req_flush(req) ((req)->flush((req)->handle)) #define req_error(req) ((req)->error((req)->handle)) /* common data, request for a whole file load */ #define IMG_EVENTS_HEADER_READY 1 #define IMG_EVENTS_DATA_READY 2 typedef struct _ImgLoadFileInstance { /* instance data, filled by core */ char * fileName; PImgIORequest req; Bool req_is_stdio; int eventMask; /* IMG_EVENTS_XXX / if set, Image:: events are issued */ /* instance data, filled by open_load */ int frameCount; /* total frames in the file; can return -1 if unknown */ HV * fileProperties; /* specific file data */ void * instance; /* user instance */ /* user-specified data - applied to whole file */ Bool loadExtras; Bool loadAll; Bool noImageData; Bool iconUnmask; HV * extras; /* profile applied to all frames */ /* user-specified data - applied to every frame */ HV * profile; /* frame-specific profile, in */ HV * frameProperties; /* frame-specific properties, out */ int frame; /* request frame index */ Bool jointFrame; /* true, if last frame was a previous one */ Handle object; /* to be used by load */ /* internal variables */ int frameMapSize; int * frameMap; Bool stop; char * errbuf; /* $! value */ /* scanline event progress */ unsigned int eventDelay; /* in milliseconds */ struct timeval lastEventTime; int lastEventScanline; int lastCachedScanline; } ImgLoadFileInstance, *PImgLoadFileInstance; /* common data, request for a whole file save */ typedef struct _ImgSaveFileInstance { /* instance data, filled by core */ char * fileName; PImgIORequest req; Bool req_is_stdio; Bool append; /* true if append, false if rewrite */ /* instance data, filled by open_save */ void * instance; /* result of open, user data for save session */ HV * extras; /* profile applied to whole save session */ /* user-specified data - applied to every frame */ int frame; Handle object; /* to be used by save */ HV * objectExtras; /* extras supplied to image object */ /* internal variables */ int frameMapSize; Handle * frameMap; char * errbuf; /* $! value */ } ImgSaveFileInstance, *PImgSaveFileInstance; #define IMG_LOAD_FROM_FILE 0x0000001 #define IMG_LOAD_FROM_STREAM 0x0000002 #define IMG_LOAD_MULTIFRAME 0x0000004 #define IMG_SAVE_TO_FILE 0x0000010 #define IMG_SAVE_TO_STREAM 0x0000020 #define IMG_SAVE_MULTIFRAME 0x0000040 #define IMG_SAVE_APPEND 0x0000080 /* codec info */ typedef struct _ImgCodecInfo { char * name; /* DUFF codec */ char * vendor; /* Duff & Co. */ int versionMaj; /* 1 */ int versionMin; /* 0 */ char ** fileExtensions; /* duf, duff */ char * fileType; /* Dumb File Format */ char * fileShortType; /* DUFF */ char ** featuresSupported; /* duff-version 1, duff-rgb, duff-cmyk */ char * primaModule; /* Prima::ImgPlugins::duff.pm */ char * primaPackage; /* Prima::ImgPlugins::duff */ unsigned int IOFlags; /* IMG_XXX */ int * saveTypes; /* imMono, imBW ... 0 */ char ** loadOutput; /* hash keys reported by load */ } ImgCodecInfo, *PImgCodecInfo; struct ImgCodec; struct ImgCodecVMT; typedef struct ImgCodecVMT *PImgCodecVMT; typedef struct ImgCodec *PImgCodec; struct ImgCodec { struct ImgCodecVMT * vmt; PImgCodecInfo info; void *instance; void *initParam; }; struct ImgCodecVMT { int size; void * (* init) ( PImgCodecInfo * info, void * param); void (* done) ( PImgCodec instance); HV * (* load_defaults) ( PImgCodec instance); void (* load_check_in) ( PImgCodec instance, HV * system, HV * user); void * (* open_load) ( PImgCodec instance, PImgLoadFileInstance fi); Bool (* load) ( PImgCodec instance, PImgLoadFileInstance fi); void (* close_load) ( PImgCodec instance, PImgLoadFileInstance fi); HV * (* save_defaults) ( PImgCodec instance); void (* save_check_in) ( PImgCodec instance, HV * system, HV * user); void * (* open_save) ( PImgCodec instance, PImgSaveFileInstance fi); Bool (* save) ( PImgCodec instance, PImgSaveFileInstance fi); void (* close_save) ( PImgCodec instance, PImgSaveFileInstance fi); }; extern List imgCodecs; extern struct ImgCodecVMT CNullImgCodecVMT; extern char * imgPVEmptySet[]; extern int imgIVEmptySet[]; extern void apc_img_init(void); extern void apc_img_done(void); extern Bool apc_img_register( PImgCodecVMT codec, void * initParam); extern int apc_img_frame_count( char * fileName, PImgIORequest ioreq); extern PList apc_img_load( Handle self, char * fileName, PImgIORequest ioreq, HV * profile, char * error); extern int apc_img_save( Handle self, char * fileName, PImgIORequest ioreq, HV * profile, char * error); extern void apc_img_codecs( PList result); extern HV * apc_img_info2hash( PImgCodec c); extern void apc_img_profile_add( HV * to, HV * from, HV * keys); extern int apc_img_read_palette( PRGBColor palBuf, SV * palette, Bool triplets); /* event macros */ extern void apc_img_notify_header_ready( PImgLoadFileInstance fi); extern void apc_img_notify_scanlines_ready( PImgLoadFileInstance fi, int scanlines); #define EVENT_HEADER_READY(fi) \ if ( fi-> eventMask & IMG_EVENTS_HEADER_READY) \ apc_img_notify_header_ready((fi)) #define EVENT_SCANLINES_RESET(fi) \ (fi)-> lastEventScanline = (fi)-> lastCachedScanline = 0; \ gettimeofday( &(fi)-> lastEventTime, nil) #define EVENT_TOPDOWN_SCANLINES_READY(fi,scanlines) \ if ( (fi)-> eventMask & IMG_EVENTS_DATA_READY) \ apc_img_notify_scanlines_ready((fi),scanlines) #define EVENT_SCANLINES_FINISHED(fi) \ if ( (fi)-> eventMask & IMG_EVENTS_DATA_READY) {\ fi-> lastEventTime.tv_sec = fi-> lastEventTime.tv_usec = 0;\ apc_img_notify_scanlines_ready((fi),0); \ } #ifdef __cplusplus } #endif #endif Prima-1.28/Timer.cls0000644000175100017510000000364511150770061012065 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $id: Timer.cls,v 1.12 2002/01/10 20:42:32 dk Exp $ object Prima::Timer( Prima::Component) { property int timeout; method void cleanup(); method void done(); method Bool get_active(); method SV * get_handle(); c_only void handle_event ( PEvent event); method void init( HV * profile); import SV * notification_types(); import SV * profile_default (); method Bool start(); method void stop(); c_only void update_sys_handle( HV * profile); c_only Bool validate_owner( Handle * newOwner, HV * profile); } Prima-1.28/Makefile.PL0000644000175100017510000020460311150770061012251 0ustar dkdk#! /usr/bin/perl -w # # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Makefile.PL,v 1.221 2008/11/08 23:19:02 dk Exp $ # BEGIN { unshift @INC, '.'; }; my $END; END { print $END if defined $END; }; require 5.00502; use strict; use Config; my %Config = %Config::Config; # original %Config is read-only use File::Find; use File::Basename; use File::Path; use File::Copy; use Cwd; use DynaLoader; use Prima::Gencls; use ExtUtils::Packlist; use vars qw( %make_trans @ovvars @path_expand_ovvars $dir_sep $path_sep @no_compat ); use vars @ovvars = qw( $CC $CFLAGS $CCFLAGS $CCCDLFLAGS $CDLFLAGS $C_FLAGS $CDEBUGFLAGS $CDLFLAGS $COUTOFLAG $COUTEXEFLAG $CINCPATHFLAG $CDEFFLAG $COMPONLYFLAG $CLIBPATHFLAG $CLINKPREFIX $LD $LDFLAGS $LD_FLAGS $LDOUTFLAG $LDLIBPATHFLAG $LDLIBFLAG $LIB $LIBOFLAG $OBJ_EXT $LIB_EXT $LIB_PREFIX $EXE_EXT $DL_EXT $SCRIPT_EXT @INCPATH @LIBPATH $LIBS $INC $PLATFORM $COMPILER $PREFIX $X11BASE $INSTALLSCRIPT $INSTALLSITEARCH $INSTALL_BASE $INSTALL_LIB $INSTALL_DL $INSTALL_EXAMPLES $INSTALL_MAN3 $INSTALL_MAN1 $TMPDIR $NULLDEV $MAKE $RM $SHQUOTE $MAKETYPE $DEFFILE $DISTNAME $DL_LOAD_FLAGS $DEBUG $WITH_XFT $WITH_ICONV $WITH_GTK2 $AUTOMATED_RUN $CYGWIN_X11 ); use vars @path_expand_ovvars = qw( @INCPATH @LIBPATH $INC $LIBS $COMPILER $PREFIX $X11BASE $INSTALLSCRIPT $INSTALLSITEARCH $INSTALL_BASE $INSTALL_LIB $INSTALL_DL $INSTALL_EXAMPLES $INSTALL_MAN3 $INSTALL_MAN1 $TMPDIR $MAKE $RM $DEFFILE ); @no_compat = qw( SITELIBEXP INSTALLDIRS PERLPREFIX SITEPREFIX VENDORPREFIX INST_ARCHLIB INSTALLARCHLIB INSTALLVENDORARCH INST_LIB INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB INST_BIN INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INST_SCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT INST_MAN1DIR INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR INST_MAN3DIR INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR ); use vars qw( $CWD $Win32 $cygwin $NeedX11 $OS2 $OS2DLLF $useGC %cc_specs @LIBS %DEFINES %PASSIVE_CODECS @ACTIVE_CODECS %USER_VARS %USER_VARS_ADDONS %USER_VARS_LINKS %USER_DEFINES %USER_DEFINES_ADDONS %overrideable $ARGV_STR @alltml @alltmldeps @allclean @allrealclean @allojects %alldeps @allinstall @allbins @alldirs @allman @headers @footers @Makefile_deps $PrimaLib $PrimaTarget @Prima_exports $extralibs @executables $install_manuals $packlist %cache_find_files $binary_prereq $win32_use_dlltool ); my $see_makefile_log = "(see also makefile.log for details)"; sub print_config { foreach my $var ( sort keys %Config) { print "$var='", $Config{ $var} || '', "'\n"; } } sub qd { my ( $path_str) = @_; $path_str =~ s[/][$dir_sep]g; return $path_str; } sub quoted_split { my @neww = (); my $text = shift; while ($text =~ m< "((?:[^\"\\]*\\.[^\"\\]*)*)"\s* | (\S+)\s* | \s+ >gx) { if ( defined $1) { push @neww, $1; } elsif ( defined $2) { push @neww, $2; } } return @neww; } sub fatal { open ERRLOG, ">". qd "$CWD/makefile.log"; print ERRLOG @_; close ERRLOG; die @_; } sub quotemake { return join '', map { $make_trans{ $MAKETYPE}->[ ord]} split //, $_[ 0]; } sub tempfile { my $mask = shift; my $name; my $n = 0; do { $name = sprintf $mask, $n++; } while ( -e $name); return $name; } sub cc_command_line { my ( $srcf, $objf, $exef, $compile_only, $dl) = @_; my @cc = ( $CC, split(' ', $CFLAGS), split(' ', $CCFLAGS)); push @cc, split ' ', $CCCDLFLAGS if $dl; push @cc, split ' ', $CDLFLAGS if $dl && !$compile_only; push @cc, $COMPONLYFLAG if $compile_only; push @cc, map( { "$CINCPATHFLAG$_"} @INCPATH); # for ( keys %DEFINES) { # next unless $DEFINES{$_}; # push @cc, "$CDEFFLAG$_=$DEFINES{$_}"; # } push @cc, "${ CDEFFLAG}HAVE_CONFIG_H=1"; push @cc, ( $compile_only ? "$COUTOFLAG$objf" : "$COUTEXEFLAG$exef"); push @cc, "$COUTOFLAG$objf" if $COMPILER =~ /^(msvc|bcc32)$/ && !$compile_only; push @cc, map { "$CLIBPATHFLAG$_"} @LIBPATH unless $compile_only || ( $COMPILER eq 'msvc'); push @cc, $srcf; return @cc if $compile_only; push @cc, $CLINKPREFIX; push @cc, map { "\"$CLIBPATHFLAG\\\"$_\\\"\"" } @LIBPATH if $COMPILER eq 'msvc'; push @cc, map { "$LDLIBFLAG$_"} @LIBS; return @cc; } sub ld_command_line { my ( $dstf) = shift; my @ld = ( $LD, split( ' ', $LDFLAGS)); if ( $COMPILER eq 'bcc32') { push @ld, '-L"' . join( ';', @LIBPATH) . '" c0d32.obj '; push @ld, @_; push @ld, ",", $dstf, ", ,", @LIBS, ",", "win32\\Prima.def,"; } else { push @ld, map { m/\s/ ? "$SHQUOTE$LDLIBPATHFLAG$_$SHQUOTE" : "$LDLIBPATHFLAG$_" } @LIBPATH; push @ld, map { "-Wl,-R$_" } @LIBPATH if $^O =~ /netbsd/; push @ld, "$LDOUTFLAG$dstf", @_; push @ld, map { "$LDLIBFLAG$_"} @LIBS; push @ld, "os2\\Prima.def" if $OS2; if ( $Win32) { push @ld, "/def:win32\\Prima.def" if $COMPILER eq 'msvc'; push @ld, "win32/Prima.def" if $COMPILER eq 'gcc'; } } return @ld; } sub null_output { open OLDSTDOUT, ">&STDOUT" or die "STDOUT dup failed: $!"; open OLDSTDERR, ">&STDERR" or die "STDERR dup failed: $!"; # $NULLDEV = ( $Win32 || $OS2) ? "CON" : "/dev/tty"; # $NULLDEV = ( $Win32 || $OS2) ? "NUL" : "/dev/null"; if ( $^O !~ /linux/) { close STDOUT; close STDERR; } open STDOUT, ">>$NULLDEV" or fatal "STDOUT redirect failed: $!"; open STDERR, ">&STDOUT" or fatal "STDERR redirect failed: $!"; } sub restore_output { if ( $^O !~ /linux/) { close STDOUT; close STDERR; } open STDOUT, ">&OLDSTDOUT" or fatal "STDOUT restoration failed: $!"; open STDERR, ">&OLDSTDERR" or fatal "STDERR restoration failed: $!"; close OLDSTDOUT; close OLDSTDERR; } sub compile { my ( $text, $compile_only, @extra) = @_; my $tmpsrc = qd( tempfile( "$TMPDIR/pmts%04d.c")); my $tmpo = qd( tempfile( "$TMPDIR/pmts%04d$OBJ_EXT")); my $tmpexe = qd( tempfile( "$TMPDIR/pmts%04d$EXE_EXT")); my @tmpextras = ( $tmpsrc, $tmpsrc); $tmpextras[0] =~ s/\.[^\.+]$/.ilk/; $tmpextras[1] =~ s/\.[^\.+]$/.pdb/; open TMPSRC, ">$tmpsrc" or die "Creation of temporary file $tmpsrc failed $see_makefile_log"; print TMPSRC $text; close TMPSRC; null_output; my @cc = grep !/^-W(all|error|\d)/i, cc_command_line( $tmpsrc, $tmpo, $tmpexe, $compile_only || 0); push @cc, @extra; print STDERR "@cc\n"; my $rc = system("@cc"); restore_output; unlink $tmpsrc; unlink $tmpo if -w $tmpo; unlink $tmpexe if -w $tmpexe; unlink $_ for @tmpextras; return( $rc == 0); } sub have_header { my $header = shift; (my $defname = "HAVE_" . uc $header) =~ s/\W/_/g; return $DEFINES{$defname} if exists $DEFINES{$defname}; my @pre_headers = map { "#include <$_>\n" } @_; print "Checking for presence of $header... "; my $present = compile( < EOF $DEFINES{ $defname} = undef; $DEFINES{ $defname} = 1 if $present; print( $present ? "yes" : "no", "\n"); return $present; } sub find_header { my $header = shift; my $options = ref($_[0]) eq 'HASH' ? shift : {}; my ( $incpath, $present); foreach $incpath ( @_) { local @INCPATH = @INCPATH; push @INCPATH, $incpath if $incpath; my $code = $options->{Code} || < EOF $present = compile( $code, 1); return $incpath if $present; } return undef; } sub find_lib { my ( $lib, $inc) = ( shift, shift ); my ( $libpath, $present); if ( $OS2 && !length $inc) { # link386 is broken - warns, not dies if no library found if ( -f $lib) { $lib =~ s/(\\|\/[^\\|\/]*)$//g; return $lib; } for ( @LIBPATH) { return $_ if -f "$_/$lib"; return $_ if -f "$_/$lib.lib"; return $_ if -f "$_/$lib.a"; } return undef; } local @LIBS = @LIBS; push @LIBS, $lib; foreach $libpath ( @_) { local @LIBPATH = (@LIBPATH, $libpath) if $libpath; $present = compile( <\n"} @headers; $defname =~ s/\W/_/g; print "Checking for function $funcname... "; my $rc = compile( <$tmpsrc" or die "Creation of temporary file $tmpsrc failed $see_makefile_log"; print TMPSRC <\n"} @headers; my $rc = compile( <{ src}}) { eval "\$$varname = sprintf \"$USER_VARS_LINKS{ $varname}->{ format}\", \$$USER_VARS_LINKS{ $varname}->{ src}"; } else { eval "\$$varname = join( '', \@_)"; } die $@ if $@; if ( defined $USER_VARS_ADDONS{ $varname}) { eval "\$$varname .= join( '', \@{ \$USER_VARS_ADDONS{ \$varname}})"; } die $@ if $@; } elsif ( $overrideable{ $varname} eq '@') { if ( defined $USER_VARS{ $varname}) { eval "\@$varname = \@{\$USER_VARS{ \$varname}}"; } else { eval "\@$varname = \@_"; } die $@ if $@; if ( defined $USER_VARS_ADDONS{ $varname}) { eval "push \@$varname, \@{ \$USER_VARS_ADDONS{ \$varname}}"; } die $@ if $@; } else { die "Unsupported type of variable"; } } sub env_true { my ( $var) = @_; return( $ENV{ $var} && $ENV{ $var} =~ /^1|yes|on|true$/i); } sub suck_symbols { my $fn = shift; open F, $fn or die "Cannot open $fn:$!\n"; local $/; my $x = ; close F; return ( $x =~ m/\bextern\s+\w+(?:\s*\*\s*)?\s+(\w+)\s*\(.*?;/gs ); } sub setup_variables { setvar( 'CYGWIN_X11', 0); $Win32 = 0 if $CYGWIN_X11; my $platform; $NeedX11 = 0; if ( $Win32) { $platform = 'win32'; } elsif ( $OS2) { $platform = 'os2'; } else { $platform = 'unix'; $NeedX11 = 1; } setvar( 'PLATFORM', $platform); %cc_specs = ( cc => { warnflags => "", cflags => "", coutoflag => '-o ', coutexeflag => '-o ', cdebugflags => '-g -O', clinkprefix => '', clibpathflag => '-L', ldflags => '', ldoutflag => '-o ', ldlibpathflag => '-L', ldlibflag => '-l', ldlibext => '', lddebugflags => '-g', name => "CC", lib => '', liboflag => '', }, gcc => { warnflags => "", cflags => "", coutoflag => '-o ', coutexeflag => '-o ', cdebugflags => '-g -O -Wall', clinkprefix => '', clibpathflag => '-L', ldflags => '', ldoutflag => '-o ', ldlibpathflag => '-L', ldlibflag => '-l', ldlibext => '', lddebugflags => '-g', name => "GNU", lib => '', liboflag => '', }, hpcc => { warnflags => "", #"+w1", cflags => "-Ae", coutoflag => '-o ', coutexeflag => '-o ', cdebugflags => '-g +O2 +Onolimit', clinkprefix => '', clibpathflag => '-L', ldflags => '', ldoutflag => '-o ', ldlibpathflag => '-L', ldlibflag => '-l', ldlibext => '', lddebugflags => '-g', name => "HP-UX C-ANSI-C", lib => '', liboflag => '', }, irixcc => { warnflags => "-fullwarn", cflags => "-diag_error 1035 -woff 1011,1042,1048,1140,1164,1174,1209,1506,1515,1552", coutoflag => '-o', coutexeflag => '-o', cdebugflags => '-g -O0', clinkprefix => '', clibpathflag => '-L', ldflags => '', ldoutflag => '-o', ldlibpathflag => '-L', ldlibflag => '-l', ldlibext => '', lddebugflags => '-g', name => "IRIX Native", lib => '', liboflag => '', }, emx => { warnflags => "-Wall", cflags => "", coutoflag => '-o', coutexeflag => '-o', cdebugflags => '-g -O', clinkprefix => '', clibpathflag => '-L', ldflags => '', ldoutflag => '-o', ldlibpathflag => '-L', ldlibflag => '-l', ldlibext => '', lddebugflags => '-g', lib => 'emxomf', liboflag => '-o', name => "EMX", }, msvc => { warnflags => "-W3 -WX", cflags => "-nologo", coutoflag => '-Fo', coutexeflag => '-Fe', clinkprefix => '/link', clibpathflag => '/LIBPATH:', cdebugflags => '-Zi', ldflags => '', ldoutflag => '/OUT:', ldlibpathflag => '/LIBPATH:', ldlibflag => '', ldlibext => '.lib', lddebugflags => '/DEBUG', name => "Microsoft Visual C++", lib => 'lib', liboflag => '-out:', }, bcc32 => { warnflags => "-w0", # Borland is the only compiler which doesn't allow of geting rid of warnings. cflags => "-tWM", coutoflag => '-o', coutexeflag => '-e', clinkprefix => '', clibpathflag => '-L', cdebugflags => '-v -y', ldflags => '', ldoutflag => '', ldlibpathflag => '-L', ldlibflag => '', ldlibext => '', lddebugflags => '-v', lib => '', liboflag => '', name => "Borland C++", }, ); setvar( 'TMPDIR', $ENV{ TMPDIR} || $ENV{ TEMPDIR} || ( $Win32 ? ( $ENV{ TEMP} || "$ENV{ SystemDrive}\\TEMP") : "/tmp")); setvar( 'NULLDEV', "$CWD/makefile.log"); setvar( 'DL_LOAD_FLAGS', ( $Win32 || $OS2) ? 0 : -1); setvar( 'SHQUOTE', $Win32 ? '"' : "'"); setvar( 'CC', $Config{ cc}); print "Determining compiler type... "; # setting preliminary $COMPILER so have_define() can run if ( $Win32) { $COMPILER = ( $CC =~ /cl(\.exe)?$/i ) ? 'msvc' : $CC; } else { $COMPILER = $CC; } if ( defined $USER_VARS{ COMPILER}) { $COMPILER = $USER_VARS{ COMPILER}; die "Compiler type $COMPILER is unknown" unless defined $cc_specs{ $COMPILER}; } elsif ( $^O =~ /irix/ && $CC =~ /^(\S*\/)?cc\b/) { # this code should be put first, as cc call does not treat #error as error, # and have_define() is therefore always true $COMPILER = 'irixcc'; } elsif ( $^O eq "hpux" && $CC =~ /^(\S*\/)?cc\b/) { # this code should be put first, as cc call does not treat #error as error, # and have_define() is therefore always true $COMPILER = 'hpcc'; } elsif ( have_define( "__EMX__")) { $COMPILER = 'emx'; } elsif ( have_define( "__GNUC__")) { $COMPILER = 'gcc'; } elsif ( have_define( "__BORLANDC__")) { $COMPILER = 'bcc32'; } elsif ( have_define( "_MSC_VER")) { $COMPILER = 'msvc'; } elsif ( $CC =~ /^(\S*\/)?cc\b/ ) { $COMPILER = 'cc'; } else { print "($CC is unknown, assuming COMPILER=cc) "; $COMPILER = 'cc'; } print "$cc_specs{ $COMPILER}->{ name}\n"; $win32_use_dlltool = $Win32 && ( $COMPILER eq 'gcc') && !$cygwin; # 5.8.0 hack $Config{PATCHLEVEL} = $Config{PERL_PATCHLEVEL} if !defined $Config{PATCHLEVEL} || !length $Config{PATCHLEVEL}; $Config{SUBVERSION} = $Config{PERL_SUBVERSION} if !defined $Config{SUBVERSION} || !length $Config{SUBVERSION}; # Checking some Config.pm - were empty for ActiveState 626 $Config{PATCHLEVEL} = $Config{patchlevel} if !defined $Config{PATCHLEVEL} || !length $Config{PATCHLEVEL}; $Config{SUBVERSION} = $Config{subversion} if !defined $Config{SUBVERSION} || !length $Config{SUBVERSION}; $Config{ld} = (($COMPILER eq 'msvc') ? 'link' : 'ld'), print("** warning: malformed Config.pm\n") unless length $Config{ld}; my $ccflags = $Config{ ccflags}; my $warnflags = $cc_specs{ $COMPILER}->{ warnflags}; # my $ldflags = $COMPILER eq 'emx' ? "" : "$Config{ ldflags} "; my $ldflags = ""; my $lddlflags = $Config{ lddlflags}; setvar( 'DEBUG', defined($ENV{ PRIMA_DEVEL}) ? $ENV{ PRIMA_DEVEL} : 0); if ( $COMPILER eq 'msvc' && (( $ccflags =~ /TP/) || ($ccflags =~ /O\d/))) { # M$VC++ protection $warnflags =~ s/W3/W1/; # lower warning level $ccflags =~ s/\-W3/\-W1/; # lower warning level $warnflags =~ s/(-|\/)WX//; # and dismiss 'warnings as errors'; ( for its stupidity in the c++ case) $ldflags =~ s/(-|\/)nodefaultlib//g; $lddlflags =~ s/(-|\/)nodefaultlib//g; $ccflags =~ s/(-|\/)O\d//g if $DEBUG; # remove optimization } setvar( 'C_FLAGS', "$ccflags $warnflags $cc_specs{ $COMPILER}->{ cflags} " . ( $Config{ optimize} || '') . " "); setvar( 'CFLAGS', "$ccflags $warnflags $cc_specs{ $COMPILER}->{ cflags}" . ( $DEBUG ? " $cc_specs{ $COMPILER}->{ cdebugflags}" : " " . ( $Config{ optimize} || '')) . " "); setvar( 'CCFLAGS', ''); if ( $COMPILER eq 'gcc' && $Config{ cccdlflags} =~ /-K\S/) { # remove known proprietary compiler junk flags $Config{ cccdlflags} =~ s/-K\S*//; } setvar( 'CCCDLFLAGS', $Config{ cccdlflags}); setvar( 'CDLFLAGS', $Config{ ccdlflags}); setvar( 'COUTOFLAG', $cc_specs{ $COMPILER}->{ coutoflag}); setvar( 'COUTEXEFLAG', $cc_specs{ $COMPILER}->{ coutexeflag}); setvar( 'CINCPATHFLAG', '-I'); setvar( 'CDEFFLAG', '-D'); setvar( 'COMPONLYFLAG', '-c'); setvar( 'CLINKPREFIX', $cc_specs{ $COMPILER}->{ clinkprefix}); setvar( 'CLIBPATHFLAG', $cc_specs{ $COMPILER}->{ clibpathflag}); setvar( 'LD', $Config{ ld}); setvar( 'LD_FLAGS', "$ldflags $lddlflags $cc_specs{ $COMPILER}->{ ldflags} "); setvar( 'LDFLAGS', "$ldflags $lddlflags $cc_specs{ $COMPILER}->{ ldflags}" . ( $DEBUG ? " $cc_specs{ $COMPILER}->{ lddebugflags}" : "") . " "); setvar( 'LDOUTFLAG', $cc_specs{ $COMPILER}->{ ldoutflag}); setvar( 'LDLIBPATHFLAG', $cc_specs{ $COMPILER}->{ ldlibpathflag}); setvar( 'LDLIBFLAG', $cc_specs{ $COMPILER}->{ ldlibflag}); setvar( 'OBJ_EXT', $Config{ _o}); setvar( 'LIB_EXT', ( $cygwin ? '.dll' : '') . $Config{ _a}); setvar( 'LIB_PREFIX', $cygwin ? 'lib' : ''); setvar( 'EXE_EXT', $Config{ _exe}); setvar( 'LIB', $cc_specs{ $COMPILER}->{ lib}); setvar( 'LIBOFLAG', $cc_specs{ $COMPILER}->{ liboflag}); setvar( 'SCRIPT_EXT', (( $Win32 && !$cygwin) ? '.bat' : ( $OS2 ? '.cmd' : ''))); setvar( 'DL_EXT', "." . $Config{ dlext}); setvar( 'INC', ''); # compat mode INC setvar( 'INCPATH', ( "include", qd( "include/generic"), $Config{installarchlib} . qd( "/CORE"), ( map { s/-I//; $_ } split ' ', $INC) )); my @libpaths = quoted_split( $Config{ libpth}); push( @libpaths, '/usr/local/lib') if $platform eq 'unix'; # or perl makefile.pl LIBPATH+=/usr/local/lib setvar( 'LIBPATH', @libpaths); my @libs = map { s/^$LDLIBFLAG//; $_} quoted_split($Config{ libs}); # compat mode LIBS setvar( 'LIBS', ''); for ( split ' ', $LIBS) { if ( /^-l(.*)/) { push @libs, $1; } elsif ( /^-L(.*)/) { push @LIBPATH, $1; } else { $LDFLAGS .= " $_"; } } # push ( @libs, 'pmprintf') if $OS2 && defined $ENV{PRIMA_PMPRINTF}; if ( $useGC) { push @libs, 'leak'; } if ( $COMPILER eq 'gcc') { push @libs, 'gcc'; } my @flibs; if ( $Win32 && $COMPILER eq 'gcc') { $Config{libperl} =~ s/^lib(.*)\.a$/$1/i; push @libs, qw(gdi32 mpr winspool comdlg32); # add more when appropriate } if ( $CYGWIN_X11) { $Config{libperl} =~ s/^lib(.*)\.a$/$1/i; } open F, 'Prima.pm' or die "Cannot open Prima.pm:$!\n"; my ($ver1, $ver2); while () { next unless m/\$VERSION[^\.\d]*(\d+)\.(\d+)/; $ver1 = $1, $ver2 = $2, last; } close F; die "Cannot find VERSION string in Prima.pm\n" unless defined $ver1; print "Version: $ver1.$ver2\n"; setvar( 'DISTNAME', "Prima-$ver1.$ver2"); # here starts lot of execs... setup_compiler(); for my $lib (@libs) { print "Checking for library $lib... "; my $path = find_lib($lib, '', ''); if ( defined $path) { push @flibs, $lib; print "yes"; print ", in $path" if length($path); print "\n"; } else { print "no\n"; $END .= "*** Warning (probably harmless): `$lib' library not found\n"; } } @LIBS = @flibs; %DEFINES = ( PRIMA_VERSION => $ver1, PRIMA_SUBVERSION => $ver2, PERL_PATCHLEVEL => $Config{ PATCHLEVEL}, PERL_SUBVERSION => $Config{ SUBVERSION}, PRIMA_CORE => 1, PERL_POLLUTE => 1, PRIMA_DEBUG => $DEBUG, ); $DEFINES{PRIMA_PLATFORM} = $OS2 ? 1 : ( $Win32 ? 2 : 3); if ( env_true( 'PRIMA_PARANOID_MALLOC')) { $DEFINES{ PARANOID_MALLOC} = 1; } if ( $useGC) { $DEFINES{ USE_GC} = 1; } while ( $CFLAGS =~ s/-D(\w+)(?:=(\S+))?\s*//) { my ( $defname, $defvalue) = ( $1, $2 || 1); $DEFINES{ $defname} = $defvalue; } while ( $CCFLAGS =~ s/-D(\w+)(?:=(\S+))?\s*//) { my ( $defname, $defvalue) = ( $1, $2 || 1); $DEFINES{ $defname} = $defvalue; } if ( $COMPILER eq 'msvc') { $DEFINES{_CRT_SECURE_NO_DEPRECATE} = 1; # to be invoked on command line $CFLAGS .= " -D_CRT_SECURE_NO_DEPRECATE"; } # find common denominator with installsitearch and installscript my @a = split( '\\\\|\/', $Config{installscript}); my @b = split( '\\\\|\/', $Config{installsitearch}); my $i = 0; while ( defined $a[$i] && defined $b[$i]) { last if $a[$i] ne $b[$i]; $i++; } my $prefix = qd(($i ? join( '/', @a[0..$i-1]) : '')); $USER_VARS{PREFIX} ||= $USER_VARS{INSTALL_BASE} if exists $USER_VARS{INSTALL_BASE}; setvar( 'PREFIX', $prefix); setvar( 'INSTALLSCRIPT', $PREFIX . qd( '/' . join( '/', @a[$i .. $#a]))); setvar( 'INSTALLSITEARCH', $PREFIX . qd( '/' . join( '/', @b[$i .. $#b]))); setvar( 'INSTALL_LIB', $INSTALLSITEARCH . qd( "/Prima")); setvar( 'INSTALL_DL', $INSTALLSITEARCH . qd( "/auto/Prima")); setvar( 'INSTALL_EXAMPLES', $INSTALLSITEARCH . qd( "/Prima/examples")); if ( exists $USER_VARS{PREFIX}) { setvar( 'INSTALL_MAN1', $INSTALLSITEARCH . qd( "/man/man1")); setvar( 'INSTALL_MAN3', $INSTALLSITEARCH . qd( "/man/man3")); } else { setvar( 'INSTALL_MAN1', $Config{installman1dir}); setvar( 'INSTALL_MAN3', $Config{installman3dir}); } setvar( 'X11BASE'); setvar( 'MAKETYPE', lc ( $MAKE = $Config{ make})); # Note that Borland's make utility also named 'make'. But its # usage is deprecated, thus we can ignore it. # # In Linux GNU make also has name 'make'. But Makefile been # generated by this script is compatible with it. If it named # 'gmake' then we force $MAKETYPE to contain 'make'. $MAKETYPE = 'make' if $MAKETYPE =~ /^gmake|pmake$/; die "Unknown make utility" unless $MAKETYPE =~ /^make|nmake|dmake$/; setvar( 'RM', $Config{ rm}); $OS2DLLF = 'Prima'; $OS2DLLF = &DynaLoader::mod2fname([$OS2DLLF]) if $OS2 && defined &DynaLoader::mod2fname; $PrimaLib = qd( "auto/Prima/${LIB_PREFIX}Prima$LIB_EXT"); $PrimaTarget = qd( "auto/Prima/$OS2DLLF$DL_EXT"); $extralibs = ''; $extralibs = qd("auto/Prima/Prima.lib") if $OS2; setvar( 'DEFFILE', $Win32 ? qd( "win32/Prima.def") : ( $OS2 ? qd( "os2/Prima.def") : '')); setvar( 'AUTOMATED_RUN', 0); @executables = qw( Prima/VB/VB.pl Prima/VB/cfgmaint.pl ); my $unix = (!$Win32 && !$OS2); setvar('WITH_ICONV', $unix); setvar('WITH_XFT', $unix); setvar('WITH_GTK2', $unix); $install_manuals = $cygwin || (!$Win32 && !$OS2); $install_manuals = 0 if !length( $INSTALL_MAN1) || !length($INSTALL_MAN3); $binary_prereq = ''; @Prima_exports = qw( boot_Prima build_dynamic_vmt build_static_vmt call_perl call_perl_indirect clean_perl_call_method clean_perl_call_pv create_mate create_object ctx_remap_def cv_call_perl debug_write duplicate_string eval gimme_the_mate gimme_the_vmt kind_of kill_zombies notify_perl Object_create Object_destroy parse_hv plist_create plist_destroy prima_mallocz pop_hv_for_REDEFINED protect_object push_hv push_hv_for_REDEFINED query_method sv_call_perl sv_query_method unprotect_object perl_error ); push @Prima_exports, grep { /^(apc|list|prima)/ } suck_symbols('include/apricot.h'); push @Prima_exports, suck_symbols('include/img.h'); push @Prima_exports, suck_symbols('include/img_conv.h'); my %g = map { $_ => 1 } @Prima_exports; delete @g{qw(prima_utf8_to_uv prima_uv_to_utf8)}; @Prima_exports = sort keys %g; } sub setup_compiler { print "Checking if can compile... "; compile('int a;', 1) or die "no $see_makefile_log\n"; print "yes\n"; print "Checking if can link... "; compile( < < 1 } @INCPATH; push @INCPATH, $_ for grep { not exists $inc{$_}} $inc =~ /-I(\S+)/g; my $lib = `pkg-config --libs-only-l gtk+-2.0`; chomp $lib; my %lib = map { $_ => 1 } @LIBS; push @LIBS, $_ for grep { not exists $lib{$_}} $lib =~ /-l(\S+)/g; # now, try to compile with GTK. I've got lots of CPAN build failures # because GTK wasn't willing to compile or god knows what. print "Checking if can compile and link with gtk2... "; my $ok = compile( "#include \nint main() { return 0; }\n"); if ( $ok) { $DEFINES{WITH_GTK2} = 1; print "yes\n"; } else { $WITH_GTK2 = 0; @LIBS = @savelib; @INCPATH = @saveinc; print "no\n"; } } } print "Using Xft library\n" if $WITH_XFT; print "Using iconv library\n" if $WITH_ICONV; print "Using gtk2 library\n" if $WITH_GTK2; } sub generate_win32_def { open PRIMADEF, ">$DEFFILE" or die "Cannot create $DEFFILE: $!"; print PRIMADEF <$DEFFILE" or die "Cannot create $DEFFILE: $!"; print PRIMADEF < 1 } @LIBS; my @codecs; my @builtin_codecs; while ( ) { if ( m/prigraph/) { unshift @codecs, $_; # put it first } elsif ( m/codec_(bmp)/) { push @builtin_codecs, $1; } else { push @codecs, $_; } } my @codec_libpath = qd( $Config{installsitearch}); my @warn_codecs; for my $cx ( @codecs) { my @inc; my $foundlib; $cx =~ m/codec_(.*)\.c$/i; my ( $fn, $lib, $codec) = ( $cx, $1, $1); next unless open F, $fn; while() { push @inc, $_ if m/^\s*#include\s*\[ ord] = "^$_"; } $nmake_tbl->[ ord '%'] = '%%'; $nmake_tbl->[ ord '$'] = $make_tbl->[ ord '$'] = '$$'; $dmake_tbl->[ ord '#'] = '\\#'; $make_tbl->[ ord '#'] = '\\#'; %make_trans = ( make => $make_tbl, nmake => $nmake_tbl, dmake => $dmake_tbl, ); generate_win32_def if $Win32; generate_os2_def if $OS2; # check if we need dl_load_flags(0x01) if ( $DL_LOAD_FLAGS < 0) { print "Determining dl_load_flags... "; my $c1 = qd( tempfile( "$TMPDIR/pmts%04d.c")); $c1 =~ m/pmts([^\.]*).c$/; my ( $n1, $n2) = ( $1, sprintf("%04d", 1 + $1)); my $o1 = qd( "$TMPDIR/pmts$n1$OBJ_EXT"); my $o2 = qd( "$TMPDIR/pmts$n2$OBJ_EXT"); my $dl1 = qd( "$TMPDIR/pmts$n1$DL_EXT"); my $dl2 = qd( "$TMPDIR/pmts$n2$DL_EXT"); my @ex = map { qd("$TMPDIR/pmts$_")} map { ("$n1$_", "$n2$_") } ('.ilk', '.pdb'); open TMPSRC, ">$c1" or die "Creation of temporary file $c1 failed"; print TMPSRC < #include #include int test( void ) { return 1; } XS(boot_pmts$n1) { dXSARGS; XSRETURN(1); } D close TMPSRC; my $c2 = qd( tempfile( "$TMPDIR/pmts%04d.c")); open TMPSRC, ">$c2" or die "Creation of temporary file $c2 failed"; print TMPSRC < #include #include extern int test ( void ); XS(boot_pmts$n2) { dXSARGS; test(); XSRETURN(1); } D close TMPSRC; my @cc1 = grep !/^-W(all|error|\d)/i, cc_command_line( $c1, $o1, $dl1, 1, 1); my @cc2 = grep !/^-W(all|error|\d)/i, cc_command_line( $c2, $o2, $dl2, 1, 1); my @ld1 = ld_command_line( $dl1, $o1); my @ld2 = ld_command_line( $dl2, $o2); my $dlpl = "$^X -e '" . (join ' ', split("\n", < new(); } sub process_commandline { %overrideable = map { /^(.)(.*)$/; $2 => $1} @ovvars; # Script variables which may be overridden. my %expand = map { /^.(.*)$/; $1 => 1 } @path_expand_ovvars; my %no_compat = map { $_ => 1 } @no_compat; $ARGV_STR = join( " ", map { "\"$_\""} @ARGV); foreach my $arg ( @ARGV) { if ( $arg =~ /^\s*(\w+)\s*(\+?)\=(.*)$/) { my ( $varname, $setmode, $varval) = ( $1, $2 || '', $3); if ( $no_compat{ $varname}) { print "Variable $varname is not supported. Expect wrong behavior\n"; next; } die "Unknown variable $varname" unless $overrideable{ $varname}; $varval =~ s/~/$ENV{HOME}/g if $expand{ $varname}; if ( $overrideable{ $varname} eq '$') { if ( $setmode eq '+') { push @{ $USER_VARS_ADDONS{ $varname}}, $varval; } else { $USER_VARS{ $varname} = $varval; } die $@ if $@; } elsif ( $overrideable{ $varname} eq '@') { my @values = split /$path_sep/, $varval; if ( $expand{ $varname}) { s/~/$ENV{HOME}/g for @values; } if ( $setmode eq '+') { push @{ $USER_VARS_ADDONS{ $varname}}, @values; } else { $USER_VARS{ $varname} = \@values; } die $@ if $@; } } elsif ( $arg =~ /^-(D|U)(\w+)(?:(\+?)=(.*))?$/) { my ( $defmode, $defname, $setmode, $value) = ( $1, $2, $3 || '', $4 || ''); if ( $defmode eq 'U') { $USER_DEFINES{ $defname} = undef; # I.e. it will exists in the hash... } else { if ( $setmode eq '+') { push @{ $USER_DEFINES_ADDONS{ $defname}}, $value; } else { $USER_DEFINES{ $defname} = $value; } } } else { die "Unknown command line argument or wrong syntax: '$arg'"; } } } sub _find_file { my ( $fname, $dir) = @_; my ( $pathname, $found); $pathname = qd( "$dir/$fname"); return $pathname if -e $pathname; opendir D, $dir or die "Cannot open dir $dir: $!"; my @entries = map { qd( "$dir/$_")} grep { /^[^.]/ && -d qd( "$dir/$_")} readdir D; closedir D; foreach my $entry ( @entries) { $pathname = _find_file( $fname, $entry); next unless defined $pathname; return $pathname; } return undef; } sub find_file { my ( $fname) = @_; $fname =~ s/\\/\//g; $fname = qd($fname); return $cache_find_files{$fname} if exists $cache_find_files{$fname}; return $cache_find_files{$fname} = _find_file( $fname, '.'); } sub canon_name { my ( $fname) = @_; my $qdirsep = quotemeta( $dir_sep); $fname =~ s{[^$qdirsep]+$qdirsep\.\.(?:$qdirsep|\Z)}{} while $fname =~ /(?:$qdirsep|\A)\.\.(?:$qdirsep|\Z)/; $fname =~ s{(?:(?<=$qdirsep)|(?<=\A))\.(?=$qdirsep|\Z)$qdirsep?}{}g; return $fname; } sub find_cdeps { my ( $cfile, $deps, $included) = @_; $deps ||= {}; $included ||= {}; return () if exists $deps->{ $cfile}; $deps->{ $cfile} = []; return @{ $alldeps{ $cfile}} if exists $alldeps{ $cfile}; $alldeps{ $cfile} = []; return () unless -f $cfile; local *CF; open CF, "<$cfile" or die "Cannot open $cfile: $!"; while ( ) { chomp; next unless /^\s*\#\s*include\s+"([^\"]+)"/; my $incfile = $1; my $i = find_file( $incfile); $incfile = defined($i) ? $i : qd( "include/generic/$incfile"); $incfile = canon_name( $incfile); unless ( exists $included->{ $incfile}) { push @{ $alldeps{ $cfile}}, $incfile; push @{ $deps->{ $cfile}}, $incfile; $included->{ $incfile} = 1; } my @subdeps = find_cdeps( $incfile, $deps, $included); push @{ $deps->{ $cfile}}, @subdeps; push @{ $alldeps{ $cfile}}, @subdeps; } close CF; return @{ $deps->{ $cfile}}; } sub cmake { my ( $cfile) = @_; print "Finding dependencies for $cfile...\n"; my $ofile = "$1$OBJ_EXT" if $cfile =~ /^(.*)\.c$/; die "Internal error: illegal c file" unless defined $ofile; $cfile = qd( $cfile); $ofile = qd( $ofile); push @allclean, $ofile; push @allojects, $ofile; my @deps = find_cdeps( $cfile); return( "$ofile: Makefile $cfile @deps\n\t" . join( " ", cc_command_line( $cfile, $ofile, "", 1, 1)) . "\n\n" ); } sub clsmake { my ( $clsfile) = @_; print "Finding dependencies for $clsfile..."; my $classname = $1 if $clsfile =~ /^(.*)\.cls$/; die "Internal error: illegal cls file" unless defined $classname; my $mk = qd( "include/generic/$classname.h") . ": Makefile " . "$clsfile " . qd( "utils/gencls.pl ") . qd( "Prima/Gencls.pm "); push @alltml, qd( "include/generic/$classname.tml"); push @alltmldeps, qd( "include/generic/$classname.h"); push @allclean, ( qd( "include/generic/$classname.h"), qd( "include/generic/$classname.inc"), qd( "include/generic/$classname.tml") ); push @allinstall, qd( "include/generic/$classname.h"), $INSTALL_LIB . qd( "/CORE/generic"); my @ancestors = gencls( $clsfile, depend => 1); $mk .= qd( "include/generic/$_.h $_.cls ") foreach @ancestors; print "\n"; $mk .= "\n\t$^X -I. utils/gencls.pl --inc --h --tml $clsfile include/generic\n\n"; } sub qqd { my ( $path_str) = @_; $path_str =~ s[/][$dir_sep]g; $path_str =~ s[\\][\\\\]g; return $path_str; } sub manname { my ( $name, $section, $prefix) = @_; $prefix = quotemeta( $prefix ); my $ds = quotemeta($dir_sep); $name =~ s/^$prefix(?:[\\\/$ds])//; $name =~ s/[\\\/$ds]/::/g; $name =~ s/\.[^\.]*$/\.$section/; return (( $section == 3 ) ? $INSTALL_MAN3 : $INSTALL_MAN1) . $dir_sep . $name; } sub create_config_pm { my $_cwd = cwd; my $cwd = qqd($_cwd); my $ifs = ($Win32 && !$cygwin) ? '\\\\' : '/'; my @ip = map { qqd($_) } @INCPATH; $ip[0] = "$cwd${ifs}include"; $ip[1] = "$cwd${ifs}include${ifs}generic"; my $ipp = join(',', map {"\'$_\'"} @ip); $ip[0] = qqd("$INSTALLSITEARCH/Prima/CORE"); $ip[1] = qqd("$INSTALLSITEARCH/Prima/CORE/generic"); my $ippi = join(',', map {"\'$_\'"} @ip); my @cdefs = ('HAVE_CONFIG_H=1'); my $cdefs = join( ',', map {"'$_'"} @cdefs); my $lddef = ( $COMPILER eq 'msvc') ? '/def:' : '', my @libpath = @LIBPATH; my @libs = @LIBS; my $perllib = pop @libs; if ( $perllib =~ m/^(.*)\/([^\/]*)$/) { my $pfile = $2; push @libpath, $1; $pfile =~ s/$LIB_EXT$//; push @libs, $pfile; } else { push @libs, $perllib; } unless ( $PLATFORM eq 'unix' or $COMPILER eq 'gcc') { push @libpath, "$_cwd/auto/Prima"; push @libs, 'Prima' . $cc_specs{$COMPILER}->{ldlibext}; } my $libpath = qqd(join( ',', map {"'$_'"} @libpath)); unless ( $PLATFORM eq 'unix' or $COMPILER eq 'gcc') { $libpath[-1] = "$INSTALLSITEARCH/auto/Prima"; } my $libpathi = qqd(join( ',', map {"'$_'"} @libpath)); my $ldlibs = qqd(join( ',', map {"'$_'"} @libs)); my $perl = qqd($^X); my $pl = qqd( $PrimaLib); my $pt = qqd( $PrimaTarget); my $iscr = qqd($INSTALLSCRIPT); my $isa = qqd($INSTALLSITEARCH); my $define = join(' ', map { "-D$_" } @cdefs); my $inc = join(' ', map { "-I$_" } @ip); my $libs = ''; if ( $cygwin) { $libs = "-L$INSTALL_DL -lPrima"; } elsif ( $Win32 || $OS2) { $libs = "$INSTALLSITEARCH/auto/Prima/${LIB_PREFIX}Prima$LIB_EXT"; } open F, "> Prima/Config.pm" or die "cannot open Prima/Config.pm:$!\n"; print F < [ $ippi ], gencls => '$iscr${ifs}gencls$SCRIPT_EXT', tmlink => '$iscr${ifs}tmlink$SCRIPT_EXT', libname => '$isa${ifs}auto${ifs}Prima${ifs}Prima$LIB_EXT', dlname => '$isa${ifs}$pt', ldpaths => [$libpathi], libs => '$libs', define => '$define', inc => '$inc', ); %Config = ( ifs => '$ifs', quote => '\\$SHQUOTE', platform => '$PLATFORM', compiler => '$COMPILER', incpaths => [ $ipp ], platform_path => '$cwd${ifs}$PLATFORM', gencls => '\\$SHQUOTE$perl\\$SHQUOTE $cwd${ifs}utils${ifs}gencls.pl', tmlink => '\\$SHQUOTE$perl\\$SHQUOTE $cwd${ifs}utils${ifs}tmlink.pl', scriptext => '$SCRIPT_EXT', genclsoptions => '--tml --h --inc', cc => '$CC', cflags => '-c $C_FLAGS $CCFLAGS', cdebugflags => '$cc_specs{$COMPILER}->{cdebugflags}', cincflag => '$CINCPATHFLAG', cobjflag => '$COUTOFLAG', cdefflag => '$CDEFFLAG', cdefs => [$cdefs], objext => '$OBJ_EXT', lib => '$LIB', liboutflag => '$LIBOFLAG', libext => '$LIB_EXT', libprefix => '$LIB_PREFIX', libname => '$cwd${ifs}$pl', libs => '$cwd${ifs}$pl', dlname => '$cwd${ifs}$pt', dlext => '$DL_EXT', ld => '$LD', ldflags => '$LD_FLAGS', lddefflag => '$lddef', lddebugflags => '$cc_specs{$COMPILER}->{lddebugflags}', ldoutflag => '$LDOUTFLAG', ldlibflag => '$LDLIBFLAG', ldlibpathflag => '$LDLIBPATHFLAG', ldpaths => [$libpath], ldlibs => [$ldlibs], ldlibext =>'$cc_specs{$COMPILER}->{ldlibext}', inline => '$DEFINES{__INLINE__}', perl => '$perl', dl_load_flags => $DL_LOAD_FLAGS, libs => '$libs', define => '$define', inc => '$inc', ); 1; CONFIG close F; } sub create_codecs_c { open F, "> img/codecs.c" or die "cannot open img/codecs.c:$!\n"; my $def1 = join("\n", map { "extern void apc_img_codec_$_(void);"} @ACTIVE_CODECS); my $def2 = join("\n", map { "\tapc_img_codec_$_();"} @ACTIVE_CODECS); print F <= 0 && $ARGV[ 0] =~ /^\-\-cp(bin)?$/) { my $isbin = defined $1; shift @ARGV; die qq(Even number of parameters expected) unless ( $#ARGV % 2); while ( scalar @ARGV) { my ( $src, $dst) = ( shift @ARGV, shift @ARGV); print qq(Installing $src -> $dst\n); next unless -f $src; if ( $isbin) { my $dstdir = dirname( $dst); mkpath $dstdir if $dstdir && ! -d $dstdir; unlink $dst; open SRCPL, "<$src" or die "Cannot open $src: $!"; open DSTPL, ">$dst" or die "Cannot create $dst: $!"; chmod 0755, $dst unless ($Win32 && !$cygwin) || $OS2; if ( $Win32 && !$cygwin) { print DSTPL <) { next if $filestart && /^\#\!/; $filestart = 0; print DSTPL; } if ( $Win32 && !$cygwin) { print DSTPL <= 0 && $ARGV[ 0] eq '--md') { shift @ARGV; mkpath \@ARGV; } elsif ( $#ARGV >= 0 && $ARGV[ 0] eq '--rm') { shift @ARGV; unlink @ARGV; } elsif ( $#ARGV >= 0 && $ARGV[ 0] eq '--rmdir') { shift @ARGV; rmdir for @ARGV; } elsif ( $#ARGV >= 0 && $ARGV[ 0] eq '--updateconfig') { shift @ARGV; my ( $fn_cfg, $fn_prima) = ( shift @ARGV, shift @ARGV); open F, $fn_cfg or die "cannot open $fn_cfg:$!\n"; open FF, "> $fn_cfg.tmp" or die "cannot open $fn_cfg.tmp:$!\n"; my ( $c_state, $ci_state) = (0,0); my %ci; print FF <) { if ( $ci_state == 0) { if ( m/\%Config_inst = \(/) { $ci_state = 1; } } elsif ( $ci_state == 1) { if ( m/^\);/) { $ci_state = 0; } else { $ci{$1} = $_ if m/^\s*(\S+)\s*/; } } if ( $c_state == 0) { if ( m/\%Config = \(/) { $c_state = 1; } } elsif ( $c_state == 1) { if ( m/^\);/) { $c_state = 0; } else { if ( m/^\s*(\S+)\s*/ && exists $ci{$1}) { print FF $ci{$1}; } else { print FF $_; } } } } print FF <; close F; $ct =~ s/(dl_load_flags\s*\{\s*)0x00/${1}0x01/; open F, "> $fn_prima" or die "cannot write $fn_prima:$!\n"; print F $ct; close F; } } elsif ( $#ARGV >= 2 && $ARGV[ 0] eq '--dist') { my $type = lc $ARGV[1]; my $cwd = cwd(); my $distname = $ARGV[2]; sub clean_dist { my @dirs; return unless -d $distname; print "Cleaning...\n"; finddepth( sub { my $f = "$File::Find::dir/$_"; -d($f) ? push(@dirs, $f) : unlink($f); }, "$cwd/$distname"); rmdir $_ for sort {length($b) <=> length($a)} @dirs; rmdir $distname; } sub cleanup { clean_dist; warn("$_[0]:$!\n") if defined $_[0]; exit(0); } clean_dist; my @dirs; my @files; finddepth( sub { return if $_ eq '.' || ($_ eq 'Makefile' && $File::Find::dir eq $cwd) || $_ eq 'makefile.log' || $_ eq '.packlist'; return if /\.(pdb|ncb|opt|dsp|dsw)$/i; # M$VC my $f = "$File::Find::dir/$_"; return if $f =~ /include.generic|CVS/; if ($type eq 'bin') { return if $f =~ /\.(c|cls|h)$/i; return if $f =~ /$cwd.(img|include|os2|win32|unix|Makefile.PL)/i; } else { return if $f =~ /auto/; } if ( -d $f) { $f =~ s/^$cwd/$distname/; push @dirs, $f; } else { return if $f =~ m/$Config{_o}$/; push @files, $f; } }, $cwd); print "Creating directories...\n"; for ( @dirs) { next if -d $_; cleanup( "Can't mkdir $_") unless mkpath $_; } print "Copying files...\n"; for ( @files) { my $f = $_; $f =~ s/^$cwd/$distname/; cleanup("Error copying $_ to $_") unless copy $_, $f; } if ( $type eq 'bin') { my $os_suffix = $^O; $os_suffix =~ s/\s/_/g; my $zipname = "$distname-$os_suffix.zip"; unlink $zipname; unlink "$distname/$zipname"; system "zip -r $zipname $distname"; } elsif ( $type eq 'zip') { my $zipname = "$distname.zip"; unlink $zipname; unlink "$distname/$zipname"; system "zip -r $zipname $distname"; } else { # tar dist my $tarname = "$distname.tar"; unlink $tarname; unlink "$distname/$tarname"; system "tar -cv -f $tarname $distname" } clean_dist; } elsif ( $#ARGV >= 0 && $ARGV[ 0] eq '--help') { print < { src => 'PREFIX', format => '%s/bin', }, INSTALLSITEARCH => { src => 'PREFIX', format => '%s', }, ); =cut process_commandline; setup_variables; setup_X11; setup_perl; setup_defines; setup_xft; my $config_dir = "include/generic"; my $config_h = "$config_dir/config.h"; print "Creating $config_h\n"; unless ( -d "$config_dir") { mkdir $config_dir, 0777; } open CONFIG, ">$config_h" or die "Creation of $config_h failed: $!"; print CONFIG < $INSTALL_LIB . qd( "/CORE/generic"); # install pod files print "Enumerating POD files\n"; push @allinstall, map { qd($_), $INSTALLSITEARCH} ; push @allman, map { qd($_), manname($_, 1, 'pod')} ; finddepth( sub { my $f = "$File::Find::dir/$_"; return unless -f $_; my $d = $File::Find::dir; $d =~ s/^pod[\\\/]Prima//; if ( m/pod$/) { push @allinstall, qd($f), qd("$INSTALL_LIB$d"); push @allman, qd($f), manname($f, 3, 'pod'); } elsif( m/gif$/) { push @allinstall, qd($f), qd("$INSTALL_LIB$d"); } }, "pod/Prima"); push @alldirs, qd( "include/generic"), qd( "auto/Prima"); print "Creating Prima::Config.pm\n"; create_config_pm; print "Creating img/codecs.c\n"; create_codecs_c; #exit; my $make = < { Prima::codecs::$binary_prereq=>q[0] } # PREREQ $make .= <) { $make .= clsmake( $_); } while ( <*.c>) { $make .= cmake( $_); } while ( ) { next if exists $PASSIVE_CODECS{$_}; $make .= cmake( $_); } while ( <$PLATFORM/*.c>) { next if !$WITH_XFT && m/xft.c/; $make .= cmake( $_); } while ( ) { if ( m/\.pl$/i) { push @allbins, $_, $INSTALL_EXAMPLES; } else { push @allinstall, $_, $INSTALL_EXAMPLES; } } while ( ) { push @allbins, $_, $INSTALLSCRIPT; } for ( @executables) { push @allbins, $_, $INSTALLSCRIPT; m/\/([^\/]+)$/; push @allman, qd($_), manname( $1, 1, ''); } my $thunks_tinc = qd( "include/generic/thunks.tinc"); push @allclean, $thunks_tinc; push @allrealclean, 'Makefile'; print "Writing Makefile..."; $make =~ tr[/][]s; open MAKE, ">Makefile" or die "Creation of Makefile failed: $!"; print MAKE $make; # dist-related veriables if ( $OS2) { print MAKE <\\n}. qq{\\tPrima\\n}. qq{\\tPerl GUI toolkit\\n}. qq{\\tDmitry Karasik\\n}. qq{\\t\\n}. qq{\\t\\t\\n}. qq{\\t\\t\\n}. qq{\\t\\t\\n}. qq{\\t\\n}. qq{\\n}" > Prima.ppd Makefile: Makefile.PL @Makefile_deps \t\@echo Rebuilding Makefile... \t\@$^X Makefile.PL $ARGV_STR \t\@$MAKE \t\@echo You are safe to ignore the following error... \t\@false EOF print MAKE < ) { next unless /^\=head1/; push @allman, qd($fn), manname( $fn, 3, ''); last; } close F; } } }, 'Prima'); delete $cp{qd($_)} for @executables; while (@allinstall) { my ( $src, $dst) = ( shift(@allinstall), shift(@allinstall)); next if $src =~ /CVS/; $cp{$src} = $dst; } while ( ) { my $dst = $_; $dst =~ s/^include/CORE/; $cp{$_} = dirname( qd( "$INSTALL_LIB/$dst")); } while ( ) { my $dst = $_; $dst =~ s/^include/CORE/; $cp{$_} = dirname( qd( "$INSTALL_LIB/$dst")); } my $i = 0; sub dump_cmd { my ( $line, $sub, $command) = ( 0, shift, shift); print MAKE "\t\@\$($command) \\\n" if scalar @_; for ( @_) { my $call = $sub->($_); if (( $line++ % 20) == 19) { print MAKE "\n\t\@\$($command) \\\n"; } elsif ( $line <= scalar @_ && $line > 1) { print MAKE " \\\n"; } print MAKE "\t$call"; } print MAKE "\n"; } print MAKE "\ninstall: all\n"; dump_cmd( sub { "$_[0] $cp{$_[0]}"}, 'CP', sort keys %cp); while ( scalar @allbins) { my ( $src, $dst) = ( shift @allbins, shift @allbins); $cp{qd( basename( $src, '.pl') . $SCRIPT_EXT)} = $dst; $cpbin{$src} = qd( "$dst/" . basename( $src, '.pl')) . $SCRIPT_EXT; } dump_cmd( sub { "$_[0] $cpbin{$_[0]}"}, 'CPBIN', sort keys %cpbin); dump_cmd( sub { $_[0] }, 'CHMOD', @chmodx); print MAKE "\n\t\@echo Updating config...\n"; print MAKE "\t$^X Makefile.PL --updateconfig $INSTALLSITEARCH/Prima/Config.pm"; print MAKE " $INSTALLSITEARCH/Prima.pm" if $DL_LOAD_FLAGS; my @man_to_remove; if ( $install_manuals) { my $cmd = "\t\@pod2man --lax --section=\%d \%s " . ( length( $Config{gzip} ) ? "| $Config{gzip} -c > \%s.gz\n" : "> \%s\n" ); print MAKE "\n\t\@echo Installing man pages...\n"; print MAKE "\t\@\$(MD) $INSTALL_MAN1 $INSTALL_MAN3\n"; while ( scalar @allman ) { my ( $src, $dest) = splice( @allman, 0, 2); $dest =~ s/::/./g if ($Win32 || $cygwin); push @man_to_remove, $dest; $dest =~ m/([^\/]+)\.(\d+)$/; print MAKE "\t\@echo $dest" . (length( $Config{gzip} ) ? '.gz' : ''). "\n"; printf MAKE $cmd, $2, $src, $dest; } if ( length $Config{gzip}) { s/$/.gz/ for @man_to_remove } } print MAKE "\n\ndeinstall:\n"; my %dirs_to_rm; dump_cmd( sub { $dirs_to_rm{$cp{$_[0]}} = 1; $_[0] =~ m/(\\|\/)?([^\\|\/]+)$/; my $rm = "$cp{$_[0]}$dir_sep$2"; $packlist->{$rm}++; return $rm; }, 'RM', keys %cp); dump_cmd( sub { $_ }, 'RM', @man_to_remove); delete $dirs_to_rm{$INSTALLSITEARCH}; delete $dirs_to_rm{$INSTALLSCRIPT}; dump_cmd( sub { $_[0] }, 'RMDIR', sort { length($b) <=> length($a) } keys %dirs_to_rm); print MAKE "\n"; print MAKE join( "\n", @footers), "\n"; close MAKE; $packlist-> write('.packlist'); print "\nAll done. Now you can run ${ MAKE}.\n"; } Prima-1.28/Widget.c0000644000175100017510000026040111150770061011664 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: Widget.c,v 1.140 2008/04/28 09:58:27 dk Exp $ */ #include "apricot.h" #include "Application.h" #include "Icon.h" #include "Popup.h" #include "Widget.h" #include "Window.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CDrawable #define enter_method PWidget_vmt selfvmt = ((( PWidget) self)-> self) #define my selfvmt #define var (( PWidget) self) typedef Bool ActionProc ( Handle self, Handle item, void * params); typedef ActionProc *PActionProc; #define his (( PWidget) child) /* local defines */ typedef struct _SingleColor { Color color; int index; } SingleColor, *PSingleColor; static Bool find_dup_msg( PEvent event, int * cmd); static Bool pquery ( Handle window, Handle self, void * v); static Bool get_top_current( Handle self); static Bool sptr( Handle window, Handle self, void * v); static Handle find_tabfoc( Handle self); static Bool showhint_notify ( Handle self, Handle child, void * data); static Bool hint_notify ( Handle self, Handle child, SV * hint); extern void Widget_pack_slaves( Handle self); extern void Widget_place_slaves( Handle self); extern Bool Widget_size_notify( Handle self, Handle child, const Rect* metrix); extern Bool Widget_move_notify( Handle self, Handle child, Point * moveTo); /* init, done & update_sys_handle */ void Widget_init( Handle self, HV * profile) { dPROFILE; enter_method; SV * sv; inherited-> init( self, profile); list_create( &var-> widgets, 0, 8); var-> tabOrder = -1; var-> geomInfo. side = 3; /* default pack side is 'top', anchor ='center' */ var-> geomInfo. anchorx = var-> geomInfo. anchory = 1; my-> update_sys_handle( self, profile); /* props init */ /* font and colors */ SvHV_Font( pget_sv( font), &Font_buffer, "Widget::init"); my-> set_widgetClass ( self, pget_i( widgetClass )); my-> set_color ( self, pget_i( color )); my-> set_backColor ( self, pget_i( backColor )); my-> set_font ( self, Font_buffer); opt_assign( optOwnerBackColor, pget_B( ownerBackColor)); opt_assign( optOwnerColor , pget_B( ownerColor)); opt_assign( optOwnerFont , pget_B( ownerFont)); opt_assign( optOwnerHint , pget_B( ownerHint)); opt_assign( optOwnerShowHint , pget_B( ownerShowHint)); opt_assign( optOwnerPalette , pget_B( ownerPalette)); my-> colorIndex( self, true, ciHiliteText, pget_i( hiliteColor) ); my-> colorIndex( self, true, ciHilite, pget_i( hiliteBackColor) ); my-> colorIndex( self, true, ciDisabledText, pget_i( disabledColor) ); my-> colorIndex( self, true, ciDisabled, pget_i( disabledBackColor)); my-> colorIndex( self, true, ciLight3DColor, pget_i( light3DColor) ); my-> colorIndex( self, true, ciDark3DColor, pget_i( dark3DColor) ); my-> set_palette( self, pget_sv( palette)); /* light props */ my-> set_autoEnableChildren ( self, pget_B( autoEnableChildren)); my-> set_briefKeys ( self, pget_B( briefKeys)); my-> set_buffered ( self, pget_B( buffered)); my-> set_cursorVisible ( self, pget_B( cursorVisible)); my-> set_growMode ( self, pget_i( growMode)); my-> set_helpContext ( self, pget_sv( helpContext)); my-> set_hint ( self, pget_sv( hint)); my-> set_firstClick ( self, pget_B( firstClick)); { Point hotSpot; Handle icon = pget_H( pointerIcon); prima_read_point( pget_sv( pointerHotSpot), (int*)&hotSpot, 2, "RTC0087: Array panic on 'pointerHotSpot'"); if ( icon != nilHandle && !kind_of( icon, CIcon)) { warn("RTC083: Illegal object reference passed to Widget::pointerIcon"); icon = nilHandle; } apc_pointer_set_user( self, icon, hotSpot); } my-> set_pointerType ( self, pget_i( pointerType)); my-> set_selectingButtons ( self, pget_i( selectingButtons)); my-> set_selectable ( self, pget_B( selectable)); my-> set_showHint ( self, pget_B( showHint)); my-> set_tabOrder ( self, pget_i( tabOrder)); my-> set_tabStop ( self, pget_i( tabStop)); my-> set_text ( self, pget_sv( text)); opt_assign( optScaleChildren, pget_B( scaleChildren)); /* subcomponents props */ my-> popupColorIndex( self, true, ciFore, pget_i( popupColor) ); my-> popupColorIndex( self, true, ciBack, pget_i( popupBackColor) ); my-> popupColorIndex( self, true, ciHiliteText, pget_i( popupHiliteColor) ); my-> popupColorIndex( self, true, ciHilite, pget_i( popupHiliteBackColor) ); my-> popupColorIndex( self, true, ciDisabledText, pget_i( popupDisabledColor) ); my-> popupColorIndex( self, true, ciDisabled, pget_i( popupDisabledBackColor) ); my-> popupColorIndex( self, true, ciLight3DColor, pget_i( popupLight3DColor) ); my-> popupColorIndex( self, true, ciDark3DColor, pget_i( popupDark3DColor) ); SvHV_Font( pget_sv( popupFont), &Font_buffer, "Widget::init"); my-> set_popup_font ( self, Font_buffer); if ( SvTYPE( sv = pget_sv( popupItems)) != SVt_NULL) my-> set_popupItems( self, sv); if ( SvTYPE( sv = pget_sv( accelItems)) != SVt_NULL) my-> set_accelItems( self, sv); /* size, position, enabling, visibliity etc. runtime */ { Point set, set2; AV * av; SV ** holder; NPoint ds = {1,1}; prima_read_point( pget_sv( sizeMin), (int*)&set, 2, "RTC0082: Array panic on 'sizeMin'"); prima_read_point( pget_sv( sizeMax), (int*)&set2, 2, "RTC0083: Array panic on 'sizeMax'"); var-> sizeMax = set2; my-> set_sizeMin( self, set); my-> set_sizeMax( self, set2); prima_read_point( pget_sv( cursorSize), (int*)&set, 2, "RTC0084: Array panic on 'cursorSize'"); my-> set_cursorSize( self, set); prima_read_point( pget_sv( cursorPos), (int*)&set, 2, "RTC0085: Array panic on 'cursorPos'"); my-> set_cursorPos( self, set); av = ( AV *) SvRV( pget_sv( designScale)); holder = av_fetch( av, 0, 0); ds. x = holder ? SvNV( *holder) : 1; if ( !holder) warn("RTC0086: Array panic on 'designScale'"); holder = av_fetch( av, 1, 0); ds. y = holder ? SvNV( *holder) : 1; if ( !holder) warn("RTC0086: Array panic on 'designScale'"); my-> set_designScale( self, ds); } my-> set_enabled ( self, pget_B( enabled)); if ( !pexist( originDontCare) || !pget_B( originDontCare)) { Point pos; pos. x = pget_i( left); pos. y = pget_i( bottom); my-> set_origin( self, pos); } else var-> pos = my-> get_origin( self); if ( !pexist( sizeDontCare ) || !pget_B( sizeDontCare )) { Point size; size. x = pget_i( width); size. y = pget_i( height); my-> set_size( self, size); } else var-> virtualSize = my-> get_size( self); var-> geomSize = var-> virtualSize; { Bool x = 0, y = 0; if ( pget_B( centered)) { x = 1; y = 1; }; if ( pget_B( x_centered) || ( var-> growMode & gmXCenter)) x = 1; if ( pget_B( y_centered) || ( var-> growMode & gmYCenter)) y = 1; if ( x || y) my-> set_centered( self, x, y); } opt_assign( optPackPropagate, pget_B( packPropagate)); my-> set_packInfo( self, pget_sv( packInfo)); my-> set_placeInfo( self, pget_sv( placeInfo)); my-> set_geometry( self, pget_i( geometry)); my-> set_shape ( self, pget_H( shape)); my-> set_visible ( self, pget_B( visible)); if ( pget_B( capture)) my-> set_capture( self, 1, nilHandle); if ( pget_B( current)) my-> set_current( self, 1); CORE_INIT_TRANSIENT(Widget); { SV * widgets = pget_sv( widgets); if ( SvTYPE( widgets) != SVt_NULL) { dSP; ENTER; SAVETMPS; PUSHMARK( sp); XPUSHs( var-> mate); XPUSHs( sv_2mortal( newSVsv( widgets))); PUTBACK; perl_call_method( "widgets", G_DISCARD); SPAGAIN; PUTBACK; FREETMPS; LEAVE; } } } void Widget_update_sys_handle( Handle self, HV * profile) { dPROFILE; enter_method; Handle owner; Bool clipOwner; ApiHandle parentHandle; if (!( pexist( owner) || pexist( syncPaint) || pexist( clipOwner) || pexist( transparent) )) return; owner = pexist( owner) ? pget_H( owner) : var-> owner; clipOwner = pexist( clipOwner) ? pget_B( clipOwner) : my-> get_clipOwner( self); parentHandle = pexist( parentHandle) ? pget_i( parentHandle) : apc_widget_get_parent_handle( self); if ( parentHandle) { if (( owner != application) && clipOwner) croak("RTC008D: Cannot accept 'parentHandle' for non-application child and clip-owner widget"); } if ( !apc_widget_create( self, owner, pexist( syncPaint) ? pget_B( syncPaint) : my-> get_syncPaint( self), clipOwner, pexist( transparent) ? pget_B( transparent): my-> get_transparent( self), parentHandle )) croak( "RTC0080: Cannot create widget"); pdelete( transparent); pdelete( syncPaint); pdelete( clipOwner); pdelete( parentHandle); } void Widget_done( Handle self) { free( var-> text); apc_widget_destroy( self); free( var-> helpContext); free( var-> hint); var-> text = nil; var-> helpContext = nil; var-> hint = nil; if ( var-> owner) { Handle * enum_lists = PWidget( var-> owner)-> enum_lists; while ( enum_lists) { unsigned int i, count; count = (unsigned int) enum_lists[1]; for ( i = 2; i < count + 2; i++) { if ( self == enum_lists[i]) enum_lists[i] = nilHandle; } enum_lists = ( Handle*) enum_lists[0]; } } list_destroy( &var-> widgets); inherited-> done( self); } /* ::a */ void Widget_attach( Handle self, Handle objectHandle) { if ( objectHandle == nilHandle) return; if ( var-> stage > csNormal) return; if ( kind_of( objectHandle, CWidget)) { if ( list_index_of( &var-> widgets, objectHandle) >= 0) { warn( "RTC0040: Object attach failed"); return; } list_add( &var-> widgets, objectHandle); } inherited-> attach( self, objectHandle); } /*::b */ Bool Widget_begin_paint( Handle self) { Bool ok; if ( !inherited-> begin_paint( self)) return false; if ( !( ok = apc_widget_begin_paint( self, false))) { inherited-> end_paint( self); perl_error(); } return ok; } Bool Widget_begin_paint_info( Handle self) { Bool ok; if ( is_opt( optInDraw)) return true; if ( !inherited-> begin_paint_info( self)) return false; if ( !( ok = apc_widget_begin_paint_info( self))) { inherited-> end_paint_info( self); perl_error(); } return ok; } void Widget_bring_to_front( Handle self) { if ( opt_InPaint) return; apc_widget_set_z_order( self, nilHandle, true); } /*::c */ Bool Widget_can_close( Handle self) { enter_method; Event ev = { cmClose}; return ( var-> stage <= csNormal) ? my-> message( self, &ev) : true; } void Widget_cleanup( Handle self) { Handle ptr; enter_method; /* disconnect all geometry slaves */ ptr = var-> packSlaves; while ( ptr) { PWidget( ptr)-> geometry = gtDefault; ptr = PWidget( ptr)-> geomInfo. next; } var-> packSlaves = nilHandle; ptr = var-> placeSlaves; while ( ptr) { PWidget( ptr)-> geometry = gtDefault; ptr = PWidget( ptr)-> geomInfo. next; } var-> placeSlaves = nilHandle; my-> set_geometry( self, gtDefault); if ( application && (( PApplication) application)-> hintUnder == self) my-> set_hintVisible( self, 0); { int i; for ( i = 0; i < var-> widgets. count; i++) Object_destroy( var-> widgets. items[i]); } my-> detach( self, var-> accelTable, true); var-> accelTable = nilHandle; my-> detach( self, var-> popupMenu, true); var-> popupMenu = nilHandle; inherited-> cleanup( self); } Bool Widget_close( Handle self) { Bool canClose; enter_method; if ( var-> stage > csNormal) return true; if (( canClose = my-> can_close( self))) { Object_destroy( self); } return canClose; } Bool Widget_custom_paint( Handle self) { PList list; void * ret; enter_method; if ( my-> on_paint != Widget_on_paint) return true; if ( var-> eventIDs == nil) return false; ret = hash_fetch( var-> eventIDs, "Paint", 5); if ( ret == nil) return false; list = var-> events + PTR2UV( ret) - 1; return list-> count > 0; } /*::d */ void Widget_detach( Handle self, Handle objectHandle, Bool kill) { enter_method; if ( kind_of( objectHandle, CWidget)) { list_delete( &var-> widgets, objectHandle); if ( var-> currentWidget == objectHandle && objectHandle != nilHandle) my-> set_currentWidget( self, nilHandle); } inherited-> detach( self, objectHandle, kill); } /*::e */ void Widget_end_paint( Handle self) { if ( !is_opt( optInDraw)) return; apc_widget_end_paint( self); inherited-> end_paint( self); } void Widget_end_paint_info( Handle self) { if ( !is_opt( optInDrawInfo)) return; apc_widget_end_paint_info( self); inherited-> end_paint_info( self); } /*::f */ SV* Widget_fetch_resource( char *className, char *name, char *classRes, char *res, Handle owner, int resType) { char *str = nil; Color clr; void *parm; Font font; SV * ret; switch ( resType) { case frColor: parm = &clr; break; case frFont: parm = &font; bzero( &font, sizeof( font)); break; default: parm = &str; resType = frString; } if ( !apc_fetch_resource( prima_normalize_resource_string( className, true), prima_normalize_resource_string( name, false), prima_normalize_resource_string( classRes, true), prima_normalize_resource_string( res, false), owner, resType, parm)) return nilSV; switch ( resType) { case frColor: ret = newSViv( clr); break; case frFont: ret = sv_Font2HV( &font); break; default: ret = str ? newSVpv( str, 0) : nilSV; free( str); } return ret; } Handle Widget_first( Handle self) { return apc_widget_get_z_order( self, zoFirst); } Handle Widget_first_that( Handle self, void * actionProc, void * params) { Handle child = nilHandle; int i, count = var-> widgets. count; Handle * list; if ( actionProc == nil || count == 0) return nilHandle; if (!(list = allocn( Handle, count + 2))) return nilHandle; list[0] = (Handle)( var-> enum_lists); list[1] = (Handle)( count); var-> enum_lists = list; memcpy( list + 2, var-> widgets. items, sizeof( Handle) * count); for ( i = 2; i < count + 2; i++) { if ( list[i] && (( PActionProc) actionProc)( self, list[ i], params)) { child = list[ i]; break; } } var-> enum_lists = (Handle*)(*list); free( list); return child; } /*::g */ /*::h */ void Widget_handle_event( Handle self, PEvent event) { enter_method; #define evOK ( var-> evStack[ var-> evPtr - 1]) #define objCheck if ( var-> stage > csNormal) return inherited-> handle_event ( self, event); objCheck; switch ( event-> cmd) { case cmCalcBounds: { Point min, max; min = var-> sizeMin; max = var-> sizeMax; if (( min. x > 0) && ( min. x > event-> gen. R. right )) event-> gen. R. right = min. x; if (( min. y > 0) && ( min. y > event-> gen. R. top )) event-> gen. R. top = min. y; if (( max. x > 0) && ( max. x < event-> gen. R. right )) event-> gen. R. right = max. x; if (( max. y > 0) && ( max. y < event-> gen. R. top )) event-> gen. R. top = max. y; } break; case cmSetup: if ( !is_opt( optSetupComplete)) { opt_set( optSetupComplete); my-> notify( self, " repaint( self); break; case cmPaint : if ( !opt_InPaint && !my-> get_locked( self)) if ( inherited-> begin_paint( self)) { if ( apc_widget_begin_paint( self, true)) { my-> notify( self, " end_paint( self); } else inherited-> end_paint( self); } break; case cmEnable : my-> notify( self, " notify( self, " notify( self, " notify( self, " notify( self, " notify( self, " notify( self, " gen. B); break; case cmClose : if ( my-> first_that( self, (void*)pquery, nil)) { my-> clear_event( self); return; } objCheck; my-> notify( self, " notify( self, " notify( self, " gen. source, CPopup)) my-> notify( self, " gen. i); else var-> popupColor[ event-> gen. i] = apc_menu_get_color( event-> gen. source, event-> gen. i); break; case cmFontChanged: if ( !kind_of( event-> gen. source, CPopup)) my-> notify( self, " gen. source, &var-> popupFont); break; case cmMenu: if ( event-> gen. H) { char buffer[16], *context; context = ((( PAbstractMenu) event-> gen. H)-> self)-> make_id_context( event-> gen. H, event-> gen. i, buffer); my-> notify( self, " gen. H, context); } break; case cmMouseClick: my-> notify( self, " pos. button, event-> pos. mod, event -> pos. where, event-> pos. dblclk); break; case cmMouseDown: if ((( PApplication) application)-> hintUnder == self) my-> set_hintVisible( self, 0); objCheck; if (((event-> pos. button & var-> selectingButtons) != 0) && my-> get_selectable( self)) my-> set_selected( self, true); objCheck; my-> notify( self, " pos. button, event-> pos. mod, event -> pos. where); break; case cmMouseUp: my-> notify( self, " pos. button, event-> pos. mod, event -> pos. where); break; case cmMouseMove: if ((( PApplication) application)-> hintUnder == self) my-> set_hintVisible( self, -1); objCheck; my-> notify( self, " pos. mod, event -> pos. where); break; case cmMouseWheel: my-> notify( self, " pos. mod, event -> pos. where, event-> pos. button); /* +n*delta == up, -n*delta == down */ break; case cmMouseEnter: my-> notify( self, " pos. mod, event -> pos. where); objCheck; if ( application && is_opt( optShowHint) && ((( PApplication) application)-> options. optShowHint) && var-> hint[0]) { PApplication app = ( PApplication) application; app-> self-> set_hint_action( application, self, true, true); } break; case cmMouseLeave: if ( application && is_opt( optShowHint)) { PApplication app = ( PApplication) application; app-> self-> set_hint_action( application, self, false, true); } my-> notify( self, " key. repeat; if ( is_opt( optBriefKeys)) rep = 1; else event-> key. repeat = 1; for ( i = 0; i < rep; i++) { my-> notify( self, " key.code, event-> key. key, event-> key. mod, event-> key. repeat); objCheck; if ( evOK) { Event ev = *event; ev. key. source = self; ev. cmd = var-> owner ? cmDelegateKey : cmTranslateAccel; ev. key. subcmd = 0; if ( !my-> message( self, &ev)) { my-> clear_event( self); return; } objCheck; } if ( !evOK) break; { Handle next = nilHandle; switch( event-> key. key) { case kbF1: case kbHelp: my-> help( self); my-> clear_event( self); return; case kbLeft: next = my-> next_positional( self, -1, 0); break; case kbRight: next = my-> next_positional( self, 1, 0); break; case kbUp: next = my-> next_positional( self, 0, 1); break; case kbDown: next = my-> next_positional( self, 0, -1); break; case kbTab: next = my-> next_tab( self, true); break; case kbBackTab: next = my-> next_tab( self, false); break; default:; } if ( next) { CWidget( next)-> set_selected( next, true); objCheck; my-> clear_event( self); return; } } } } break; case cmDelegateKey: switch ( event-> key. subcmd) { case 0: { Event ev = *event; ev. cmd = cmTranslateAccel; if ( !my-> message( self, &ev)) { my-> clear_event( self); return; } objCheck; if ( my-> first_that( self, (void*)accel_notify, &ev)) { my-> clear_event( self); return; } objCheck; ev. cmd = cmDelegateKey; ev. key. subcmd = 1; if ( my-> first_that( self, (void*)accel_notify, &ev)) { my-> clear_event( self); return; } if ( var-> owner) { if ( var-> owner == application) ev. cmd = cmTranslateAccel; else ev. key. subcmd = 0; ev. key. source = self; if (!(((( PWidget) var-> owner)-> self)-> message( var-> owner, &ev))) { objCheck; my-> clear_event( self); return; } } } break; case 1: { Event ev = *event; ev. cmd = cmTranslateAccel; if ( my-> first_that( self, (void*)accel_notify, &ev)) { my-> clear_event( self); return; } objCheck; ev = *event; if ( my-> first_that( self, (void*)accel_notify, &ev)) { my-> clear_event( self); return; } } break; } break; case cmTranslateAccel: { int key = CAbstractMenu-> translate_key( nilHandle, event-> key. code, event-> key. key, event-> key. mod); if ( my-> first_that_component( self, (void*)find_accel, &key)) { my-> clear_event( self); return; } objCheck; } my-> notify( self, " key.code, event-> key. key, event-> key. mod); break; case cmKeyUp: my-> notify( self, " key.code, event-> key. key, event-> key. mod); break; case cmMenuCmd: if ( event-> gen. source) ((( PAbstractMenu) event-> gen. source)-> self)-> sub_call_id( event-> gen. source, event-> gen. i); break; case cmMove: { Bool doNotify = false; Point oldP; if ( var-> stage == csNormal && var-> evQueue == nil) { doNotify = true; } else if ( var-> stage > csNormal) { break; } else if ( var-> evQueue != nil) { int i = list_first_that( var-> evQueue, (void*)find_dup_msg, &event-> cmd); PEvent n; if ( i < 0) { if ( !( n = alloc1( Event))) goto MOVE_EVENT; memcpy( n, event, sizeof( Event)); n-> gen. B = 1; n-> gen. R. left = n-> gen. R. bottom = 0; list_add( var-> evQueue, ( Handle) n); } else n = ( PEvent) list_at( var-> evQueue, i); n-> gen. P = event-> gen. P; } MOVE_EVENT:; if ( !event-> gen. B) my-> first_that( self, (void*) Widget_move_notify, &event-> gen. P); if ( doNotify) oldP = var-> pos; var-> pos = event-> gen. P; if ( doNotify && (oldP. x != event-> gen. P. x || oldP. y != event-> gen. P. y)) { my-> notify( self, " gen. P); objCheck; if ( var-> growMode & gmCenter) my-> set_centered( self, var-> growMode & gmXCenter, var-> growMode & gmYCenter); } } break; case cmPopup: { Handle org = self; my-> notify( self, " gen. B, event-> gen. P. x, event-> gen. P. y); objCheck; if ( evOK) { while ( self) { PPopup p = ( PPopup) CWidget( self)-> get_popup( self); if ( p && p-> self-> get_autoPopup(( Handle) p)) { Point px = event-> gen. P; apc_widget_map_points( org, true, 1, &px); apc_widget_map_points( self, false, 1, &px); p-> self-> popup(( Handle) p, px. x, px. y ,0,0,0,0); CWidget( org)-> clear_event( org); return; } self = var-> owner; } } } break; case cmSize: /* expecting new size in P, old & new size in R. */ { Bool doNotify = false; if ( var-> stage == csNormal && var-> evQueue == nil) { doNotify = true; } else if ( var-> stage > csNormal) { break; } else if ( var-> evQueue != nil) { int i = list_first_that( var-> evQueue, (void*)find_dup_msg, &event-> cmd); PEvent n; if ( i < 0) { if ( !( n = alloc1( Event))) goto SIZE_EVENT; memcpy( n, event, sizeof( Event)); n-> gen. B = 1; n-> gen. R. left = n-> gen. R. bottom = 0; list_add( var-> evQueue, ( Handle) n); } else n = ( PEvent) list_at( var-> evQueue, i); n-> gen. P. x = n-> gen. R. right = event-> gen. P. x; n-> gen. P. y = n-> gen. R. top = event-> gen. P. y; } SIZE_EVENT:; if ( var-> growMode & gmCenter) my-> set_centered( self, var-> growMode & gmXCenter, var-> growMode & gmYCenter); if ( !event-> gen. B) my-> first_that( self, (void*) Widget_size_notify, &event-> gen. R); if ( doNotify) { Point oldSize; oldSize. x = event-> gen. R. left; oldSize. y = event-> gen. R. bottom; my-> notify( self, " gen. P); } Widget_pack_slaves( self); Widget_place_slaves( self); } break; } } void Widget_hide( Handle self) { enter_method; my-> set_visible( self, false); } void Widget_hide_cursor( Handle self) { enter_method; if ( my-> get_cursorVisible( self)) my-> set_cursorVisible( self, false); else var-> cursorLock++; } /*::i */ void Widget_insert_behind ( Handle self, Handle widget) { apc_widget_set_z_order( self, widget, 0); } void Widget_invalidate_rect( Handle self, Rect rect) { enter_method; if ( !opt_InPaint && ( var-> stage == csNormal) && !my-> get_locked( self)) apc_widget_invalidate_rect( self, &rect); } Bool Widget_is_child( Handle self, Handle owner) { if ( !owner) return false; while ( self) { if ( self == owner) return true; self = var-> owner; } return false; } /*::j */ /*::k */ void Widget_key_event( Handle self, int command, int code, int key, int mod, int repeat, Bool post) { Event ev; if ( command != cmKeyDown && command != cmKeyUp) return; memset( &ev, 0, sizeof( ev)); if ( repeat <= 0) repeat = 1; ev. cmd = command; ev. key. code = code; ev. key. key = key; ev. key. mod = mod; ev. key. repeat = repeat; apc_message( self, &ev, post); } /*::l */ Handle Widget_last( Handle self) { return apc_widget_get_z_order( self, zoLast); } Bool Widget_lock( Handle self) { var-> lockCount++; return true; } /*::m */ void Widget_mouse_event( Handle self, int command, int button, int mod, int x, int y, Bool dbl, Bool post) { Event ev; if ( command != cmMouseDown && command != cmMouseUp && command != cmMouseClick && command != cmMouseMove && command != cmMouseWheel && command != cmMouseEnter && command != cmMouseLeave ) return; memset( &ev, 0, sizeof( ev)); ev. cmd = command; ev. pos. where. x = x; ev. pos. where. y = y; ev. pos. mod = mod; ev. pos. button = button; if ( command == cmMouseClick) ev. pos. dblclk = dbl; apc_message( self, &ev, post); } /*::n */ Handle Widget_next( Handle self) { return apc_widget_get_z_order( self, zoNext); } static void fill_tab_candidates( PList list, Handle level) { int i; PList w = &(PWidget( level)-> widgets); for ( i = 0; i < w-> count; i++) { Handle x = w-> items[i]; if ( CWidget( x)-> get_visible( x) && CWidget( x)-> get_enabled( x)) { if ( CWidget( x)-> get_selectable( x) && CWidget( x)-> get_tabStop( x)) list_add( list, x); fill_tab_candidates( list, x); } } } Handle Widget_next_positional( Handle self, int dx, int dy) { Handle horizon = self; int i, maxDiff = INT_MAX; Handle max = nilHandle; List candidates; Point p[2]; int minor[2], major[2], axis, extraDiff, ir[4]; /* In order to compute positional difference, using four penalties. To simplify algorithm, Rect will be translated to int[4] and minor, major and extraDiff assigned to array indices for those steps - minor for first and third, major for second and extraDiff for last one. */ axis = ( dx == 0) ? dy : dx; minor[0] = ( dx == 0) ? 0 : 1; minor[1] = minor[0] + 2; extraDiff = major[(axis < 0) ? 0 : 1] = ( dx == 0) ? 1 : 0; major[(axis < 0) ? 1 : 0] = extraDiff + 2; extraDiff = ( dx == 0) ? (( axis < 0) ? 0 : 2) : (( axis < 0) ? 1 : 3); while ( PWidget( horizon)-> owner) { if ( ( PWidget( horizon)-> options. optSystemSelectable) || /* fast check for CWindow */ ( PWidget( horizon)-> options. optModalHorizon) ) break; horizon = PWidget( horizon)-> owner; } if ( !CWidget( horizon)-> get_visible( horizon) || !CWidget( horizon)-> get_enabled( horizon)) return nilHandle; list_create( &candidates, 64, 64); fill_tab_candidates( &candidates, horizon); p[0].x = p[0].y = 0; p[1] = CWidget( self)-> get_size( self); apc_widget_map_points( self, true, 2, p); apc_widget_map_points( horizon, false, 2, p); ir[0] = p[0].x; ir[1] = p[0].y; ir[2] = p[1].x; ir[3] = p[1].y; for ( i = 0; i < candidates. count; i++) { int diff, ix[4]; Handle x = candidates. items[i]; if ( x == self) continue; p[0].x = p[0].y = 0; p[1] = CWidget( x)-> get_size( x); apc_widget_map_points( x, true, 2, p); apc_widget_map_points( horizon, false, 2, p); ix[0] = p[0].x; ix[1] = p[0].y; ix[2] = p[1].x; ix[3] = p[1].y; /* First step - checking if the widget is subject to comparison. It is not, if it's minor axis is not contiguous with self's */ if ( ix[ minor[0]] > ir[ minor[1]] || ix[ minor[1]] < ir[ minor[0]]) continue; /* Using x100 penalty for distance in major axis - and discarding those that of different sign */ diff = ( ix[ major[ 1]] - ir[ major[0]]) * 100 * axis; if ( diff < 0) continue; /* Adding x10 penalty for incomplete minor axis congruence. Addition goes in tenths, in a way to not allow congruence overweight major axis distance */ if ( ix[ minor[0]] > ir[ minor[0]]) diff += ( ix[ minor[0]] - ir[ minor[0]]) * 100 / ( ir[ minor[1]] - ir[ minor[0]]); if ( ix[ minor[1]] < ir[ minor[1]]) diff += ( ir[ minor[1]] - ix[ minor[1]]) * 100 / ( ir[ minor[1]] - ir[ minor[0]]); /* Adding 'distance from level' x1 penalty */ if (( ix[ extraDiff] - ir[ extraDiff]) * axis < 0) diff += abs( ix[ extraDiff] - ir[ extraDiff]); if ( diff < maxDiff) { max = x; maxDiff = diff; } } list_destroy( &candidates); return max; } static int compare_taborders_forward( const void *a, const void *b) { if ((*(PWidget*) a)-> tabOrder < (*(PWidget*) b)-> tabOrder) return -1; else if ((*(PWidget*) a)-> tabOrder > (*(PWidget*) b)-> tabOrder) return 1; else return 0; } static int compare_taborders_backward( const void *a, const void *b) { if ((*(PWidget*) a)-> tabOrder < (*(PWidget*) b)-> tabOrder) return 1; else if ((*(PWidget*) a)-> tabOrder > (*(PWidget*) b)-> tabOrder) return -1; else return 0; } static int do_taborder_candidates( Handle level, Handle who, int (*compareProc)(const void *, const void *), int * stage, Handle * result) { int i, fsel = -1; PList w = &(PWidget( level)-> widgets); Handle * ordered; if ( w-> count == 0) return true; ordered = ( Handle *) malloc( w-> count * sizeof( Handle)); if ( !ordered) return true; memcpy( ordered, w-> items, w-> count * sizeof( Handle)); qsort( ordered, w-> count, sizeof( Handle), compareProc); /* finding current widget in the group */ for ( i = 0; i < w-> count; i++) { Handle x = ordered[i]; if ( CWidget( x)-> get_current( x)) { fsel = i; break; } } if ( fsel < 0) fsel = 0; for ( i = 0; i < w-> count; i++) { int j; Handle x; j = i + fsel; if ( j >= w-> count) j -= w-> count; x = ordered[j]; if ( CWidget( x)-> get_visible( x) && CWidget( x)-> get_enabled( x)) { if ( CWidget( x)-> get_selectable( x) && CWidget( x)-> get_tabStop( x)) { if ( *result == nilHandle) *result = x; switch( *stage) { case 0: /* nothing found yet */ if ( x == who) *stage = 1; break; default: /* next widget after 'who' is ours */ *result = x; free( ordered); return false; } } if ( !do_taborder_candidates( x, who, compareProc, stage, result)) { free( ordered); return false; /* fall through */ } } } free( ordered); return true; } Handle Widget_next_tab( Handle self, Bool forward) { Handle horizon = self, result = nilHandle; int stage = 0; while ( PWidget( horizon)-> owner) { if ( ( PWidget( horizon)-> options. optSystemSelectable) || /* fast check for CWindow */ ( PWidget( horizon)-> options. optModalHorizon) ) break; horizon = PWidget( horizon)-> owner; } if ( !CWidget( horizon)-> get_visible( horizon) || !CWidget( horizon)-> get_enabled( horizon)) return nilHandle; do_taborder_candidates( horizon, self, forward ? compare_taborders_forward : compare_taborders_backward, &stage, &result); if ( result == self) result = nilHandle; return result; } /*::o */ /*::p */ void Widget_post_message( Handle self, SV * info1, SV * info2) { PPostMsg p; Event ev = { cmPost}; if ( var-> stage > csNormal) return; if (!( p = alloc1( PostMsg))) return; p-> info1 = newSVsv( info1); p-> info2 = newSVsv( info2); p-> h = self; if ( var-> postList == nil) var-> postList = plist_create( 8, 8); list_add( var-> postList, ( Handle) p); ev. gen. p = p; ev. gen. source = ev. gen. H = self; apc_message( self, &ev, true); } Handle Widget_prev( Handle self) { return apc_widget_get_z_order( self, zoPrev); } Bool Widget_process_accel( Handle self, int key) { enter_method; if ( my-> first_that_component( self, (void*)find_accel, &key)) return true; return kind_of( var-> owner, CWidget) ? ((( PWidget) var-> owner)-> self)->process_accel( var-> owner, key) : false; } /*::q */ /*::r */ void Widget_repaint( Handle self) { enter_method; if ( !opt_InPaint && ( var-> stage == csNormal) && !my-> get_locked( self)) apc_widget_invalidate_rect( self, nil); } /*::s */ void Widget_scroll( Handle self, int dx, int dy, Rect *confine, Rect *clip, Bool withChildren) { enter_method; if ( !opt_InPaint && ( var-> stage == csNormal) && !my-> get_locked( self)) apc_widget_scroll( self, dx, dy, confine, clip, withChildren); } void Widget_scroll_REDEFINED( Handle self, int dx, int dy, Rect *confine, Rect *clip, Bool withChildren) { warn("Invalid call of Widget::scroll"); } XS( Widget_scroll_FROMPERL) { dPROFILE; dXSARGS; Handle self; int dx, dy; Rect *confine = nil; Rect *clip = nil; Rect confine_rect, clip_rect; Bool withChildren = false; HV *profile; int rect[4]; if ( items < 3 || (items - 3) % 2) goto invalid_usage; if (!( self = gimme_the_mate( ST(0)))) goto invalid_usage; dx = SvIV( ST(1)); dy = SvIV( ST(2)); profile = parse_hv( ax, sp, items, mark, 3, "Widget::scroll"); if ( pexist( confineRect)) { prima_read_point( pget_sv( confineRect), rect, 4, "RTC008B: Array panic on 'confineRect'"); confine = &confine_rect; confine-> left = rect[0]; confine-> bottom = rect[1]; confine-> right = rect[2]; confine-> top = rect[3]; } if ( pexist( clipRect)) { prima_read_point( pget_sv( clipRect), rect, 4, "RTC008C: Array panic on 'clipRect'"); clip = &clip_rect; clip-> left = rect[0]; clip-> bottom = rect[1]; clip-> right = rect[2]; clip-> top = rect[3]; } if ( pexist( withChildren)) withChildren = pget_B( withChildren); sv_free((SV*)profile); Widget_scroll( self, dx, dy, confine, clip, withChildren); SPAGAIN; SP -= items; PUTBACK; XSRETURN_EMPTY; invalid_usage: croak ("Invalid usage of %s", "Widget::scroll"); } void Widget_send_to_back( Handle self) { apc_widget_set_z_order( self, nilHandle, false); } void Widget_set( Handle self, HV * profile) { dPROFILE; enter_method; Handle postOwner = nilHandle; AV *order = nil; int geometry = gtDefault; if ( pexist(__ORDER__)) order = (AV*)SvRV(pget_sv( __ORDER__)); if ( pexist( owner)) { if ( !my-> validate_owner( self, &postOwner, profile)) croak( "Illegal 'owner' reference passed to %s::%s", my-> className, "set"); if ( postOwner != var-> owner) { if ( is_opt( optOwnerColor)) { my-> set_color( self, CWidget( postOwner)-> get_color( postOwner)); opt_set( optOwnerColor); } if ( is_opt( optOwnerBackColor)) { my-> set_backColor( self, CWidget( postOwner)-> get_backColor( postOwner)); opt_set( optOwnerBackColor); } if ( is_opt( optOwnerShowHint)) { Bool newSH = ( postOwner == application) ? 1 : CWidget( postOwner)-> get_showHint( postOwner); my-> set_showHint( self, newSH); opt_set( optOwnerShowHint); } if ( is_opt( optOwnerHint)) { my-> set_hint( self, CWidget( postOwner)-> get_hint( postOwner)); opt_set( optOwnerHint); } if ( is_opt( optOwnerFont)) { my-> set_font ( self, CWidget( postOwner)-> get_font( postOwner)); opt_set( optOwnerFont); } } if ( var-> geometry != gtDefault) { geometry = var-> geometry; my-> set_geometry( self, gtDefault); } } /* geometry manipulations */ { #define iLEFT 0 #define iRIGHT 1 #define iTOP 2 #define iBOTTOM 3 #define iWIDTH 4 #define iHEIGHT 5 int i, count; Bool exists[ 6]; int values[ 6]; bzero( values, sizeof(values)); if ( pexist( origin)) { int set[2]; if (order && !pexist(left)) av_push( order, newSVpv("left",0)); if (order && !pexist(bottom)) av_push( order, newSVpv("bottom",0)); prima_read_point( pget_sv( origin), set, 2, "RTC0087: Array panic on 'origin'"); pset_i( left, set[0]); pset_i( bottom, set[1]); pdelete( origin); } if ( pexist( rect)) { int rect[4]; if (order && !pexist(left)) av_push( order, newSVpv("left",0)); if (order && !pexist(bottom)) av_push( order, newSVpv("bottom",0)); if (order && !pexist(width)) av_push( order, newSVpv("width",0)); if (order && !pexist(height)) av_push( order, newSVpv("height",0)); prima_read_point( pget_sv( rect), rect, 4, "RTC0088: Array panic on 'rect'"); pset_i( left, rect[0]); pset_i( bottom, rect[1]); pset_i( width, rect[2] - rect[0]); pset_i( height, rect[3] - rect[1]); pdelete( rect); } if ( pexist( size)) { int set[2]; if (order && !pexist(width)) av_push( order, newSVpv("width",0)); if (order && !pexist(height)) av_push( order, newSVpv("height",0)); prima_read_point( pget_sv( size), set, 2, "RTC0089: Array panic on 'size'"); pset_i( width, set[0]); pset_i( height, set[1]); pdelete( size); } if (( exists[ iLEFT] = pexist( left))) values[ iLEFT] = pget_i( left); if (( exists[ iRIGHT] = pexist( right))) values[ iRIGHT] = pget_i( right); if (( exists[ iTOP] = pexist( top))) values[ iTOP] = pget_i( top); if (( exists[ iBOTTOM] = pexist( bottom ))) values[ iBOTTOM] = pget_i( bottom); if (( exists[ iWIDTH] = pexist( width))) values[ iWIDTH] = pget_i( width); if (( exists[ iHEIGHT] = pexist( height))) values[ iHEIGHT] = pget_i( height); count = 0; for ( i = 0; i < 6; i++) if ( exists[ i]) count++; if ( count > 1) { if ( exists[ iWIDTH] && exists[ iRIGHT] && exists[ iLEFT]) { exists[ iRIGHT] = 0; count--; } if ( exists[ iHEIGHT] && exists[ iTOP] && exists[ iBOTTOM]) { exists[ iTOP] = 0; count--; } if ( exists[ iRIGHT] && exists[ iLEFT]) { exists[ iWIDTH] = 1; values[ iWIDTH] = values[ iRIGHT] - values[ iLEFT]; exists[ iRIGHT] = 0; } if ( exists[ iTOP] && exists[ iBOTTOM]) { exists[ iHEIGHT] = 1; values[ iHEIGHT] = values[ iTOP] - values[ iBOTTOM]; exists[ iTOP] = 0; } if ( ( count == 2) && ( ( exists[ iLEFT] && exists[ iBOTTOM]) || ( exists[ iWIDTH] && exists[ iHEIGHT]) ) ) { Point p; if ( exists[ iLEFT]) { p. x = values[ iLEFT]; p. y = values[ iBOTTOM]; my-> set_origin( self, p); } else { p. x = values[ iWIDTH]; p. y = values[ iHEIGHT]; my-> set_size( self, p); } } else { Rect r; if ( !exists[ iWIDTH] || !exists[ iHEIGHT]) { Point sz; sz = my-> get_size( self); if ( !exists[ iWIDTH]) values[ iWIDTH] = sz. x; if ( !exists[ iHEIGHT]) values[ iHEIGHT] = sz. y; exists[ iWIDTH] = exists[ iHEIGHT] = 1; } if ( ( !exists[ iLEFT] && !exists[ iRIGHT]) || ( !exists[ iBOTTOM] && !exists[ iTOP])) { Point pos; pos = my-> get_origin( self); if ( !exists[ iLEFT]) values[ iLEFT] = pos. x; if ( !exists[ iBOTTOM]) values[ iBOTTOM] = pos. y; exists[ iLEFT] = exists[ iBOTTOM] = 1; } if ( !exists[ iLEFT]) { exists[ iLEFT] = 1; values[ iLEFT] = values[ iRIGHT] - values[ iWIDTH]; } if ( !exists[ iBOTTOM]) { exists[ iBOTTOM] = 1; values[ iBOTTOM] = values[ iTOP] - values[ iHEIGHT]; } r. left = values[ iLEFT]; r. bottom = values[ iBOTTOM]; r. right = values[ iLEFT] + values[ iWIDTH]; r. top = values[ iBOTTOM] + values[ iHEIGHT]; my-> set_rect( self, r); } pdelete( left); pdelete( right); pdelete( top); pdelete( bottom); pdelete( width); pdelete( height); } /* count > 1 */ } if ( pexist( popupFont)) { SvHV_Font( pget_sv( popupFont), &Font_buffer, "Widget::set"); my-> set_popup_font( self, Font_buffer); pdelete( popupFont); } if ( pexist( pointerIcon) && pexist( pointerHotSpot)) { Point hotSpot; Handle icon = pget_H( pointerIcon); prima_read_point( pget_sv( pointerHotSpot), (int*)&hotSpot, 2, "RTC0087: Array panic on 'pointerHotSpot'"); if ( icon != nilHandle && !kind_of( icon, CIcon)) { warn("RTC083: Illegal object reference passed to Widget.set_pointer_icon"); icon = nilHandle; } apc_pointer_set_user( self, icon, hotSpot); if ( var-> pointerType == crUser) my-> first_that( self, (void*)sptr, nil); pdelete( pointerIcon); pdelete( pointerHotSpot); } if ( pexist( designScale)) { AV * av = ( AV *) SvRV( pget_sv( designScale)); SV ** holder = av_fetch( av, 0, 0); NPoint ds = {1,1}; ds. x = holder ? SvNV( *holder) : 1; if ( !holder) warn("RTC0086: Array panic on 'designScale'"); holder = av_fetch( av, 1, 0); ds. y = holder ? SvNV( *holder) : 1; if ( !holder) warn("RTC0086: Array panic on 'designScale'"); my-> set_designScale( self, ds); pdelete( designScale); } if ( pexist( sizeMin)) { Point set; prima_read_point( pget_sv( sizeMin), (int*)&set, 2, "RTC0082: Array panic on 'sizeMin'"); my-> set_sizeMin( self, set); pdelete( sizeMin); } if ( pexist( sizeMax)) { Point set; prima_read_point( pget_sv( sizeMax), (int*)&set, 2, "RTC0083: Array panic on 'sizeMax'"); my-> set_sizeMax( self, set); pdelete( sizeMax); } if ( pexist( cursorSize)) { Point set; prima_read_point( pget_sv( cursorSize), (int*)&set, 2, "RTC0084: Array panic on 'cursorSize'"); my-> set_cursorSize( self, set); pdelete( cursorSize); } if ( pexist( cursorPos)) { Point set; prima_read_point( pget_sv( cursorPos), (int*)&set, 2, "RTC0085: Array panic on 'cursorPos'"); my-> set_cursorPos( self, set); pdelete( cursorPos); } if ( pexist( geomSize)) { Point set; prima_read_point( pget_sv( geomSize), (int*)&set, 2, "RTC0089: Array panic on 'geomSize'"); my-> set_geomSize( self, set); pdelete( geomSize); } inherited-> set( self, profile); if ( postOwner) { my-> set_tabOrder( self, var-> tabOrder); my-> set_geometry( self, geometry); } } void Widget_setup( Handle self) { enter_method; if ( get_top_current( self) && my-> get_enabled( self) && my-> get_visible( self)) my-> set_selected( self, true); inherited-> setup( self); } void Widget_show( Handle self) { enter_method; my-> set_visible( self, true); } void Widget_show_cursor( Handle self) { enter_method; if ( var-> cursorLock-- <= 0) { my-> set_cursorVisible( self, true); var-> cursorLock = 0; } } /*::t */ /*::u */ static Bool repaint_all( Handle owner, Handle self, void * dummy) { enter_method; my-> repaint( self); my-> first_that( self, (void*)repaint_all, nil); return false; } Bool Widget_unlock( Handle self) { if ( --var-> lockCount <= 0) { var-> lockCount = 0; repaint_all( var-> owner, self, nil); } return true; } void Widget_update_view( Handle self) { if ( !opt_InPaint) apc_widget_update( self); } /*::v */ Bool Widget_validate_owner( Handle self, Handle * owner, HV * profile) { dPROFILE; *owner = pget_H( owner); if ( !kind_of( *owner, CWidget)) return false; return inherited-> validate_owner( self, owner, profile); } /*::w */ /*::x */ /*::y */ /*::z */ /* get_props() */ Font Widget_get_default_font( char * dummy) { Font font; apc_widget_default_font( &font); return font; } Font Widget_get_default_popup_font( char * dummy) { Font f; apc_popup_default_font( &f); return f; } NPoint Widget_designScale( Handle self, Bool set, NPoint designScale) { if ( !set) return var-> designScale; if ( designScale. x < 0) designScale. x = 0; if ( designScale. y < 0) designScale. y = 0; var-> designScale = designScale; return designScale; } int Widget_growMode( Handle self, Bool set, int growMode) { enter_method; Bool x = false, y = false; if ( !set) return var-> growMode; var-> growMode = growMode; if ( var-> growMode & gmXCenter) x = true; if ( var-> growMode & gmYCenter) y = true; if ( x || y) my-> set_centered( self, x, y); return var-> growMode; } SV * Widget_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", apc_widget_get_handle( self)); return newSVpv( buf, 0); } SV * Widget_get_parent_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", apc_widget_get_parent_handle( self)); return newSVpv( buf, 0); } int Widget_hintVisible( Handle self, Bool set, int hintVisible) { Bool wantVisible; if ( !set) return PApplication( application)-> hintVisible; if ( var-> stage >= csDead) return false; wantVisible = ( hintVisible != 0); if ( wantVisible == PApplication( application)-> hintVisible) return false; if ( wantVisible) { if ( strlen( var-> hint) == 0) return false; if ( hintVisible > 0) PApplication(application)-> hintActive = -1; /* immediate */ } CApplication( application)-> set_hint_action( application, self, wantVisible, false); return false; } Bool Widget_get_locked( Handle self) { while ( self) { if ( var-> lockCount != 0) return true; self = var-> owner; } return false; } Handle Widget_get_parent( Handle self) { enter_method; return my-> get_clipOwner( self) ? var-> owner : application; } Point Widget_get_pointer_size( char*dummy) { return apc_pointer_get_size( nilHandle); } Font Widget_get_popup_font( Handle self) { return var-> popupFont; } Handle Widget_get_selectee( Handle self) { if ( var-> stage > csFrozen) return nilHandle; if ( is_opt( optSelectable)) return self; else if ( var-> currentWidget) { PWidget w = ( PWidget) var-> currentWidget; if ( w-> options. optSystemSelectable && !w-> self-> get_clipOwner(( Handle) w)) return ( Handle) w; else return w-> self-> get_selectee(( Handle) w); } else if ( is_opt( optSystemSelectable)) return self; else return find_tabfoc( self); } Point Widget_get_virtual_size( Handle self) { return var-> virtualSize; } /* set_props() */ void Widget_set_capture( Handle self, Bool capture, Handle confineTo) { if ( opt_InPaint) return; apc_widget_set_capture( self, capture, confineTo); } void Widget_set_centered( Handle self, Bool x, Bool y) { enter_method; Handle parent = my-> get_parent( self); Point size = CWidget( parent)-> get_size( parent); Point mysize = my-> get_size ( self); Point mypos = my-> get_origin( self); if ( x) mypos. x = ( size. x - mysize. x) / 2; if ( y) mypos. y = ( size. y - mysize. y) / 2; my-> set_origin( self, mypos); } void Widget_set_font( Handle self, Font font) { enter_method; if ( var-> stage > csFrozen) return; if ( !opt_InPaint) my-> first_that( self, (void*)font_notify, &font); if ( var-> handle == nilHandle) return; /* aware of call from Drawable::init */ apc_font_pick( self, &font, & var-> font); if ( opt_InPaint) apc_gp_set_font ( self, & var-> font); else { opt_clear( optOwnerFont); apc_widget_set_font( self, & var-> font); my-> repaint( self); } } void Widget_set_popup_font( Handle self, Font font) { apc_font_pick( self, &font, &var-> popupFont); } /* event handlers */ void Widget_on_paint( Handle self, SV * canvas) { int i; dSP; ENTER; SAVETMPS; PUSHMARK( sp); XPUSHs( canvas); for ( i = 0; i < 4; i++) XPUSHs( sv_2mortal( newSViv( -1))); PUTBACK; PERL_CALL_METHOD( "clear", G_DISCARD); SPAGAIN; PUTBACK; FREETMPS; LEAVE; } /* void Widget_on_click( Handle self) {} void Widget_on_change( Handle self) {} void Widget_on_close( Handle self) {} void Widget_on_colorchanged( Handle self, int colorIndex){} void Widget_on_disable( Handle self) {} void Widget_on_dragdrop( Handle self, Handle source , int x , int y ) {} void Widget_on_dragover( Handle self, Handle source , int x , int y , int state ) {} void Widget_on_enable( Handle self) {} void Widget_on_enddrag( Handle self, Handle target , int x , int y ) {} void Widget_on_fontchanged( Handle self) {} void Widget_on_enter( Handle self) {} void Widget_on_keydown( Handle self, int code , int key , int shiftState, int repeat ) {} void Widget_on_keyup( Handle self, int code , int key , int shiftState ) {} void Widget_on_menu( Handle self, Handle menu, char * variable) {} void Widget_on_setup( Handle self) {} void Widget_on_size( Handle self, Point oldSize, Point newSize) {} void Widget_on_move( Handle self, Point oldPos, Point newPos) {} void Widget_on_show( Handle self) {} void Widget_on_hide( Handle self) {} void Widget_on_hint( Handle self, Bool show) {} void Widget_on_translateaccel( Handle self, int code , int key , int shiftState ) {} void Widget_on_zorderchanged( Handle self) {} void Widget_on_popup( Handle self, Bool mouseDriven, int x, int y) {} void Widget_on_mouseclick( Handle self, int button , int shiftState , int x , int y , Bool dbl ) {} void Widget_on_mousedown( Handle self, int button , int shiftState , int x , int y ) {} void Widget_on_mouseup( Handle self, int button , int shiftState , int x , int y ) {} void Widget_on_mousemove( Handle self, int shiftState , int x , int y ) {} void Widget_on_mousewheel( Handle self, int shiftState , int x , int y, int z ) {} void Widget_on_mouseenter( Handle self, int shiftState , int x , int y ) {} void Widget_on_mouseleave( Handle self ) {} void Widget_on_leave( Handle self) {} */ /* static iterators */ Bool kill_all( Handle self, Handle child, void * dummy) { Object_destroy( child); return 0; } static Bool find_dup_msg( PEvent event, int * cmd) { return event-> cmd == *cmd; } Bool accel_notify ( Handle group, Handle self, PEvent event) { enter_method; if (( self != event-> key. source) && my-> get_enabled( self)) return ( var-> stage <= csNormal) ? !my-> message( self, event) : false; else return false; } static Bool pquery ( Handle window, Handle self, void * v) { enter_method; Event ev = {cmClose}; return ( var-> stage <= csNormal) ? !my-> message( self, &ev) : false; } Bool find_accel( Handle self, Handle item, int * key) { return ( kind_of( item, CAbstractMenu) && CAbstractMenu(item)-> sub_call_key( item, *key)); } static Handle find_tabfoc( Handle self) { int i; Handle toRet; for ( i = 0; i < var-> widgets. count; i++) { PWidget w = ( PWidget)( var-> widgets. items[ i]); if ( w-> self-> get_selectable(( Handle) w) && w-> self-> get_enabled(( Handle) w) ) return ( Handle) w; } for ( i = 0; i < var-> widgets. count; i++) if (( toRet = find_tabfoc( var-> widgets. items[ i]))) return toRet; return nilHandle; } static Bool get_top_current( Handle self) { PWidget o = ( PWidget) var-> owner; Handle me = self; while ( o) { if ( o-> currentWidget != me) return false; me = ( Handle) o; o = ( PWidget) o-> owner; } return true; } static Bool sptr( Handle window, Handle self, void * v) { enter_method; /* does nothing but refreshes system pointer */ if ( var-> pointerType == crDefault) my-> set_pointerType( self, crDefault); return false; } /* static iterators for ownership notifications */ Bool font_notify ( Handle self, Handle child, void * font) { if ( his-> options. optOwnerFont) { his-> self-> set_font ( child, *(( PFont) font)); his-> options. optOwnerFont = 1; } return false; } static Bool showhint_notify ( Handle self, Handle child, void * data) { if ( his-> options. optOwnerShowHint) { his-> self-> set_showHint ( child, *(( Bool *) data)); his-> options. optOwnerShowHint = 1; } return false; } static Bool hint_notify ( Handle self, Handle child, SV * hint) { if ( his-> options. optOwnerHint) { his-> self-> set_hint( child, hint); his-> options. optOwnerHint = 1; } return false; } Bool single_color_notify ( Handle self, Handle child, void * color) { PSingleColor s = ( PSingleColor) color; if ( his-> options. optOwnerColor && ( s-> index == ciFore)) { his-> self-> colorIndex ( child, true, s-> index, s-> color); his-> options. optOwnerColor = 1; } else if (( his-> options. optOwnerBackColor) && ( s-> index == ciBack)) { his-> self-> colorIndex ( child, true, s-> index, s-> color); his-> options. optOwnerBackColor = 1; } else if ( s-> index > ciBack) his-> self-> colorIndex ( child, true, s-> index, s-> color); return false; } Bool prima_read_point( SV *rv_av, int * pt, int number, char * error) { SV ** holder; int i; AV *av; Bool result = true; if ( !rv_av || !SvROK( rv_av) || ( SvTYPE( SvRV( rv_av)) != SVt_PVAV)) { result = false; if ( error) croak( error); } else { av = (AV*)SvRV(rv_av); for ( i = 0; i < number; i++) { holder = av_fetch( av, i, 0); if ( holder) pt[i] = SvIV( *holder); else { pt[i] = 0; result = false; if ( error) croak( error); } } } return result; } static Bool auto_enable_children( Handle self, Handle child, void * enable) { apc_widget_set_enabled( child, PTR2UV( enable)); return false; } /* properties section */ SV * Widget_accelItems( Handle self, Bool set, SV * accelItems) { dPROFILE; enter_method; if ( var-> stage > csFrozen) return nilSV; if ( !set) return var-> accelTable ? CAbstractMenu( var-> accelTable)-> get_items( var-> accelTable, "") : nilSV; if ( var-> accelTable == nilHandle) { HV * profile = newHV(); if ( SvTYPE( accelItems)) pset_sv( items, accelItems); pset_H ( owner, self); my-> set_accelTable( self, create_instance( "Prima::AccelTable")); sv_free(( SV *) profile); } else CAbstractMenu( var-> accelTable)-> set_items( var-> accelTable, accelItems); return nilSV; } Handle Widget_accelTable( Handle self, Bool set, Handle accelTable) { enter_method; if ( var-> stage > csFrozen) return nilHandle; if ( !set) return var-> accelTable; if ( accelTable && !kind_of( accelTable, CAbstractMenu)) return nilHandle; if ( accelTable && (( PAbstractMenu) accelTable)-> owner != self) my-> set_accelItems( self, CAbstractMenu( accelTable)-> get_items( accelTable, "")); else var-> accelTable = accelTable; return accelTable; } Color Widget_backColor( Handle self, Bool set, Color color) { enter_method; if (!set) return my-> colorIndex( self, false, ciBack, 0); my-> colorIndex( self, true, ciBack, color); return color; } int Widget_bottom( Handle self, Bool set, int bottom) { enter_method; Point p = my-> get_origin( self); if ( !set) return p. y; p. y = bottom; my-> set_origin( self, p); return 0; } Bool Widget_autoEnableChildren( Handle self, Bool set, Bool autoEnableChildren) { if ( !set) return is_opt( optAutoEnableChildren); opt_assign( optAutoEnableChildren, autoEnableChildren); return false; } Bool Widget_briefKeys( Handle self, Bool set, Bool briefKeys) { if ( !set) return is_opt( optBriefKeys); opt_assign( optBriefKeys, briefKeys); return false; } Bool Widget_buffered( Handle self, Bool set, Bool buffered) { if ( !set) return is_opt( optBuffered); if ( !opt_InPaint) opt_assign( optBuffered, buffered); return false; } Bool Widget_clipOwner( Handle self, Bool set, Bool clipOwner) { HV * profile; enter_method; if ( !set) return apc_widget_get_clip_owner( self); profile = newHV(); pset_i( clipOwner, clipOwner); my-> set( self, profile); sv_free(( SV *) profile); return false; } Color Widget_color( Handle self, Bool set, Color color) { enter_method; if (!set) return my-> colorIndex( self, false, ciFore, 0); return my-> colorIndex( self, true, ciFore, color); } Color Widget_colorIndex( Handle self, Bool set, int index, Color color) { if ( !set) { if ( index < 0 || index > ciMaxId) return clInvalid; switch ( index) { case ciFore: return opt_InPaint ? inherited-> get_color ( self) : apc_widget_get_color( self, ciFore); case ciBack: return opt_InPaint ? inherited-> get_backColor ( self) : apc_widget_get_color( self, ciBack); default: return apc_widget_get_color( self, index); } } else { enter_method; SingleColor s; s. color = color; s. index = index; if (( index < 0) || ( index > ciMaxId)) return clInvalid; if ( !opt_InPaint) my-> first_that( self, (void*)single_color_notify, &s); if ( var-> handle == nilHandle) return clInvalid; /* aware of call from Drawable::init */ if ((( color & clSysFlag) != 0) && (( color & wcMask) == 0)) color |= var-> widgetClass; if ( opt_InPaint) { switch ( index) { case ciFore: inherited-> set_color ( self, color); break; case ciBack: inherited-> set_backColor ( self, color); break; default: apc_widget_set_color ( self, color, index); } } else { switch ( index) { case ciFore: opt_clear( optOwnerColor); break; case ciBack: opt_clear( optOwnerBackColor); break; } apc_widget_set_color( self, color, index); my-> repaint( self); } } return 0; } Bool Widget_current( Handle self, Bool set, Bool current) { PWidget o; if ( var-> stage > csFrozen) return false; if ( !set) return var-> owner && ( PWidget( var-> owner)-> currentWidget == self); o = ( PWidget) var-> owner; if ( o == nil) return false; if ( current) o-> self-> set_currentWidget( var-> owner, self); else if ( o-> currentWidget == self) o-> self-> set_currentWidget( var-> owner, nilHandle); return current; } Handle Widget_currentWidget( Handle self, Bool set, Handle widget) { enter_method; if ( var-> stage > csFrozen) return nilHandle; if ( !set) return var-> currentWidget; if ( widget) { if ( !widget || ( PWidget( widget)-> stage > csFrozen) || ( PWidget( widget)-> owner != self) ) return nilHandle; var-> currentWidget = widget; } else var-> currentWidget = nilHandle; /* adjust selection if we're in currently selected chain */ if ( my-> get_selected( self)) my-> set_selectedWidget( self, widget); return nilHandle; } Point Widget_cursorPos( Handle self, Bool set, Point cursorPos) { if ( !set) return apc_cursor_get_pos( self); apc_cursor_set_pos( self, cursorPos. x, cursorPos. y); return cursorPos; } Point Widget_cursorSize( Handle self, Bool set, Point cursorSize) { if ( !set) return apc_cursor_get_size( self); apc_cursor_set_size( self, cursorSize. x, cursorSize. y); return cursorSize; } Bool Widget_cursorVisible( Handle self, Bool set, Bool cursorVisible) { if ( !set) return apc_cursor_get_visible( self); return apc_cursor_set_visible( self, cursorVisible); } Bool Widget_enabled( Handle self, Bool set, Bool enabled) { if ( !set) return apc_widget_is_enabled( self); if ( !apc_widget_set_enabled( self, enabled)) return false; if ( is_opt( optAutoEnableChildren)) CWidget(self)-> first_that( self, (void*)auto_enable_children, INT2PTR(void*,enabled)); return true; } Bool Widget_firstClick( Handle self, Bool set, Bool firstClick) { return set ? apc_widget_set_first_click( self, firstClick) : apc_widget_get_first_click( self); } Bool Widget_focused( Handle self, Bool set, Bool focused) { enter_method; if ( var-> stage > csNormal) return false; if ( !set) return apc_widget_is_focused( self); if ( focused) { PWidget x = ( PWidget)( var-> owner); Handle current = self; while ( x) { x-> currentWidget = current; current = ( Handle) x; x = ( PWidget) x-> owner; } var-> currentWidget = nilHandle; if ( var-> stage == csNormal) apc_widget_set_focused( self); } else if ( var-> stage == csNormal && my-> get_selected( self)) apc_widget_set_focused( nilHandle); return focused; } SV * Widget_helpContext( Handle self, Bool set, SV *helpContext) { if ( set) { if ( var-> stage > csFrozen) return nilSV; free( var-> helpContext); var-> helpContext = duplicate_string( SvPV_nolen( helpContext)); opt_assign( optUTF8_helpContext, SvUTF8(helpContext)); } else { helpContext = newSVpv( var-> helpContext ? var-> helpContext : "", 0); if ( is_opt( optUTF8_helpContext)) SvUTF8_on( helpContext); return helpContext; } return nilSV; } SV * Widget_hint( Handle self, Bool set, SV *hint) { enter_method; if ( set) { if ( var-> stage > csFrozen) return nilSV; my-> first_that( self, (void*)hint_notify, (void*)hint); free( var-> hint); var-> hint = duplicate_string( SvPV_nolen( hint)); opt_assign( optUTF8_hint, SvUTF8(hint)); if ( application && (( PApplication) application)-> hintVisible && (( PApplication) application)-> hintUnder == self) { SV * hintText = my-> get_hint( self); Handle hintWidget = (( PApplication) application)-> hintWidget; if ( strlen( var-> hint) == 0) my-> set_hintVisible( self, 0); if ( hintWidget) CWidget(hintWidget)-> set_text( hintWidget, hintText); sv_free( hintText); } opt_clear( optOwnerHint); } else { hint = newSVpv( var-> hint ? var-> hint : "", 0); if ( is_opt( optUTF8_hint)) SvUTF8_on( hint); return hint; } return nilSV; } int Widget_left( Handle self, Bool set, int left) { enter_method; Point p = my-> get_origin( self); if ( !set) return p. x; p. x = left; my-> set_origin( self, p); return 0; } Point Widget_origin( Handle self, Bool set, Point origin) { if ( !set) return apc_widget_get_pos( self); apc_widget_set_pos( self, origin.x, origin.y); return origin; } Bool Widget_ownerBackColor( Handle self, Bool set, Bool ownerBackColor) { enter_method; if ( !set) return is_opt( optOwnerBackColor); opt_assign( optOwnerBackColor, ownerBackColor); if ( is_opt( optOwnerBackColor) && var-> owner) { my-> set_backColor( self, ((( PWidget) var-> owner)-> self)-> get_backColor( var-> owner)); opt_set( optOwnerBackColor); my-> repaint ( self); } return false; } Bool Widget_ownerColor( Handle self, Bool set, Bool ownerColor) { enter_method; if ( !set) return is_opt( optOwnerColor); opt_assign( optOwnerColor, ownerColor); if ( is_opt( optOwnerColor) && var-> owner) { my-> set_color( self, ((( PWidget) var-> owner)-> self)-> get_color( var-> owner)); opt_set( optOwnerColor); my-> repaint( self); } return false; } Bool Widget_ownerFont( Handle self, Bool set, Bool ownerFont ) { enter_method; if ( !set) return is_opt( optOwnerFont); opt_assign( optOwnerFont, ownerFont); if ( is_opt( optOwnerFont) && var-> owner) { my-> set_font ( self, ((( PWidget) var-> owner)-> self)-> get_font ( var-> owner)); opt_set( optOwnerFont); my-> repaint ( self); } return false; } Bool Widget_ownerHint( Handle self, Bool set, Bool ownerHint ) { enter_method; if ( !set) return is_opt( optOwnerHint); opt_assign( optOwnerHint, ownerHint); if ( is_opt( optOwnerHint) && var-> owner) { my-> set_hint( self, ((( PWidget) var-> owner)-> self)-> get_hint ( var-> owner)); opt_set( optOwnerHint); } return false; } Bool Widget_ownerPalette( Handle self, Bool set, Bool ownerPalette) { enter_method; if ( !set) return is_opt( optOwnerPalette); if ( ownerPalette) my-> set_palette( self, nilSV); opt_assign( optOwnerPalette, ownerPalette); return false; } Bool Widget_ownerShowHint( Handle self, Bool set, Bool ownerShowHint ) { enter_method; if ( !set) return is_opt( optOwnerShowHint); opt_assign( optOwnerShowHint, ownerShowHint); if ( is_opt( optOwnerShowHint) && var-> owner) { my-> set_showHint( self, CWidget( var-> owner)-> get_showHint ( var-> owner)); opt_set( optOwnerShowHint); } return false; } SV * Widget_palette( Handle self, Bool set, SV * palette) { int colors; if ( !set) return inherited-> palette( self, set, palette); if ( var-> stage > csFrozen) return nilSV; if ( var-> handle == nilHandle) return nilSV; /* aware of call from Drawable::init */ colors = var-> palSize; free( var-> palette); var-> palette = read_palette( &var-> palSize, palette); opt_clear( optOwnerPalette); if ( colors == 0 && var-> palSize == 0) return nilSV; /* do not bother apc */ if ( opt_InPaint) apc_gp_set_palette( self); else apc_widget_set_palette( self); return nilSV; } Handle Widget_pointerIcon( Handle self, Bool set, Handle icon) { enter_method; Point hotSpot; if ( var-> stage > csFrozen) return nilHandle; if ( !set) { HV * profile = newHV(); Handle icon = Object_create( "Prima::Icon", profile); sv_free(( SV *) profile); apc_pointer_get_bitmap( self, icon); --SvREFCNT( SvRV((( PAnyObject) icon)-> mate)); return icon; } if ( icon != nilHandle && !kind_of( icon, CIcon)) { warn("RTC083: Illegal object reference passed to Widget::pointerIcon"); return nilHandle; } hotSpot = my-> get_pointerHotSpot( self); apc_pointer_set_user( self, icon, hotSpot); if ( var-> pointerType == crUser) my-> first_that( self, (void*)sptr, nil); return nilHandle; } Point Widget_pointerHotSpot( Handle self, Bool set, Point hotSpot) { enter_method; Handle icon; if ( !set) return apc_pointer_get_hot_spot( self); if ( var-> stage > csFrozen) return hotSpot; icon = my-> get_pointerIcon( self); apc_pointer_set_user( self, icon, hotSpot); if ( var-> pointerType == crUser) my-> first_that( self, (void*)sptr, nil); return hotSpot; } int Widget_pointerType( Handle self, Bool set, int type) { enter_method; if ( var-> stage > csFrozen) return 0; if ( !set) return var-> pointerType; var-> pointerType = type; apc_pointer_set_shape( self, type); my-> first_that( self, (void*)sptr, nil); return type; } Point Widget_pointerPos( Handle self, Bool set, Point p) { if ( !set) { p = apc_pointer_get_pos( self); apc_widget_map_points( self, false, 1, &p); return p; } apc_widget_map_points( self, true, 1, &p); apc_pointer_set_pos( self, p. x, p. y); return p; } Handle Widget_popup( Handle self, Bool set, Handle popup) { enter_method; if ( var-> stage > csFrozen) return nilHandle; if ( !set) return var-> popupMenu; if ( popup && !kind_of( popup, CPopup)) return nilHandle; if ( popup && PAbstractMenu( popup)-> owner != self) my-> set_popupItems( self, CAbstractMenu( popup)-> get_items( popup, "")); else var-> popupMenu = popup; return nilHandle; } Color Widget_popupColorIndex( Handle self, Bool set, int index, Color color) { if (( index < 0) || ( index > ciMaxId)) return clInvalid; if ( !set) return var-> popupColor[ index]; if ((( color & clSysFlag) != 0) && (( color & wcMask) == 0)) color |= wcPopup; var-> popupColor[ index] = color; return color; } SV * Widget_popupItems( Handle self, Bool set, SV * popupItems) { dPROFILE; enter_method; if ( var-> stage > csFrozen) return nilSV; if ( !set) return var-> popupMenu ? CAbstractMenu( var-> popupMenu)-> get_items( var-> popupMenu, "") : nilSV; if ( var-> popupMenu == nilHandle) { if ( SvTYPE( popupItems)) { HV * profile = newHV(); pset_sv( items, popupItems); pset_H ( owner, self); my-> set_popup( self, create_instance( "Prima::Popup")); sv_free(( SV *) profile); } } else CAbstractMenu( var-> popupMenu)-> set_items( var-> popupMenu, popupItems); return popupItems; } Rect Widget_rect( Handle self, Bool set, Rect r) { enter_method; if ( !set) { Point p = my-> get_origin( self); Point s = my-> get_size( self); r. left = p. x; r. bottom = p. y; r. right = p. x + s. x; r. top = p. y + s. y; } else apc_widget_set_rect( self, r. left, r. bottom, r. right - r. left, r. top - r. bottom); return r; } int Widget_right( Handle self, Bool set, int right) { enter_method; Point p; Rect r = my-> get_rect( self); if ( !set) return r. right; p. x = r. left - r. right + right; p. y = r. bottom; my-> set_origin( self, p); return 0; } Bool Widget_scaleChildren( Handle self, Bool set, Bool scaleChildren) { if ( !set) return is_opt( optScaleChildren); opt_assign( optScaleChildren, scaleChildren); return false; } Bool Widget_selectable( Handle self, Bool set, Bool selectable) { if ( !set) return is_opt( optSelectable); opt_assign( optSelectable, selectable); return false; } Bool Widget_selected( Handle self, Bool set, Bool selected) { enter_method; if ( !set) return my-> get_selectedWidget( self) != nilHandle; if ( var-> stage > csFrozen) return selected; if ( selected) { if ( is_opt( optSelectable) && !is_opt( optSystemSelectable)) { my-> set_focused( self, true); } else if ( var-> currentWidget) { PWidget w = ( PWidget) var-> currentWidget; if ( w-> options. optSystemSelectable && !w-> self-> get_clipOwner(( Handle) w)) w-> self-> bring_to_front(( Handle) w); /* <- very uncertain !!!! */ else w-> self-> set_selected(( Handle) w, true); } else if ( is_opt( optSystemSelectable)) { /* nothing to do with Widget, reserved for Window */ } else { PWidget toFocus = ( PWidget) find_tabfoc( self); if ( toFocus) toFocus-> self-> set_selected(( Handle) toFocus, 1); else { /* if group has no selectable widgets and cannot be selected by itself, */ /* process chain of bring_to_front(), followed by set_focused(1) call, if available */ PWidget x = ( PWidget) var-> owner; List lst; int i; list_create( &lst, 8, 8); while ( x) { if ( !toFocus && x-> options. optSelectable) { toFocus = x; /* choose closest owner to focus */ break; } if (( Handle) x != application && !kind_of(( Handle) x, CWindow)) list_insert_at( &lst, ( Handle) x, 0); x = ( PWidget) x-> owner; } if ( toFocus) toFocus-> self-> set_focused(( Handle) toFocus, 1); for ( i = 0; i < lst. count; i++) { PWidget v = ( PWidget) list_at( &lst, i); v-> self-> bring_to_front(( Handle) v); } list_destroy( &lst); } } /* end set_selected( true); */ } else my-> set_focused( self, false); return selected; } Handle Widget_selectedWidget( Handle self, Bool set, Handle widget) { if ( var-> stage > csFrozen) return nilHandle; if ( !set) { if ( var-> stage <= csNormal) { Handle foc = apc_widget_get_focused(); PWidget f = ( PWidget) foc; while( f) { if (( Handle) f == self) return foc; f = ( PWidget) f-> owner; } } return nilHandle; /* classic solution should be recursive and inheritant call */ /* of get_selected() here, when Widget would return state of */ /* child-group selected state until Widget::selected() called; */ /* thus, each of them would call apc_widget_get_focused - that's expensive, */ /* so that's the reason not to use classic object model here. */ } if ( widget) { if ( PWidget( widget)-> owner == self) CWidget( widget)-> set_selected( widget, true); } else { /* give selection up to hierarchy chain */ Handle s = self; while ( s) { if ( CWidget( s)-> get_selectable( s)) { CWidget( s)-> set_selected( s, true); break; } s = PWidget( s)-> owner; } } return nilHandle; } int Widget_selectingButtons( Handle self, Bool set, int sb) { if ( !set) return var-> selectingButtons; return var-> selectingButtons = sb; } Handle Widget_shape( Handle self, Bool set, Handle mask) { if ( var-> stage > csFrozen) return nilHandle; if ( !set) { if ( apc_widget_get_shape( self, nilHandle)) { HV * profile = newHV(); Handle i = Object_create( "Prima::Image", profile); sv_free(( SV *) profile); apc_widget_get_shape( self, i); --SvREFCNT( SvRV((( PAnyObject) i)-> mate)); return i; } else return nilHandle; } if ( mask && !kind_of( mask, CImage)) { warn("RTC008A: Illegal object reference passed to Widget::shape"); return nilHandle; } if ( mask && (( PImage( mask)-> type & imBPP) != imbpp1)) { Handle i = CImage( mask)-> dup( mask); ++SvREFCNT( SvRV( PImage( i)-> mate)); CImage( i)-> set_conversion( i, ictNone); CImage( i)-> set_type( i, imBW); apc_widget_set_shape( self, i); --SvREFCNT( SvRV( PImage( i)-> mate)); Object_destroy( i); } else apc_widget_set_shape( self, mask); return nilHandle; } Bool Widget_showHint( Handle self, Bool set, Bool showHint ) { enter_method; Bool oldShowHint = is_opt( optShowHint); if ( !set) return oldShowHint; my-> first_that( self, (void*)showhint_notify, &showHint); opt_clear( optOwnerShowHint); opt_assign( optShowHint, showHint); if ( application && !is_opt( optShowHint) && oldShowHint) my-> set_hintVisible( self, 0); return false; } Point Widget_size( Handle self, Bool set, Point size) { if ( !set) return apc_widget_get_size( self); apc_widget_set_size( self, size.x, size.y); return size; } Bool Widget_syncPaint( Handle self, Bool set, Bool syncPaint) { HV * profile; enter_method; if ( !set) return apc_widget_get_sync_paint( self); profile = newHV(); pset_i( syncPaint, syncPaint); my-> set( self, profile); sv_free(( SV *) profile); return false; } int Widget_tabOrder( Handle self, Bool set, int tabOrder) { int count; PWidget owner; if ( var-> stage > csFrozen) return 0; if ( !set) return var-> tabOrder; owner = ( PWidget) var-> owner; count = owner-> widgets. count; if ( tabOrder < 0) { int i, maxOrder = -1; /* finding maximal tabOrder value among the siblings */ for ( i = 0; i < count; i++) { PWidget ctrl = ( PWidget) owner-> widgets. items[ i]; if ( self == ( Handle) ctrl) continue; if ( maxOrder < ctrl-> tabOrder) maxOrder = ctrl-> tabOrder; } if ( maxOrder < INT_MAX) { var-> tabOrder = maxOrder + 1; return 0; } /* maximal value found, but has no use; finding gaps */ { int j = 0; Bool match = 1; while ( !match) { for ( i = 0; i < count; i++) { PWidget ctrl = ( PWidget) owner-> widgets. items[ i]; if ( self == ( Handle) ctrl) continue; if ( ctrl-> tabOrder == j) { match = 1; break; } } j++; } var-> tabOrder = j - 1; } } else { int i; Bool match = 0; /* finding exact match among the siblings */ for ( i = 0; i < count; i++) { PWidget ctrl = ( PWidget) owner-> widgets. items[ i]; if ( self == ( Handle) ctrl) continue; if ( ctrl-> tabOrder == tabOrder) { match = 1; break; } } if ( match) /* incrementing all tabOrders that greater than ours */ for ( i = 0; i < count; i++) { PWidget ctrl = ( PWidget) owner-> widgets. items[ i]; if ( self == ( Handle) ctrl) continue; if ( ctrl-> tabOrder >= tabOrder) ctrl-> tabOrder++; } var-> tabOrder = tabOrder; } return 0; } Bool Widget_tabStop( Handle self, Bool set, Bool stop) { if ( !set) return is_opt( optTabStop); opt_assign( optTabStop, stop); return false; } Bool Widget_transparent( Handle self, Bool set, Bool transparent) { HV * profile; enter_method; if ( !set) return apc_widget_get_transparent( self); profile = newHV(); pset_i( transparent, transparent); my-> set( self, profile); sv_free(( SV *) profile); return false; } SV * Widget_text( Handle self, Bool set, SV *text) { if ( set) { if ( var-> stage > csFrozen) return nilSV; free( var-> text); var-> text = duplicate_string( SvPV_nolen( text)); opt_assign( optUTF8_text, SvUTF8(text)); } else { text = newSVpv( var-> text ? var-> text : "", 0); if ( is_opt( optUTF8_text)) SvUTF8_on( text); return text; } return nilSV; } int Widget_top( Handle self, Bool set, int top) { enter_method; Point p; Rect r = my-> get_rect( self); if ( !set) return r. top; p. x = r. left; p. y = r. bottom - r. top + top; my-> set_origin( self, p); return 0; } Bool Widget_visible( Handle self, Bool set, Bool visible) { return set ? apc_widget_set_visible( self, visible) : apc_widget_is_visible( self); } int Widget_widgetClass( Handle self, Bool set, int widgetClass) { enter_method; if ( !set) return var-> widgetClass; var-> widgetClass = widgetClass; my-> repaint( self); return 0; } /* XS section */ XS( Widget_client_to_screen_FROMPERL) { dXSARGS; Handle self; int i, count; Point * points; if (( items % 2) != 1) croak ("Invalid usage of Widget::client_to_screen"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Widget::client_to_screen"); count = ( items - 1) / 2; if ( !( points = allocn( Point, count))) { PUTBACK; return; } for ( i = 0; i < count; i++) { points[i]. x = SvIV( ST( i * 2 + 1)); points[i]. y = SvIV( ST( i * 2 + 2)); } apc_widget_map_points( self, true, count, points); EXTEND( sp, count * 2); for ( i = 0; i < count; i++) { PUSHs( sv_2mortal( newSViv( points[i].x))); PUSHs( sv_2mortal( newSViv( points[i].y))); } PUTBACK; free( points); return; } XS( Widget_screen_to_client_FROMPERL) { dXSARGS; Handle self; int i, count; Point * points; if (( items % 2) != 1) croak ("Invalid usage of Widget::screen_to_client"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Widget::screen_to_client"); count = ( items - 1) / 2; if ( !( points = allocn( Point, count))) { PUTBACK; return; } for ( i = 0; i < count; i++) { points[i]. x = SvIV( ST( i * 2 + 1)); points[i]. y = SvIV( ST( i * 2 + 2)); } apc_widget_map_points( self, false, count, points); EXTEND( sp, count * 2); for ( i = 0; i < count; i++) { PUSHs( sv_2mortal( newSViv( points[i].x))); PUSHs( sv_2mortal( newSViv( points[i].y))); } PUTBACK; free( points); return; } XS( Widget_get_widgets_FROMPERL) { dXSARGS; Handle self; Handle * list; int i, count; if ( items != 1) croak ("Invalid usage of Widget.get_widgets"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Widget.get_widgets"); count = var-> widgets. count; list = var-> widgets. items; EXTEND( sp, count); for ( i = 0; i < count; i++) PUSHs( sv_2mortal( newSVsv((( PAnyObject) list[ i])-> mate))); PUTBACK; return; } void Widget_get_widgets ( Handle self) { warn("Invalid call of Widget::get_widgets"); } void Widget_get_widgets_REDEFINED( Handle self) { warn("Invalid call of Widget::get_widgets"); } void Widget_screen_to_client ( Handle self) { warn("Invalid call of Widget::screen_to_client"); } void Widget_screen_to_client_REDEFINED ( Handle self) { warn("Invalid call of Widget::screen_to_client"); } void Widget_client_to_screen ( Handle self) { warn("Invalid call of Widget::screen_to_client"); } void Widget_client_to_screen_REDEFINED ( Handle self) { warn("Invalid call of Widget::screen_to_client"); } #ifdef __cplusplus } #endif Prima-1.28/Drawable.c0000644000175100017510000012512311150770061012163 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * -------------------------------------------------------------------- * Parabolic spline procedures taken from TclTk's tkTrig.c * * Copyright (c) 1992-1994 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * * See the file "license.terms" in TclTk distribution * for information on usage and redistribution * of this code, and for a DISCLAIMER OF ALL WARRANTIES. * --------------------------------------------------------------------- * * $Id: Drawable.c,v 1.99 2008/04/24 21:30:14 dk Exp $ */ #include "apricot.h" #include "Drawable.h" #include "Image.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CComponent-> #define my ((( PDrawable) self)-> self) #define var (( PDrawable) self) #define gpARGS Bool inPaint = opt_InPaint #define gpENTER(fail) if ( !inPaint) if ( !my-> begin_paint_info( self)) return (fail) #define gpLEAVE if ( !inPaint) my-> end_paint_info( self) void Drawable_init( Handle self, HV * profile) { dPROFILE; inherited init( self, profile); apc_gp_init( self); var-> w = var-> h = 0; my-> set_color ( self, pget_i ( color)); my-> set_backColor ( self, pget_i ( backColor)); my-> set_fillWinding ( self, pget_B ( fillWinding)); my-> set_fillPattern ( self, pget_sv( fillPattern)); my-> set_lineEnd ( self, pget_i ( lineEnd)); my-> set_lineJoin ( self, pget_i ( lineJoin)); my-> set_linePattern ( self, pget_sv( linePattern)); my-> set_lineWidth ( self, pget_i ( lineWidth)); my-> set_region ( self, pget_H ( region)); my-> set_rop ( self, pget_i ( rop)); my-> set_rop2 ( self, pget_i ( rop2)); my-> set_textOpaque ( self, pget_B ( textOpaque)); my-> set_textOutBaseline( self, pget_B ( textOutBaseline)); my-> set_splinePrecision( self, pget_i ( splinePrecision)); if ( pexist( translate)) { AV * av = ( AV *) SvRV( pget_sv( translate)); Point tr = {0,0}; SV ** holder = av_fetch( av, 0, 0); if ( holder) tr.x = SvIV( *holder); else warn("RTC0059: Array panic on 'translate'"); holder = av_fetch( av, 1, 0); if ( holder) tr.y = SvIV( *holder); else warn("RTC0059: Array panic on 'translate'"); my-> set_translate( self, tr); } SvHV_Font( pget_sv( font), &Font_buffer, "Drawable::init"); my-> set_font( self, Font_buffer); my-> set_palette( self, pget_sv( palette)); CORE_INIT_TRANSIENT(Drawable); } static void clear_font_abc_caches( Handle self) { PList u; if (( u = var-> font_abc_unicode)) { int i; for ( i = 0; i < u-> count; i += 2) free(( void*) u-> items[ i + 1]); plist_destroy( u); var-> font_abc_unicode = nil; } if ( var-> font_abc_ascii) { free( var-> font_abc_ascii); var-> font_abc_ascii = nil; } } void Drawable_done( Handle self) { clear_font_abc_caches( self); apc_gp_done( self); inherited done( self); } void Drawable_cleanup( Handle self) { if ( is_opt( optInDrawInfo)) my-> end_paint_info( self); if ( is_opt( optInDraw)) my-> end_paint( self); inherited cleanup( self); } Bool Drawable_begin_paint( Handle self) { if ( var-> stage > csFrozen) return false; if ( is_opt( optInDrawInfo)) my-> end_paint_info( self); opt_set( optInDraw); var-> splinePrecision_saved = var-> splinePrecision; return true; } void Drawable_end_paint( Handle self) { clear_font_abc_caches( self); opt_clear( optInDraw); var-> splinePrecision = var-> splinePrecision_saved; } Bool Drawable_begin_paint_info( Handle self) { if ( var-> stage > csFrozen) return false; if ( is_opt( optInDraw)) return true; if ( is_opt( optInDrawInfo)) return false; opt_set( optInDrawInfo); var-> splinePrecision_saved = var-> splinePrecision; return true; } void Drawable_end_paint_info( Handle self) { clear_font_abc_caches( self); opt_clear( optInDrawInfo); var-> splinePrecision = var-> splinePrecision_saved; } void Drawable_set( Handle self, HV * profile) { dPROFILE; if ( pexist( font)) { SvHV_Font( pget_sv( font), &Font_buffer, "Drawable::set"); my-> set_font( self, Font_buffer); pdelete( font); } if ( pexist( translate)) { AV * av = ( AV *) SvRV( pget_sv( translate)); Point tr = {0,0}; SV ** holder = av_fetch( av, 0, 0); if ( holder) tr.x = SvIV( *holder); else warn("RTC0059: Array panic on 'translate'"); holder = av_fetch( av, 1, 0); if ( holder) tr.y = SvIV( *holder); else warn("RTC0059: Array panic on 'translate'"); my-> set_translate( self, tr); pdelete( translate); } if ( pexist( width) && pexist( height)) { Point size; size. x = pget_i( width); size. y = pget_i( height); my-> set_size( self, size); pdelete( width); pdelete( height); } inherited set( self, profile); } Font * Drawable_font_match( char * dummy, Font * source, Font * dest, Bool pick) { if ( pick) apc_font_pick( nilHandle, source, dest); else Drawable_font_add( nilHandle, source, dest); return dest; } Bool Drawable_font_add( Handle self, Font * source, Font * dest) { Bool useHeight = source-> height != C_NUMERIC_UNDEF; Bool useWidth = source-> width != C_NUMERIC_UNDEF; Bool useSize = source-> size != C_NUMERIC_UNDEF; Bool usePitch = source-> pitch != C_NUMERIC_UNDEF; Bool useStyle = source-> style != C_NUMERIC_UNDEF; Bool useDir = source-> direction != C_NUMERIC_UNDEF; Bool useName = strcmp( source-> name, C_STRING_UNDEF) != 0; Bool useEnc = strcmp( source-> encoding, C_STRING_UNDEF) != 0; /* assignning values */ if ( dest != source) { if ( useHeight) dest-> height = source-> height; if ( useWidth ) dest-> width = source-> width; if ( useDir ) dest-> direction = source-> direction; if ( useStyle ) dest-> style = source-> style; if ( usePitch ) dest-> pitch = source-> pitch; if ( useSize ) dest-> size = source-> size; if ( useName ) strcpy( dest-> name, source-> name); if ( useEnc ) strcpy( dest-> encoding, source-> encoding); } /* nulling dependencies */ if ( !useHeight && useSize) dest-> height = 0; if ( !useWidth && ( usePitch || useHeight || useName || useSize || useDir || useStyle)) dest-> width = 0; if ( !usePitch && ( useStyle || useName || useDir || useWidth)) dest-> pitch = fpDefault; if ( useHeight) dest-> size = 0; if ( !useHeight && !useSize && ( dest-> height <= 0 || dest-> height > 16383)) useSize = 1; /* validating entries */ if ( dest-> height <= 0) dest-> height = 1; else if ( dest-> height > 16383 ) dest-> height = 16383; if ( dest-> width < 0) dest-> width = 1; else if ( dest-> width > 16383 ) dest-> width = 16383; if ( dest-> size <= 0) dest-> size = 1; else if ( dest-> size > 16383 ) dest-> size = 16383; if ( dest-> name[0] == 0) strcpy( dest-> name, "Default"); if ( dest-> pitch < fpDefault || dest-> pitch > fpFixed) dest-> pitch = fpDefault; if ( dest-> direction == C_NUMERIC_UNDEF) dest-> direction = 0; if ( dest-> style == C_NUMERIC_UNDEF) dest-> style = 0; return useSize && !useHeight; } int Drawable_get_paint_state( Handle self) { if ( is_opt( optInDraw)) return 1; else if ( is_opt( optInDrawInfo)) return 2; else return 0; } int Drawable_get_bpp( Handle self) { gpARGS; int ret; gpENTER(0); ret = apc_gp_get_bpp( self); gpLEAVE; return ret; } SV * Drawable_linePattern( Handle self, Bool set, SV * pattern) { if ( set) { STRLEN len; unsigned char *pat = ( unsigned char *) SvPV( pattern, len); if ( len > 255) len = 255; apc_gp_set_line_pattern( self, pat, len); } else { unsigned char ret[ 256]; int len = apc_gp_get_line_pattern( self, ret); return newSVpvn((char*) ret, len); } return nilSV; } Color Drawable_get_nearest_color( Handle self, Color color) { gpARGS; gpENTER(clInvalid); color = apc_gp_get_nearest_color( self, color); gpLEAVE; return color; } Point Drawable_resolution( Handle self, Bool set, Point resolution) { if ( set) croak("Attempt to write read-only property %s", "Drawable::resolution"); resolution = apc_gp_get_resolution( self); return resolution; } SV * Drawable_get_physical_palette( Handle self) { gpARGS; int i, nCol; AV * av = newAV(); PRGBColor r; gpENTER(newRV_noinc(( SV *) av)); r = apc_gp_get_physical_palette( self, &nCol); gpLEAVE; for ( i = 0; i < nCol; i++) { av_push( av, newSViv( r[ i].b)); av_push( av, newSViv( r[ i].g)); av_push( av, newSViv( r[ i].r)); } free( r); return newRV_noinc(( SV *) av); } SV * Drawable_get_font_abc( Handle self, int first, int last, Bool unicode) { int i; AV * av; PFontABC abc; if ( first < 0) first = 0; if ( last < 0) last = 255; if ( !unicode) { if ( first > 255) first = 255; if ( last > 255) last = 255; } if ( first > last) abc = nil; else { gpARGS; gpENTER( newRV_noinc(( SV *) newAV())); abc = apc_gp_get_font_abc( self, first, last, unicode ); gpLEAVE; } av = newAV(); if ( abc != nil) { for ( i = 0; i <= last - first; i++) { av_push( av, newSVnv( abc[ i]. a)); av_push( av, newSVnv( abc[ i]. b)); av_push( av, newSVnv( abc[ i]. c)); } free( abc); } return newRV_noinc(( SV *) av); } SV * Drawable_get_font_ranges( Handle self) { int count = 0; unsigned long * ret; AV * av = newAV(); gpARGS; gpENTER( newRV_noinc(( SV *) av)); ret = apc_gp_get_font_ranges( self, &count); gpLEAVE; if ( ret) { int i; for ( i = 0; i < count; i++) av_push( av, newSViv( ret[i])); free( ret); } return newRV_noinc(( SV *) av); } SV * Drawable_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", apc_gp_get_handle( self)); return newSVpv( buf, 0); } int Drawable_height( Handle self, Bool set, int height) { Point p = my-> get_size( self); if ( !set) return p. y; p. y = height; my-> set_size( self, p); return height; } Point Drawable_size ( Handle self, Bool set, Point size) { if ( set) croak("Attempt to write read-only property %s", "Drawable::size"); size. x = var-> w; size. y = var-> h; return size; } int Drawable_width( Handle self, Bool set, int width) { Point p = my-> get_size( self); if ( !set) return p. x; p. x = width; my-> set_size( self, p); return width; } Bool Drawable_put_image_indirect( Handle self, Handle image, int x, int y, int xFrom, int yFrom, int xDestLen, int yDestLen, int xLen, int yLen, int rop) { Bool ok; if ( image == nilHandle) return false; if ( xLen == xDestLen && yLen == yDestLen) ok = apc_gp_put_image( self, image, x, y, xFrom, yFrom, xLen, yLen, rop); else ok = apc_gp_stretch_image( self, image, x, y, xFrom, yFrom, xDestLen, yDestLen, xLen, yLen, rop); if ( !ok) perl_error(); return ok; } Bool Drawable_text_out( Handle self, SV * text, int x, int y) { Bool ok; STRLEN dlen; char * c_text = SvPV( text, dlen); Bool utf8 = SvUTF8( text); if ( utf8) dlen = utf8_length(( U8*) c_text, ( U8*) c_text + dlen); ok = apc_gp_text_out( self, c_text, x, y, dlen, utf8); if ( !ok) perl_error(); return ok; } Point * Drawable_polypoints( SV * points, char * procName, int mod, int * n_points) { AV * av; int i, count; Point * p; if ( !SvROK( points) || ( SvTYPE( SvRV( points)) != SVt_PVAV)) { warn("RTC0050: Invalid array reference passed to %s", procName); return nil; } av = ( AV *) SvRV( points); count = av_len( av) + 1; if ( count % mod) { warn("RTC0051: Drawable::%s: Number of elements in an array must be a multiple of %d", procName, mod); return nil; } count /= 2; if ( count < 2) return nil; if (!( p = allocn( Point, count))) return false; for ( i = 0; i < count; i++) { SV** psvx = av_fetch( av, i * 2, 0); SV** psvy = av_fetch( av, i * 2 + 1, 0); if (( psvx == nil) || ( psvy == nil)) { free( p); warn("RTC0052: Array panic on item pair %d on Drawable::%s", i, procName); return nil; } p[ i]. x = SvIV( *psvx); p[ i]. y = SvIV( *psvy); } *n_points = count; return p; } static Bool polypoints( Handle self, SV * points, char * procName, int mod, Bool (*procPtr)(Handle,int,Point*)) { int count; Point * p; Bool ret = false; if (( p = Drawable_polypoints( points, procName, mod, &count))) { ret = procPtr( self, count, p); if ( !ret) perl_error(); free( p); } return ret; } Bool Drawable_polyline( Handle self, SV * points) { return polypoints( self, points, "Drawable::polyline", 2, apc_gp_draw_poly); } Bool Drawable_lines( Handle self, SV * points) { return polypoints( self, points, "Drawable::lines", 4, apc_gp_draw_poly2); } Bool Drawable_fillpoly( Handle self, SV * points) { return polypoints( self, points, "Drawable::fillpoly", 2, apc_gp_fill_poly); } /* *-------------------------------------------------------------- * * TkBezierScreenPoints -- * * Given four control points, create a larger set of XPoints * for a Bezier spline based on the points. * * Results: * The array at *xPointPtr gets filled in with numSteps XPoints * corresponding to the Bezier spline defined by the four * control points. Note: no output point is generated for the * first input point, but an output point *is* generated for * the last input point. * * Side effects: * None. * *-------------------------------------------------------------- */ static void TkBezierScreenPoints( double control[], /* Array of coordinates for four * control points: x0, y0, x1, y1, * ... x3 y3. */ int numSteps, /* Number of curve points to * generate. */ register Point *xPointPtr) /* Where to put new points. */ { int i; double u, u2, u3, t, t2, t3; for (i = 1; i <= numSteps; i++, xPointPtr++) { t = ((double) i)/((double) numSteps); t2 = t*t; t3 = t2*t; u = 1.0 - t; u2 = u*u; u3 = u2*u; xPointPtr-> x = control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3; xPointPtr-> y = control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3; } } /* *-------------------------------------------------------------- * * TkMakeBezierCurve -- * * Given a set of points, create a new set of points that fit * parabolic splines to the line segments connecting the original * points. * * Note: in spite of this procedure's name, it does *not* generate * Bezier curves. Since only three control points are used for * each curve segment, not four, the curves are actually just * parabolic. * * Results: * xPoints array is always filled * in. The return value is the number of points placed in the * array. Note: if the first and last points are the same, then * a closed curve is generated. * * Side effects: * None. * *-------------------------------------------------------------- */ static int TkMakeBezierCurve( int *pointPtr, /* Array of input coordinates: x0, * y0, x1, y1, etc.. */ int numPoints, /* Number of points at pointPtr. */ int numSteps, /* Number of steps to use for each * spline segments (determines * smoothness of curve). */ Point xPoints[]) /* Array of Points to fill in (e.g. * for display. NULL means don't * fill in any Points. */ { int closed, outputPoints, i; int numCoords = numPoints*2; double control[8]; /* * If the curve is a closed one then generate a special spline * that spans the last points and the first ones. Otherwise * just put the first point into the output. */ if (!pointPtr) { /* Of pointPtr == NULL, this function returns an upper limit. * of the array size to store the coordinates. This can be * used to allocate storage, before the actual coordinates * are calculated. */ return 1 + numPoints * numSteps; } outputPoints = 0; if ((pointPtr[0] == pointPtr[numCoords-2]) && (pointPtr[1] == pointPtr[numCoords-1])) { closed = 1; control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0]; control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1]; control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0]; control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1]; control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2]; control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; if (xPoints != NULL) { xPoints-> x = control[0]; xPoints-> y = control[1]; TkBezierScreenPoints( control, numSteps, xPoints+1); xPoints += numSteps+1; } outputPoints += numSteps+1; } else { closed = 0; if (xPoints != NULL) { xPoints->x = pointPtr[0]; xPoints->y = pointPtr[1]; xPoints += 1; } outputPoints += 1; } for (i = 2; i < numPoints; i++, pointPtr += 2) { /* * Set up the first two control points. This is done * differently for the first spline of an open curve * than for other cases. */ if ((i == 2) && !closed) { control[0] = pointPtr[0]; control[1] = pointPtr[1]; control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2]; control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3]; } else { control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2]; control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3]; } /* * Set up the last two control points. This is done * differently for the last spline of an open curve * than for other cases. */ if ((i == (numPoints-1)) && !closed) { control[4] = .667*pointPtr[2] + .333*pointPtr[4]; control[5] = .667*pointPtr[3] + .333*pointPtr[5]; control[6] = pointPtr[4]; control[7] = pointPtr[5]; } else { control[4] = .833*pointPtr[2] + .167*pointPtr[4]; control[5] = .833*pointPtr[3] + .167*pointPtr[5]; control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4]; control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5]; } /* * If the first two points coincide, or if the last * two points coincide, then generate a single * straight-line segment by outputting the last control * point. */ if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3])) || ((pointPtr[2] == pointPtr[4]) && (pointPtr[3] == pointPtr[5]))) { if (xPoints != NULL) { xPoints[0].x = control[6]; xPoints[0].y = control[7]; xPoints++; } outputPoints += 1; continue; } /* * Generate a Bezier spline using the control points. */ if (xPoints != NULL) { TkBezierScreenPoints(control, numSteps, xPoints); xPoints += numSteps; } outputPoints += numSteps; } return outputPoints; } #define STATIC_ARRAY_SIZE 200 static Bool plot_spline( Handle self, int count, Point * points, Bool fill) { Bool ret; int array_size; Point static_array[STATIC_ARRAY_SIZE], *array; array_size = TkMakeBezierCurve( NULL, count, var-> splinePrecision, NULL); if ( array_size >= STATIC_ARRAY_SIZE) { if ( !( array = malloc( array_size * sizeof( Point)))) { warn("Not enough memory"); return false; } } else array = static_array; array_size = TkMakeBezierCurve((int*) points, count, var-> splinePrecision, array); if ( fill && ( my-> fillpoly == Drawable_fillpoly)) { ret = apc_gp_fill_poly( self, array_size, array); if ( !ret) perl_error(); } else if ( !fill && ( my-> polyline == Drawable_polyline)) { ret = apc_gp_draw_poly( self, array_size, array); if ( !ret) perl_error(); } else { int i; AV * av = newAV(); SV * sv = newRV(( SV*) av); for ( i = 0; i < array_size; i++) { av_push( av, newSViv( array[i]. x)); av_push( av, newSViv( array[i]. y)); } ret = fill ? my-> fillpoly( self, sv) : my-> polyline( self, sv); sv_free( sv); } if ( array != static_array) free( array); return ret; } static Bool spline( Handle self, int count, Point * points) { return plot_spline( self, count, points, false); } static Bool fill_spline( Handle self, int count, Point * points) { return plot_spline( self, count, points, true); } Bool Drawable_spline( Handle self, SV * points) { return polypoints( self, points, "Drawable::spline", 2, spline); } Bool Drawable_fill_spline( Handle self, SV * points) { return polypoints( self, points, "Drawable::fill_spline", 2, fill_spline); } SV * Drawable_render_spline( SV * obj, SV * points, int precision) { int i, n_p, array_size; Point static_array[STATIC_ARRAY_SIZE], *array, *p; AV * av; if ( precision < 0) { Handle self; self = gimme_the_mate( obj); precision = self ? var-> splinePrecision : 24; } av = newAV(); p = Drawable_polypoints( points, "Drawable::render_spline", 2, &n_p); if ( p) { array_size = TkMakeBezierCurve( NULL, n_p, precision, NULL); if ( array_size >= STATIC_ARRAY_SIZE) { if ( !( array = malloc( array_size * sizeof( Point)))) { warn("Not enough memory"); free( p); return newRV_noinc(( SV *) av); } } else array = static_array; array_size = TkMakeBezierCurve((int*) p, n_p, precision, array); for ( i = 0; i < array_size; i++) { av_push( av, newSViv( array[i]. x)); av_push( av, newSViv( array[i]. y)); } if ( array != static_array) free( array); free( p); } return newRV_noinc(( SV *) av); } int Drawable_get_text_width( Handle self, SV * text, Bool addOverhang) { gpARGS; int res; STRLEN dlen; char * c_text = SvPV( text, dlen); Bool utf8 = SvUTF8( text); if ( utf8) dlen = utf8_length(( U8*) c_text, ( U8*) c_text + dlen); gpENTER(0); res = apc_gp_get_text_width( self, c_text, dlen, addOverhang, utf8); gpLEAVE; return res; } SV * Drawable_get_text_box( Handle self, SV * text) { gpARGS; Point * p; AV * av; int i; STRLEN dlen; char * c_text = SvPV( text, dlen); Bool utf8 = SvUTF8( text); if ( utf8) dlen = utf8_length(( U8*) c_text, ( U8*) c_text + dlen); gpENTER( newRV_noinc(( SV *) newAV())); p = apc_gp_get_text_box( self, c_text, dlen, utf8); gpLEAVE; av = newAV(); if ( p) { for ( i = 0; i < 5; i++) { av_push( av, newSViv( p[ i]. x)); av_push( av, newSViv( p[ i]. y)); }; free( p); } return newRV_noinc(( SV *) av); } static PFontABC query_abc_range( Handle self, TextWrapRec * t, unsigned int base) { PFontABC abc; /* find if present in cache */ if ( t-> utf8_text) { if ( *(t-> unicode)) { int i; PList p; if (( p = *(t-> unicode))) for ( i = 0; i < p-> count; i += 2) if (( unsigned int) p-> items[ i] == base) return ( PFontABC) p-> items[i + 1]; } } else if ( *( t-> ascii)) return *(t-> ascii); /* query ABC information */ if ( !self) { abc = apc_gp_get_font_abc( self, base * 256, base * 256 + 255, t-> utf8_text); if ( !abc) return nil; } else if ( my-> get_font_abc == Drawable_get_font_abc) { gpARGS; gpENTER(nil); abc = apc_gp_get_font_abc( self, base * 256, base * 256 + 255, t-> utf8_text); gpLEAVE; if ( !abc) return nil; } else { SV * sv; if ( !( abc = malloc( 256 * sizeof( FontABC)))) return nil; sv = my-> get_font_abc( self, base * 256, base * 256 + 255, t-> utf8_text); if ( SvOK( sv) && SvROK( sv) && SvTYPE( SvRV( sv)) == SVt_PVAV) { AV * av = ( AV*) SvRV( sv); int i, j = 0, n = av_len( av) + 1; if ( n > 256 * 3) n = 256 * 3; n = ( n / 3) * 3; if ( n < 256) memset( abc, 0, 256 * sizeof( FontABC)); for ( i = 0; i < n; i += 3) { SV ** holder = av_fetch( av, i, 0); if ( holder) abc[j]. a = ( float) SvNV( *holder); holder = av_fetch( av, i + 1, 0); if ( holder) abc[j]. b = ( float) SvNV( *holder); holder = av_fetch( av, i + 2, 0); if ( holder) abc[j]. c = ( float) SvNV( *holder); j++; } } else memset( abc, 0, 256 * sizeof( FontABC)); sv_free( sv); } /* store in cache */ if ( t-> utf8_text) { PList p; if ( !*(t-> unicode)) *(t-> unicode) = plist_create( 8, 8); if (( p = *(t-> unicode))) { list_add( p, ( Handle) base); list_add( p, ( Handle) abc); } else { free( abc); return nil; } } else *(t-> ascii) = abc; return abc; } static Bool precalc_abc_buffer( PFontABC src, float * width, PFontABC dest) { int i; if ( !dest) return false; for ( i = 0; i < 256; i++) { width[i] = src[i]. a + src[i]. b + src[i]. c; dest[i]. a = ( src[i]. a < 0) ? - src[i]. a : 0; dest[i]. b = src[i]. b; dest[i]. c = ( src[i]. c < 0) ? - src[i]. c : 0; } return true; } static Bool add_wrapped_text( TextWrapRec * t, int start, int utfstart, int end, int utfend, int tildeIndex, int * tildePos, int * tildeLPos, int * tildeLine, char *** lArray, int * lSize) { int l = end - start; char *c = nil; if (!( t-> options & twReturnChunks)) { if ( !( c = allocs( l + 1))) return false; memcpy( c, t-> text + start, l); c[ l] = 0; } if ( tildeIndex >= 0 && tildeIndex >= start && tildeIndex < end) { *tildeLine = t-> t_line = t-> count; *tildePos = *tildeLPos = tildeIndex - start; if ( tildeIndex == end - 1) { t-> t_line++; tildeLPos = 0; } } if ( t-> count == *lSize) { char ** n = allocn( char*, *lSize + 16); if ( !n) return false; memcpy( n, *lArray, sizeof( char*) * (*lSize)); *lSize += 16; free( *lArray); *lArray = n; } if ( t-> options & twReturnChunks) { (*lArray)[ t-> count++] = INT2PTR(char*,utfstart); (*lArray)[ t-> count++] = INT2PTR(char*,utfend - utfstart); } else (*lArray)[ t-> count++] = c; return true; } char ** Drawable_do_text_wrap( Handle self, TextWrapRec * t) { unsigned int base = 0x10000000; float width[256]; FontABC abc[256]; int start = 0, utf_start = 0, split_start = -1, split_end = -1, i, utf_p, utf_split = -1; float w = 0, inc = 0; char **ret; Bool wasTab = 0, reassign_w = 1; Bool doWidthBreak = t-> width >= 0; int tildeIndex = -100, tildeLPos = 0, tildeLine = 0, tildePos = 0, tildeOffset = 0, lSize = 16; int spaceWidth = 0, spaceC = 0, spaceOK = 0; #define lAdd(end, utfend) \ if ( !add_wrapped_text( t, start, utf_start, end, utfend, tildeIndex, \ &tildePos, &tildeLPos, &tildeLine, &ret, &lSize)) return ret;\ start = end; \ utf_start = utfend; \ if (( t-> options & twReturnFirstLineLength) == twReturnFirstLineLength) return ret t-> count = 0; if (!( ret = allocn( char*, lSize))) return nil; /* determining ~ character location */ if ( t-> options & twCalcMnemonic) for ( i = 0; i < t-> textLen - 1; i++) if ( t-> text[ i] == '~') { unsigned char c = t-> text[ i + 1]; if ( c == '~' || c < ' ') { i++; continue; } else { tildeIndex = i; break; } } /* process UV chars */ for ( i = 0, utf_p = 0; i < t-> textLen; utf_p++) { UV uv; float winc; int p = i; if ( t-> utf8_text) { STRLEN len; uv = utf8_to_uvchr(( U8*) t-> text + i, &len); i += len; } else uv = (( unsigned char *)(t-> text))[i++]; if ( uv / 256 != base) if ( !precalc_abc_buffer( query_abc_range( self, t, base = uv / 256), width, abc)) return ret; if ( reassign_w) w = abc[ uv & 0xff]. a; reassign_w = 0; switch ( uv ) { case '\t': split_start = p; split_end = i; utf_split = utf_p; if (!( t-> options & twCalcTabs)) goto _default; if ( t-> options & twSpaceBreak) { lAdd( p, utf_p); start = i; utf_start++; reassign_w = 1; continue; } if ( !spaceOK) { PFontABC s = query_abc_range( self, t, 0); if ( !s) return ret; spaceWidth = (s[' '].a + s[' '].b + s[' '].c) * t-> tabIndent; spaceC = (s[' '].c < 0) ? - s[' ']. c : 0; spaceOK = 1; } winc = spaceWidth; inc = spaceC; wasTab = true; break; case '\n': case 0x2028: case 0x2029: split_start = p; split_end = i; utf_split = utf_p; if (!( t-> options & twNewLineBreak)) goto _default; lAdd( p, utf_p); start = i; utf_start++; reassign_w = 1; continue; case ' ': split_start = p; split_end = i; utf_split = utf_p; if (!( t-> options & twSpaceBreak)) goto _default; lAdd( p, utf_p); start = i; utf_start++; reassign_w = 1; continue; case '~': if ( p == tildeIndex ) { tildeOffset = w; inc = winc = 0; break; } _default: default: winc = width[ uv & 0xff]; inc = abc[ uv & 0xff]. c; } if ( doWidthBreak && w + winc + inc > t-> width) { if (( p == start) || (( p == start - 1) && ( p - 1 == tildeIndex))) { /* case when even single char cannot be fit in */ if ( t-> options & twBreakSingle) { /* do not return anything in this case */ int j; if (!( t-> options & twReturnChunks)) { for ( j = 0; j < t-> count; j++) free( ret[ j]); ret[ 0] = duplicate_string(""); } t-> count = 0; return ret; } /* or push this character disregarding the width */ lAdd( i, utf_p + 1); } else { /* normal break condition */ /* checking if break was at word boundary */ if ( t-> options & twWordBreak) { if ( start <= split_start) { lAdd( split_start, utf_split ); i = start = split_end; utf_start = utf_split + 1; utf_p = utf_split; w = 0; continue; } else if ( t-> options & twBreakSingle) { /* cannot be split, return nothing */ int j; if (!( t-> options & twReturnChunks)) { for ( j = 0; j < t-> count; j++) free( ret[ j]); ret[ 0] = duplicate_string(""); } t-> count = 0; return ret; } } /* repeat again */ lAdd( p, utf_p ); i = start = p; utf_start = utf_p; utf_p--; } w = 0; continue; } else w += winc; } /* adding or skipping last line */ if ( t-> textLen - start > 0 || t-> count == 0) lAdd( t-> textLen, t-> utf8_textLen); /* removing ~ and determining it's location */ if ( tildeIndex >= 0 && !(t-> options & twReturnChunks)) { UV uv; STRLEN len; PFontABC abc; char *l = ret[ tildeLine]; t-> t_char = t-> text + tildePos + 1; if ( t-> options & twCollapseTilde) memmove( l + tildePos, l + tildePos + 1, strlen( l) - tildePos); l = ret[ t-> t_line] + tildeLPos; uv = t-> utf8_text ? utf8_to_uvchr(( U8*) l, &len) : *((unsigned char*)l); abc = query_abc_range( self, t, uv / 256) + (uv & 0xff); w = tildeOffset; t-> t_start = w - 1; t-> t_end = w + abc->a + abc->b + abc->c; } else { t-> t_start = t-> t_end = t-> t_line = C_NUMERIC_UNDEF; } /* expanding tabs */ if (( t-> options & twExpandTabs) && !(t-> options & twReturnChunks) && wasTab) { for ( i = 0; i < t-> count; i++) { int tabs = 0, len = 0; char *substr = ret[ i], *n; while (*substr) { if ( *substr == '\t') tabs++; substr++; len++; } if ( tabs == 0) continue; if ( !( n = allocs( len + tabs * t-> tabIndent + 1))) return ret; len = 0; substr = ret[ i]; while ( *substr) { if ( *substr == '\t') { int j = t-> tabIndent; while ( j--) n[ len++] = ' '; } else n[ len++] = *substr; substr++; } free( ret[ i]); n[ len] = 0; ret[ i] = n; } } return ret; } SV* Drawable_text_wrap( Handle self, SV * text, int width, int options, int tabIndent) { TextWrapRec t; Bool retChunks; char** c; int i; AV * av; STRLEN tlen; t. text = SvPV( text, tlen); t. utf8_text = SvUTF8( text); if ( t. utf8_text) { t. utf8_textLen = prima_utf8_length( t. text); t. textLen = utf8_hop(( U8*) t. text, t. utf8_textLen) - (U8*) t. text; } else { t. utf8_textLen = t. textLen = tlen; } t. width = ( width < 0) ? 0 : width; t. tabIndent = ( tabIndent < 0) ? 0 : tabIndent; t. options = options; retChunks = t. options & twReturnChunks; t. ascii = &var-> font_abc_ascii; t. unicode = &var-> font_abc_unicode; t. t_char = nil; c = Drawable_do_text_wrap( self, &t); if (( t. options & twReturnFirstLineLength) == twReturnFirstLineLength) { IV rlen = 0; if ( c) { if ( t. count > 0) rlen = PTR2IV(c[1]); free( c); } return newSViv( rlen); } if ( !c) return nilSV; av = newAV(); for ( i = 0; i < t. count; i++) { SV * sv = retChunks ? newSViv( PTR2IV(c[i])) : newSVpv( c[ i], 0); if ( !retChunks) { if ( t. utf8_text) SvUTF8_on( sv); free( c[i]); } av_push( av, sv); } free( c); if ( t. options & ( twCalcMnemonic | twCollapseTilde)) { HV * profile = newHV(); SV * sv_char; if ( t. t_char) { STRLEN len = t. utf8_text ? utf8_hop(( U8*) t. t_char, 1) - ( U8*) t. t_char : 1; sv_char = newSVpv( t. t_char, len); if ( t. utf8_text) SvUTF8_on( sv_char); pset_i( tildeStart, t. t_start); pset_i( tildeEnd, t. t_end); pset_i( tildeLine, t. t_line); } else { sv_char = newSVsv( nilSV); pset_sv( tildeStart, nilSV); pset_sv( tildeEnd, nilSV); pset_sv( tildeLine, nilSV); } pset_sv_noinc( tildeChar, sv_char); av_push( av, newRV_noinc(( SV *) profile)); } return newRV_noinc(( SV *) av); } PRGBColor read_palette( int * palSize, SV * palette) { AV * av; int i, count; Byte * buf; if ( !SvROK( palette) || ( SvTYPE( SvRV( palette)) != SVt_PVAV)) { *palSize = 0; return nil; } av = (AV *) SvRV( palette); count = av_len( av) + 1; *palSize = count / 3; count = *palSize * 3; if ( count == 0) return nil; if ( !( buf = allocb( count))) return nil; for ( i = 0; i < count; i++) { SV **itemHolder = av_fetch( av, i, 0); if ( itemHolder == nil) return ( PRGBColor) buf; buf[ i] = SvIV( *itemHolder); } return ( PRGBColor) buf; } Color Drawable_backColor( Handle self, Bool set, Color color) { if (!set) return apc_gp_get_back_color( self); apc_gp_set_back_color( self, color); return color; } Color Drawable_color( Handle self, Bool set, Color color) { if (!set) return apc_gp_get_color( self); apc_gp_set_color( self, color); return color; } Rect Drawable_clipRect( Handle self, Bool set, Rect clipRect) { if ( !set) return apc_gp_get_clip_rect( self); apc_gp_set_clip_rect( self, clipRect); return clipRect; } Bool Drawable_fillWinding( Handle self, Bool set, Bool fillWinding) { if (!set) return apc_gp_get_fill_winding( self); apc_gp_set_fill_winding( self, fillWinding); return fillWinding; } int Drawable_lineEnd( Handle self, Bool set, int lineEnd) { if (!set) return apc_gp_get_line_end( self); apc_gp_set_line_end( self, lineEnd); return lineEnd; } int Drawable_lineJoin( Handle self, Bool set, int lineJoin) { if (!set) return apc_gp_get_line_join( self); apc_gp_set_line_join( self, lineJoin); return lineJoin; } int Drawable_lineWidth( Handle self, Bool set, int lineWidth) { if (!set) return apc_gp_get_line_width( self); apc_gp_set_line_width( self, lineWidth); return lineWidth; } SV * Drawable_palette( Handle self, Bool set, SV * palette) { int colors; if ( var-> stage > csFrozen) return nilSV; colors = var-> palSize; if ( set) { free( var-> palette); var-> palette = read_palette( &var-> palSize, palette); if ( colors == 0 && var-> palSize == 0) return nilSV; /* do not bother apc */ apc_gp_set_palette( self); } else { AV * av = newAV(); int i; Byte * pal = ( Byte*) var-> palette; for ( i = 0; i < colors * 3; i++) av_push( av, newSViv( pal[ i])); return newRV_noinc(( SV *) av); } return nilSV; } SV * Drawable_pixel( Handle self, Bool set, int x, int y, SV * color) { if (!set) return newSViv( apc_gp_get_pixel( self, x, y)); apc_gp_set_pixel( self, x, y, SvIV( color)); return nilSV; } Handle Drawable_region( Handle self, Bool set, Handle mask) { if ( var-> stage > csFrozen) return nilHandle; if ( set) { if ( mask && !kind_of( mask, CImage)) { warn("RTC005A: Illegal object reference passed to Drawable::region"); return nilHandle; } if ( mask && (( PImage( mask)-> type & imBPP) != imbpp1)) { Handle i = CImage( mask)-> dup( mask); ++SvREFCNT( SvRV( PImage( i)-> mate)); CImage( i)-> set_conversion( i, ictNone); CImage( i)-> set_type( i, imBW); apc_gp_set_region( self, i); --SvREFCNT( SvRV( PImage( i)-> mate)); Object_destroy( i); } else apc_gp_set_region( self, mask); } else if ( apc_gp_get_region( self, nilHandle)) { HV * profile = newHV(); Handle i = Object_create( "Prima::Image", profile); sv_free(( SV *) profile); apc_gp_get_region( self, i); --SvREFCNT( SvRV((( PAnyObject) i)-> mate)); return i; } return nilHandle; } int Drawable_rop( Handle self, Bool set, int rop) { if (!set) return apc_gp_get_rop( self); apc_gp_set_rop( self, rop); return rop; } int Drawable_rop2( Handle self, Bool set, int rop2) { if (!set) return apc_gp_get_rop2( self); apc_gp_set_rop2( self, rop2); return rop2; } int Drawable_splinePrecision( Handle self, Bool set, int splinePrecision) { if ( !set) return var-> splinePrecision; if ( splinePrecision < 1) return -1; var-> splinePrecision = splinePrecision; return splinePrecision; } Bool Drawable_textOpaque( Handle self, Bool set, Bool opaque) { if (!set) return apc_gp_get_text_opaque( self); apc_gp_set_text_opaque( self, opaque); return opaque; } Bool Drawable_textOutBaseline( Handle self, Bool set, Bool textOutBaseline) { if (!set) return apc_gp_get_text_out_baseline( self); apc_gp_set_text_out_baseline( self, textOutBaseline); return textOutBaseline; } Point Drawable_translate( Handle self, Bool set, Point translate) { if (!set) return apc_gp_get_transform( self); apc_gp_set_transform( self, translate. x, translate. y); return translate; } SV * Drawable_fillPattern( Handle self, Bool set, SV * svpattern) { int i; if ( !set) { AV * av; FillPattern * fp = apc_gp_get_fill_pattern( self); if ( !fp) return nilSV; av = newAV(); for ( i = 0; i < 8; i++) av_push( av, newSViv(( int) (*fp)[i])); return newRV_noinc(( SV *) av); } else { if ( SvROK( svpattern) && ( SvTYPE( SvRV( svpattern)) == SVt_PVAV)) { FillPattern fp; AV * av = ( AV *) SvRV( svpattern); if ( av_len( av) != 7) { warn("RTC0056: Illegal fillPattern passed to Drawable::fillPattern"); return nilSV; } for ( i = 0; i < 8; i++) { SV ** holder = av_fetch( av, i, 0); if ( !holder) { warn("RTC0057: Array panic on Drawable::fillPattern"); return nilSV; } fp[ i] = SvIV( *holder); } apc_gp_set_fill_pattern( self, fp); } else { int id = SvIV( svpattern); if (( id < 0) || ( id > fpMaxId)) { warn("RTC0058: fillPattern index out of range passed to Drawable::fillPattern"); return nilSV; } apc_gp_set_fill_pattern( self, fillPatterns[ id]); } } return nilSV; } Font Drawable_get_font( Handle self) { return var-> font; } void Drawable_set_font( Handle self, Font font) { clear_font_abc_caches( self); apc_font_pick( self, &font, &var-> font); apc_gp_set_font( self, &var-> font); } #ifdef __cplusplus } #endif Prima-1.28/Widget_geometry.c0000644000175100017510000012156211150770061013603 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: Widget_geometry.c,v 1.7 2007/11/14 21:11:03 dk Exp $ */ #include "apricot.h" #include "Widget.h" #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CDrawable #define my ((( PWidget) self)-> self) #define var (( PWidget) self) #define his (( PWidget) child) void Widget_pack_slaves( Handle self); void Widget_place_slaves( Handle self); Bool Widget_size_notify( Handle self, Handle child, const Rect* metrix); Bool Widget_move_notify( Handle self, Handle child, Point * moveTo); static void Widget_pack_enter( Handle self); static void Widget_pack_leave( Handle self); static void Widget_place_enter( Handle self); static void Widget_place_leave( Handle self); /* geometry managers. growMode - native Prima model, borrowed from TurboVision. Does not live with geomSize request size, uses virtualSize instead. pack and place - copy-pasted from Perl-Tk. */ /* pack Handle fields: next - available only when geometry == gtPack order, in - available always, but is guaranteedly valid when geometry == gtPack only in and order cause croaks when submitted via packInfo(), but are silently converted to nil when geometry changes and the references are not valid anymore */ #define MASTER ((var->geometry != gtGrowMode && var->geomInfo.in)?var->geomInfo.in:var->owner) #define geometry_reset_all() geometry_reset(MASTER,-1) /* resets particular ( or all, if geometry < 0 ) geometry widgets */ static void geometry_reset( Handle self, int geometry) { if ( !self) return; if ( (var-> geometry == gtGrowMode) && (var-> growMode & gmCenter) && ( geometry == gtGrowMode || geometry < 0) ) { my-> set_centered( self, var-> growMode & gmXCenter, var-> growMode & gmYCenter); } if ( geometry == gtPack || geometry < 0) Widget_pack_slaves( self); if ( geometry == gtPlace || geometry < 0) Widget_place_slaves( self); } int Widget_geometry( Handle self, Bool set, int geometry) { if ( !set) return var-> geometry; if ( geometry == var-> geometry) { /* because called within set_owner() */ if ((var-> geometry == gtGrowMode) && (var-> growMode & gmCenter)) my-> set_centered( self, var-> growMode & gmXCenter, var-> growMode & gmYCenter); return geometry; } if ( geometry < gtDefault || geometry > gtMax) croak("Prima::Widget::geometry: invalid value passed"); switch ( var-> geometry) { case gtPlace: Widget_place_leave( self); break; case gtPack: Widget_pack_leave( self); break; } var-> geometry = geometry; switch ( var-> geometry) { case gtGrowMode: if ( var-> growMode & gmCenter) my-> set_centered( self, var-> growMode & gmXCenter, var-> growMode & gmYCenter); break; case gtPlace: Widget_place_enter( self); break; case gtPack: Widget_pack_enter( self); break; } geometry_reset_all(); return var-> geometry; } Point Widget_geomSize( Handle self, Bool set, Point geomSize) { if ( !set) return var-> geomSize; /* return ( var-> geometry == gtDefault) ? my-> get_size(self) : var-> geomSize; */ var-> geomSize = geomSize; if ( var-> geometry == gtDefault) my-> set_size( self, var-> geomSize); else geometry_reset_all(); return var-> geomSize; } int Widget_geomHeight( Handle self, Bool set, int geomHeight) { if ( set) { Point p = { var-> geomSize. x, geomHeight}; my-> set_geomSize( self, p); } return var-> geomSize. y; } int Widget_geomWidth( Handle self, Bool set, int geomWidth) { if ( set) { Point p = { geomWidth, var-> geomSize. y}; my-> set_geomSize( self, p); } return var-> geomSize. x; } Bool Widget_packPropagate( Handle self, Bool set, Bool propagate) { Bool repack; if ( !set) return is_opt( optPackPropagate); repack = !(is_opt( optPackPropagate)) && propagate; opt_assign( optPackPropagate, propagate); if ( repack) geometry_reset(self,-1); return is_opt( optPackPropagate); } void Widget_reset_children_geometry( Handle self) { Widget_pack_slaves( self); Widget_place_slaves( self); } /* checks if Handle in is allowed to be a master for self - used for gt::Pack */ static Handle Widget_check_in( Handle self, Handle in, Bool barf) { Handle h = in; /* check overall validity */ if ( !in || !kind_of( in, CWidget)) { if ( barf) croak("%s: invalid 'in': not a widget", "RTC008F: Prima::Widget::pack"); else return nilHandle; } /* check direct inheritance */ while ( h) { if ( h == self) { if ( barf) croak("%s: invalid 'in': is already a child", "RTC008F: Prima::Widget::pack"); else return nilHandle; } h = PWidget( h)-> owner; } /* check slaves chain */ h = PWidget( in)-> packSlaves; while ( h) { if ( h == in) { if ( barf) croak("%s: invalid 'in': already a pack slave", "RTC008F: Prima::Widget::pack"); else return nilHandle; } h = PWidget( h)-> geomInfo. next; } h = PWidget( in)-> placeSlaves; while ( h) { if ( h == in) { if ( barf) croak("%s: invalid 'in': already a place slave", "RTC008F: Prima::Widget::pack"); else return nilHandle; } h = PWidget( h)-> geomInfo. next; } /* place to check other chains if needed */ return in; } Point Widget_sizeMin( Handle self, Bool set, Point min) { if ( !set) return var-> sizeMin; var-> sizeMin = min; if ( var-> stage <= csFrozen) { Point sizeActual = my-> get_size( self); Point newSize = sizeActual; if ( sizeActual. x < min. x) newSize. x = min. x; if ( sizeActual. y < min. y) newSize. y = min. y; if (( newSize. x != sizeActual. x) || ( newSize. y != sizeActual. y)) my-> set_size( self, newSize); if ( var-> geometry != gtDefault) geometry_reset_all(); } apc_widget_set_size_bounds( self, var-> sizeMin, var-> sizeMax); return min; } Point Widget_sizeMax( Handle self, Bool set, Point max) { if ( !set) return var-> sizeMax; var-> sizeMax = max; if ( var-> stage <= csFrozen) { Point sizeActual = my-> get_size( self); Point newSize = sizeActual; if ( sizeActual. x > max. x) newSize. x = max. x; if ( sizeActual. y > max. y) newSize. y = max. y; if (( newSize. x != sizeActual. x) || ( newSize. y != sizeActual. y)) my-> set_size( self, newSize); if ( var-> geometry != gtDefault) geometry_reset_all(); } apc_widget_set_size_bounds( self, var-> sizeMin, var-> sizeMax); return max; } /* geometry managers */ /* gtGrowMode */ Bool Widget_size_notify( Handle self, Handle child, const Rect* metrix) { if ( his-> growMode) { Point size = his-> self-> get_virtual_size( child); Point pos = his-> self-> get_origin( child); Point osize = size, opos = pos; int dx = ((Rect *) metrix)-> right - ((Rect *) metrix)-> left; int dy = ((Rect *) metrix)-> top - ((Rect *) metrix)-> bottom; if ( his-> growMode & gmGrowLoX) pos. x += dx; if ( his-> growMode & gmGrowHiX) size. x += dx; if ( his-> growMode & gmGrowLoY) pos. y += dy; if ( his-> growMode & gmGrowHiY) size. y += dy; if ( his-> growMode & gmXCenter) pos. x = (((Rect *) metrix)-> right - size. x) / 2; if ( his-> growMode & gmYCenter) pos. y = (((Rect *) metrix)-> top - size. y) / 2; if ( pos.x != opos.x || pos.y != opos.y || size.x != osize.x || size.y != osize.y) { if ( pos.x == opos.x && pos.y == opos.y) { his-> self-> set_size( child, size); } else if ( size.x == osize.x && size.y == osize.y) { his-> self-> set_origin( child, pos); } else { Rect r; r. left = pos. x; r. bottom = pos. y; r. right = pos. x + size. x; r. top = pos. y + size. y; his-> self-> set_rect( child, r); } } } return false; } Bool Widget_move_notify( Handle self, Handle child, Point * moveTo) { Bool clp = his-> self-> get_clipOwner( child); int dx = moveTo-> x - var-> pos. x; int dy = moveTo-> y - var-> pos. y; Point p; if ( his-> growMode & gmDontCare) { if ( !clp) return false; p = his-> self-> get_origin( child); p. x -= dx; p. y -= dy; his-> self-> set_origin( child, p); } else { if ( clp) return false; p = his-> self-> get_origin( child); p. x += dx; p. y += dy; his-> self-> set_origin( child, p); } return false; } /* PACK */ #define LEFT 0 #define BOTTOM 1 #define RIGHT 2 #define TOP 3 #define SOUTH 0 #define NORTH 2 #define WEST 0 #define EAST 2 #define CENTER 1 /* pack() internal mechanism - stolen from Tk v800.24, tkPack.c Note that the original algorithm is taught to respect sizeMin and sizeMax, not present in Tk */ /* *---------------------------------------------------------------------- * * XExpansion -- * * Given a list of packed slaves, the first of which is packed * on the left or right and is expandable, compute how much to * expand the child. * * Results: * The return value is the number of additional pixels to give to * the child. * *---------------------------------------------------------------------- */ static int slave_width( register PWidget slavePtr, register int plus) { register int width = slavePtr-> geomSize. x + slavePtr-> geomInfo. pad.x + slavePtr-> geomInfo. ipad.x + plus; if ( width < slavePtr-> sizeMin.x) width = slavePtr-> sizeMin.x; if ( width > slavePtr-> sizeMax.x) width = slavePtr-> sizeMax.x; return width; } static int slave_height( register PWidget slavePtr, register int plus) { register int height = slavePtr-> geomSize.y + slavePtr-> geomInfo. pad.y + slavePtr-> geomInfo. ipad.y + plus; if ( height < slavePtr-> sizeMin.y) height = slavePtr-> sizeMin.y; if ( height > slavePtr-> sizeMax.y) height = slavePtr-> sizeMax.y; return height; } static int XExpansion(slavePtr, cavityWidth) register PWidget slavePtr; /* First in list of remaining slaves. */ int cavityWidth; /* Horizontal space left for all * remaining slaves. */ { int numExpand, minExpand, curExpand; int childWidth; /* * This procedure is tricky because windows packed top or bottom can * be interspersed among expandable windows packed left or right. * Scan through the list, keeping a running sum of the widths of * all left and right windows (actually, count the cavity space not * allocated) and a running count of all expandable left and right * windows. At each top or bottom window, and at the end of the * list, compute the expansion factor that seems reasonable at that * point. Return the smallest factor seen at any of these points. */ minExpand = cavityWidth; numExpand = 0; for (; slavePtr != NULL; slavePtr = ( PWidget) slavePtr-> geomInfo. next) { childWidth = slave_width(slavePtr, 0); if ((slavePtr-> geomInfo. side == TOP) || (slavePtr-> geomInfo. side == BOTTOM)) { curExpand = (cavityWidth - childWidth)/numExpand; if (curExpand < minExpand) { minExpand = curExpand; } } else { cavityWidth -= childWidth; if (slavePtr->geomInfo. expand) { numExpand++; } } } curExpand = cavityWidth/numExpand; if (curExpand < minExpand) { minExpand = curExpand; } return (minExpand < 0) ? 0 : minExpand; } /* *---------------------------------------------------------------------- * * YExpansion -- * * Given a list of packed slaves, the first of which is packed * on the top or bottom and is expandable, compute how much to * expand the child. * * Results: * The return value is the number of additional pixels to give to * the child. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int YExpansion(slavePtr, cavityHeight) register PWidget slavePtr; /* First in list of remaining * slaves. */ int cavityHeight; /* Vertical space left for all * remaining slaves. */ { int numExpand, minExpand, curExpand; int childHeight; /* * See comments for XExpansion. */ minExpand = cavityHeight; numExpand = 0; for (; slavePtr != NULL; slavePtr = (PWidget) slavePtr->geomInfo. next) { childHeight = slave_height(slavePtr, 0); if ((slavePtr-> geomInfo. side == LEFT) || (slavePtr-> geomInfo. side == RIGHT)) { curExpand = (cavityHeight - childHeight)/numExpand; if (curExpand < minExpand) { minExpand = curExpand; } } else { cavityHeight -= childHeight; if (slavePtr-> geomInfo. expand) { numExpand++; } } } curExpand = cavityHeight/numExpand; if (curExpand < minExpand) { minExpand = curExpand; } return (minExpand < 0) ? 0 : minExpand; } void Widget_pack_slaves( Handle self) { PWidget masterPtr, slavePtr; int cavityX, cavityY, cavityWidth, cavityHeight; /* These variables keep track of the * as-yet-unallocated space remaining in * the middle of the parent window. */ int frameX, frameY, frameWidth, frameHeight; /* These variables keep track of the frame * allocated to the current window. */ int x, y, width, height; /* These variables are used to hold the * actual geometry of the current window. */ int maxWidth, maxHeight, tmp; int borderX, borderY; Point size; if ( var-> stage > csNormal) return; /* * If the parent has no slaves anymore, then don't do anything * at all: just leave the parent's size as-is. */ if (!( masterPtr = ( PWidget) var-> packSlaves)) return; /* * Pass #1: scan all the slaves to figure out the total amount * of space needed. Two separate width and height values are * computed: * * width - Holds the sum of the widths (plus padding) of * all the slaves seen so far that were packed LEFT * or RIGHT. * height - Holds the sum of the heights (plus padding) of * all the slaves seen so far that were packed TOP * or BOTTOM. * * maxWidth - Gradually builds up the width needed by the master * to just barely satisfy all the slave's needs. For * each slave, the code computes the width needed for * all the slaves so far and updates maxWidth if the * new value is greater. * maxHeight - Same as maxWidth, except keeps height info. */ width = height = maxWidth = maxHeight = 0; for (slavePtr=masterPtr; slavePtr != NULL; slavePtr = ( PWidget) slavePtr-> geomInfo. next) { if ((slavePtr-> geomInfo. side == TOP) || (slavePtr-> geomInfo. side == BOTTOM)) { tmp = slave_width( slavePtr, width); if (tmp > maxWidth) maxWidth = tmp; height += slave_height(slavePtr,0); } else { tmp = slave_height(slavePtr, height); if (tmp > maxHeight) maxHeight = tmp; width += slave_width(slavePtr,0); } } if (width > maxWidth) { maxWidth = width; } if (height > maxHeight) { maxHeight = height; } /* * If the total amount of space needed in the parent window has * changed, and if we're propagating geometry information, then * notify the next geometry manager up and requeue ourselves to * start again after the parent has had a chance to * resize us. */ if ((((maxWidth != my-> get_geomWidth(self))) || (maxHeight != my-> get_geomHeight(self))) && is_opt( optPackPropagate)) { Point p, oldsize; p. x = maxWidth; p. y = maxHeight; oldsize = my-> get_size( self); my-> set_geomSize( self, p); size = my-> get_size( self); /* if size didn't change, that means, that no cmSize came, and thus the actual repacking of slaves never took place */ if ( oldsize. x != size. x || oldsize. y != size. y) return; } else { size = my-> get_size( self); } /* * Pass #2: scan the slaves a second time assigning * new sizes. The "cavity" variables keep track of the * unclaimed space in the cavity of the window; this * shrinks inward as we allocate windows around the * edges. The "frame" variables keep track of the space * allocated to the current window and its frame. The * current window is then placed somewhere inside the * frame, depending on anchor. */ cavityX = cavityY = x = y = 0; cavityWidth = size. x; cavityHeight = size. y; for ( slavePtr=masterPtr; slavePtr != NULL; slavePtr = ( PWidget) slavePtr-> geomInfo. next) { if ((slavePtr-> geomInfo. side == TOP) || (slavePtr-> geomInfo. side == BOTTOM)) { frameWidth = cavityWidth; frameHeight = slave_height(slavePtr,0); if (slavePtr-> geomInfo. expand) frameHeight += YExpansion(slavePtr, cavityHeight); cavityHeight -= frameHeight; if (cavityHeight < 0) { frameHeight += cavityHeight; cavityHeight = 0; } frameX = cavityX; if (slavePtr-> geomInfo. side == BOTTOM) { frameY = cavityY; cavityY += frameHeight; } else { frameY = cavityY + cavityHeight; } } else { frameHeight = cavityHeight; frameWidth = slave_width(slavePtr,0); if (slavePtr-> geomInfo. expand) frameWidth += XExpansion(slavePtr, cavityWidth); cavityWidth -= frameWidth; if (cavityWidth < 0) { frameWidth += cavityWidth; cavityWidth = 0; } frameY = cavityY; if (slavePtr-> geomInfo. side == LEFT) { frameX = cavityX; cavityX += frameWidth; } else { frameX = cavityX + cavityWidth; } } /* * Now that we've got the size of the frame for the window, * compute the window's actual size and location using the * fill, padding, and frame factors. */ borderX = slavePtr-> geomInfo. pad.x; borderY = slavePtr-> geomInfo. pad.y; width = slavePtr-> geomSize. x + slavePtr-> geomInfo. ipad.x; if (slavePtr-> geomInfo. fillx || (width > (frameWidth - borderX))) width = frameWidth - borderX; height = slavePtr-> geomSize. y + slavePtr-> geomInfo. ipad.y; if (slavePtr-> geomInfo. filly || (height > (frameHeight - borderY))) height = frameHeight - borderY; borderX /= 2; borderY /= 2; if ( width < slavePtr-> sizeMin.x) width = slavePtr-> sizeMin.x; if ( height < slavePtr-> sizeMin.y) height = slavePtr-> sizeMin.y; if ( width > slavePtr-> sizeMax.x) width = slavePtr-> sizeMax.x; if ( height > slavePtr-> sizeMax.y) height = slavePtr-> sizeMax.y; switch (slavePtr-> geomInfo. anchorx) { case WEST: x = frameX + borderX; break; case CENTER: x = frameX + (frameWidth - width)/2; break; case EAST: x = frameX + frameWidth - width - borderX; break; } switch (slavePtr-> geomInfo. anchory) { case SOUTH: y = frameY + borderY; break; case CENTER: y = frameY + (frameHeight - height)/2; break; case NORTH: y = frameY + frameHeight - height - borderY; break; } { Rect r; r. left = x; r. bottom = y; r. right = x + width; r. top = y + height; /* printf("%s: %d %d %d %d\n", slavePtr-> name, x, r.bottom, width, r.top); */ slavePtr-> self-> set_rect(( Handle) slavePtr, r); } } } /* applies pack parameters and enters pack slaves chain */ void Widget_pack_enter( Handle self) { Handle master, ptr; /* see if leftover object references are alive */ if ( var-> geomInfo. order && !hash_fetch( primaObjects, &var-> geomInfo. order, sizeof(Handle))) { var-> geomInfo. order = nilHandle; var-> geomInfo. after = 0; } if ( var-> geomInfo. in) { if ( hash_fetch( primaObjects, &var-> geomInfo. in, sizeof(Handle))) var-> geomInfo. in = Widget_check_in( self, var-> geomInfo. in, false); else var-> geomInfo. in = nilHandle; } /* store into slaves list */ master = (( var-> geomInfo. in) ? var-> geomInfo. in : var-> owner); if ( PWidget( master)-> packSlaves) { /* insert into list using 'order' marker */ ptr = PWidget( master)-> packSlaves; if ( ptr != var-> geomInfo. order) { Handle optr = ptr; Bool inserted = false; while ( ptr) { if ( ptr == var-> geomInfo. order) { if ( var-> geomInfo. after) { var-> geomInfo. next = PWidget( ptr)-> geomInfo. next; PWidget( ptr)-> geomInfo. next = self; } else { var-> geomInfo. next = ptr; PWidget( optr)-> geomInfo. next = self; } inserted = true; break; } optr = ptr; ptr = PWidget( ptr)-> geomInfo. next; } if ( !inserted) PWidget( optr)-> geomInfo. next = self; } else { /* order is first in list */ if ( var-> geomInfo. after) { var-> geomInfo. next = PWidget( ptr)-> geomInfo. next; PWidget( ptr)-> geomInfo. next = self; } else { var-> geomInfo. next = ptr; PWidget( master)-> packSlaves = self; } } } else { /* master has no slaves, we're first */ PWidget( master)-> packSlaves = self; } } /* removes widget from list of pack slaves */ void Widget_pack_leave( Handle self) { Handle ptr, master; master = (( var-> geomInfo. in) ? var-> geomInfo. in : var-> owner); if ( master) { if (( ptr = PWidget( master)-> packSlaves) != self) { if ( ptr) { while ( PWidget(ptr)-> geomInfo. next) { if ( PWidget(ptr)-> geomInfo. next == self) { PWidget(ptr)-> geomInfo. next = var-> geomInfo. next; break; } ptr = PWidget(ptr)-> geomInfo. next; } } } else { PWidget( master)-> packSlaves = var-> geomInfo. next; } } var-> geomInfo. next = nilHandle; } SV * Widget_packInfo( Handle self, Bool set, SV * packInfo) { if ( !set) { HV * profile = newHV(); GeomInfo *p = &var-> geomInfo; switch ( p-> side) { case LEFT : pset_c( side, "top"); break; case BOTTOM : pset_c( side, "bottom"); break; case RIGHT : pset_c( side, "right"); break; case TOP : pset_c( side, "top"); break; } if ( p-> fillx) { pset_c( fill, p-> filly ? "both" : "x"); } else { pset_c( fill, p-> filly ? "y" : "none"); } pset_i( expand, p-> expand); switch ( p-> anchorx) { case WEST: pset_c( anchor, (( p-> anchory == NORTH) ? "nw" : (( p-> anchory == CENTER) ? "w" : "sw")) ); break; case CENTER: pset_c( anchor, (( p-> anchory == NORTH) ? "n" : (( p-> anchory == CENTER) ? "center" : "s")) ); break; case EAST: pset_c( anchor, (( p-> anchory == NORTH) ? "ne" : (( p-> anchory == CENTER) ? "e" : "se")) ); break; } pset_H( after, ( p-> order && p-> after) ? p-> order : nilHandle); pset_H( before, ( p-> order && !p-> after) ? p-> order : nilHandle); pset_H( in, var-> geomInfo. in); pset_i( ipadx, p-> ipad. x); pset_i( ipady, p-> ipad. y); pset_i( padx, p-> pad. x); pset_i( pady, p-> pad. y); return newRV_noinc(( SV *) profile); } else { dPROFILE; HV * profile; Bool reset_zorder = false, set_in = false; Handle in = nilHandle; if ( SvTYPE(packInfo) == SVt_NULL) return nilSV; if ( !SvOK(packInfo) || !SvROK(packInfo) || SvTYPE(SvRV(packInfo)) != SVt_PVHV) croak("Widget::packInfo: parameter is not a hash"); profile = ( HV*) SvRV( packInfo); if ( pexist( side)) { char * c = pget_c( side); if ( *c == 'l' && (strcmp( c, "left")==0)) var-> geomInfo. side = LEFT; else if ( *c == 'b' && (strcmp( c, "bottom")==0)) var-> geomInfo. side = BOTTOM; else if ( *c == 'r' && (strcmp( c, "right")==0)) var-> geomInfo. side = RIGHT; else if ( *c == 't' && (strcmp( c, "top")==0)) var-> geomInfo. side = TOP; else croak("%s: invalid 'side'", "RTC008F: Prima::Widget::pack"); } if ( pexist( fill)) { char * c = pget_c( fill); if (( strcmp( c, "x") == 0)) { var-> geomInfo. fillx = 1; var-> geomInfo. filly = 0; } else if (( strcmp( c, "y") == 0)) { var-> geomInfo. fillx = 0; var-> geomInfo. filly = 1; } else if ( *c == 'n' && ( strcmp( c, "none") == 0)) { var-> geomInfo. fillx = var-> geomInfo. filly = 0; } else if ( *c == 'b' && ( strcmp( c, "both") == 0)) { var-> geomInfo. fillx = var-> geomInfo. filly = 1; } else croak("%s: invalid 'fill'", "RTC008F: Prima::Widget::pack"); } if ( pexist( expand)) { var-> geomInfo. expand = pget_B( expand); } if ( pexist( anchor)) { char * c = pget_c( anchor); if (( strcmp( c, "n") == 0)) { var-> geomInfo. anchorx = CENTER; var-> geomInfo. anchory = NORTH; } else if (( strcmp( c, "ne") == 0)) { var-> geomInfo. anchorx = EAST; var-> geomInfo. anchory = NORTH; } else if (( strcmp( c, "e") == 0)) { var-> geomInfo. anchorx = EAST; var-> geomInfo. anchory = CENTER; } else if (( strcmp( c, "se") == 0)) { var-> geomInfo. anchorx = EAST; var-> geomInfo. anchory = SOUTH; } else if (( strcmp( c, "s") == 0)) { var-> geomInfo. anchorx = CENTER; var-> geomInfo. anchory = SOUTH; } else if (( strcmp( c, "sw") == 0)) { var-> geomInfo. anchorx = WEST; var-> geomInfo. anchory = SOUTH; } else if (( strcmp( c, "w") == 0)) { var-> geomInfo. anchorx = WEST; var-> geomInfo. anchory = CENTER; } else if (( strcmp( c, "nw") == 0)) { var-> geomInfo. anchorx = WEST; var-> geomInfo. anchory = NORTH; } else if ( *c == 'c' && ( strcmp( c, "center") == 0)) { var-> geomInfo. anchorx = CENTER; var-> geomInfo. anchory = CENTER; } else croak("%s: invalid 'anchor'", "RTC008F: Prima::Widget::pack"); } if ( pexist( ipadx)) var-> geomInfo. ipad. x = pget_i( ipadx); if ( pexist( ipady)) var-> geomInfo. ipad. y = pget_i( ipady); if ( pexist( padx)) var-> geomInfo. pad. x = pget_i( padx); if ( pexist( pady)) var-> geomInfo. pad. y = pget_i( pady); if ( pexist( after)) { SV * sv = pget_sv( after); if ( SvTYPE(sv) != SVt_NULL) { if ( !( var-> geomInfo. order = gimme_the_mate( sv))) croak("%s: invalid 'after'", "RTC008F: Prima::Widget::pack"); var-> geomInfo. after = 1; if ( pexist( before)) { sv = pget_sv( before); if ( SvTYPE(sv) != SVt_NULL) croak("%s: 'after' and 'before' cannot be present simultaneously", "RTC008F: Prima::Widget::pack"); } } else { var-> geomInfo. order = nilHandle; var-> geomInfo. after = 0; } reset_zorder = true; } else if ( pexist( before)) { SV * sv = pget_sv( before); if ( SvTYPE(sv) != SVt_NULL) { if ( !( var-> geomInfo. order = gimme_the_mate( sv))) croak("%s: invalid 'before'", "RTC008F: Prima::Widget::pack"); } else var-> geomInfo. order = nilHandle; var-> geomInfo. after = 0; reset_zorder = true; } if ( pexist( in)) { SV * sv = pget_sv( in); in = nilHandle; if ( SvTYPE( sv) != SVt_NULL) in = Widget_check_in( self, gimme_the_mate( sv), true); set_in = reset_zorder = true; } if ( var-> geometry == gtPack) { if ( reset_zorder) Widget_pack_leave( self); } if ( set_in) var-> geomInfo. in = in; if ( var-> geometry == gtPack) { if ( reset_zorder) Widget_pack_enter( self); geometry_reset( MASTER, gtPack); } } return nilSV; } XS( Widget_get_pack_slaves_FROMPERL) { dXSARGS; Handle self; if ( items != 1) croak ("Invalid usage of Widget.get_pack_slaves"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Widget.get_pack_slaves"); self = var-> packSlaves; while ( self) { XPUSHs( sv_2mortal( newSVsv((( PAnyObject) self)-> mate))); self = var-> geomInfo. next; } PUTBACK; return; } void Widget_get_pack_slaves ( Handle self) { warn("Invalid call of Widget::get_pack_slaves"); } void Widget_get_pack_slaves_REDEFINED( Handle self) { warn("Invalid call of Widget::get_pack_slaves"); } /* PLACE */ /* place internal mechanism - stolen from Tk v800.24, tkPlace.c */ void Widget_place_enter( Handle self) { Handle master, ptr; /* see if leftover object references are alive */ if ( var-> geomInfo. in) { if ( hash_fetch( primaObjects, &var-> geomInfo. in, sizeof(Handle))) var-> geomInfo. in = Widget_check_in( self, var-> geomInfo. in, false); else var-> geomInfo. in = nilHandle; } /* store into slaves list */ master = (( var-> geomInfo. in) ? var-> geomInfo. in : var-> owner); if ( PWidget( master)-> placeSlaves) { /* append to the end of list */ if (( ptr = PWidget( master)-> placeSlaves)) { while ( PWidget( ptr)-> geomInfo. next) ptr = PWidget( ptr)-> geomInfo. next; PWidget( ptr)-> geomInfo. next = self; } else { /* first in list */ var-> geomInfo. next = ptr; PWidget( master)-> placeSlaves = self; } } else { /* master has no slaves, we're first */ PWidget( master)-> placeSlaves = self; } } /* removes widget from list of place slaves */ void Widget_place_leave( Handle self) { Handle ptr, master; master = (( var-> geomInfo. in) ? var-> geomInfo. in : var-> owner); if ( master) { if (( ptr = PWidget( master)-> placeSlaves) != self) { if ( ptr) { while ( PWidget(ptr)-> geomInfo. next) { if ( PWidget(ptr)-> geomInfo. next == self) { PWidget(ptr)-> geomInfo. next = var-> geomInfo. next; break; } ptr = PWidget(ptr)-> geomInfo. next; } } } else { PWidget( master)-> placeSlaves = var-> geomInfo. next; } } var-> geomInfo. next = nilHandle; } void Widget_place_slaves( Handle self) { PWidget slave, master; int x, y, width, height, tmp; int masterWidth, masterHeight; double x1, y1, x2, y2; Point size; /* * Iterate over all the slaves for the master. Each slave's * geometry can be computed independently of the other slaves. */ if (!( master = ( PWidget) var-> placeSlaves)) return; size = my-> get_size( self); masterWidth = size. x; masterHeight = size. y; for (slave=master; slave != NULL; slave = ( PWidget) slave-> geomInfo. next) { Point sz; register GeomInfo* slavePtr = &slave-> geomInfo; sz = slave-> self-> get_size(( Handle) slave); /* * Step 2: compute size of slave (outside dimensions including * border) and location of anchor point within master. */ x1 = slavePtr->x + (slavePtr->relX*masterWidth); x = (int) (x1 + ((x1 > 0) ? 0.5 : -0.5)); y1 = slavePtr->y + (slavePtr->relY*masterHeight); y = (int) (y1 + ((y1 > 0) ? 0.5 : -0.5)); if (slavePtr-> use_w || slavePtr-> use_rw) { width = 0; if (slavePtr-> use_w) { width += slave->geomSize.x; } if (slavePtr-> use_rw) { /* * The code below is a bit tricky. In order to round * correctly when both relX and relWidth are specified, * compute the location of the right edge and round that, * then compute width. If we compute the width and round * it, rounding errors in relX and relWidth accumulate. */ x2 = x1 + (slavePtr->relWidth*masterWidth); tmp = (int) (x2 + ((x2 > 0) ? 0.5 : -0.5)); width += tmp - x; } } else { width = sz. x; } if (slavePtr-> use_h || slavePtr-> use_rh) { height = 0; if (slavePtr->use_h) { height += slave->geomSize. y; } if (slavePtr->use_rh) { /* * See note above for rounding errors in width computation. */ y2 = y1 + (slavePtr->relHeight*masterHeight); tmp = (int) (y2 + ((y2 > 0) ? 0.5 : -0.5)); height += tmp - y; } } else { height = sz. y; } /* * Step 3: adjust the x and y positions so that the desired * anchor point on the slave appears at that position. Also * adjust for the border mode and master's border. */ switch (slavePtr-> anchorx) { case WEST: break; case CENTER: x -= width/2; break; case EAST: x -= width; break; } switch (slavePtr-> anchory) { case NORTH: y -= height; break; case CENTER: y -= height/2; break; case SOUTH: break; } { Rect r; r. left = x; r. bottom = y; r. right = x + width; r. top = y + height; /* printf("%s: %d %d %d %d\n", slave-> name, x, y, width, height); */ slave-> self-> set_rect(( Handle) slave, r); } } } SV * Widget_placeInfo( Handle self, Bool set, SV * placeInfo) { if ( !set) { HV * profile = newHV(); GeomInfo *p = &var-> geomInfo; switch ( p-> anchorx) { case WEST: pset_c( anchor, (( p-> anchory == NORTH) ? "nw" : (( p-> anchory == CENTER) ? "w" : "sw")) ); break; case CENTER: pset_c( anchor, (( p-> anchory == NORTH) ? "n" : (( p-> anchory == CENTER) ? "center" : "s")) ); break; case EAST: pset_c( anchor, (( p-> anchory == NORTH) ? "ne" : (( p-> anchory == CENTER) ? "e" : "se")) ); break; } pset_H( in, var-> geomInfo. in); if ( p-> use_x) pset_i( x, p-> x); if ( p-> use_y) pset_i( y, p-> y); if ( p-> use_w) pset_i( width, var-> geomSize. x); if ( p-> use_h) pset_i( height, var-> geomSize. y); if ( p-> use_rx) pset_f( relx, p-> relX); if ( p-> use_ry) pset_f( rely, p-> relY); if ( p-> use_rw) pset_f( relwidth, p-> relWidth); if ( p-> use_rh) pset_f( relheight, p-> relHeight); return newRV_noinc(( SV *) profile); } else { dPROFILE; HV * profile; Handle in = nilHandle; Bool set_in = false; if ( SvTYPE(placeInfo) == SVt_NULL) return nilSV; if ( !SvOK(placeInfo) || !SvROK(placeInfo) || SvTYPE(SvRV(placeInfo)) != SVt_PVHV) croak("Widget::placeInfo: parameter is not a hash"); profile = ( HV*) SvRV( placeInfo); if ( pexist( anchor)) { char * c = pget_c( anchor); if (( strcmp( c, "n") == 0)) { var-> geomInfo. anchorx = CENTER; var-> geomInfo. anchory = NORTH; } else if (( strcmp( c, "ne") == 0)) { var-> geomInfo. anchorx = EAST; var-> geomInfo. anchory = NORTH; } else if (( strcmp( c, "e") == 0)) { var-> geomInfo. anchorx = EAST; var-> geomInfo. anchory = CENTER; } else if (( strcmp( c, "se") == 0)) { var-> geomInfo. anchorx = EAST; var-> geomInfo. anchory = SOUTH; } else if (( strcmp( c, "s") == 0)) { var-> geomInfo. anchorx = CENTER; var-> geomInfo. anchory = SOUTH; } else if (( strcmp( c, "sw") == 0)) { var-> geomInfo. anchorx = WEST; var-> geomInfo. anchory = SOUTH; } else if (( strcmp( c, "w") == 0)) { var-> geomInfo. anchorx = WEST; var-> geomInfo. anchory = CENTER; } else if (( strcmp( c, "nw") == 0)) { var-> geomInfo. anchorx = WEST; var-> geomInfo. anchory = NORTH; } else if ( *c == 'c' && ( strcmp( c, "center") == 0)) { var-> geomInfo. anchorx = CENTER; var-> geomInfo. anchory = CENTER; } else croak("%s: invalid 'anchor'", "RTC008F: Prima::Widget::place"); } if ( pexist( x)) { SV * sv = pget_sv( x); if (( var-> geomInfo. use_x = (SvTYPE( sv) != SVt_NULL))) var-> geomInfo. x = SvIV( sv); } if ( pexist( y)) { SV * sv = pget_sv( y); if (( var-> geomInfo. use_y = (SvTYPE( sv) != SVt_NULL))) var-> geomInfo. y = SvIV( sv); } if ( pexist( width)) { SV * sv = pget_sv( width); if (( var-> geomInfo. use_w = (SvTYPE( sv) != SVt_NULL))) var-> geomSize. x = SvIV( sv); } if ( pexist( height)) { SV * sv = pget_sv( height); if (( var-> geomInfo. use_h = (SvTYPE( sv) != SVt_NULL))) var-> geomSize. y = SvIV( sv); } if ( pexist( relx)) { SV * sv = pget_sv( relx); if (( var-> geomInfo. use_rx = (SvTYPE( sv) != SVt_NULL))) var-> geomInfo. relX = SvNV( sv); } if ( pexist( rely)) { SV * sv = pget_sv( rely); if (( var-> geomInfo. use_ry = (SvTYPE( sv) != SVt_NULL))) var-> geomInfo. relY = SvNV( sv); } if ( pexist( relwidth)) { SV * sv = pget_sv( relwidth); if (( var-> geomInfo. use_rw = (SvTYPE( sv) != SVt_NULL))) var-> geomInfo. relWidth = SvNV( sv); } if ( pexist( relheight)) { SV * sv = pget_sv( relheight); if (( var-> geomInfo. use_rh = (SvTYPE( sv) != SVt_NULL))) var-> geomInfo. relHeight = SvNV( sv); } if ( pexist( in)) { SV * sv = pget_sv( in); in = nilHandle; if ( SvTYPE( sv) != SVt_NULL) in = Widget_check_in( self, gimme_the_mate( sv), true); set_in = true; } if ( var-> geometry == gtPlace) { if ( set_in) Widget_place_leave( self); } if ( set_in) var-> geomInfo. in = in; if ( var-> geometry == gtPlace) { if ( set_in) Widget_place_enter( self); geometry_reset( MASTER, gtPlace); } } return nilSV; } XS( Widget_get_place_slaves_FROMPERL) { dXSARGS; int i; Handle self; if ( items != 1) croak ("Invalid usage of Widget.get_pack_slaves"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Widget.get_pack_slaves"); for ( i = 0; i < var-> widgets. count; i++) { if ( PWidget( var-> widgets. items[i])-> geometry == gtPlace) XPUSHs( sv_2mortal( newSVsv((( PAnyObject)(var-> widgets. items[i]))-> mate))); } PUTBACK; return; } void Widget_get_place_slaves ( Handle self) { warn("Invalid call of Widget::get_place_slaves"); } void Widget_get_place_slaves_REDEFINED( Handle self) { warn("Invalid call of Widget::get_place_slaves"); } /* */ #ifdef __cplusplus } #endif Prima-1.28/utils/0000755000175100017510000000000011150770061011432 5ustar dkdkPrima-1.28/utils/fmview.pl0000644000175100017510000000037211150770061013266 0ustar dkdk# $Id: fmview.pl,v 1.1 2005/09/28 09:30:03 dk Exp $ die < execute; Prima-1.28/utils/podview.pl0000644000175100017510000000363311150770061013451 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: podview.pl,v 1.3 2005/10/13 17:22:55 dk Exp $ # use strict; use Prima; use Prima::HelpViewer; use Prima::Application; package SoleHelpViewer; use vars qw(@ISA); @ISA = qw(Prima::PodViewWindow); sub on_destroy { $_[0]-> SUPER::on_destroy; $::application-> close unless @Prima::HelpViewer::helpWindows; } package main; $Prima::HelpViewer::windowClass = 'SoleHelpViewer'; my $htx = ( @ARGV ? $ARGV[0] : 'Prima' ); if ( -f $htx) { $htx = "file://$htx"; } else { $htx .= '/' unless $htx =~ /\//; } $::application-> open_help( $htx); run Prima; Prima-1.28/utils/makedoc/0000755000175100017510000000000011150770061013035 5ustar dkdkPrima-1.28/utils/makedoc/makedoc.pl0000644000175100017510000001005311150770061014774 0ustar dkdk# $Id: makedoc.pl,v 1.6 2007/09/21 10:58:17 dk Exp $ use strict; use Config; my $path; my $build; for ( @ARGV) { if ( m/^--build$/) { $build = 1; } elsif ( m/^--path=(.+)$/) { $path = $1; } } unless ( $path) { for ( '../..', @INC) { next unless -f "$_/Prima.pm"; $path = $_; last; } } print "Using $path as root\n"; $build = 1 unless -f 'Prima.cache.tex'; my @tex; my @bs; if ( $build) { open F, "$path/Prima.pm" or die "Cannot open $path/Prima.pm:$!\n"; my $begin; for ( ) { $begin = 1 if !$begin && m/Tutorials/; next unless $begin; if ( m/L\<([^<]*)\>/) { push @bs, [ 0, $1]; } elsif ( m/^=item\s*(.*)/) { if ( $1 eq '*') { $_ = ; $_ = ; chomp; push @bs, [ 1, $_]; } else { push @bs, [ 1, $1]; } push @bs, [0,'Prima'] if $#bs && $bs[-1][0] == 1 && $bs[-1][1] =~ /Core toolkit classes/; } } close F; } else { open F, "Prima.cache.tex" or die "Cannot open Prima.cache.tex:$!\n"; push @tex, ''; for ( ) { push @tex, '' if m/^\\documentclass{article}/; $tex[-1] .= $_; } close F; } sub Link { my $x = $_[0]; if ( $x =~ /^perl/) { return "L<$x>"; } else { $x =~ s/"//g; if ( $x =~ /^([^\/]+)\/([^\/]+)$/) { return "the B<$2> entry in the I<$1> section"; } else { $x =~ s/\///g; if ( $x =~ /^Prima|VB|cfgmaint|gencls/) { return "the I<$x> section"; } else { return "the I<$x> entry"; } } } } if ( $build) { my $chapter; for ( @bs) { my @ch = @$_; if ( $ch[0]) { $chapter = $ch[1]; next; } my $xfn = $ch[1]; my $fn = $ch[1]; $fn =~ s/::/\//g; for ( qw( .pod .pm .pl), '') { my $ext = $_; for ( $path, "$path/pod", "$path/utils", "$path/Prima/VB", $Config{installsitebin}) { next unless -f "$_/$fn$ext"; $fn = "$_/$fn$ext"; goto FOUND; } } die "`$fn' document is not found\n"; FOUND: open W, $fn or die "Cannot open $fn:$!\n"; my @ctx; my $cut; my $cow = 1; for ( ) { if ( m/^=for\s*podview\s*<\s*img\s*src=\"?([^\"\s]+)\"?\s*(cut\s*=\s*1)?\s*>/) { my ( $gif, $eps, $do_cut) = ( $1, $1, $2); $eps =~ s/\//_/g; $eps =~ s/\.[^\.]+$/.eps/; unless ( -f $eps) { for ( "$path/Prima", "$path/Prima/pod", "$path/pod/Prima") { next unless -f "$_/$gif"; $gif = "$_/$gif"; goto FOUND; } warn "** $gif is not found\n"; undef $gif; FOUND: if ( defined $gif) { print "convert $gif $eps\n"; system "convert $gif $eps\n"; } } if ( -f $eps) { $cow = 1; $cut = 1 if $do_cut; push @ctx, "=for latex \n\\includegraphics[keepaspectratio]{$eps}\n\n"; } else { warn "** error creating $eps\n"; } } elsif ( m/^=for\s*podview.*\/cut/) { $cut = 0; } s/L<([^\>]+)>/Link($1)/ge; s/\b(DESCRIPTION|USAGE|BUGS|SYNOPSIS|EXAMPLE|FORMAT|ARGUMENTS|SYNTAX|FILES|FILE FORMAT|METHODS|BASIC PROGRAM)\b/ucfirst(lc $1)/ge; push @ctx, $_ unless $cut; } close W; my $ffn = $fn; if ( $cow) { open W, "> tmp.pm" or die "Cannot write tmp.pm:$!\n"; print W @ctx; close W; $ffn = 'tmp.pm'; } unlink 'out.tex'; my $q = ($^O =~ /win32/i) ? '"' : "'"; system "pod2latex -full -modify -sections $q!SEE ALSO|AUTHOR|AUTHORS|COPYRIGHT$q -out out.tex $ffn"; unlink 'tmp.pm' if $cow; { open W, "out.tex" or die "Cannot open out.tex:$!\n"; local $/; push @tex, ; $tex[-1] =~ s/(\n\\section)/\\chapter{$chapter}$1/ if $chapter; print $fn, "\n"; undef $chapter; close W; } } open F, "> Prima.cache.tex" or die "Cannot write Prima.cache.tex:$!\n"; print F $_ for @tex; close F; } my $i; local $/; open F, "intro.tex" or die "Cannot open intro.tex:$!\n"; my $intro = ; close F; open W, "> Prima.tex" or die "Cannot open Prima.tex:$!\n"; print W $intro; for ( $i = 0; $i < @tex; $i++) { $tex[$i] =~ s/^.*\\begin{document}//s; $tex[$i] =~ s/\\tableofcontents//s; $tex[$i] =~ s/\\end{document}.*//s if $i < $#tex; $tex[$i] =~ s/\\item \d/\\item/gs; # $tex[$i] =~ s/ elsewhere in this document//gs; # $tex[$i] =~ s/the (\\emph{[^}]+}) manpage/$1/gs; print W $tex[$i]; } close W; Prima-1.28/utils/makedoc/Makefile0000644000175100017510000000113511150770061014475 0ustar dkdk# $Id: Makefile,v 1.3 2007/12/21 16:29:39 dk Exp $ all: Prima.dvi Prima.pdf Prima.dvi: Prima.tex latex Prima.tex latex Prima.tex Prima.ps: Prima.dvi dvips -Ppdf -o Prima.ps Prima.dvi Prima.pdf: Prima.ps ps2pdf -dAutoFilterColorImages=false -dColorImageFilter=/FlateEncode -dAutoFilterGrayImages=false -dGrayImageFilter=/FlateEncode Prima.ps Prima.tex: intro.tex perl makedoc.pl clean: rm -f Prima.ps Prima.dvi Prima.pdf Prima.tex Prima.log Prima.cache.tex Prima.ind Prima.aux Prima.idx Prima.toc texput.log out.tex *.eps view: Prima.dvi xdvi Prima.dvi pdfview: Prima.pdf acroread Prima.pdf Prima-1.28/utils/makedoc/intro.tex0000644000175100017510000000475011150770061014720 0ustar dkdk% $Id: intro.tex,v 1.6 2007/09/21 10:58:17 dk Exp $ \documentclass{report} \usepackage[a4paper]{geometry} \usepackage{a4wide} \usepackage{makeidx} \makeindex \usepackage{graphicx} \usepackage{titlesec} \begin{document} \titleformat{\chapter}[display] {}{}{0pc} { \Huge\bfseries \ifnum \thechapter>0 \thechapter\space\space\space \fi } \author{Dmitry Karasik} \title{Prima - the perl graphic toolkit} \maketitle \thispagestyle{empty} \clearpage \tableofcontents \sloppy \chapter{Introduction} \subsubsection{Preface} Prima is an extensible Perl toolkit for multi-platform GUI development. Platforms supported include Linux, Windows NT/9x/2K, OS/2 and UNIX/X11 workstations (FreeBSD, IRIX, SunOS, Solaris and others). The toolkit contains a rich set of standard widgets and has emphasis on 2D image processing tasks. A Perl program using PRIMA looks and behaves identically on X, Win32 and OS/2 PM. The Prima project was started in 1997 in Protein Laboratory, Copenhagen, by Anton Berezin, Dmitry Karasik, and Vadim Belman. This document describes programming with Prima graphic toolkit, and is a collection of manual pages of Prima application program interface ( API ), written by D.Karasik, except Prima::IniFile and Prima::ScrollBar, written by A.Berezin. \subsubsection{Requirements} Prima supports perl versions 5.004 and above. The recommended perl versions are 5.005 and above. In UNIX(tm) environments, Prima can use the following graphic libraries: libjpeg, libungif, libtiff, libpng, libXpm. \subsubsection{Installation} The toolkit can be downloaded from \texttt{http://www.prima.eu.org} in source and binary forms. Before installing, check the content of README file in the distribution. The installation from the source is performed by executing commands \begin{verbatim} perl Makefile.PL make make test make install \end{verbatim} There is a mailing list dedicated for various Prima-related discussions, prima@prima.eu.org. This list is also a proper place to send bug reports to. To subscribe to the list, send mail to \texttt{} and include \texttt{subscribe prima } in the body of your message. \subsubsection{Authors} Dmitry Karasik, Anton Berezin, Vadim Belman \subsubsection{Credits} David Scott, Kai Fiebach, Johannes Blankenstein, Teo Sankaro, Mike Castle, H.Merijn Brand, Richard Morgan -- thank you for your help. \subsubsection{Copyright} (c) 1997-2003 The Protein Laboratory, University of Copenhagen (c) 1997-2007 Dmitry Karasik Prima-1.28/utils/tmlink.pl0000644000175100017510000000714611150770061013275 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: tmlink.pl,v 1.9 2007/05/23 17:48:21 dk Exp $ # # TMLINK # # .tml -> .inc # tml files linker # use strict; my $warnings = 1; my $incFile; my @files = (); my @includeDirs = qw(./); my %funcs = (); sub find_file { my $fName = $_[0]; return $fName if -f $fName; for (@includeDirs) { return "$_$fName" if -f "$_$fName"; } return undef; } sub load_file { open FILE, $_[0] or die "APC001: Cannot open $_[0]\n"; { local $/; $_ = ; close FILE; } s#/\*.*?\*/##gs; s#//.*?\n##g; my ( $res, $title, $parms, $body); while (1) { if ( s|([\s\n\t]*\w+\s*\*?[\s\n\t]*)(\w+)([\s\n\t]*\([^\)]*\)[\s\n\t]*)(\{)||s) { ( $res, $title, $parms, $body) = ( $1, $2, $3, '{'); my $brackets = 1; while ( s|(.*?)([{}])||s) { $body .= "$1$2"; last if ( $brackets += (( $2 eq '{') ? 1 : -1)) == 0; } die "APC003: Unmatched bracket in $_[0] ( in $title)\n" if $brackets; $funcs{$title} = "$res$title$parms$body"; } else { s|[\s\n\t]*||; last if length( $_) == 0; my $title ||= 'start of file'; die "APC004: Error parsing $_[0] ( in $title)\n"; } } } # Main unless ( $ARGV[ 0]) { print "Apricot project. Tml file linker.\n"; print "format: tmlink.pl [ options] filename.tml [filename2.tml...]\n"; print "options: -Iinclude_path\n"; print "options: -Ofilename.inc\n"; die "\n"; } ARGUMENT: while( 1) { $_ = $ARGV[0]; /^-I(.*)$/ && do { my $ii = $1; @includeDirs = map { m{[\\/]$} ? $_ : "$_/" } (@includeDirs, split ';', $ii); next ARGUMENT; }; /^-o(.*)$/ && do { $incFile = $1; next ARGUMENT; }; last ARGUMENT; } continue { shift @ARGV; } die "APC000: insufficient number of parameters" unless $ARGV [0]; @files = @ARGV; for ( @files) { s/\\/\//g; my $fName = find_file( $_); die "APC005: Cannot find file: $_\n" if !defined $fName; load_file( $fName); } open FILE, ">$incFile" or die "APC002: Cannot open $incFile\n" if defined $incFile; my $f = ( defined $incFile) ? \*FILE : \*STDOUT; my $fName = defined $incFile ? $incFile : '.Untitled.tml'; print $f <{ depend} = 1; next ARGUMENT; }; /^--sayparent$/ && do { $args->{ sayparent} = 1; next ARGUMENT; }; /^--h$/ && do { $args->{ genH} = 1; next ARGUMENT; }; /^--inc$/ && do { $args->{ genInc} = 1; next ARGUMENT; }; /^--tml$/ && do { $args->{ genTml} = 1; next ARGUMENT; }; /^-O$/ && do { $args->{ optimize} = 1; next ARGUMENT; }; /^-I(.*)$/ && do { my $ii = $1; push @{ $args->{ incpath}}, map { m{[\\/]$} ? $_ : "$_/" } split ';', $ii; next ARGUMENT; }; last ARGUMENT; } continue { shift @ARGV; } die "APC000: insufficient number of parameters" unless $ARGV [0]; $ARGV[ 0] =~ m{^(.*[\\/])[^\\/]*$}; $args->{ dirPrefix} = $1 || ""; $args->{ dirOut} = "$ARGV[ 1]/" if $ARGV[ 1]; my @ancestors = gencls( $ARGV[ 0], $args); if ( @ancestors) { print ( map { "ancestor: $_\n"} @ancestors); } Prima-1.28/utils/p-class.pl0000644000175100017510000003035711150770061013341 0ustar dkdk#!/usr/bin/perl -w # # Copyright (c) 1997-2004 Dmitry Karasik # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: p-class.pl,v 1.3 2005/10/13 17:22:55 dk Exp $ # # dumps hierarchy of widget classes. # # Used by podview ( see File/Run/p-class ) # use strict; my $glob_path; my $debug = 0; my $want_all; my $want_hier; my @want_class; my $otype_pod = 1; my $ftype_pod = 0; for ( @ARGV) { if ( m/^--help$/ || m/^-h$/) { usage(); } if ( m/^--debug/ || m/^-d$/) { $debug = 1; } elsif ( m/^--path=(.+)$/) { $glob_path = $1; } elsif ( m/^--perldoc$/ || m/^-c$/) { $ftype_pod = 2; } elsif ( m/^--podview$/ || m/^-p$/) { $ftype_pod = 1; } elsif ( m/^--text$/ || m/^-t$/) { $otype_pod = 0; } elsif ( m/^--hier$/) { $want_hier = 1; } elsif ( m/^--all$/) { $want_all = 1; } elsif ( !m/^-/) { $_ = "Prima::$_" unless /^Prima::/; push @want_class, $_; } else { die "Unknown option `$_'\n"; } } die "The '--all' option and explicit classes names cannnot be set together\n" if $want_all && @want_class; usage() if !$want_all && !@want_class; sub usage { print < { # source tree type => 'pod', classes => 'kernel', exclude => qr/\/([a-z]|X11)[^\s\/]*\.pod$/, # no lowercase invariant => 1, }, 'Prima/*.pod' => { # installed type => 'pod', classes => 'kernel', exclude => qr/\/([a-z]|X11)[^\s\/]*\.pod$/, # no lowercase invariant => 1, }, 'Prima/*.pm' => { type => 'pm', classes => 'user', exclude => qr/\b(Classes|Application|Make|Themes|Tie|Const|IniFile|noX11|StdBitmap|Stress|Utils|StartupWindow|Config|EventHook|MsgBox|Utils|Gencls)\.pm$/, }, 'Prima/Classes.pm' => { type => 'pm', classes => 'kernel', }, 'Prima/Application.pm' => { type => 'pm', classes => 'kernel', }, 'Prima/PS/*.pm' => { type => 'pm', classes => 'user', exclude => qr/(Setup|Fonts|Encodings)\.pm$/, }, ); # the script deduces the property type from the head name, but sometimes fails. # here are the hints to proper types my @hints = ( { match => qr/Prima\/Object.pod\/Events/, property => undef, }, ); my ( $pod_root, @itemgroups, @stack, %invariants); my (%ascendants, %class_priority, %all_items, %pods); sub new_entry { my $entry = { @_, children => [] }; $entry->{path} = join('/', map { $_->{topic}} @stack); $entry->{pod_root} = $pod_root; push @itemgroups, $entry; $entry; } # load pod content from files while ( my ($path, $path_hints) = each %paths) { # check invariant paths next if $path_hints->{invariant} && $invariants{$path_hints->{invariant}}; my @glob = glob "$glob_path/$path"; next unless @glob; $invariants{$path_hints->{invariant}} = 1 if $path_hints->{invariant}; for ( @glob) { next if $path_hints->{exclude} && m/$path_hints->{exclude}/; my $filename = $_; open F, $filename or die "Cannot open $filename:$!\n"; print "FILE $filename\n" if $debug; my $root = { type => 'pod', topic => $filename, children => [], path => $filename, }; my $cap_name = 0; $pod_root = $filename; $pod_root =~ s/^.*?(Prima)/$1/; $pod_root =~ s/\//::/g; $pod_root =~ s/\.[\w]+$//; my $class_priority = (( $path_hints->{classes} eq 'kernel' ) ? 1 : 0); @stack = ($root); my $over = 0; @itemgroups = ($root); my $last_package; while () { if ( $path_hints->{type} ne 'pod') { unless ( m/^=(pod|head)/ .. m/^=cut/) { if ( m/package (Prima::.*);/) { $last_package = $1; } elsif ( defined $last_package && m/\@ISA\s*=\s*qw\s*\(([^\)]*)\)/) { $ascendants{$last_package} = [ grep { /^Prima/} split ' ', $1]; $class_priority{$last_package} = $class_priority; print "=> $path_hints->{classes} $last_package inherits @{$ascendants{$last_package}}\n" if $debug; } next; } } # store pod commands in a hierarchy my ($head,$topic,$parent,$entry); # any entry created? if ( m/^=(\S+)\s*(.*?)\s*$/) { ( $head, $topic) = ( $1, $2); # print "$1 $2\n"; if ( $head eq 'head1' && $topic eq 'NAME') { $cap_name = 1; next; } if ( $head eq 'head1') { $entry = new_entry( type => 'head1', topic => $topic ); $parent = $root; @stack = ($root, $entry); } elsif ( $head eq 'head2') { pop @stack while @stack && $stack[-1]->{type} !~ /head1|pod/; $entry = new_entry( type => 'head2', topic => $topic); $parent = $stack[-1]; push @stack, $entry; } elsif ( $head eq 'over') { $parent = $stack[-1]; $entry = new_entry( type => 'over', topic => 'over', depth => $over++); push @stack, $entry; } elsif ( $head eq 'back') { $over--; pop @stack; } elsif ( $head eq 'item') { push @{$stack[-1]->{children}}, $topic; } elsif ( $head =~ m/for|cut|pod/ ) { } else { warn "unknown pod directive '$head'\n"; } } else { # extract the full name from =head1 NAME if ( $cap_name) { next unless m/^\S+/m; chomp; $cap_name = 0; $entry = new_entry( type => 'head1', topic => $topic = $_, root_class => 1); $parent = $root; } } # check various dependencies in $entry if ( $entry) { # hierarchy push @{$parent->{children}}, $entry; # property if ( $topic =~ /(method)|(propert)|(event)/oi) { $entry->{property} = ( $1 ? 'Methods' : ( $2 ? 'Properties' : 'Events')); } elsif ( defined $parent->{property}) { $entry->{property} = $parent->{property} } # classes if ( $topic =~ /(Prima::[\w\d_\:]+)/) { $entry->{class} = $1; $pods{$1} = $pod_root; } elsif ( defined $parent->{class}) { $entry->{class} = $parent->{class}; $pods{$entry->{class}} = $pod_root; } if ( $entry->{class} && $entry->{root_class}) { $parent->{class} = $entry->{class}; # for =head1 NAME } # apply hints for my $hint ( @hints) { if ( $entry->{path} =~ /$hint->{match}/) { $entry->{property} = $hint->{property} if exists $hint->{property}; } } } } close F; # pod stream parse over - now parse dom # run for ( @itemgroups) { my $i = $_; my ( $prop, $class, $d_prop); if ( $debug) { print "$i->{path} $i->{topic}\n"; $d_prop = $i->{property} || '??'; $class = $i->{class} || '**'; $d_prop = '--' if $i->{type} eq 'over' && $i->{depth} > 0; } else { next if !defined $i->{property} || !defined $i->{class} || ($i->{type} eq 'over' && $i->{depth} > 0); $class = $i->{class}; } $prop = $i->{property}; for (@{$_->{children}}) { next if ref($_) eq 'HASH'; if ( $otype_pod) { s//\0xfe/g; s/\0xff/E/g; s/\0xfe/E/g; } my $topic = $_; s/\s.*$//; my $link = $_; print " $d_prop $class\:\:$topic => $pod_root/$link\n" if $debug; push @{$all_items{$class}->{$prop}}, [ $topic, $pod_root, $link ] if defined $prop; # just when debugging $pods{$class} = $pod_root; } } } } # inheritance tree my %descendants; while ( my ( $class, $inh) = each %ascendants) { print "$class => @$inh\n" if $debug; for ( @$inh) { push @{$descendants{$_}}, $class; } } # hacks hacks! $class_priority{'Prima::Object'} = 2; $class_priority{'Prima::Widget'} = 1; $pods{'Prima::AbstractMenu'} = $pods{'Prima::Menu'}; $pods{'Prima::ReplaceDialog'} = $pods{'Prima::FindDialog'}; my $prio = 3; my %processed_classes; for ( keys %descendants) { $class_priority{$_} = -1 unless defined $class_priority{$_}; # roots except Prima::Object } my $header; my $links_body;# = ( $otype_pod ? "=head1 HIERARCHY\n\n" : ''); my @classes; if ( @want_class) { for ( @want_class) { if ( $all_items{$_} || $descendants{$_} || $ascendants{$_}) { $header = "$_ - hierarchy"; push @classes, $_; } else { print "No information for `$_'\n"; exit; } } } else { $header = "Prima - hierarchy of Prima classes"; while ( $prio-- >= 0) { for ( grep { $class_priority{$_} == $prio } keys %descendants) { my @big_class_list = ($_); while ( $_ = shift @big_class_list) { next if $processed_classes{$_}; next if ($class_priority{$_} < $prio - 1); $processed_classes{$_} = 1; push @big_class_list, @{$descendants{$_}} if $descendants{$_}; # print "$_ => @{$descendants{$_}} \n" if $descendants{$_}; push @classes, $_; } } } } sub dump_class { my $class = $_[0]; my %items; my @traverse = ( $class); my @all_classes; # run inheritance traversal print "Traverse $class\n" if $debug; $links_body .= "=head1 $class\n\n" if $otype_pod; while ( $_ = shift @traverse) { push @traverse, @{$ascendants{$_}} if $ascendants{$_}; push @all_classes, $_; } $links_body .= ( $otype_pod ? "=head2 Related classes\n\n" : "* Related classes\n\n") unless $want_hier; for ( reverse @all_classes) { my $pod = $pods{$_} ? " in $pods{$_} manpage" : ''; if ( $otype_pod) { $links_body .= ( $pods{$_} ? "L<$_|$pods{$_}/>$pod\n\n" : "$_\n\n"); } else { $links_body .= " $_$pod\n"; } } return if $want_hier; for ( @all_classes) { my $curr_class = $_; print "-> $curr_class\n" if $debug; $links_body .= ( $otype_pod ? "=head2 $curr_class\n\n" : "\n\n* $curr_class\n"); if ( $all_items{$curr_class}) { while ( my ( $prop, $items) = each %{$all_items{$curr_class}}) { # e.g. METHOD, EVENT, PROPERTY print " -> $prop\n" if $debug; $links_body .= ( $otype_pod ? "B<$prop>\n\n=over 4\n\n" : "\n - $prop\n"); for ( @$items) { my ( $topic, $root, $name) = @$_; $items{$prop}->{$name} = "L<$topic|$root/$name>"; print " +-> $name\n" if $debug; $links_body .= ( $otype_pod ? $items{$prop}->{$name} . "\n\n" : " $topic\n"); } $links_body .= "\n\n=back\n\n" if $otype_pod; } } } } dump_class($_) for @classes; my $text; if ( $otype_pod) { $text = "=pod\n\n=head1 NAME\n\n$header\n\n$links_body\n=cut\n\n"; } else { $text = "\n$header\n\n$links_body\n"; } if ( $ftype_pod) { my $rname = ( $want_all ? 'prima-classes' : $want_class[0]); $rname =~ s/[\\:\/]/_/g; my $d = ($ENV{TEMP}?$ENV{TEMP}:'/tmp')."/$rname.$$"; open F, "> $d" or die "Cannot write $d:$!\n"; print F $text; close F; my $proc = ( $ftype_pod == 1 ? 'podview' : 'perldoc'); system( $proc, $d) == 0 or warn "Error running $proc $d:$?$!\n"; unlink $d; } else { print $text; } Prima-1.28/Prima/0000755000175100017510000000000011150770061011342 5ustar dkdkPrima-1.28/Prima/Edit.pm0000644000175100017510000027241611150770061012601 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by: # Dmitry Karasik # Anton Berezin # # $Id: Edit.pm,v 1.52 2008/10/29 19:40:52 dk Exp $ # # edit block types package bt; use constant CUA => 0; use constant Vertical => 1; use constant Horizontal => 2; package Prima::Edit; use vars qw(@ISA); @ISA = qw(Prima::Widget Prima::MouseScroller Prima::GroupScroller); use strict; use Prima::Const; use Prima::Classes; use Prima::ScrollBar; use Prima::IntUtils; { my %RNT = ( %{Prima::Widget-> notification_types()}, ParseSyntax => nt::Action, ); sub notification_types { return \%RNT; } } sub profile_default { my %def = %{$_[ 0]-> SUPER::profile_default}; my $font = $_[ 0]-> get_default_font; return { %def, accelItems => [ # navigation [ CursorDown => 0, 0, kb::Down , sub{$_[0]-> cursor_down}], [ CursorUp => 0, 0, kb::Up , sub{$_[0]-> cursor_up}], [ CursorLeft => 0, 0, kb::Left , sub{$_[0]-> cursor_left}], [ CursorRight => 0, 0, kb::Right , sub{$_[0]-> cursor_right}], [ PageUp => 0, 0, kb::PgUp , sub{$_[0]-> cursor_pgup}], [ PageDown => 0, 0, kb::PgDn , sub{$_[0]-> cursor_pgdn}], [ Home => 0, 0, kb::Home , sub{$_[0]-> cursor_home}], [ End => 0, 0, kb::End , sub{$_[0]-> cursor_end}], [ CtrlPageUp => 0, 0, kb::PgUp|km::Ctrl , sub{$_[0]-> cursor_cpgup}], [ CtrlPageDown => 0, 0, kb::PgDn|km::Ctrl , sub{$_[0]-> cursor_cpgdn}], [ CtrlHome => 0, 0, kb::Home|km::Ctrl , sub{$_[0]-> cursor_chome}], [ CtrlEnd => 0, 0, kb::End |km::Ctrl , sub{$_[0]-> cursor_cend}], [ WordLeft => 0, 0, kb::Left |km::Ctrl , sub{$_[0]-> word_left}], [ WordRight => 0, 0, kb::Right|km::Ctrl , sub{$_[0]-> word_right}], [ ShiftCursorDown => 0, 0, km::Shift|kb::Down , q(cursor_shift_key)], [ ShiftCursorUp => 0, 0, km::Shift|kb::Up , q(cursor_shift_key)], [ ShiftCursorLeft => 0, 0, km::Shift|kb::Left , q(cursor_shift_key)], [ ShiftCursorRight => 0, 0, km::Shift|kb::Right , q(cursor_shift_key)], [ ShiftPageUp => 0, 0, km::Shift|kb::PgUp , q(cursor_shift_key)], [ ShiftPageDown => 0, 0, km::Shift|kb::PgDn , q(cursor_shift_key)], [ ShiftHome => 0, 0, km::Shift|kb::Home , q(cursor_shift_key)], [ ShiftEnd => 0, 0, km::Shift|kb::End , q(cursor_shift_key)], [ ShiftCtrlPageUp => 0, 0, km::Shift|kb::PgUp|km::Ctrl , q(cursor_shift_key)], [ ShiftCtrlPageDown => 0, 0, km::Shift|kb::PgDn|km::Ctrl , q(cursor_shift_key)], [ ShiftCtrlHome => 0, 0, km::Shift|kb::Home|km::Ctrl , q(cursor_shift_key)], [ ShiftCtrlEnd => 0, 0, km::Shift|kb::End |km::Ctrl , q(cursor_shift_key)], [ ShiftWordLeft => 0, 0, km::Shift|kb::Left |km::Ctrl , q(cursor_shift_key)], [ ShiftWordRight => 0, 0, km::Shift|kb::Right|km::Ctrl , q(cursor_shift_key)], [ Insert => 0, 0, kb::Insert , sub {$_[0]-> insertMode(!$_[0]-> insertMode)}], # edit keys [ Delete => 0, 0, kb::Delete, sub { return if $_[0]-> {readOnly}; $_[0]-> has_selection ? $_[0]-> delete_block : $_[0]-> delete_char; }], [ Backspace => 0, 0, kb::Backspace, sub {$_[0]-> back_char unless $_[0]-> {readOnly}}], [ DeleteChunk => 0, 0, '^Y', sub {$_[0]-> delete_current_chunk unless $_[0]-> {readOnly}}], [ DeleteToEnd => 0, 0, '^E', sub {$_[0]-> delete_to_end unless $_[0]-> {readOnly}}], [ DupLine => 0, 0, '^K', sub {$_[0]-> insert_line($_[0]-> cursorY, $_[0]-> get_line($_[0]-> cursorY)) unless $_[0]-> {readOnly}}], [ DeleteBlock => 0, 0, '@D', sub {$_[0]-> delete_block unless $_[0]-> {readOnly}}], [ SplitLine => 0, 0, kb::Enter, sub {$_[0]-> split_line if !$_[0]-> {readOnly} && $_[0]-> {wantReturns}}], [ SplitLine2 => 0, 0, km::Ctrl|kb::Enter,sub {$_[0]-> split_line if !$_[0]-> {readOnly} && !$_[0]-> {wantReturns}}], # block keys [ CancelBlock => 0, 0, '@U', q(cancel_block)], [ MarkVertical => 0, 0, '@B', q(mark_vertical)], [ MarkHorizontal => 0, 0, '@L', q(mark_horizontal)], [ CopyBlock => 0, 0, '@C', q(copy_block)], [ OvertypeBlock => 0, 0, '@O', q(overtype_block)], # clipboard keys [ Cut => 0, 0, km::Shift|kb::Delete, q(cut)], [ Copy => 0, 0, km::Ctrl |kb::Insert, q(copy)], [ Paste => 0, 0, km::Shift|kb::Insert, q(paste)], [ CutMS => 0, 0, '^X', q(cut)], [ CopyMS => 0, 0, '^C', q(copy)], [ PasteMS => 0, 0, '^V', q(paste)], # undo [ Undo => 0, 0, km::Alt|kb::Backspace, q(undo)], [ Redo => 0, 0, '^R', q(redo)], ], autoIndent => 1, autoHScroll => 1, autoVScroll => 1, blockType => bt::CUA, borderWidth => 1, cursorSize => [ $::application-> get_default_cursor_width, $font-> { height}], cursorVisible => 1, cursorX => 0, cursorY => 0, cursorWrap => 0, insertMode => 0, hiliteNumbers => cl::Green, hiliteQStrings => cl::LightBlue, hiliteQQStrings => cl::LightBlue, hiliteIDs => [[qw( abs accept alarm atan2 bind binmode bless caller chdir chmod chomp chop chown chr chroot close closedir connect continue cos crypt defined delete die do dump each endgrent endhostent endnetent endprotoent endpwent endservent eof eval exec exists exit exp fcntl fileno flock for fork format formline getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername getpgrp getppid getpriority getprotobyname getprotobynumber getprotoent getpwent getpwnam getpwuid getservbyname getservbyport getservent getsockname getsockopt glob gmtime goto grep hex if import index int ioctl join keys kill last lc lcfirst length link listen local localtime log lstat m map mkdir msgctl msgget msgrcv msgsnd my next no oct open opendir ord our pack package pipe pop pos print printf prototype push q qq qr quotemeta qw qx rand read readdir readline readlink readpipe recv redo ref rename require reset return reverse rewinddir rindex rmdir s scalar seek seekdir select semctl semget semop send setgrent sethostent setnetent setpgrp setpriority setprotoent setpwent setservent setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep socket socketpair sort splice split sprintf sqrt srand stat study sub substr symlink syscall sysopen sysread sysseek system syswrite tell telldir tie tied time times tr truncate uc ucfirst umask undef unless unlink unpack unshift untie use utime values vec wait waitpid wantarray warn while write y )], cl::Blue], hiliteChars => ['~!@#$%^&*()+-=[]{};:\'"\\|?.,<>/', cl::Blue], hiliteREs => [ '(#.*)$', cl::Gray, '(\/\/.*)$', cl::Gray], hScroll => 0, markers => [], modified => 0, offset => 0, pointerType => cr::Text, persistentBlock => 0, readOnly => 0, selection => [0, 0, 0, 0], selStart => [0, 0], selEnd => [0, 0], selectable => 1, syntaxHilite => 0, tabIndent => 8, textRef => undef, topLine => 0, vScroll => 0, undoLimit => 1000, wantTabs => 0, wantReturns => 1, widgetClass => wc::Edit, wordDelimiters => ".()\"',#$@!%^&*{}[]?/|;:<>-= \xff\t", wordWrap => 0, } } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); if ( exists( $p-> { selection})) { my $s = $p-> {selection}; $p-> {selStart} = [$$s[0], $$s[1]]; $p-> {selEnd } = [$$s[2], $$s[3]]; } $p-> { text} = '' if exists( $p-> { textRef}); $p-> {autoHScroll} = 0 if exists $p-> {hScroll}; $p-> {autoVScroll} = 0 if exists $p-> {vScroll}; } sub init { my $self = shift; for ( qw( autoIndent topLine offset resetDisabled blockType persistentBlock tabIndent readOnly wantReturns wantTabs)) { $self-> {$_} = 1; } for ( qw( wordWrap hScroll vScroll rows maxLineCount maxLineLength maxLineWidth scrollTransaction maxLine maxChunk capLen cursorY cursorX cursorWrap cursorXl cursorYl syntaxHilite hiliteNumbers hiliteQStrings hiliteQQStrings notifyChangeLock modified borderWidth autoHScroll autoVScroll blockShiftMark )) { $self-> {$_} = 0;} $self-> { insertMode} = $::application-> insertMode; for ( qw( markers lines chunkMap hiliteIDs hiliteChars hiliteREs )) { $self-> {$_} = []} for ( qw( selStart selEnd selStartl selEndl)) { $self-> {$_} = [0,0]} $self-> {defcw} = $::application-> get_default_cursor_width; my %profile = $self-> SUPER::init(@_); $self-> setup_indents; $self-> {undo} = []; $self-> {redo} = []; $profile{selection} = [@{$profile{selStart}}, @{$profile{selEnd}}]; for ( qw( hiliteNumbers hiliteQStrings hiliteQQStrings hiliteIDs hiliteChars hiliteREs autoHScroll autoVScroll textRef syntaxHilite autoIndent persistentBlock blockType hScroll vScroll borderWidth topLine tabIndent readOnly offset wordDelimiters wantTabs wantReturns wordWrap cursorWrap markers undoLimit)) { $self-> $_( $profile{ $_}); } delete $self-> {resetDisabled}; $self-> {uChange} = 0; $self-> reset; $self-> selection( @{$profile{selection}}); for ( qw( cursorX cursorY)) { $self-> $_( $profile{ $_}); } $self-> reset_scrolls; $self-> {modified} = 0; return %profile; } sub reset { my $self = $_[0]; return if $self-> {resetDisabled}; my @a = ( $self-> {indents}-> [0], $self-> {indents}-> [1]); my @size = $self-> get_active_area(2); my $cw = $self-> {defcw}; my $ti = $self-> {tabIndent}; my $uC = $self-> {uChange}; my $mw; $size[0] -= $cw; if ( $uC < 2) { $self-> {fixed} = $self-> font-> pitch == fp::Fixed; $self-> {averageWidth} = $self-> font-> width; $mw = $self-> {averageWidth}; $self-> {maxFixedLength} = int( $size[0] / $mw); $self-> {tabs} = ' 'x$ti; } # changes that apply to string output must issue recalculation here. # # Calculating wrap chunks ( if necessary) and build chunkMap. # chunkMap is actual only in wordWrap = 1 mode; it maps lines to real lines. # it's structure is: [ subline offset, subline length, line index]. if ( $self-> {wordWrap}) { if ( $uC < 2) { my $twOpts = tw::WordBreak|tw::CalcTabs|tw::NewLineBreak|tw::ReturnChunks; my @chunkMap; $self-> begin_paint_info; $#chunkMap = scalar @{$self-> {lines}} * 2; @chunkMap = (); my $j = 0; for ( @{$self-> {lines}}) { my $i; my $breaks = $self-> text_wrap( $_, $size[0], $twOpts, $ti); for ( $i = 0; $i < scalar @{$breaks} / 2; $i++) { # push( @chunkMap, $$breaks[$i * 2]); # push( @chunkMap, $$breaks[$i * 2 + 1]); # push( @chunkMap, $j); push( @chunkMap, $$breaks[$i * 2], $$breaks[$i * 2 + 1], $j); } $j++; } $self-> end_paint_info; $self-> {chunkMap} = \@chunkMap; $self-> {maxLineWidth} = $size[0]; } } else { # fast ( but not exact) calculation of maximal line width. if ( $uC == 0) { my $max = 0; my $maxLinesCount = 0; for ( @{$self-> {lines}}) { my $l = length( $_); $max = $l, $maxLinesCount = 0 if $max < $l; $maxLinesCount++ if $l == $max; } $self-> {maxLineLength} = $max; $self-> {maxLineCount} = $maxLinesCount; } if ( $uC < 2) { $self-> {maxLineWidth} = $self-> {maxLineLength} * $mw; } } my $fh = $self-> font-> height; $self-> {rows} = int($size[1] / $fh); my $yTail = $size[1] - $self-> {rows} * $fh; if ( $uC < 2) { $self-> {maxLine} = scalar @{$self-> {lines}} - 1; $self-> {maxChunk} = $self-> {wordWrap} ? (scalar @{$self-> {chunkMap}}/3-1) : $self-> {maxLine}; $self-> {yTail} = ( $yTail > 0) ? 1 : 0; # updating selections $self-> selection( @{$self-> {selStart}}, @{$self-> {selEnd}}); # updating cursor $self-> cursor( $self-> cursor); my $chunk = $self-> get_chunk( $self-> {cursorYl}); my $x = $self-> {cursorXl}; $self-> {cursorAtX} = $self-> get_chunk_width( $chunk, 0, $x); $self-> {cursorInsWidth} = $self-> get_chunk_width( $chunk, $x, 1); } # positioning cursor my $cx = $a[0] + $self-> {cursorAtX} - $self-> {offset}; my $cy = $a[1] + $yTail + ($self-> {rows} - $self-> {cursorYl} + $self-> {topLine } - 1) * $fh; my $xcw = $self-> {insertMode} ? $cw : $self-> {cursorInsWidth}; my $ycw = $fh; $ycw -= $a[1] - $cy, $cy = $a[1] if $cy < $a[1]; $xcw = $size[0] + $a[0] - $cx - 1 if $cx + $xcw >= $size[0] + $a[0]; $self-> cursorVisible( $xcw > 0); if ( $xcw > 0) { $self-> cursorPos( $cx, $cy); $self-> cursorSize( $xcw, $ycw); } $self-> {uChange} = 0; } sub reset_cursor { my $self = $_[0]; $self-> {uChange} = 2; $self-> reset; $self-> {uChange} = 0; } sub reset_render { my $self = $_[0]; $self-> {uChange} = 1; $self-> reset; $self-> {uChange} = 0; } sub reset_scrolls { my $self = $_[0]; return if $self-> {resetDisabled}; if ( $self-> {scrollTransaction} != 1) { $self-> vScroll( $self-> {maxChunk} >= $self-> {rows}) if $self-> {autoVScroll}; $self-> {vScrollBar}-> set( max => $self-> {maxChunk} - $self-> {rows} + 1, pageStep => $self-> {rows}, whole => $self-> {maxChunk} + 1, partial => $self-> {rows}, value => $self-> {topLine }, ) if $self-> {vScroll}; } if ( $self-> {scrollTransaction} != 2) { my $w = $self-> width - $self-> {indents}-> [0] - $self-> {indents}-> [2]; my $lw = $self-> {maxLineWidth}; if ( $self-> {autoHScroll}) { my $hs = ( $lw > $w) ? 1 : 0; if ( $hs != $self-> {hScroll}) { $self-> hScroll( $hs); $w = $self-> width - $self-> {indents}-> [0] - $self-> {indents}-> [2]; } } $self-> {hScrollBar}-> set( max => $self-> {wordWrap} ? 0 : $lw - $w, whole => $lw < $w ? $w : $lw, value => $self-> {offset}, partial => $w, pageStep => $lw / 5, step => $self-> font-> width, ) if $self-> {hScroll}; } } sub VScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction}; $self-> {scrollTransaction} = 1; $self-> topLine ( $scr-> value); $self-> {scrollTransaction} = 0; } sub HScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction}; $self-> {scrollTransaction} = 2; $self-> offset( $scr-> value); $self-> {scrollTransaction} = 0; } sub reset_syntax { my $self = $_[0]; if ( $self-> {syntaxHilite}) { my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(ParseSyntax)); my @syntax; $#syntax = $self-> {maxLine}; @syntax = (); my $i = 0; $self-> push_event; for ( @{$self-> {lines}}) { my $sref = undef; $notifier-> ( @notifyParms, $_, $sref); push( @syntax, $sref); last if $i++ > 50; # test speed... } $self-> pop_event; $self-> {syntax} = \@syntax; } else { $self-> {syntax} = undef; } } sub reset_syntaxer { my $self = $_[0]; unless ($self-> {hiliteNumbers} || $self-> {hiliteQStrings} || $self-> {hiliteQQStrings} || $self-> {hiliteIDs} || $self-> {hiliteChars} || $self-> {hiliteREs}) { $self-> {syntaxer} = sub {$_[2]=[];}; } else { my @doers; my $rest = 'push @a, $l, cl::Fore if $l; $l = 0;'; if ($self-> {hiliteREs}) { my $i; for ($i = 0; $i < scalar @{$self-> {hiliteREs}} - 1; $i+=2) { my $re = $self-> {hiliteREs}-> [$i]; push @doers, "/\\G$re/gc && do { " . $rest . 'push @a, length($1), ' . $self-> {hiliteREs}-> [$i+1] . "; redo; };\n"; } } if ($self-> {hiliteIDs}) { my $i; for ($i = 0; $i < scalar @{$self-> {hiliteIDs}} - 1; $i+=2) { my $re = join '|', @{$self-> {hiliteIDs}-> [$i]}; push @doers, "/\\G\\b($re)\\b/gc && do { " . $rest . 'push @a, length($1), ' . $self-> {hiliteIDs}-> [$i+1] . "; redo; };\n"; } } push @doers, '/\\G\\b(\\d+)\\b/gc && do { ' . $rest . 'push @a, length($1), ' . $self-> {hiliteNumbers} . "; redo; };\n" if defined $self-> {hiliteNumbers}; push @doers, '/\\G("[^\\"\\\\]*(?:\\\\.[^\\"\\\\]*)*")/gc && do { ' . $rest . 'push @a, length($1), ' . $self-> {hiliteQQStrings} . "; redo; };\n" if defined $self-> {hiliteQQStrings}; push @doers, '/\\G(\'[^\\\'\\\\]*(?:\\\\.[^\\\'\\\\]*)*\')/gc && do { ' . $rest . 'push @a, length($1), ' . $self-> {hiliteQStrings} . "; redo; };\n" if defined $self-> {hiliteQStrings}; if ($self-> {hiliteChars}) { my $i; for ($i = 0; $i < scalar @{$self-> {hiliteChars}} - 1; $i+=2) { my $re = quotemeta $self-> {hiliteChars}-> [$i]; push @doers, "/\\G([$re]+)/gc && do { " . $rest . 'push @a, length($1), ' . $self-> {hiliteChars}-> [$i+1] . "; redo; };\n"; } } $self-> {syntaxer} = eval(< {syntax}-> [$i]; unless ( defined $sd) { $self-> notify(q(ParseSyntax), $chunk, $sd); $self-> {syntax}-> [$i] = $sd; } my ( $cc,$j); my $ofs = 0; for ( $j = 0; $j < scalar @{$sd} - 1; $j += 2) { my $xd = $self-> get_chunk_width( $chunk, $ofs, $$sd[$j], \$cc); $canvas-> color(( $$sd[$j+1] == cl::Fore) ? $clr : $$sd[$j+1]); $cc =~ s/\t/$self->{tabs}/g; $canvas-> text_out( $cc, $x, $y); $x += $xd; $ofs += $$sd[$j]; } } sub on_paint { # local variables definition area my ( $self, $canvas) = @_; my @size = $canvas-> size; my @clr = $self-> enabled ? ( $self-> color, $self-> backColor) : ( $self-> disabledColor, $self-> disabledBackColor); my @sclr = ( $self-> hiliteColor, $self-> hiliteBackColor); my ( $bw, $fh, $tl, $lc, $rc, $ofs, $yt, $tabs, $cw, $bt, $issel, $sh, $sx) = ( $self-> {borderWidth}, $self-> font-> height, $self-> {topLine }, $self-> {maxChunk}+1, $self-> {rows}, $self-> {offset}, $self-> {yTail}, $self-> {tabs}, $self-> {defcw}, $self-> {blockType}, $self-> has_selection, $self-> {syntaxHilite}, $self-> {syntax}, ); my @a = $self-> get_active_area( 0, @size); # drawing sheet my @clipRect = $self-> clipRect; if ( $clipRect[0] > $a[0] && $clipRect[1] > $a[1] && $clipRect[2] < $a[2] && $clipRect[3] < $a[3] ) { $canvas-> color( $clr[ 1]); # $canvas-> clipRect( $bw, $bw + $dy, $size[0] - $bw - $dx - 1, $size[1] - $bw - 1); $canvas-> clipRect( $a[0], $a[1], $a[2] - 1, $a[3] - 1); $canvas-> bar( 0, 0, @size); } else { $self-> draw_border( $canvas, $clr[1], @size); # $canvas-> clipRect( $bw, $bw + $dy, $size[0] - $bw - $dx - 1, $size[1] - $bw - 1); $canvas-> clipRect( $a[0], $a[1], $a[2] - 1, $a[3] - 1); } $canvas-> color( $clr[0]); my $i; my $y = $a[3] - $fh; my $lim = int(( $a[3] - $clipRect[1]) / $fh) + $tl + 1; { my $fx = int(( $a[3] - $clipRect[3]) / $fh) + $tl; $fx = $tl if $fx < $tl; $y -= ( $fx - $tl) * $fh; $tl = $fx; } $lim = $lc if $lim > $lc; my $x = $a[0] - $ofs; # painting selection my @sel; my @cuaXs; if ( $issel) { @sel = (@{$self-> {selStartl}}, @{$self-> {selEndl}}); if ( $bt == bt::CUA) { @cuaXs = ( $a[0] - $ofs + $self-> get_chunk_width( $self-> get_chunk( $sel[1]), 0, $sel[0] ), $a[0] - $ofs + $self-> get_chunk_width( $self-> get_chunk( $sel[3]), 0, $sel[2] ) ); my $cSet = 0; if ( $sel[1] == $sel[3]) { if ( $sel[1] >= $tl && $sel[ 1] < $lim) { $cSet = 1; $canvas-> color( $sclr[ 1]); $canvas-> bar( $cuaXs[0], $y - $fh * ( $sel[1] - $tl - 1) - 1, $cuaXs[1]-1, $y - $fh * ( $sel[1] - $tl) ); } } else { if ( $sel[1] >= $tl && $sel[ 1] < $lim) { $cSet = 1; $canvas-> color( $sclr[ 1]); $canvas-> bar( $cuaXs[0], $y - $fh * ( $sel[1] - $tl - 1) - 1, $size[0], $y - $fh * ( $sel[1] - $tl) ); } if ( $sel[3] >= $tl && $sel[ 3] < $lim) { $canvas-> color( $sclr[ 1]) unless $cSet; $cSet = 1; $canvas-> bar( 0, $y - $fh * ( $sel[3] - $tl - 1) - 1, $cuaXs[1]-1, $y - $fh * ( $sel[3] - $tl) ); } if ( $sel[3] -1 > $sel[1] && ( $sel[1] + 1 < $lim || $sel[ 3] - 1 >= $tl) ) { $canvas-> color( $sclr[ 1]) unless $cSet; $cSet = 1; $canvas-> bar( 0, $y - $fh * ( $sel[1] - $tl) - 1, $size[0], $y - $fh * ( $sel[3] - $tl - 1) ); } } $canvas-> color( $clr[0]) if $cSet; } elsif ( $bt == bt::Horizontal) { if ( $sel[1] < $lim || $sel[ 3] >= $tl) { $canvas-> color( $sclr[ 1]); $canvas-> bar( 0, $y - $fh * ( $sel[1] - $tl - 1) - 1, $size[0], $y - $fh * ( $sel[3] - $tl)); # painting horizontal block lines, if available $canvas-> color( $sclr[0]); my ($from, $to) = ( ( $tl > $sel[1]) ? $tl : $sel[1], ( $lim < ($sel[3]+1)) ? $lim : ( $sel[3] + 1) ); my $horz_y = $y - ( $from - $tl) * $fh; for ( $i = $from; $i < $to; $i++) { my $c = $self-> get_chunk( $i); $c =~ s/\t/$tabs/g; $canvas-> text_out( $c, $x, $horz_y); $horz_y -= $fh; } $canvas-> color( $clr[0]); } } } my $cSet = 0; # painting lines for ( $i = $tl; $i < $lim; $i++) { my $c = $self-> get_chunk( $i); if ( $issel && $i >= $sel[1] && $i <= $sel[3]) { # painting selected lines if ( $bt == bt::CUA) { if ( $sel[1] == $sel[3]) { my $cl = $sel[2] - length( $c); $c .= ' 'x$cl if $cl > 0; my $lc; if ( $sh) { $self-> draw_colorchunk( $canvas, $c, $i, $x, $y, $clr[0] ); } else { $lc = substr( $c, 0, $sel[0]); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $x, $y); $lc = substr( $c, $sel[2], length($c)); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $cuaXs[1], $y); } $lc = substr( $c, $sel[0], $sel[2] - $sel[0]); $lc =~ s/\t/$tabs/g; $canvas-> color( $sclr[0]); $canvas-> text_out( $lc, $cuaXs[0], $y); $canvas-> color( $clr[0]); } elsif ( $i == $sel[1]) { my $cl = $sel[0] - length( $c); $c .= ' 'x$cl if $cl > 0; my $lc; if ( $sh) { $self-> draw_colorchunk( $canvas, $c, $i, $x, $y, $clr[0] ); } else { $lc = substr( $c, 0, $sel[0]); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $x, $y); } $canvas-> color( $sclr[0]); $lc = substr( $c, $sel[0], length( $c)); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $cuaXs[0], $y); $cSet = 1; } elsif ( $i == $sel[3]) { my $cl = $sel[2] - length( $c); $c .= ' 'x$cl if $cl > 0; if ( $sh) { $self-> draw_colorchunk( $canvas, $c, $i, $x, $y, $clr[0]); } else { $canvas-> color( $clr[0]); $lc = substr( $c, $sel[2], length( $c)); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $cuaXs[1], $y); } $canvas-> color( $sclr[0]); my $lc = substr( $c, 0, $sel[2]); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $x, $y); $canvas-> color( $clr[0]); } else { $c =~ s/\t/$tabs/g; $canvas-> color( $sclr[0]) unless $cSet; $cSet = 1; $canvas-> text_out( $c, $x, $y); } } elsif ( $bt == bt::Vertical) { my @vXs = ( $self-> get_chunk_width( $c, 0, $sel[0]) - $ofs + $a[0], $self-> get_chunk_width( $c, 0, $sel[2]) - $ofs + $a[0] ); $canvas-> color( $sclr[1]); $canvas-> bar( $vXs[0], $y, $vXs[1]-1, $y + $fh - 1); $canvas-> color( $clr[0]); my $cl = $sel[2] - length( $c); $c .= ' 'x$cl if $cl > 0; my $lc; if ( $sh) { $self-> draw_colorchunk( $canvas, $c, $i, $x, $y, $clr[0] ); } else { $lc = substr( $c, 0, $sel[0]); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $x, $y); $lc = substr( $c, $sel[2], length($c)); $lc =~ s/\t/$tabs/g; $canvas-> text_out( $lc, $vXs[1], $y); } $lc = substr( $c, $sel[0], $sel[2] - $sel[0]); $lc =~ s/\t/$tabs/g; $canvas-> color( $sclr[0]); $canvas-> text_out( $lc, $vXs[0], $y); $canvas-> color( $clr[0]); } } else { # painting syntaxed lines if ( $sh) { $self-> draw_colorchunk( $canvas, $c, $i, $x, $y, $clr[0]); } else { # painting normal lines $c =~ s/\t/$tabs/g; $canvas-> color( $clr[0]); $canvas-> text_out( $c, $x, $y); } } $y -= $fh; } } sub point2xy { my ( $self, $x, $y) = @_; my ( $fh, $ofs, $avg, @a) = ( $self-> font-> height, $self-> {offset}, $self-> {averageWidth}, $self-> get_active_area ); my ( $rx, $ry, $inBounds); $inBounds = !( $x <= $a[0] || $x > $a[2] || $y < $a[1] || $y > $a[3]); $x -= $a[0]; $y -= $a[1]; my ( $w, $h) = ( $a[2] - $a[0], $a[3] - $a[1]); $y = $h + $fh if $y > $h; $y = -$fh if $y < 0; $x = $w + $avg * 2 if $x > $w + $avg * 2; $x = - $avg * 2 if $x < - $avg * 2; $ry = int(( $h - $y) / $fh) + $self-> {topLine }; $ry = 0 if $ry < 0; $ry = $self-> {maxChunk} if $ry > $self-> {maxChunk}; $rx = 0; my $chunk = $self-> get_chunk( $ry); my $cl = ( $w + $ofs) / ($self-> get_text_width(' ')||1); $chunk .= ' 'x$cl; if ( $ofs + $x > 0) { my $ofsx = $ofs + $x; $ofsx = $self-> {maxLineWidth} if $ofsx > $self-> {maxLineWidth}; $rx = $self-> text_wrap( $chunk, $ofsx, tw::CalcTabs|tw::BreakSingle|tw::ReturnFirstLineLength, $self-> {tabIndent}); } return $self-> make_physical( $rx, $ry), $inBounds; } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {mouseTransaction}; return if $btn != mb::Left && $btn != mb::Middle; my @xy = $self-> point2xy( $x, $y); return unless $xy[2]; $self-> cursor( @xy); if ( $btn == mb::Middle) { my $cp = $::application-> bring('Primary'); return if !$cp || $self-> {readOnly}; $self-> insert_text( $cp-> text, 0); $self-> clear_event; return; } $self-> {mouseTransaction} = 1; if ( $self-> {persistentBlock} && $self-> has_selection) { $self-> {mouseTransaction} = 2; } else { $self-> start_block unless exists $self-> {anchor}; } $self-> capture(1); $self-> clear_event; } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return unless $self-> {mouseTransaction}; return if $btn != mb::Left; $self-> capture(0); $self-> end_block unless $self-> {mouseTransaction} == 2; $self-> {mouseTransaction} = undef; $self-> clear_event; return if $self-> {writeOnly} || !$self-> has_selection; my $cp = $::application-> bring('Primary'); $cp-> text( $self-> get_selected_text) if $cp; } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; return unless $self-> {mouseTransaction}; my @xy = $self-> point2xy( $x, $y); $self-> clear_event; if ( $xy[2]) { $self-> scroll_timer_stop; } else { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); } $self-> {delayPanning} = 1; $self-> blockShiftMark(1); $self-> cursor( @xy); $self-> blockShiftMark(0); $self-> update_block unless $self-> {mouseTransaction} == 2; $self-> realize_panning; } sub on_mousewheel { my ( $self, $mod, $x, $y, $z) = @_; $z = int( $z/120); $z *= $self-> {rows} if $mod & km::Ctrl; my $newTop = $self-> topLine - $z; my $maxTop = $self-> {maxChunk} - $self-> {rows} + 1; $self-> topLine ( $newTop > $maxTop ? $maxTop : $newTop); $self-> clear_event; } sub on_mouseclick { my ( $self, $btn, $mod, $x, $y, $dbl) = @_; return if $self-> {mouseTransaction}; return if $btn != mb::Left; my @xy = $self-> point2xy( $x, $y); return unless $xy[2]; my $s = $self-> get_line( $xy[1]); $self-> clear_event; if ( !$dbl) { if ( $self-> {doubleclickTimer}) { $self-> {doubleclickTimer}-> destroy; delete $self-> {doubleclickTimer}; $self-> selection( 0, $xy[1], length $s, $xy[1]); } return; } $self-> cancel_block; $self-> cursor( @xy); my $p = $xy[0]; my $sl = length $s; my ($l,$r); return unless $sl; $p = $sl-1 if $p >= $sl; my $word = quotemeta($self-> {wordDelimiters}); my $nonword = "[$word]"; $word = "[^$word]"; if ( substr($s,$p,1) =~ /$word/) { substr($s,0,$p) =~ /($word*)$/; $l = $p - length $1; substr($s,$p) =~ /^($word*)/; $r = $p + length $1; } else { substr($s,0,$p) =~ /($nonword*)$/; $l = $p - length $1; substr($s,$p) =~ /^($nonword*)/; $r = $p + length $1; } $self-> selection( $l, $xy[1], $r, $xy[1]); $self-> {doubleclickTimer} = Prima::Timer-> create( onTick => sub{ $self-> {doubleclickTimer}-> destroy; delete $self-> {doubleclickTimer}; }) unless $self-> {doubleclickTimer}; $self-> {doubleclickTimer}-> timeout( Prima::Application-> get_system_value( sv::DblClickDelay) ); $self-> {doubleclickTimer}-> start; } sub on_keydown { my ( $self, $code, $key, $mod, $repeat) = @_; return if $self-> {readOnly}; return if $mod & km::DeadKey; $mod &= ( km::Shift|km::Ctrl|km::Alt); $self-> notify(q(MouseUp),0,0,0) if $self-> {mouseTransaction}; if ( $key == kb::Tab && !$self-> {wantTabs}) { return unless $mod & km::Ctrl; $mod &= ~km::Ctrl; } if ( ( $code >= ord(' ') || ( $code == ord("\t"))) && (( $mod & (km::Alt | km::Ctrl)) == 0) && (( $key == kb::NoKey) || ( $key == kb::Space) || ( $key == kb::Tab)) ) { my @cs = $self-> cursor; my $c = $self-> get_line( $cs[1]); my $l = 0; $self-> begin_undo_group; if ( $self-> insertMode) { $l = $cs[0] - length( $c), $c .= ' ' x $l if length( $c) < $cs[ 0]; substr( $c, $cs[0], 0) = chr($code) x $repeat; $self-> set_line( $cs[1], $c, q(add), $cs[0], $l + $repeat); } else { $l = $cs[0] - length( $c) + $repeat, $c .= ' ' x $l if length( $c) < $cs[ 0] + $repeat; substr( $c, $cs[0], $repeat) = chr($code) x $repeat; $self-> set_line( $cs[1], $c, q(overtype)); } $self-> cursor( $cs[0] + $repeat, $cs[1]); $self-> end_undo_group; $self-> clear_event; } } sub on_fontchanged { my $self = $_[0]; $self-> reset_render; $self-> reset_scrolls; } sub on_size { my $self = $_[0]; $self-> reset_render; $self-> reset_scrolls; } sub on_enable { $_[0]-> repaint; } sub on_disable { $_[0]-> repaint; } sub on_enter { my $self = $_[0]; $self-> insertMode( $::application-> insertMode); } sub on_change { $_[0]-> {modified} = 1;} sub on_parsesyntax { $_[0]-> {syntaxer}-> (@_); } sub set_block_type { my ( $self, $bt) = @_; return if $bt == $self-> {blockType}; $self-> push_group_undo_action('blockType', $self-> {blockType}); $self-> {blockType} = $bt; return unless $self-> has_selection; $self-> reset_render; $self-> repaint; } sub set_text_ref { my ( $self, $ref) = @_; return unless defined $ref; $self-> {capLen} = length( $$ref); $#{$self-> {lines}} = $self-> {capLen} / 40; @{$self-> {lines}} = (); @{$self-> {lines}} = split( "\n", $$ref); $self-> {maxLine} = scalar @{$self-> {lines}} - 1; $self-> reset_syntax; $self-> reset_scrolls; if ( !$self-> {resetDisabled}) { $self-> lock; $self-> selection(0,0,0,0); $self-> reset; $self-> cursor($self-> {cursorX}, $self-> {cursorY}); $self-> unlock; $self-> notify(q(Change)); $self-> reset_scrolls; } } sub text { unless ($#_) { my $hugeScalarRef = $_[0]-> textRef; return $$hugeScalarRef; } else { $_[0]-> textRef( \$_[1]); } } sub get_text_ref { my $self = $_[0]; my $hugeScalar = join( "\n", @{$self-> {lines}}); return \$hugeScalar; } sub get_chunk { my ( $self, $index) = @_; my $ck = $self-> {lines}; return '' if $self-> {maxLine} < 0; Carp::confess($index) if $index > $self-> {maxChunk}; if ( $self-> {wordWrap}) { my $cm = $self-> {chunkMap}; return substr( $$ck[ $$cm[ $index * 3 + 2]], $$cm[ $index * 3], $$cm[ $index * 3 + 1]); } else { return $$ck[ $index]; } } sub get_line { my ( $self, $index) = @_; return $self-> {maxLine} >= 0 ? $self-> {lines}-> [$index] : ''; } sub get_line_ext { my ( $self, $index) = @_; return '' if $self-> {maxLine} < 0; return $self-> {lines}-> [ $self-> {wordWrap} ? ( $self-> {chunkMap}-> [ $index * 3 + 2]) : $index ]; } sub get_line_dimension { my ( $self, $y) = @_; return $y, 1 unless $self-> {wordWrap}; ( undef, $y) = $self-> make_logical( 0, $y); my ($ret, $ix, $cm) = ( 0, $y * 3 + 2, $self-> {chunkMap}); $ret++, $ix += 3 while $$cm[ $ix] == $y; return $y, $ret; } sub get_chunk_org { my ( $self, $index) = @_; return $index unless $self-> {wordWrap}; my $cm = $self-> {chunkMap}; my $y = $$cm[ $index * 3 + 2]; $index-- while $y == $$cm[ $index * 3 + 2]; return $index + 1; } sub get_chunk_end { my ( $self, $index) = @_; return $index unless $self-> {wordWrap}; my $cm = $self-> {chunkMap}; my $y = $$cm[ $index * 3 + 2]; my $maxY = $self-> {maxChunk}; return -1 if $maxY < 0; $index++ while $index <= $maxY && $y == $$cm[ $index * 3 + 2]; return $index - 1; } sub get_chunk_width { my ( $self, $chunk, $from, $len, $retC) = @_; my $cl; $cl = $from + $len - length( $chunk) + 1; $chunk .= ' 'x$cl if $cl >= 0; $chunk = substr( $chunk, $from, $len); $chunk =~ s/\t/$self->{tabs}/g; $$retC = $chunk if $retC; return $self-> {fixed} ? ( length( $chunk) * $self-> {averageWidth}) : $self-> get_text_width( $chunk); } sub has_selection { my @s = $_[0]-> selection; return !(($s[0] == $s[2]) && ( $s[1] == $s[3])); } sub realize_panning { delete $_[0]-> {delayPanning}; for ( qw( topLine offset)) { my $c = 'delay_' . $_; next unless defined $_[0]-> {$c}; $_[0]-> $_( $_[0]-> {$c}); delete $_[0]-> {$c}; } } sub set_cursor { my ( $self, $x, $y) = @_; my ( $ox, $oy) = ($self-> {cursorX}, $self-> {cursorY}); my $maxY = $self-> {maxLine}; $y = $maxY if $y < 0 || $y > $maxY; $y = 0 if $y < 0; # ?? my $line = $self-> get_line( $y); $x = length( $line) if $x < 0; my ( $lx, $ly) = $self-> make_logical( $x, $y); my ( $olx, $oly) = ( $self-> {cursorXl}, $self-> {cursorYl}); $self-> {cursorXl} = $lx; $self-> {cursorYl} = $ly; return if $y == $oy and $x == $ox and $lx == $olx and $ly == $oly; my ( $tl, $r, $yt) = ( $self-> {topLine }, $self-> {rows}, $self-> {yTail}); if ( $ly < $tl) { $self-> topLine ( $ly); } elsif ( $ly >= $tl + $r) { my $nfc = $ly - $r + 1; $self-> topLine ( $nfc); } my $chunk = $self-> get_chunk( $ly); my $atX = $self-> get_chunk_width( $chunk, 0, $lx); my $deltaX = $self-> get_chunk_width( $chunk, $lx, 1); my $actualWidth = $self-> width - $self-> {indents}-> [0] - $self-> {indents}-> [2] - $self-> {defcw}; my $ofs = $self-> {offset}; my $avg = $self-> {averageWidth}; if ( $atX < $ofs) { my $nofs = $atX; $self-> offset( $nofs - $avg); } elsif ( $atX >= $ofs + $actualWidth - $deltaX) { my $nofs = $atX - $actualWidth + $deltaX; $nofs = $ofs + $avg if $nofs - $ofs < $avg; $self-> offset( $nofs); } # check if last undo record contains cursor movements only, so these movements # can be grouped my $undo = 1; if ( !$self-> {undo_in_action} && @{$self-> {undo}} && @{$self-> {undo}-> [-1]}) { my $ok = 1; for ( @{$self-> {undo}-> [-1]}) { $ok = 0, last if $$_[0] ne 'cursor'; } $undo = 0 if $ok; } $self-> push_undo_action( 'cursor', $self-> {cursorX}, $self-> {cursorY}) if $undo; $self-> {cursorX} = $x; $self-> {cursorY} = $y; $self-> {cursorAtX} = $atX; $self-> {cursorInsWidth} = $deltaX; $self-> reset_cursor; $self-> cancel_block if !$self-> {blockShiftMark} && !$self-> {persistentBlock}; } sub set_top_line { my ( $self, $tl) = @_; $tl = $self-> {maxChunk} if $tl >= $self-> {maxChunk}; $tl = 0 if $tl < 0; return if $self-> {topLine } == $tl; if ( $self-> {delayPanning}) { $self-> {delay_topLine } = $tl; return; } my $dt = $tl - $self-> {topLine }; $self-> push_group_undo_action( 'topLine', $self-> {topLine}); $self-> {topLine } = $tl; if ( $self-> {vScroll} && $self-> {scrollTransaction} != 1) { $self-> {scrollTransaction} = 1; $self-> {vScrollBar}-> value( $tl); $self-> {scrollTransaction} = 0; } $self-> reset_cursor; $self-> scroll( 0, $dt * $self-> font-> height, clipRect => [ $self-> get_active_area]); } sub reset_indents { my ( $self) = @_; $self-> reset_render; $self-> reset_scrolls; $self-> repaint; } sub set_hilite_numbers { my $self = $_[0]; $self-> {hiliteNumbers} = $_[1]; if ( $self-> {syntaxHilite}) { $self-> reset_syntaxer; $self-> repaint; } } sub set_hilite_q_strings { my $self = $_[0]; $self-> {hiliteQStrings} = $_[1]; if ( $self-> {syntaxHilite}) { $self-> reset_syntaxer; $self-> repaint; } } sub set_hilite_qq_strings { my $self = $_[0]; $self-> {hiliteQQStrings} = $_[1]; if ( $self-> {syntaxHilite}) { $self-> reset_syntaxer; $self-> repaint; } } sub set_hilite_ids { my ($self, $hi) = @_; if ( $hi) { push @{$hi}, cl::Fore if scalar @{$hi} / 2 != 0; $hi = [@{$hi}]; } $self-> {hiliteIDs} = $hi; if ( $self-> {syntaxHilite}) { $self-> reset_syntaxer; $self-> repaint; } } sub set_hilite_chars { my ($self, $hi) = @_; if ( $hi) { push @{$hi}, cl::Fore if scalar @{$hi} / 2 != 0; $hi = [@{$hi}]; } $self-> {hiliteChars} = $hi; if ( $self-> {syntaxHilite}) { $self-> reset_syntaxer; $self-> repaint; } } sub set_hilite_res { my ($self, $hi) = @_; if ( $hi) { push @{$hi}, cl::Fore if scalar @{$hi} / 2 != 0; $hi = [@{$hi}]; } $self-> {hiliteREs} = $hi; if ( $self-> {syntaxHilite}) { $self-> reset_syntaxer; $self-> repaint; } } sub set_insert_mode { my ( $self, $insert) = @_; my $oi = $self-> {insertMode}; $self-> {insertMode} = $insert; $self-> reset_cursor if $oi != $insert; $::application-> insertMode( $insert); $self-> push_group_undo_action( 'insertMode', $oi) if $oi != $insert; } sub set_offset { my ( $self, $offset) = @_; $offset = 0 if $offset < 0; $offset = 0 if $self-> {wordWrap}; return if $self-> {offset} == $offset; if ( $self-> {delayPanning}) { $self-> {delay_offset} = $offset; return; } my $dt = $offset - $self-> {offset}; $self-> push_group_undo_action( 'offset', $self-> {offset}); $self-> {offset} = $offset; if ( $self-> {hScroll} && $self-> {scrollTransaction} != 2) { $self-> {scrollTransaction} = 2; $self-> {hScrollBar}-> value( $offset); $self-> {scrollTransaction} = 0; } $self-> reset_cursor; $self-> scroll( -$dt, 0, clipRect => [ $self-> get_active_area]); } sub set_selection { my ( $self, $sx, $sy, $ex, $ey) = @_; my $maxY = $self-> {maxLine}; my ( $osx, $osy, $oex, $oey) = $self-> selection; my $onsel = ( $osx == $oex && $osy == $oey); if ( $maxY < 0) { $self-> {selStart} = [0,0]; $self-> {selEnd} = [0,0]; $self-> {selStartl} = [0,0]; $self-> {selEndl } = [0,0]; $self-> repaint unless $onsel; return; } $sy = $maxY if $sy < 0 || $sy > $maxY; $ey = $maxY if $ey < 0 || $ey > $maxY; ( $sy, $ey, $sx, $ex) = ( $ey, $sy, $ex, $sx) if $sy > $ey; $osx = $oex = $sx, $osy = $oey = $ey if $onsel; if ( $sx == $ex && $sy == $ey) { $osy = $maxY if $osy < 0 || $osy > $maxY; $oey = $maxY if $oey < 0 || $oey > $maxY; $sx = $ex = $osx; $sy = $ey = $osy; } my ($firstChunk, $lastChunk) = ( $self-> get_line( $sy), $self-> get_line( $ey)); my ($fcl, $lcl) = ( length( $firstChunk), length( $lastChunk)); my $bt = $self-> {blockType}; $sx = $fcl if ( $bt != bt::Vertical && $sx > $fcl) || ( $sx < 0); $ex = $lcl if ( $bt != bt::Vertical && $ex > $lcl) || ( $ex < 0); ( $sx, $ex) = ( $ex, $sx) if $sx > $ex && (( $sy == $ey && $bt == bt::CUA) || ( $bt == bt::Vertical)); my ( $lsx, $lsy) = $self-> make_logical( $sx, $sy); my ( $lex, $ley) = $self-> make_logical( $ex, $ey); ( $lsx, $lex) = ( $lex, $lsx) if $lsx > $lex && (( $lsy == $ley && $bt == bt::CUA) || ( $bt == bt::Vertical)); $sy = $ey if $sx == $ex and $bt == bt::Vertical; my ( $_osx, $_osy) = @{$self-> {selStartl}}; my ( $_oex, $_oey) = @{$self-> {selEndl}}; $self-> {selStart} = [ $sx, $sy]; $self-> {selStartl} = [ $lsx, $lsy]; $self-> {selEnd} = [ $ex, $ey]; $self-> {selEndl} = [ $lex, $ley]; return if $sx == $osx && $ex == $oex && $sy == $osy && $ey == $oey; return if $sx == $ex && $sy == $ey && $onsel; $self-> push_group_undo_action('selection', $osx, $osy, $oex, $oey); ( $osx, $osy, $oex, $oey) = ( $_osx, $_osy, $_oex, $_oey); ( $sx, $sy) = @{$self-> {selStartl}}; ( $ex, $ey) = @{$self-> {selEndl}}; $osx = $oex = $sx, $osy = $oey = $ey if $onsel; if (( $osy > $ey && $oey > $ey) || ( $oey < $sy && $oey < $sy)) { $self-> repaint; return; } # connective selection my ( $start, $end); if ( $bt == bt::CUA || ( $sx == $osx && $ex == $oex)) { if ( $sy == $osy) { if ( $ey == $oey) { if ( $sx == $osx) { $start = $end = $ey; } elsif ( $ex == $oex) { $start = $end = $sy; } else { ($start, $end) = ( $sy, $ey); } } else { ( $start, $end) = ( $ey < $oey) ? ( $ey, $oey) : ( $oey, $ey); } } elsif ( $ey == $oey) { ( $start, $end) = ( $sy < $osy) ? ( $sy, $osy) : ( $osy, $sy); } else { $start = ( $sy < $osy) ? $sy : $osy; $end = ( $ey > $oey) ? $ey : $oey; } } else { $start = ( $sy < $osy) ? $sy : $osy; $end = ( $ey > $oey) ? $ey : $oey; } my ( $ofs, $tl, $fh, $r, $yT) = ( $self-> {offset}, $self-> {topLine }, $self-> font-> height, $self-> {rows}, $self-> {yTail} ); my @a = $self-> get_active_area( 0); return if $end < $tl || $start >= $tl + $r + $yT; if ( $start == $end && $bt == bt::CUA) { # single connective line paint my $chunk; my ( $xstart, $xend); if ( $sx == $osx) { ( $xstart, $xend) = ( $ex < $oex) ? ( $ex, $oex) : ( $oex, $ex); } elsif ( $ex == $oex) { ( $xstart, $xend) = ( $sx < $osx) ? ( $sx, $osx) : ( $osx, $sx); } else { $xstart = ( $sx < $osx) ? $sx : $osx; $xend = ( $ex > $oex) ? $ex : $oex; } unless ( $self-> {wordWrap}) { if ( $start == $sy) { $chunk = $firstChunk; } elsif ( $start == $ey) { $chunk = $lastChunk; } else { $chunk = $self-> get_chunk( $start); } } else { $chunk = $self-> get_chunk( $start); } $self-> invalidate_rect( $a[0] - $ofs + $self-> get_chunk_width( $chunk, 0, $xstart) - 1, $a[3] - $fh * ( $start - $tl + 1), $a[0] - $ofs + $self-> get_chunk_width( $chunk, 0, $xend), $a[3] - $fh * ( $start - $tl) ); } else { # general connected lines paint $self-> invalidate_rect( $a[0], $a[3] - $fh * ( $end - $tl + 1), $a[2], $a[3] - $fh * ( $start - $tl), ); } } sub set_tab_indent { my ( $self, $ti) = @_; $ti = 0 if $ti < 0; $ti = 256 if $ti > 256; return if $ti == $self-> {tabIndent}; $self-> {tabIndent} = $ti; $self-> reset; $self-> repaint; } sub set_syntax_hilite { my ( $self, $sh) = @_; $sh = 0 if $self-> {wordWrap}; return if $sh == $self-> {syntaxHilite}; $self-> {syntaxHilite} = $sh; $self-> reset_syntaxer if $sh; $self-> reset_syntax; $self-> repaint; } sub set_word_wrap { my ( $self, $ww) = @_; return if $ww == $self-> {wordWrap}; $self-> {wordWrap} = $ww; $self-> syntaxHilite(0) if $ww; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub cut { my $self = $_[0]; return if $self-> {readOnly}; $self-> begin_undo_group; $self-> copy; $self-> delete_block; $self-> end_undo_group; } sub copy { my $self = $_[0]; my $text = $self-> get_selected_text; $::application-> Clipboard-> text($text) if defined $text; } sub get_selected_text { my $self = $_[0]; return undef unless $self-> has_selection; my @sel = $self-> selection; my $text = ''; my $bt = $self-> blockType; if ( $bt == bt::CUA) { if ( $sel[1] == $sel[3]) { $text = substr( $self-> get_line( $sel[1]), $sel[0], $sel[2] - $sel[0]); } else { my $c = $self-> get_line( $sel[1]); $text = substr( $c, $sel[0], length( $c) - $sel[0])."\n"; my $i; for ( $i = $sel[1] + 1; $i < $sel[3]; $i++) { $text .= $self-> get_line( $i)."\n"; } $c = $self-> get_line( $sel[3]); $text .= substr( $c, 0, $sel[2]); } } elsif ( $bt == bt::Horizontal) { my $i; for ( $i = $sel[1]; $i <= $sel[3]; $i++) { $text .= $self-> get_line( $i)."\n"; } } else { my $i; for ( $i = $sel[1]; $i <= $sel[3]; $i++) { my $c = $self-> get_line( $i); my $cl = $sel[2] - length( $c); $c .= ' 'x$cl if $cl > 0; $text .= substr($c, $sel[0], $sel[2] - $sel[0])."\n"; } chomp( $text); } return $text; } sub lock_change { my ( $self, $lock) = @_; $lock = $lock ? 1 : -1; $self-> {notifyChangeLock} += $lock; $self-> {notifyChangeLock} = 0 if $lock > 0 && $self-> {notifyChangeLock} < 0; $self-> notify(q(Change)) if $self-> {notifyChangeLock} == 0 && $lock < 0; } sub change_locked { my $self = $_[0]; return $self-> {notifyChangeLock} != 0; } sub insert_text { my ( $self, $s, $hilite) = @_; return if !defined($s) or length( $s) == 0; $self-> begin_undo_group; $self-> cancel_block unless $self-> {blockType} == bt::CUA; my @cs = $self-> cursor; my @ln = split( "\n", $s, -1); pop @ln unless length $ln[-1]; $s = $self-> get_line( $cs[1]); my $cl = $cs[0] - length( $s); $s .= ' 'x$cl if $cl > 0; $cl = 0 if $cl < 0; $self-> lock_change(1); if ( scalar @ln == 1) { substr( $s, $cs[0], 0) = $ln[0]; $self-> set_line( $cs[1], $s, q(add), $cs[0], $cl + length( $ln[0])); $self-> selection( $cs[0], $cs[1], $cs[0] + length( $ln[0]), $cs[1]) if $hilite && $self-> {blockType} == bt::CUA; } else { my $spl = substr( $s, $cs[0], length( $s) - $cs[0]); substr( $s, $cs[0], length( $s) - $cs[0]) = $ln[0]; $self-> lock; $self-> set_line( $cs[1], $s); shift @ln; $self-> insert_line( $cs[1] + 1, (@ln, $spl)); $self-> selection( $cs[0], $cs[1], length( $ln[-1]), $cs[1]+scalar(@ln)) if $hilite && $self-> {blockType} == bt::CUA; $self-> unlock; } $self-> lock_change(0); $self-> end_undo_group; } sub paste { my $self = $_[0]; return if $self-> {readOnly}; $self-> insert_text( $::application-> Clipboard-> text, 1); } sub make_logical { my ( $self, $x, $y) = @_; return (0,0) if $self-> {maxChunk} < 0; return $x, $y unless $self-> {wordWrap}; my $maxY = $self-> {maxLine}; $y = $maxY if $y > $maxY || $y < 0; $y = 0 if $y < 0; my $l = length( $self-> {lines}-> [$y]); $x = $l if $x < 0 || $x > $l; $x = 0 if $x < 0; my $cm = $self-> {chunkMap}; my $r; ( $l, $r) = ( 0, $self-> {maxChunk} + 1); my $i = int($r / 2); my $kk = 0; while (1) { my $acd = $$cm[$i * 3 + 2]; last if $acd == $y; $acd > $y ? $r : $l = $i; $i = int(( $l + $r) / 2); if ( $kk++ > 200) { print "bcs dump to $y\n"; ( $l, $r) = ( 0, $self-> {maxChunk} + 1); $i = int($r / 2); for ( $kk = 0; $kk < 7; $kk++) { my $acd = $$cm[$i * 3 + 2]; print "i:$i [$l $r] f() = $acd\n"; $acd > $y ? $r : $l = $i; $i = int(( $l + $r) / 2); } die; last; } } $y = $i; $i *= 3; $i-= 3, $y-- while $$cm[ $i] != 0; $i+= 3, $y++ while $x > $$cm[ $i] + $$cm[ $i + 1]; $x -= $$cm[ $i]; return $x, $y; } sub make_physical { my ( $self, $x, $y) = @_; return (0,0) if $self-> {maxLine} < 0; return $x, $y unless $self-> {wordWrap}; my $maxY = $self-> {maxChunk}; $y = $maxY if $y > $maxY || $y < 0; $y = 0 if $y < 0; my $cm = $self-> {chunkMap}; my ( $ofs, $l, $nY) = ( $$cm[ $y * 3], $$cm[ $y * 3 + 1], $$cm[ $y * 3 + 2]); $x = $l if $x < 0 || $x > $l; $x = 0 if $x < 0; return $x + $ofs, $nY; } sub start_block { my $self = $_[0]; return if exists $self-> {anchor}; my $blockType = $_[1] || $self-> {blockType}; $self-> selection(0,0,0,0); $self-> blockType( $blockType); $self-> {anchor} = [ $self-> {cursorX}, $self-> {cursorY}]; } sub update_block { my $self = $_[0]; return unless exists $self-> {anchor}; $self-> selection( @{$self-> {anchor}}, $self-> {cursorX}, $self-> {cursorY}); } sub end_block { my $self = $_[0]; return unless exists $self-> {anchor}; my @anchor = @{$self-> {anchor}}; delete $self-> {anchor}; $self-> selection( @anchor, $self-> {cursorX}, $self-> {cursorY}); } sub cancel_block { delete $_[0]-> {anchor}; $_[0]-> selection(0,0,0,0); } sub set_marking { my ( $self, $mark, $blockType) = @_; return if $mark == exists $self-> {anchor}; $mark ? $self-> start_block( $blockType || $self-> {blockType}) : $self-> end_block; } sub cursor_down { my $d = $_[1] || 1; $_[0]-> cursorLog( $_[0]-> {cursorXl}, $_[0]-> {cursorYl} + $d); } sub cursor_up { return if $_[0]-> {cursorYl} == 0; my $d = $_[1] || 1; my ( $x, $y) = $_[0]-> make_physical( $_[0]-> {cursorXl}, $_[0]-> {cursorYl} - $d); $y = 0 if $y < 0; $_[0]-> cursor( $x, $y); } sub cursor_left { my $d = $_[1] || 1; my $x = $_[0]-> cursorX; if ( $x - $d >= 0) { $_[0]-> cursorX( $x - $d) } elsif ( $_[0]-> {cursorWrap}) { if ( $d == 1) { my $y = $_[0]-> cursorY - 1; $_[0]-> cursor( -1, $y < 0 ? 0 : $y); } else { $_[0]-> cursor_left( $d - 1); } } else { $_[0]-> cursorX( 0); } } sub cursor_right { my $d = $_[1] || 1; my $x = $_[0]-> cursorX; if ( $_[0]-> {cursorWrap} || $_[0]-> {wordWrap}) { my $y = $_[0]-> cursorY; if ( $x + $d > length( $_[0]-> get_line( $y))) { if ( $d == 1) { $_[0]-> cursor( 0, $y + 1) if $y < $_[0]-> {maxLine}; } else { $_[0]-> cursor_right( $d - 1); } } else { $_[0]-> cursorX( $x + $d); } } else { $_[0]-> cursorX( $x + $d); } } sub cursor_home { my ($spaces) = ($_[0]-> get_line( $_[0]-> cursorY) =~ /^([s\t]*)/); $_[0]-> begin_undo_group; $_[0]-> offset(0); $_[0]-> cursorX(0); $_[0]-> end_undo_group; } sub cursor_end { my ($nonspaces) = ($_[0]-> get_line( $_[0]-> cursorY) =~ /^(.*?)[\s\t]*$/); $_[0]-> cursorX( length $nonspaces); } sub cursor_cend { $_[0]-> cursorY(-1); } sub cursor_chome { $_[0]-> cursorY( 0); } sub cursor_cpgdn { $_[0]-> cursor(-1,-1); } sub cursor_cpgup { $_[0]-> cursor( 0, 0); } sub cursor_pgup { my $d = $_[1] || 1; my $i; for ( $i = 0; $i < $d; $i++) { my $cy = $_[0]-> topLine - ( $_[0]-> {cursorYl} > $_[0]-> topLine ? 0 : $_[0]-> {rows} ); $_[0]-> cursorLog( $_[0]-> {cursorXl}, $cy < 0 ? 0 : $cy); } } sub cursor_pgdn { my $d = $_[1] || 1; my $i; for ( $i = 0; $i < $d; $i++) { my ( $tl, $r) = ($_[0]-> topLine , $_[0]-> {rows}); my $cy = $tl + $r - 1 + (( $_[0]-> {cursorYl} < $tl+$r-1) ? 0 : $r); $_[0]-> cursorLog( $_[0]-> {cursorXl}, $cy); } } sub word_right { my $self = $_[0]; my $d = $_[1] || 1; my $i; for ( $i = 0; $i < $d; $i++) { my ( $x, $y, $w, $delta, $maxY) = ( $self-> cursorX, $self-> cursorY, $self-> wordDelimiters, 0, $self-> {maxLine} ); my $line = $self-> get_line( $y); my $clen = length( $line); if ($self-> {cursorWrap}) { while ( $x >= $clen) { $y++; return if $y > $maxY; $x = 0; $line = $self-> get_line( $y); $clen = length( $line); } } my $cl = $x - $clen + 1; $line .= ' 'x$cl if $cl >= 0; unless ($w =~ quotemeta substr $line, $x, 1) { $delta++ while ( $w !~ quotemeta substr $line, $x + $delta, 1) && $x + $delta < $clen; } if ( $x + $delta < $clen) { $delta++ while ( $w =~ quotemeta substr $line, $x + $delta, 1) && $x + $delta < $clen; } $self-> cursor( $x + $delta, $y); } } sub word_left { my $self = $_[0]; my $d = $_[1] || 1; my $i; for ( $i= 0;$i<$d; $i++) { my ( $x, $y, $w, $delta) = ( $self-> cursorX, $self-> cursorY, $self-> wordDelimiters, 0); my $line = $self-> get_line( $y); my $clen = length( $line); if ($self-> {cursorWrap}) { while ( $x == 0) { $y--; $y = 0, last if $y < 0; $line = $self-> get_line( $y); $x = $clen = length( $line); } } my $cl = $x - $clen + 1; $line .= ' 'x$cl if $cl >= 0; if ( $w =~ quotemeta( substr( $line, $x - 1, 1))) { $delta-- while (( $w =~ quotemeta( substr( $line, $x + $delta - 1, 1))) && ( $x + $delta > 0)) } if ( $x + $delta > 0) { $delta-- while (!( $w =~ quotemeta( substr( $line, $x + $delta - 1, 1))) && ( $x + $delta > 0)) } $self-> cursor( $x + $delta, $y); } } sub cursor_shift_key { my ( $self, $menuItem) = @_; $self-> begin_undo_group; $self-> start_block unless exists $self-> {anchor}; $menuItem =~ s/Shift//; my $action = $self-> accelTable-> action( $menuItem); $action = $self-> can( $action, 0) unless ref $action; $self-> {delayPanning} = 1; $self-> blockShiftMark(1); $action-> ( @_); $self-> blockShiftMark(0); $self-> selection( @{$self-> {anchor}}, $self-> {cursorX}, $self-> {cursorY}); $self-> realize_panning; $self-> end_undo_group; } sub blockShiftMark { return $_[0]-> {blockShiftMark} unless $#_; my ( $self, $mark) = @_; return if $self-> {blockShiftMark} == $mark; $self-> push_group_undo_action( 'blockShiftMark', $self-> {blockShiftMark}); $self-> {blockShiftMark} = $mark; } sub mark_vertical { my $self = $_[0]; if ( exists $self-> {anchor}) { $self-> update_block; delete $self-> {restorePersistentBlock}, $self-> persistentBlock(0) if $self-> {restorePersistentBlock}; } else { $self-> blockType( bt::Vertical); $self-> {restorePersistentBlock} = 1 unless $self-> persistentBlock; $self-> persistentBlock( 1); $self-> cursor_shift_key(q(ShiftCursorRight)); } } sub mark_horizontal { my $self = $_[0]; if ( exists $self-> {anchor}) { $self-> update_block; delete $self-> {restorePersistentBlock}, $self-> persistentBlock(0) if $self-> {restorePersistentBlock}; } else { $self-> blockType( bt::Horizontal); $self-> {restorePersistentBlock} = 1 unless $self-> persistentBlock; $self-> persistentBlock( 1); $self-> start_block; $self-> selection( $self-> make_physical( 0, $self-> {cursorYl}), $self-> make_physical( -1, $self-> {cursorYl}) ); } } sub set_line { my ( $self, $y, $line, $operation, $from, $len) = @_; my $maxY = $self-> {maxLine}; $self-> insert_empty_line(0), $y = $maxY = $self-> {maxLine} if $maxY < 0; return if $y > $maxY || $y < 0; my ( $newDim, $oldDim, $ry) = (0,0,0); my ( $fh, $tl, $ofs, @a) = ( $self-> font-> height, $self-> {topLine }, $self-> {offset}, $self-> get_active_area, ); my @sz = ( $a[2] - $a[0], $a[3] - $a[1]); my ( $_from, $_to); $self-> begin_undo_group; $self-> push_undo_action( 'set_line', $y, $self-> {lines}-> [$y]); if ( $self-> {wordWrap}) { my $breaks = $self-> text_wrap( $line, $sz[0] - $self-> {defcw}, tw::WordBreak|tw::CalcTabs|tw::NewLineBreak|tw::ReturnChunks, $self-> {tabIndent} ); my @chunkMap; ( undef, $ry) = $self-> make_logical( 0, $y); my ($ix, $cm) = ( $ry * 3 + 2, $self-> {chunkMap}); my $max_ix = $self-> {maxChunk} * 3 + 2; $oldDim++, $ix += 3 while $ix <= $max_ix && $$cm[ $ix] == $y; $newDim = scalar @{$breaks} / 2; my $i; for ( $i = 0; $i < $newDim; $i++) { push( @chunkMap, $$breaks[$i * 2], $$breaks[$i * 2 + 1], $y); } splice( @{$cm}, $ry * 3, $oldDim * 3, @chunkMap); $self-> {lines}-> [$y] = $line; $self-> {maxChunk} -= $oldDim - $newDim; if ( $oldDim == $newDim) { ( $_from, $_to) = ( $ry, $ry + $oldDim); } else { $self-> vScroll( $self-> {maxChunk} >= $self-> {rows}) if $self-> {autoVScroll}; $self-> topLine(0) if $self-> {maxChunk} < $self-> {rows}; $self-> {vScrollBar}-> set( max => $self-> {maxChunk} - $self-> {rows} + 1, whole => $self-> {maxChunk} + 1, ) if $self-> {vScroll}; } } else { my ( $oldL, $newL) = ( length( $self-> {lines}-> [$y]), length( $line)); $self-> {lines}-> [$y] = $line; if ( $oldL == $self-> {maxLineLength} || $newL > $self-> {maxLineLength}) { my $needReset = 0; if ( $newL != $oldL) { if ( $oldL == $self-> {maxLineLength}) { $self-> {maxLineCount}--; $needReset = $self-> {maxLineCount} <= 0; } if ( $newL > $self-> {maxLineLength}) { $self-> {maxLineLength} = $newL; $self-> {maxLineCount} = 1; $self-> {maxLineWidth} = $newL * $self-> {averageWidth}; $needReset = 0; } $self-> reset if $needReset; } my $lw = $self-> {maxLineWidth}; if ( $self-> {autoHScroll}) { my $hs = ( $lw > $sz[0] ) ? 1 : 0; if ( $hs != $self-> {hScroll}) { $self-> hScroll( $hs); @a = $self-> get_active_area; @sz = ( $a[2] - $a[0], $a[3] - $a[1]); } } $self-> {hScrollBar}-> set( max => $lw - $sz[0], whole => $lw, partial => $sz[0], ) if $self-> {hScroll}; } $_from = $_to = $y; } $self-> {syntax}-> [$y] = undef; if ( defined $operation && $self-> has_selection) { if ( $operation ne q(overtype)) { $len *= -1 if $operation eq q(delete); my @sel = $self-> selection; if ( $self-> {blockType} == bt::CUA) { if ( $sel[3] == $sel[1] && $sel[1] == $y) { $sel[0] += $len if $from < $sel[0]; if ( $from < $sel[2]) { $sel[2] += $len; @sel=(0,0,0,0) if $sel[2] <= $from; } } elsif ( $sel[1] == $y && $from < $sel[0]) { $sel[0] += $len; } elsif ( $sel[3] == $y && $from < $sel[2]) { $sel[2] += $len; } $sel[0] = 0 if $sel[0] < 0; $sel[2] = 0 if $sel[2] < 0; } elsif ( $newDim != $oldDim) { my @selE = @{$self-> {selEndl}}; $selE[1] -= $oldDim - $newDim; ($sel[2], $sel[3]) = $self-> make_physical( @selE); @sel = (0,0,0,0) if $sel[3] < $sel[1]; } $self-> selection( @sel); delete $self-> {anchor}; $self-> cancel_block unless $self-> has_selection; } } else { $self-> cancel_block; } if ( defined $_to) { $self-> invalidate_rect( $a[0], $a[3] - $fh * ( $_to - $tl + 1), $a[2], $a[3] - $fh * ( $_from - $tl) ); } else { $self-> repaint; } $self-> cursor( $self-> cursor); $self-> end_undo_group; $self-> notify(q(Change)) unless $self-> {notifyChangeLock}; } sub insert_empty_line { my ( $self, $y, $len) = @_; my $maxY = $self-> {maxLine}; $len ||= 1; return if $y > $maxY + 1 || $y < 0 || $len == 0; my $ly; $self-> push_undo_action('delete_line', $y, $len); if ( $self-> {wordWrap}) { if ( $y > $maxY) { $ly = $self-> {maxChunk} + 1; } else { ( undef, $ly) = $self-> make_logical( 0, $y); } my ($i, $maxC, $cm) = ( 0, $self-> {maxChunk}, $self-> {chunkMap}); if ( $y <= $maxY) { splice( @{$cm}, $ly * 3, 0, ( 0, 0, $y) x $len); for ( $i = $ly + 1; $i < $ly + $len; $i++) { $$cm[ $i * 3 + 2] += $i - $ly; } for ( $i = $ly + $len; $i <= $maxC + $len; $i++) { $$cm[ $i * 3 + 2] += $len; } } else { push( @{$cm}, ( 0, 0, $y)x$len); for ( $i = $ly; $i < $ly + $len; $i++) { $$cm[ $i * 3 + 2] += $i - $ly; } } $self-> {maxChunk} += $len; } else { $self-> {maxChunk} += $len; $ly = $y; $self-> {maxLineCount} += $len if $self-> {maxLineLength} == 0; } for (@{$self-> {markers}}) { $$_[1] += $len if $$_[1] >= $y; } splice( @{$self-> {lines}}, $y, 0, ('') x $len); $self-> {maxLine} += $len; splice( @{$self-> {syntax}}, $y, 0, ([0,cl::Black]) x $len) if $self-> {syntaxHilite}; if ( $self-> has_selection) { my @sel = $self-> selection; unless ( $sel[3] < $y) { $sel[1] += $len if $sel[1] >= $y; $sel[3] += $len; } $self-> selection( @sel); delete $self-> {anchor}; } my ( $tl, $rc, $yt, $fh, @a) = ( $self-> {topLine }, $self-> {rows}, $self-> {yTail}, $self-> font-> height, $self-> get_active_area, ); if ( $y < $tl + $rc + $yt - 1 && $y + $len > $tl && $y <= $maxY && !$self-> has_selection ) { $self-> scroll( 0, -$fh * $len, confineRect => [ @a[0..2], $a[3] - $fh * ( $y - $tl)]); } $self-> vScroll( $self-> {maxChunk} >= $self-> {rows}) if $self-> {autoVScroll}; $self-> {vScrollBar}-> set( max => $self-> {maxChunk} - $self-> {rows} + 1, whole => $self-> {maxChunk} + 1, partial => $self-> {rows}, ) if $self-> {vScroll}; return $ly; } sub insert_line { my ( $self, $y, @lines) = @_; my $len = scalar @lines; my $maxY = $self-> {maxLine}; return if $y > $maxY + 1 || $y < 0 || $len == 0; my $i; $self-> begin_undo_group; $self-> insert_empty_line( $y, $len); $self-> lock_change(1); for ( $i = 0; $i < $len; $i++) { $self-> set_line( $y + $i, $lines[ $i], q(add), 0, length( $lines[ $i])); } $self-> lock_change(0); $self-> end_undo_group; } sub delete_line { my ( $self,$y,$len) = @_; my $maxY = $self-> {maxLine}; $len ||= 1; return if $y > $maxY || $y < 0 || $len == 0; $self-> begin_undo_group; for ( my $i=0; $i < $len; $i++) { $self-> push_undo_action( 'set_line', $y+$i, $self-> {lines}-> [$y+$i]); } $self-> push_undo_action( 'insert_empty_line', $y, $len); $len = $maxY - $y + 1 if $y + $len > $maxY + 1; my ( $lx, $ly) = (0,0); if ( $self-> {wordWrap}) { ( $lx, $ly) = $self-> make_logical( 0, $y); $lx = 0; my ($i, $maxC, $cm) = ($ly, $self-> {maxChunk}, $self-> {chunkMap}); $lx++, $i++ while ( $i <= $maxC) and ( $$cm[ $i * 3 + 2] <= ( $y + $len - 1)); splice( @{$cm}, $ly * 3, $lx * 3); $self-> {maxChunk} -= $lx; for ( $i = $ly; $i <= $maxC - $lx; $i++) { $$cm[ $i * 3 + 2] -= $len; } } else { $self-> {maxChunk} -= $len; } my @removed = splice( @{$self-> {lines}}, $y, $len); splice( @{$self-> {syntax}}, $y, $len) if $self-> {syntaxHilite}; for (@{$self-> {markers}}) { $$_[1] -= $len if $$_[1] >= $y; $$_[1] = 0 if $$_[1] < 0; } $self-> {maxLine} -= $len; if ( $self-> has_selection) { my @sel = (@{$self-> {selStartl}}, @{$self-> {selEndl}}); if ( $sel[3] >= $ly) { if ( $sel[1] >= $ly) { $sel[1] -= $lx; $sel[0] = 0, $sel[1] = $ly if $sel[1] < $ly; } $sel[3] -= $lx; $sel[2] = 0, $sel[3] = $ly if $sel[3] < $ly; } $self-> selection( $self-> make_physical($sel[0], $sel[1]), $self-> make_physical($sel[2], $sel[3]) ); delete $self-> {anchor}; $self-> cancel_block unless $self-> has_selection; } $self-> vScroll( $self-> {maxChunk} >= $self-> {rows}) if $self-> {autoVScroll}; $self-> topLine(0) if $self-> {maxChunk} < $self-> {rows}; $self-> {vScrollBar}-> set( max => $self-> {maxChunk} - $self-> {rows} + 1, whole => $self-> {maxChunk} + 1, ) if $self-> {vScroll}; unless ( $self-> {wordWrap}) { my $mlv = $self-> {maxLineLength}; for ( @removed) { $self-> {maxLineCount}-- if length($_) == $mlv; if ( $self-> {maxLineCount} <= 0) { $self-> reset; my $lw = $self-> {maxLineWidth}; my $w = $self-> width - $self-> {indents}-> [0] - $self-> {indents}-> [2]; if ( $self-> {autoHScroll}) { my $hs = ( $lw > $w) ? 1 : 0; if ( $hs != $self-> {hScroll}) { $self-> hScroll( $hs); $w = $self-> width - $self-> {indents}-> [0] - $self-> {indents}-> [2]; } } $self-> {hScrollBar}-> set( max => $lw - $w, whole => $lw, partial => $w, ) if $self-> {hScroll}; last; } } } $self-> cursor( $self-> cursor); $self-> end_undo_group; $self-> repaint; $self-> notify(q(Change)) unless $self-> {notifyChangeLock}; } sub delete_chunk { my ( $self, $y, $len) = @_; my $maxY = $self-> {maxChunk}; $len ||= 1; return if $y > $maxY || $y < 0 || $len == 0; $self-> delete_line( $y, $len), return unless $self-> {wordWrap}; $len = $maxY - $y + 1 if $y + $len > $maxY + 1; return if $len == 0; my $cm = $self-> {chunkMap}; my $psy = $$cm[ $y * 3 + 2]; my $pey = $$cm[($y + $len - 1) * 3 + 2]; my $start = $$cm[ $y * 3]; my $end = $$cm[($y + $len - 1) * 3] + $$cm[($y + $len - 1) * 3 + 1]; if ( $psy == $pey) { my $c = $self-> {lines}-> [$psy]; $self-> delete_line( $psy), return if $start == 0 && $end == length( $c); substr( $c, $start, $end - $start) = ''; $self-> set_line( $psy, $c, q(delete), $start, $end - $start); return; } $self-> lock; my ( $sy, $ey) = ( $psy, $pey); my $c; $self-> begin_undo_group; $self-> lock_change(1); if ( $start > 0) { $c = $self-> {lines}-> [$psy]; my $cs = length( $c) - $start + 1; substr( $c, $start, $cs) = ''; $self-> set_line( $psy, $c, q(delete), $start, $cs); $sy++; } $c = $self-> {lines}-> [$pey]; if ( $end < length( $c)) { substr( $c, 0, $end) = ''; $self-> set_line( $pey, $c, q(delete), 0, $end); $ey--; } $self-> delete_line( $sy, $ey - $sy + 1) if $ey >= $sy; $self-> cursor( $self-> {cursorX}, $psy); $self-> unlock; $self-> lock_change(0); $self-> end_undo_group; } sub delete_text { my ( $self, $x, $y, $len) = @_; my $maxY = $self-> {maxLine}; $y = $maxY if $y < 0; return if $y > $maxY || $y < 0; my $c = $self-> {lines}-> [ $y]; my $l = length( $c); $x = $l if $x < 0; return if $x < 0; if ( $x == $l) { return if $y == $maxY; $self-> lock_change(1); $self-> begin_undo_group; $self-> set_line( $y, $self-> get_line( $y) . $self-> get_line( $y + 1)); $self-> delete_line( $y + 1); $self-> end_undo_group; $self-> lock_change(0); return; } $len = $l - $x if $len + $x >= $l; return if $len <= 0; substr( $c, $x, $len) = ''; $self-> set_line( $y, $c, q(delete), $x, $len); } sub delete_char { my $self = $_[0]; $self-> delete_text( $self-> cursor, $_[1] || 1); } sub back_char { my $self = $_[0]; my @c = $self-> cursor; my $d = $_[1] || 1; $self-> begin_undo_group; if ( $c[0] >= $d) { $self-> delete_text( $c[0] - $d, $c[1], $d); $self-> cursorX( $c[0] - $d); } elsif ( $c[1] > 0) { $self-> cursor( -1, $c[1] - 1); $self-> delete_text( -1, $c[1] - 1); } $self-> end_undo_group; } sub delete_current_chunk { my $self = $_[0]; $self-> delete_chunk( $self-> {cursorYl}); } sub delete_to_end { my $self = $_[0]; my @cs = $self-> cursor; my $c = $self-> get_line( $cs[1]); return if $cs[ 0] > length( $c); $self-> set_line( $cs[1], substr( $c, 0, $cs[0]), q(delete), $cs[0], length( $c) - $cs[0]); } sub delete_block { my $self = $_[0]; return unless $self-> has_selection; $self-> begin_undo_group; $self-> push_undo_action('selection', $self-> selection); my @sel = ( @{$self-> {selStartl}}, @{$self-> {selEndl}}); my $bt = $self-> {blockType}; if ( $bt == bt::Horizontal) { $self-> delete_chunk( $sel[1], $sel[3] - $sel[1] + 1); } elsif ( $bt == bt::CUA) { my $c; my @sel = ( @{$self-> {selStart}}, @{$self-> {selEnd}}); if ( $sel[1] == $sel[3]) { $c = $self-> get_line( $sel[1]); substr( $c, $sel[0], $sel[2] - $sel[0]) = ''; $self-> set_line( $sel[1], $c); } else { my ( $from, $len) = ( $sel[1], $sel[3] - $sel[1]); my $res = substr( $self-> get_line( $from), 0, $sel[0]); $c = $self-> get_line( $sel[3]); if ( $sel[2] < length( $c)) { $res .= substr( $c, $sel[2], length( $c) - $sel[2]); } elsif ( $sel[3] < $self-> {maxLine}) { $res .= $self-> get_line( $sel[3] + 1); } $self-> lock_change(1); $self-> delete_line( $from + 1, $len) if $len > 0; $self-> set_line( $from, $res); $self-> lock_change(0); } } else { my @sel = ( @{$self-> {selStart}}, @{$self-> {selEnd}}); my $len = $sel[2] - $sel[0]; my $i; $self-> lock_change(1); $self-> lock; for ( $i = $sel[1]; $i <= $sel[3]; $i++) { my $c = $self-> get_line( $i); if ( $c ne '') { substr( $c, $sel[0], $len) = ''; $self-> set_line( $i, $c); } } $self-> unlock; $self-> lock_change(0); } $self-> cursorLog( $sel[0], $sel[1]); $self-> cancel_block; $self-> end_undo_group; } sub copy_block { my $self = $_[0]; return if $self-> {readOnly} || $self-> {blockType} == bt::CUA || $self-> {wordWrap} || !$self-> has_selection; my @sel = $self-> selection; $self-> lock_change(0); $self-> lock; $self-> begin_undo_group; if ( $self-> {blockType} == bt::Horizontal) { my @lines; my $i; for ( $i = $sel[1]; $i <= $sel[3]; $i++) { push @lines, $self-> get_line( $i); } $self-> insert_line( $self-> cursorY, @lines); } else { my @lines; my $i; for ( $i = $sel[1]; $i <= $sel[3]; $i++) { my $c = $self-> get_line( $i); $c .= ' ' x ($sel[2]-length($c)) if length($c) < $sel[2]; push( @lines, substr( $c, $sel[0], $sel[2]-$sel[0])); } my @cs = $self-> cursor; for ( $i = $cs[1]; $i < $cs[1] + scalar @lines; $i++) { my $c = $self-> get_line( $i); $c .= ' 'x($cs[0]-length($c)) if length($c) < $cs[0]; substr( $c, $cs[0], 0) = $lines[ $i - $cs[1]]; $self-> set_line( $i, $c); } } $self-> end_undo_group; $self-> unlock; $self-> lock_change(1); } sub overtype_block { my $self = $_[0]; return if $self-> {readOnly} || $self-> {blockType} == bt::CUA || $self-> {wordWrap} || !$self-> has_selection; my @sel = $self-> selection; $self-> lock_change(0); $self-> lock; $self-> begin_undo_group; if ( $self-> {blockType} == bt::Horizontal) { my $i; for ( $i = $sel[1]; $i <= $sel[3]; $i++) { $self-> set_line( $i, $self-> get_line( $i)); } } else { my @lines; my $i; for ( $i = $sel[1]; $i <= $sel[3]; $i++) { my $c = $self-> get_line( $i); $c .= ' ' x ($sel[2]-length($c)) if length($c) < $sel[2]; push( @lines, substr( $c, $sel[0], $sel[2]-$sel[0])); } my @cs = $self-> cursor; my $bx = $sel[3] - $sel[1] + 1; for ( $i = $cs[1]; $i < $cs[1] + scalar @lines; $i++) { my $c = $self-> get_line( $i); $c .= ' ' x ($cs[0]-length($c)) if length($c) < $cs[0]; substr( $c, $cs[0], $bx) = $lines[ $i - $cs[1]]; $self-> set_line( $i, $c); } } $self-> end_undo_group; $self-> unlock; $self-> lock_change(1); } sub split_line { my $self = $_[0]; my @cs = $self-> cursor; my $c = $self-> get_line( $cs[1]); $c .= ' 'x($cs[0]-length($c)) if length($c) < $cs[0]; my ( $old, $new) = ( substr( $c, 0, $cs[0]), substr( $c, $cs[0], length( $c) - $cs[0])); $self-> lock_change(1); $self-> begin_undo_group; $self-> set_line( $cs[1], $old, q(delete), $cs[0], length( $c) - $cs[0]); my $cshift = 0; if ( $self-> {autoIndent}) { my $i = 0; my $add = ''; for ( $i = 0; $i < length( $old); $i++) { my $c = substr( $old, $i, 1); last if $c ne ' ' and $c ne '\t'; $add .= $c; } $new = $add.$new, $cshift = length( $add) if length( $add) < length( $old); } $self-> insert_line( $cs[1]+1, $new); $self-> cursor( $cshift, $cs[1] + 1); $self-> end_undo_group; $self-> lock_change(0); } sub begin_undo_group { my $self = $_[0]; return if !$self-> {undoLimit}; if ( $self-> {undo_in_action}) { push @{$self-> {redo}}, [] unless $self-> {grouped_undo}++; } else { push @{$self-> {undo}}, [] unless $self-> {grouped_undo}++; $self-> {redo} = [] if !$self-> {redo_in_action}; } } sub end_undo_group { my $self = $_[0]; return if !$self-> {undoLimit}; my $ref = $self-> {undo_in_action} ? 'redo' : 'undo'; $self-> {grouped_undo}-- if $self-> {grouped_undo} > 0; # skip last record if empty pop @{$self-> {$ref}} if !$self-> {grouped_undo} && @{$self-> {$ref}} && 0 == @{$self-> {$ref}-> [-1]}; shift @{$self-> {$ref}} if @{$self-> {$ref}} > $self-> {undoLimit}; } sub push_undo_action { my $self = shift; return if !$self-> {undoLimit}; my $ref = $self-> {undo_in_action} ? 'redo' : 'undo'; my $action = [ @_ ]; if ( $self-> {grouped_undo}) { push @{$self-> {$ref}-> [-1]}, $action; } else { push @{$self-> {$ref}}, [ $action ]; shift @{$self-> {$ref}} if @{$self-> {$ref}} > $self-> {undoLimit}; $self-> {redo} = [] if !$self-> {redo_in_action} && !$self-> {undo_in_action}; } } sub push_group_undo_action { my $self = shift; return if !$self-> {undoLimit}; my $ref = $self-> {undo_in_action} ? 'redo' : 'undo'; return $self-> push_undo_action(@_) if $self-> {grouped_undo}; push @{$self-> {$ref}}, [] unless @{$self-> {$ref}}; $self-> {grouped_undo} = 1; $self-> push_undo_action(@_); $self-> {grouped_undo} = 0; } sub undo { my $self = $_[0]; return if $self-> {undo_in_action} || !$self-> {undoLimit}; return unless @{$self-> {undo}}; my $group = pop @{$self-> {undo}}; return unless $group && @$group; $self-> {undo_in_action} = 1; $self-> begin_undo_group; for ( reverse @$group) { my ( $method, @params) = @$_; next unless $self-> can($method); $self-> $method( @params); } $self-> end_undo_group; $self-> {undo_in_action} = 0; } sub redo { my $self = $_[0]; return if !$self-> {undoLimit}; return unless @{$self-> {redo}}; my $group = pop @{$self-> {redo}}; return unless $group && @$group; $self-> {redo_in_action} = 1; $self-> begin_undo_group; for ( reverse @$group) { my ( $method, @params) = @$_; next unless $self-> can($method); $self-> $method( @params); } $self-> end_undo_group; $self-> {redo_in_action} = 0; } sub undoLimit { return $_[0]-> {undoLimit} unless $#_; my ( $self, $ul) = @_; $self-> {undoLimit} = $ul if $ul >= 0; splice @{$self-> {undo}}, 0, $ul - @{$self-> {undo}} if @{$self-> {undo}} > $ul; } sub find { my ( $self, $line, $x, $y, $replaceLine, $options) = @_; $x ||= 0; $y ||= 0; my $maxY = $self-> {maxLine}; return if $y > $maxY || $maxY < 0; $line = '('.quotemeta( $line).')' unless $options & fdo::RegularExpression; $replaceLine = quotemeta( $replaceLine), $replaceLine =~ s[\\(\$\d+)][$1]g if !($options & fdo::RegularExpression) && defined $replaceLine; $y = $maxY if $y < 0; my $c = $self-> get_line( $y); my ( $l, $b, $len, $subLine, $re, $re2, $esub); $x = length( $c) if $x < 0; $re = '/'; $re .= '\\b' if $options & fdo::WordsOnly; $re .= "$line"; $re .= '\\b' if $options & fdo::WordsOnly; $re .= '/'; $re2 = ''; $re2.= 'i' unless $options & fdo::MatchCase; unless ( $options & fdo::BackwardSearch) { $l = 0; $subLine = substr( $c, 0, $x); substr( $c, 0, $x) = ''; $esub = eval(< \$maxY; \$_ = \$self-> get_line( \$y); \$subLine = ''; \$l = \$x = 0; } } FINDER } else { $re2 .= 'g'; $l = $b = undef; $subLine = substr( $c, $x, length( $c) - $x); substr( $c, $x, length( $c) - $x) = ''; $esub = eval(< get_line( \$y); \$subLine = ''; } FINDER } return $esub-> (); } sub add_marker { my ( $self, $x, $y) = @_; push( @{$self-> {markers}}, [$x, $y]); } sub delete_marker { my ( $self, $index) = @_; return if $index > scalar @{$self-> {markers}}; splice( @{$self-> {markers}}, $index, 1); } sub select_all { $_[0]-> selection(0,0,-1,-1); } sub autoIndent {($#_)?($_[0]-> {autoIndent} = $_[1]) :return $_[0]-> {autoIndent } } sub blockType {($#_)?($_[0]-> set_block_type ( $_[1])) :return $_[0]-> {blockType} } sub cursor {($#_)?($_[0]-> set_cursor ($_[1],$_[2])) :return $_[0]-> {cursorX},$_[0]-> {cursorY}} sub cursorLog {($#_)?($_[0]-> set_cursor ($_[0]-> make_physical($_[1],$_[2]))) :return $_[0]-> {cursorXl},$_[0]-> {cursorYl}} sub cursorX {($#_)?($_[0]-> set_cursor ($_[1],$_[0]-> {cursorY})):return $_[0]-> {cursorX} } sub cursorY {($#_)?($_[0]-> set_cursor ($_[0]-> {q(cursorX)},$_[1])):return $_[0]-> {cursorY} } sub cursorWrap {($#_)?($_[0]-> {cursorWrap }=$_[1]) :return $_[0]-> {cursorWrap }} sub topLine {($#_)?($_[0]-> set_top_line ( $_[1])) :return $_[0]-> {topLine } } sub hiliteNumbers {($#_)?$_[0]-> set_hilite_numbers ($_[1]) :return $_[0]-> {hiliteNumbers} } sub hiliteQStrings {($#_)?$_[0]-> set_hilite_q_strings($_[1]) :return $_[0]-> {hiliteQStrings} } sub hiliteQQStrings {($#_)?$_[0]-> set_hilite_qq_strings($_[1]) :return $_[0]-> {hiliteQQStrings} } sub hiliteChars {($#_)?$_[0]-> set_hilite_chars ($_[1]) :return $_[0]-> {hiliteChars } } sub hiliteIDs {($#_)?$_[0]-> set_hilite_ids ($_[1]) :return $_[0]-> {hiliteIDs } } sub hiliteREs {($#_)?$_[0]-> set_hilite_res ($_[1]) :return $_[0]-> {hiliteREs } } sub insertMode {($#_)?($_[0]-> set_insert_mode ( $_[1])) :return $_[0]-> {insertMode} } sub mark {($#_)?(shift-> set_marking ( @_ )) :return exists $_[0]-> {anchor} } sub markers {($#_)?($_[0]-> {markers} = [@{$_[1]}]) :return $_[0]-> {markers } } sub modified {($#_)?($_[0]-> {modified } = $_[1]) :return $_[0]-> {modified } } sub offset {($#_)?($_[0]-> set_offset ( $_[1])) :return $_[0]-> {offset } } sub persistentBlock {($#_)?($_[0]-> {persistentBlock}=$_[1]) :return $_[0]-> {persistentBlock}} sub readOnly {($#_)?($_[0]-> {readOnly } = $_[1]) :return $_[0]-> {readOnly } } sub selection {($#_)? shift-> set_selection (@_) : return (@{$_[0]-> {selStart}},@{$_[0]-> {selEnd}})} sub selStart {($#_)? $_[0]-> set_selection ($_[1],$_[2],@{$_[0]-> {selEnd}}): return @{$_[0]-> {'selStart'}}} sub selEnd {($#_)? $_[0]-> set_selection (@{$_[0]-> {'selStart'}},$_[1],$_[2]):return @{$_[0]-> {'selEnd'}}} sub syntaxHilite {($#_)? $_[0]-> set_syntax_hilite($_[1]) :return $_[0]-> {syntaxHilite}} sub tabIndent {($#_)?$_[0]-> set_tab_indent( $_[1]) :return $_[0]-> {tabIndent} } sub textRef {($#_)?$_[0]-> set_text_ref ( $_[1]) :return $_[0]-> get_text_ref; } sub wantTabs {($#_)?($_[0]-> {wantTabs} = $_[1]) :return $_[0]-> {wantTabs} } sub wantReturns {($#_)?($_[0]-> {wantReturns} = $_[1]) :return $_[0]-> {wantReturns} } sub wordDelimiters {($#_)?($_[0]-> {wordDelimiters}= $_[1]) :return $_[0]-> {wordDelimiters}} sub wordWrap {($#_)?($_[0]-> set_word_wrap( $_[1])) :return $_[0]-> {wordWrap } } 1; __DATA__ =pod =head1 NAME Prima::Edit - standard text editing widget =head1 SYNOPSIS use Prima::Edit; my $e = Prima::Edit-> create( text => 'Hello $world', syntaxHilite => 1, ); $e-> selection( 1, 1, 1, 2); =head1 DESCRIPTION The class provides text editing capabilities, three types of selection, text wrapping, syntax highlighting, auto indenting, undo and redo function, search and replace methods. The module declares C package, that contains integer constants for selection block type, used by L property. =head1 USAGE The class addresses the text space by (X,Y)-coordinates, where X is character offset and Y is line number. The addressing can be 'physical' and 'logical', - in logical case Y is number of line of text. The difference can be observed if L property is set to 1, when a single text string can be shown as several sub-strings, called I. The text is stored line-wise in C<{lines}> array; to access it use L method. To access the text chunk-wise, use L method. All keyboard events, except the character input and tab key handling, are processed by the accelerator table ( see L ). The default C table defines names, keyboard combinations, and the corresponding actions to the class functions. The class does not provide functionality to change these mappings. To do so, consult L. =head1 API =head2 Events =over =item ParseSyntax TEXT, RESULT_ARRAY_REF Called when syntax highlighting is requires - TEXT is a string to be parsed, and the parsing results to be stored in RESULT_ARRAY_REF, which is a reference to an array of integer pairs, each representing a single-colored text chunk. The first integer in the pairs is the length of a chunk, the second - color value ( C constants ). =back =head2 Properties =over =item autoIndent BOOLEAN Selects if the auto indenting feature is on. Default value: 1 =item blockType INTEGER Defines type of selection block. Can be one of the following constants: =over =item bt::CUA Normal block, where the first and the last line of the selection can be partial, and the lines between occupy the whole line. CUA stands for 'common user access'. Default keys: Shift + arrow keys See also: L =item bt::Vertical Rectangular block, where all selected lines are of same offsets and lengths. Default key: Alt+B See also: L =item bt::Horizontal Rectangular block, where the selection occupies the whole line. Default key: Alt+L See also: L =back =item cursor X, Y Selects physical position of the cursor =item cursorX X Selects physical horizontal position of the cursor =item cursorY Y Selects physical vertical position of the cursor =item cursorWrap BOOLEAN Selects cursor behavior when moved horizontally outside the line. If 0, the cursor is not moved. If 1, the cursor moved to the adjacent line. See also: L, L, L, L. =item insertMode BOOLEAN Governs the typing mode - if 1, the typed text is inserted, if 0, the text overwrites the old text. When C is 0, the cursor shape is thick and covers the whole character; when 1, it is of default width. Default toggle key: Insert =item hiliteNumbers COLOR Selects the color for number highlighting =item hiliteQStrings COLOR Selects the color for highlighting the single-quoted strings =item hiliteQQStrings COLOR Selects the color for highlighting the double-quoted strings =item hiliteIDs ARRAY Array of scalar pairs, that define words to be highlighted. The first item in the pair is an array of words; the second item is a color value. =item hiliteChars ARRAY Array of scalar pairs, that define characters to be highlighted. The first item in the pair is a string of characters; the second item is a color value. =item hiliteREs ARRAY Array of scalar pairs, that define character patterns to be highlighted. The first item in the pair is a perl regular expression; the second item is a color value. =item mark MARK [ BLOCK_TYPE ] Selects block marking state. If MARK is 1, starts the block marking, if 0 - stops the block marking. When MARK is 1, BLOCK_TYPE can be used to set the selection type ( C constants ). If BLOCK_TYPE is unset the value of L is used. =item markers ARRAY Array of arrays with integer pairs, X and Y, where each represents a physical coordinates in text. Used as anchor storage for fast navigation. See also: L, L =item modified BOOLEAN A boolean flag that shows if the text was modified. Can be used externally, to check if the text is to be saved to a file, for example. =item offset INTEGER Horizontal offset of text lines in pixels. =item persistentBlock BOOLEAN Selects whether the selection is cancelled as soon as the cursor is moved ( 0 ) or it persists until the selection is explicitly changed ( 1 ). Default value: 0 =item readOnly BOOLEAN If 1, no user input is accepted. =item selection X1, Y1, X2, Y2 Accepts two pair of coordinates, ( X1,Y1) the beginning and ( X2,Y2) the end of new selection, and sets the block according to L property. The selection is null if X1 equals to X2 and Y1 equals to Y2. L method returns 1 if the selection is non-null. =item selStart X, Y Manages the selection start. See L, X1 and Y1. =item selEnd X, Y Manages the selection end. See L, X2 and Y2. =item syntaxHilite BOOLEAN Governs the syntax highlighting. Is not implemented for word wrapping mode. =item tabIndent INTEGER Maps tab ( \t ) key to C amount of space characters. =item text TEXT Provides access to all the text data. The lines are separated by the new line ( \n ) character. See also: L. =item textRef TEXT_PTR Provides access to all the text data. The lines are separated by the new line ( \n ) character. TEXT_PTR is a pointer to text string. The property is more efficient than L with the large text, because the copying of the text scalar to the stack stage is eliminated. See also: L. =item topLine INTEGER Selects the first line of the text drawn. =item undoLimit INTEGER Sets limit on number of stored atomic undo operations. If 0, undo is disabled. Default value: 1000 =item wantTabs BOOLEAN Selects the way the tab ( \t ) character is recognized in the user input. If 1, it is recognized by the Tab key; however, this disallows the toolkit widget tab-driven navigation. If 0, the tab character can be entered by pressing Ctrl+Tab key combination. Default value: 0 =item wantReturns BOOLEAN Selects the way the new line ( \n ) character is recognized in the user input. If 1, it is recognized by the Enter key; however, this disallows the toolkit default button activation. If 0, the new line character can be entered by pressing Ctrl+Enter key combination. Default value: 1 =item wordDelimiters STRING Contains string of character that are used for locating a word break. Default STRING value consists of punctuation marks, space and tab characters, and C<\xff> character. See also: L, L =item wordWrap BOOLEAN Selects whether the long lines are wrapped, or can be positioned outside the horizontal widget inferior borders. If 1, L is not used. A line of text can be represented by more than one line of screen text ( chunk ) . To access the text chunk-wise, use L method. =back =head2 Methods =over =item add_marker X, Y Adds physical coordinated X,Y to L property. =item back_char [ REPEAT = 1 ] Removes REPEAT times a character left to the cursor. If the cursor is on 0 x-position, removes the new-line character and concatenates the lines. Default key: Backspace =item begin_undo_group Opens bracket for group of actions, undone as single operation. The bracket is closed by calling C. =item cancel_block Removes the selection block Default key: Alt+U =item change_locked Returns 1 if the logical locking is on, 0 if it is off. See also L. =item copy Copies the selected text, if any, to the clipboard. Default key: Ctrl+Insert =item copy_block Copies the selected text and inserts it into the cursor position, according to the L value. Default key: Alt+C =item cursor_cend Moves cursor to the bottom line Default key: Ctrl+End =item cursor_chome Moves cursor to the top line Default key: Ctrl+Home =item cursor_cpgdn Default key: Ctrl+PageDown Moves cursor to the end of text. =item cursor_cpgup Moves cursor to the beginning of text. Default key: Ctrl+PageUp =item cursor_down [ REPEAT = 1 ] Moves cursor REPEAT times down Default key: Down =item cursor_end Moves cursor to the end of the line Default key: End =item cursor_home Moves cursor to the beginning of the line Default key: Home =item cursor_left [ REPEAT = 1 ] Moves cursor REPEAT times left Default key: Left =item cursor_right [ REPEAT = 1 ] Moves cursor REPEAT times right Default key: Right =item cursor_up [ REPEAT = 1 ] Moves cursor REPEAT times up Default key: Up =item cursor_pgdn [ REPEAT = 1 ] Moves cursor REPEAT pages down Default key: PageDown =item cursor_pgup [ REPEAT = 1 ] Moves cursor REPEAT pages up Default key: PageUp =item cursor_shift_key [ ACCEL_TABLE_ITEM ] Performs action of the cursor movement, bound to ACCEL_TABLE_ITEM action ( defined in C or C property ), and extends the selection block along the cursor movement. Not called directly. =item cut Cuts the selected text into the clipboard. Default key: Shift+Delete =item delete_block Removes the selected text. Default key: Alt+D =item delete_char [ REPEAT = 1 ] Delete REPEAT characters from the cursor position Default key: Delete =item delete_line LINE_ID, [ LINES = 1 ] Removes LINES of text at LINE_ID. =item delete_current_chunk Removes the chunk ( or line, if L is 0 ) at the cursor. Default key: Ctrl+Y =item delete_chunk CHUNK_ID, [ CHUNKS = 1 ] Removes CHUNKS ( or lines, if L is 0 ) of text at CHUNK_ID =item delete_marker INDEX Removes marker INDEX in L list. =item delete_to_end Removes text to the end of the chunk. Default key: Ctrl+E =item delete_text X, Y, TEXT_LENGTH Removes TEXT_LENGTH characters at X,Y physical coordinates =item draw_colorchunk CANVAS, TEXT, LINE_ID, X, Y, COLOR Paints the syntax-highlighted chunk of TEXT, taken from LINE_ID line index, at X, Y. COLOR is used if the syntax highlighting information contains C as color reference. =item end_block Stops the block selection session. =item end_undo_group Closes bracket for group of actions, opened by C. =item find SEARCH_STRING, [ X = 0, Y = 0, REPLACE_LINE = '', OPTIONS ] Tries to find ( and, if REPLACE_LINE is defined, to replace with it ) SEARCH_STRING from (X,Y) physical coordinates. OPTIONS is an integer that consists of the C constants; the same constants are used in L, which provides graphic interface to the find and replace facilities of L. =over =item fdo::MatchCase If set, the search is case-sensitive. =item fdo::WordsOnly If set, SEARCH_STRING must constitute the whole word. =item fdo::RegularExpression If set, SEARCH_STRING is a regular expression. =item fdo::BackwardSearch If set, the search direction is backwards. =item fdo::ReplacePrompt Not used in the class, however, used in L. =back =item get_chunk CHUNK_ID Returns chunk of text, located at CHUNK_ID. Returns empty string if chunk is nonexistent. =item get_chunk_end CHUNK_ID Returns the index of chunk at CHUNK_ID, corresponding to the last chunk of same line. =item get_chunk_org CHUNK_ID Returns the index of chunk at CHUNK_ID, corresponding to the first chunk of same line. =item get_chunk_width TEXT, FROM, LENGTH, [ RETURN_TEXT_PTR ] Returns the width in pixels of C. If FROM is larger than length of TEXT, TEXT is padded with space characters. Tab character in TEXT replaced to L times space character. If RETURN_TEXT_PTR pointer is specified, the converted TEXT is stored there. =item get_line INDEX Returns line of text, located at INDEX. Returns empty string if line is nonexistent. =item get_line_dimension INDEX Returns two integers, representing the line at INDEX in L mode: the first value is the corresponding chunk index, the second is how many chunks represent the line. See also: L. =item get_line_ext CHUNK_ID Returns the line, corresponding to the chunk index. =item has_selection Returns boolean value, indicating if the selection block is active. =item insert_empty_line LINE_ID, [ REPEAT = 1 ] Inserts REPEAT empty lines at LINE_ID. =item insert_line LINE_ID, @TEXT Inserts @TEXT strings at LINE_ID =item insert_text TEXT, [ HIGHLIGHT = 0 ] Inserts TEXT at the cursor position. If HIGHLIGHT is set to 1, the selection block is cancelled and the newly inserted text is selected. =item lock_change BOOLEAN Increments ( 1 ) or decrements ( 0 ) lock count. Used to defer change notification in multi-change calls. When internal lock count hits zero, C notification is called. =item make_logical X, Y Maps logical X,Y coordinates to the physical and returns the integer pair. Returns same values when L is 0. =item make_physical X, Y Maps physical X,Y coordinates to the logical and returns the integer pair. Returns same values when L is 0. =item mark_horizontal Starts block marking session with C block type. Default key: Alt+L =item mark_vertical Starts block marking session with C block type. Default key: Alt+B =item overtype_block Copies the selected text and overwrites the text next to the cursor position, according to the L value. Default key: Alt+O =item paste Copies text from the clipboard and inserts it in the cursor position. Default key: Shift+Insert =item realize_panning Performs deferred widget panning, activated by setting C<{delayPanning}> to 1. The deferred operations are those performed by L and L. =item redo Re-applies changes, formerly rolled back by C. =item set_line LINE_ID, TEXT, [ OPERATION, FROM, LENGTH ] Changes line at LINE_ID to new TEXT. Hint scalars OPERATION, FROM and LENGTH used to maintain selection and marking data. OPERATION is an arbitrary string, the ones that are recognized are C<'overtype'>, C<'add'>, and C<'delete'>. FROM and LENGTH define the range of the change; FROM is a character offset and LENGTH is a length of changed text. =item split_line Splits a line in two at the cursor position. Default key: Enter ( or Ctrl+Enter if L is 0 ) =item select_all Selects all text =item start_block [ BLOCK_TYPE ] Begins the block selection session. The block type if BLOCK_TYPE, if it is specified, or L property value otherwise. =item undo Rolls back changes into internal array, which size cannot extend C value. In case C is 0, no undo actions can be made. =item update_block Adjusts the selection inside the block session, extending of shrinking it to the current cursor position. =item word_left [ REPEAT = 1 ] Moves cursor REPEAT words to the left. =item word_right [ REPEAT = 1 ] Moves cursor REPEAT words to the right. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, L, F =cut Prima-1.28/Prima/Grids.pm0000644000175100017510000024244511150770061012763 0ustar dkdk## # Copyright (c) 1997-2003 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by: # Dmitry Karasik # # $Id: Grids.pm,v 1.10 2008/04/09 20:14:27 dk Exp $ use strict; use Prima; use Prima::IntUtils; package ci; BEGIN { eval 'use constant Grid => 1 + MaxId;' unless exists $ci::{Grid}; eval 'use constant IndentCellFore => 2 + MaxId;' unless exists $ci::{IndentCellFore}; eval 'use constant IndentCellBack => 3 + MaxId;' unless exists $ci::{IndentCellBack}; } package gsci; use constant COL_INDEX => 0; use constant ROW_INDEX => 1; use constant V_FULL => 2; use constant V_LEFT => 3; use constant V_BOTTOM => 4; use constant V_RIGHT => 5; use constant V_TOP => 6; use constant V_RECT => 3,4,5,6; use constant LEFT => 7; use constant BOTTOM => 8; use constant RIGHT => 9; use constant TOP => 10; use constant RECT => 7,8,9,10; package Prima::AbstractGridViewer; use vars qw(@ISA); @ISA = qw(Prima::Widget Prima::MouseScroller Prima::GroupScroller); { my %RNT = ( %{Prima::Widget-> notification_types()}, DrawCell => nt::Action, GetRange => nt::Action, Measure => nt::Action, SelectCell => nt::Default, SetExtent => nt::Action, Stringify => nt::Action, ); sub notification_types { return \%RNT; } } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( allowChangeCellHeight => 0, allowChangeCellWidth => 0, autoHScroll => 1, autoVScroll => 1, borderWidth => 2, cellIndents => [ 0, 0, 0, 0], clipCells => 1, columns => 1, constantCellWidth => undef, constantCellHeight => undef, drawHGrid => 1, drawVGrid => 1, focusedCell => [0, 0], gridColor => cl::Black, gridGravity => 3, indentCellBackColor => cl::Gray, indentCellColor => cl::Black, hScroll => 0, leftCell => 0, multiSelect => 0, rows => 1, topCell => 0, scaleChildren => 0, selectable => 1, vScroll => 1, widgetClass => wc::ListBox, ); @$def{keys %prf} = values %prf; return $def; } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); $p-> {autoHScroll} = 0 if exists $p-> {hScroll}; $p-> {autoVScroll} = 0 if exists $p-> {vScroll}; } sub init { my $self = shift; $self-> {$_} = -1 for qw( leftCell topCell); $self-> {$_} = 0 for qw( autoHScroll autoVScroll scrollTransaction gridColor hScroll vScroll dx dy leftCell topCell multiSelect borderWidth visibleCols visibleRows indentCellColor indentCellBackColor clipCells cache_geometry_requests allowChangeCellWidth allowChangeCellHeight gridGravity ); $self-> {$_} = 1 for qw( drawHGrid drawVGrid columns rows); $self-> {focusedCell} = [0,0]; $self-> {cellIndents} = [0,0,0,0]; $self-> {selection} = [-1,-1,-1,-1]; my %profile = $self-> SUPER::init(@_); $self-> setup_indents; $self-> $_( $profile{ $_}) for qw( allowChangeCellHeight allowChangeCellWidth constantCellWidth constantCellHeight autoHScroll autoVScroll drawHGrid drawVGrid gridColor hScroll vScroll leftCell cellIndents multiSelect focusedCell topCell borderWidth indentCellColor indentCellBackColor clipCells gridGravity ); $self-> reset; return %profile; } sub cache_geometry_requests { my ( $self, $do_cache) = @_; return if $self-> {cache_geometry_requests} == $do_cache; if (( $self-> {cache_geometry_requests} = $do_cache)) { $self-> {geometry_cache_row} = {}; $self-> {geometry_cache_column} = {}; } else { delete $self-> {geometry_cache_row}; delete $self-> {geometry_cache_column}; } } sub deselect_all { my $self = $_[0]; $self-> selection(-1,-1,-1,-1); } sub draw_cells { my ($self, $canvas, $cols, $rows, $active_area) = @_; my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(DrawCell)); my @selection = $self-> selection; my @f = $self-> focused ? $self-> focusedCell : ( -1, -1); $self-> push_event; my ( $xsel, $ysel); my ( $clipV, $clipH) = ( $self-> {clipCells} == 1, $self-> {clipCells} == 2); for ( @$cols) { my ( $col, $xtype, $br, $x1, $x2, $X1, $X2) = @$_; $canvas-> clipRect( $x1, $$active_area[1], $x2, $$active_area[3]) if $clipV; $xsel = ( $col >= $selection[0] && $col <= $selection[2] ) ? 1 : 0; for ( @$rows) { my ( $row, $ytype, $br, $y1, $y2, $Y1, $Y2) = @$_; $ysel = ( $row >= $selection[1] && $row <= $selection[3] ) ? 1 : 0 if $xsel; $canvas-> clipRect( $x1, $y1, $x2, $y2) if $clipH; $notifier-> ( @notifyParms, $canvas, $col, $row, $xtype || $ytype, $x1, $y1, $x2, $y2, $X1, $Y1, $X2, $Y2, $xsel && $ysel, ( $col == $f[0] && $row == $f[1]) ? 1 : 0 ); } } $self-> pop_event; } sub draw_text_cells { my ( $self, $canvas, $screen_rects, $cell_rects, $cell_indices, $font_height) = @_; my $i; my @clip = $canvas-> clipRect if $self-> {clipCells} == 2; for ( $i = 0; $i < @$screen_rects; $i++) { my @r = @{$$cell_rects[$i]}; $canvas-> clipRect( @{$$screen_rects[$i]}) if $self-> {clipCells} == 2; $canvas-> text_out( $self-> get_cell_text( @{$$cell_indices[$i]}), $r[0], ($r[3] + $r[1] - $font_height) / 2); } $canvas-> clipRect( @clip) if $self-> {clipCells} == 2; } sub get_cell_area { my ( $self, @size) = @_; my @a = $self-> get_active_area( 1, @size); my @r; my @px = @{$self-> {pixelCellIndents}}; $r[0] = $a[0] + $px[0]; $r[1] = $a[1] + $px[3]; $r[2] = $a[2] - $px[2]; $r[3] = $a[3] - $px[1]; if ( $self-> {lastColEmpty}) { $r[2]-- if $self-> {drawVGrid}; } if ( $self-> {lastRowEmpty}) { $r[3]-- if $self-> {drawHGrid}; } return @r; } sub get_cell_text { my ( $self, $col, $row) = @_; my $txt = ''; $self-> notify(q(Stringify), $col, $row, \$txt); return $txt; } sub get_range { my ( $self, $axis, $index) = @_; my ( $min, $max) = ( 1, 16384 ); # actually, no real restriction on $max - # just a reasonable non-undef value $self-> notify(q(GetRange), $axis, $index, \$min, \$max); $min = 1 if $min < 1; $max = $min if $max < $min; return $min, $max; } sub get_screen_cell_info { my ( $self, $x, $y) = @_; my ( $colsDraw, $rowsDraw) = ( $self-> {colsDraw}, $self-> {rowsDraw}); my ( $col, $row, $c, $r, $i); $i = 0; for ( @$colsDraw) { $i++, next unless $x == $$_[0]; $col = $i; $c = $_; } return unless defined $col; $i = 0; for ( @$rowsDraw) { $i++, next unless $y == $$_[0]; $row = $i; $r = $_; } return unless defined $row; my ( $dx, $dy) = ( $self-> {dx}, $self-> {dy}); return $col, $row, ( ( $$c[3] == $$c[5]) && ( $$c[4] == $$c[6]) && ( $$r[3] == $$r[5]) && ( $$r[4] == $$r[6]) ), $$c[3]-$dx, $$r[3]+$dy, $$c[4]-$dx+1, $$r[4]+$dy+1, $$c[5]-$dx, $$r[5]+$dy, $$c[6]-$dx+1, $$r[6]+$dy+1, ; } sub has_selection { return $_[0]-> {selection}-> [0] >= 0; } sub point2cell { my ( $self, $x, $y, $NoGrid) = @_; my @a = $self-> get_active_area( 0); $x += $self-> {dx}; $y -= $self-> {dy}; my ($cx, $cy, %hints) = (-2, -2); my ( $colsDraw, $rowsDraw) = ( $self-> {colsDraw}, $self-> {rowsDraw}); # check widget borders first if ( $x < $a[0]) { # left border $cx = -1; $hints{x} = -1; } elsif ( $x >= $a[2] - (($self-> {drawVGrid} && $self-> {cellIndents}-> [2] > 0) ? $self-> {drawVGrid} : 0)) { # right border $cx = -1; $hints{x} = +2; } if ( $y < $a[1]) { # bottom border $cy = -1; $hints{y} = +2; } elsif ( $y >= $a[3] - (($self-> {drawHGrid} && $self-> {cellIndents}-> [1] > 0) ? $self-> {drawVGrid} : 0)) { # top border $cy = -1; $hints{y} = -1; } return $cx, $cy, %hints, 'exterior', 1 if defined $hints{x} && defined $hints{y}; # check if it is the grid if ( !$NoGrid && $self-> {drawVGrid}) { my $i = -1; my $lax = $self-> allowChangeCellWidth ? $self-> {gridGravity} : 0; my $skipLast = ( $self-> {cellIndents}-> [2] > 0) ? scalar(@{$self-> {vGrid}}) - 1 : -1; for ( @{$self-> {vGrid}}) { $i++; next if $x < $$_[0] - $lax || $x > $$_[0] + $lax || $i == $skipLast; $hints{x_grid} = 1; $hints{grid} = 1; if ( $self-> {cellIndents}-> [2] > 0 && $i >= scalar(@{$self-> {vGrid}}) - $self-> {cellIndents}-> [2] - 1) { $hints{x_right} = 1; $i++ unless $self-> {lastColEmpty}; } else { $hints{x_left} = 1; } $hints{x} = 0; $hints{y} = +1 unless defined $hints{y}; return $$colsDraw[$i][0], $cy, %hints; } } if ( !$NoGrid && $self-> {drawHGrid}) { my $i = -1; my $lax = $self-> allowChangeCellHeight ? $self-> {gridGravity} : 0; my $skipLast = ( $self-> {cellIndents}-> [3] > 0) ? scalar(@{$self-> {hGrid}}) - 1 : -1; for ( @{$self-> {hGrid}}) { $i++; next if $y < $$_[0] - $lax || $y > $$_[0] + $lax || $i == $skipLast; $hints{y_grid} = 1; $hints{grid} = 1; if ( $self-> {cellIndents}-> [3] > 0 && $i >= scalar(@{$self-> {hGrid}}) - $self-> {cellIndents}-> [3] - 1) { $hints{y_bottom} = 1; $i++ unless $self-> {lastRowEmpty}; } else { $hints{y_top} = 1; } $hints{x} = +1 unless defined $hints{x}; $hints{y} = 0; return $cx, $$rowsDraw[$i][0], %hints; } } # check other areas if ( defined $hints{x}) { # nop } elsif ( $x > $$colsDraw[-1][4] + $self-> {drawVGrid}) { # right whitespace $cx = -1; $hints{x} = +1; } elsif ( $self-> {lastColEmpty} && $x < $a[2] - $self-> {pixelCellIndents}-> [2] && $x > $a[2] - $self-> {pixelCellIndents}-> [2] - $self-> {lastColTail} - (($self-> {cellIndents}-> [2] > 0) ? $self-> {drawVGrid} : 0) ) { # gap $cx = -1; $hints{x} = +1; $hints{x_gap} = 1; $hints{x_type} = 1; } else { # cycle cells to find who is it my $i = 0; my $dv = $self-> {drawVGrid}; for ( @$colsDraw) { if ( $x <= $$_[4]) { $cx = $$_[0]; $hints{x} = 0; if (( $hints{x_type} = $$_[1]) != 0) { $hints{x_type} = ( $x > $a[0] + $self-> {pixelCellIndents}-> [0]) ? (( $x < $a[2] - $self-> {pixelCellIndents}-> [2] - 1) ? 0 : +1) : -1; } last; } $i++; } unless ( defined $hints{x}) { # last column grid not catched when $NoGrid is set $hints{x} = 0; $hints{x_type} = 0; # XXX unsure $cx = $$colsDraw[-1][0]; } } if ( defined $hints{y}) { # nop } elsif ( $y < $$rowsDraw[-1][3] + $self-> {drawHGrid}) { # bottom whitespace $cy = -1; $hints{y} = +1; } elsif ( $self-> {lastColEmpty} && $y > $a[1] + $self-> {pixelCellIndents}-> [3] && $y < $a[1] + $self-> {pixelCellIndents}-> [3] + $self-> {lastRowTail} - (($self-> {cellIndents}-> [3] > 0) ? $self-> {drawHGrid} : 0) ) { # gap $cy = -1; $hints{y} = +1; $hints{y_gap} = 1; $hints{y_type} = 1; } else { # cycle cells to find who is it my $i = 0; my $dh = $self-> {drawHGrid}; for ( @$rowsDraw) { if ( $y >= $$_[3]) { $cy = $$_[0]; $hints{y} = 0; if (( $hints{y_type} = $$_[1]) != 0) { $hints{y_type} = ( $y < $a[3] - $self-> {pixelCellIndents}-> [1] - 1) ? (( $y > $a[1] + $self-> {pixelCellIndents}-> [3]) ? 0 : +1) : -1; } last; } $i++; } unless ( defined $hints{y}) { # last row grid not catched when $NoGrid is set $hints{y} = 0; $hints{y_type} = 0; # XXX unsure $cy = $$colsDraw[-1][0]; } } # area type if ( $hints{x} == 0 && $hints{y} == 0) { if ( $hints{x_type} == 0 && $hints{y_type} == 0) { $hints{normal} = 1; } else { $hints{indent} = 1; } } else { $hints{exterior} = 1; } return $cx, $cy, %hints; } sub redraw_cell { my ( $self, $x, $y) = @_; my @info = $self-> get_screen_cell_info( $x, $y); return unless scalar @info; $self-> invalidate_rect( @info[gsci::V_RECT]); } # Because grid is non-linear, x or y position shift results in that # number visible cells and rows is different . Therefore grid operates # two scroll modes - pixel and cell. The cell mode is the default, where # the scroll step is a cell. If, however, a cell is single and cannot be # fit, scrolling is switched to pixel-wise. This behavior is reflected via # {colUnits} and {rowUnits} boolean fields. The limits are {columns} and # {colSpan}, and {rows} and {rowSpan} respectively for either mode. # {colSpan} and {rowSpan} are used internally for cell unit mode also. sub reset { my ( $self, @par_sz) = @_; my ( $O, $T, $r, $c, $dh, $dv) = ( $self-> {leftCell}, $self-> {topCell}, $self-> {rows}, $self-> {columns}, $self-> {drawHGrid}, $self-> {drawVGrid}); my ( $i, $W, $H, $lastw, $lasth) = ( 0, 0, 0, 0, 0); my @scroll_steps = ( 0, 0); @par_sz = $self-> size unless @par_sz; $self-> cache_geometry_requests(1); $self-> begin_paint_info unless $self-> {NoBulkPaintInfo}; my @in = @{$self-> {cellIndents}}; my @px = ( 0,0,0,0); for ( $i = 0; $i < $in[0]; $i++) { $px[0] += $self-> columnWidth($i) + $dv; } for ( $i = 0; $i < $in[1]; $i++) { $px[1] += $self-> rowHeight($i) + $dh; } for ( $i = 0; $i < $in[2]; $i++) { $px[2] += $self-> columnWidth($c - $i - 1) + $dv; } for ( $i = 0; $i < $in[3]; $i++) { $px[3] += $self-> rowHeight($r - $i - 1) + $dh; } $self-> {pixelCellIndents} = \@px; # calculate dimension of a minimal operational field $W += $self-> columnWidth( $O++) + $dv if $c > $in[0] + $in[2]; $H += $self-> rowHeight( $T++) + $dh if $r > $in[1] + $in[3]; # select unit mode REPEAT_LAYOUT: my ( $w, $h, $o, $t) = ( $W, $H, $O, $T); my @sz = $self-> get_active_area( 2, @par_sz); $self-> {colUnits} = ( $w + $px[0] + $px[2] <= $sz[0] ) ? 1 : 0; $self-> {rowUnits} = ( $h + $px[1] + $px[3] <= $sz[1] ) ? 1 : 0; # calculate the last possible visible row $i = $r - $in[3] - 1; my $maxh = $sz[1] - $px[1] - $px[3]; my $yh = $self-> rowHeight( $i) + $dh; while ( $i > $in[1] ) { my $dh = $self-> rowHeight( $i - 1) + $dh; last if $yh + $dh > $maxh; $yh += $dh; $i--; } $self-> {rowMax} = $i; # calculate the last possible visible column my $maxw = $sz[0] - $px[0] - $px[2]; $i = $c - $in[2] - 1; my $xw = $self-> columnWidth( $i) + $dv; while ( $i > $in[0] ) { my $dw = $self-> columnWidth( $i - 1) + $dv; last if $xw + $dw > $maxw; $xw += $dw; $i--; } $self-> {colMax} = $i; # if span is more than minimal, calculate how many cells can be fit in screen if ( $self-> {colUnits}) { $sz[0] -= $px[0] + $px[2]; while ( $w < $sz[0] && $o < $c - $in[2]) { $lastw = $w; $w += $self-> columnWidth( $o++) + $dv; } $self-> {dx} = 0; $self-> {lastColEmpty} = ($in[2] > 0) ? $w < $sz[0] : 0; $self-> {lastColTail} = ( $w > $sz[0] ) ? $sz[0] - $lastw : (( $in[2] > 0) ? $sz[0] - $w : 0); $self-> {colSpan} = $lastw + ( $self-> {lastColEmpty} ? $self-> {lastColTail} : 0); } else { $self-> {lastColEmpty} = 0; $self-> {lastColTail} = 0; $self-> {colSpan} = $w + $px[0] + $px[2]; $self-> {dx} = $self-> {colSpan} - $sz[0] if $self-> {dx} > $self-> {colSpan} - $sz[0]; } if ( $self-> {rowUnits}) { $sz[1] -= $px[1] + $px[3]; while ( $h < $sz[1] && $t < $r - $in[3]) { $lasth = $h; $h += $self-> rowHeight( $t++) + $dh; } $self-> {dy} = 0; $self-> {lastRowEmpty} = ( $in[3] > 0) ? $h < $sz[1] : 0; $self-> {lastRowTail} = ( $h > $sz[1] ) ? $sz[1] - $lasth : (( $in[3] > 0) ? $sz[1] - $h : 0); $self-> {rowSpan} = $lasth + ($self-> {lastRowEmpty} ? $self-> {lastRowTail} : 0); } else { $self-> {lastRowEmpty} = 0; $self-> {lastRowTail} = 0; $self-> {rowSpan} = $h + $px[1] + $px[3]; $self-> {dy} = $self-> {rowSpan} - $sz[1] if $self-> {dy} > $self-> {rowSpan} - $sz[1]; } $self-> {visibleCols} = $o - $self-> {leftCell}; $self-> {visibleRows} = $t - $self-> {topCell}; $self-> {fullCols} = $self-> {visibleCols} - (( !$self-> {lastColEmpty} && $self-> {lastColTail} > 0) ? 1 : 0); $self-> {fullRows} = $self-> {visibleRows} - (( !$self-> {lastRowEmpty} && $self-> {lastRowTail} > 0) ? 1 : 0); my $vr = $self-> {visibleRows} + $in[1] + $in[3]; my $vc = $self-> {visibleCols} + $in[0] + $in[2]; # calculate breadth vectors my ( @colsDraw, @rowsDraw) = (); # Determine cells to be drawn # # colsDraw and rowsDraw contain arrays of cell and row geometry, with each # item laid out as follows: # 0: cell # # 1: type; 0 - normal cell, 1 - indent cell # 2: visible cell breadth # 3: visible cell start # 4: visible cell end # 5: real cell start # 6: real cell end # The coordinates are in inclusive-inclusive coordinate system, and # do not include eventual grid space, and gaps between indent and # normal cells. $o = $self-> {leftCell}; $t = $self-> {topCell}; # horizontal push @colsDraw, map {[$_, 1, $self-> columnWidth($_) + $dv]} 0 .. $in[0] - 1 if $in[0] > 0; if ( $self-> {colUnits}) { push @colsDraw, map {[$_, 0, $self-> columnWidth($_) + $dv]} $o .. $o + $self-> {visibleCols} - 1; if ( !$self-> {lastColEmpty} && $self-> {lastColTail} > 0) { $colsDraw[-1][6] = $colsDraw[-1][2] - $self-> {lastColTail}; $colsDraw[-1][2] = $self-> {lastColTail}; } } else { push @colsDraw, [ $o, 0, $self-> columnWidth($o) + $dv]; } push @colsDraw, map {[$_, 1, $self-> columnWidth($_) + $dv]} $c - $in[2] .. $c - 1 if $in[2] > 0; # and vertical push @rowsDraw, map {[$_, 1, $self-> rowHeight($_) + $dh]} 0 .. $in[1] - 1 if $in[1] > 0; if ( $self-> {rowUnits}) { push @rowsDraw, map {[$_, 0, $self-> rowHeight($_) + $dh]} $t .. $t + $self-> {visibleRows} - 1; if ( !$self-> {lastRowEmpty} && $self-> {lastRowTail} > 0) { $rowsDraw[-1][5] = $self-> {lastRowTail} + $dh - $rowsDraw[-1][2]; $rowsDraw[-1][2] = $self-> {lastRowTail}; } } else { push @rowsDraw, [ $t, 0, $self-> rowHeight($t) + $dh]; } push @rowsDraw, map {[$_, 1, $self-> rowHeight($_) + $dh]} $r - $in[3] .. $r - 1 if $in[3] > 0; $i = $self-> {indents}-> [0]; my $j = 0; for ( @colsDraw) { $$_[3] = $i; $$_[4] = $i + $$_[2] - 1 - $dv; $$_[5] += $$_[3]; $$_[6] += $$_[4]; $i += $$_[2]; $i += $self-> {lastColTail} if $self-> {lastColEmpty} && $in[2] > 0 && $$_[0] == $c - $in[2] - 1; $j++; } $i = $par_sz[1] - $self-> {indents}-> [3]; $j = 0; for ( @rowsDraw) { $$_[3] = $i - $$_[2] + $dh; $$_[4] = $i - 1; $$_[5] += $$_[3]; $$_[6] += $$_[4]; $i -= $$_[2]; $i -= $self-> {lastRowTail} if $self-> {lastRowEmpty} && $in[3] > 0 && $$_[0] == $r - $in[3] - 1; } $self-> {colsDraw} = \@colsDraw; $self-> {rowsDraw} = \@rowsDraw; # assign grid anchor points my ( @vgrid, @hgrid); if ( $dh) { @hgrid = map {[ $$_[3] - 1, $colsDraw[-1][4], $colsDraw[0][3]]} @rowsDraw; splice @hgrid, -$in[3], 0, [$rowsDraw[-$in[3]][4] + $dh, $colsDraw[-1][4], $colsDraw[0][3]] if $self-> {rowUnits} && $self-> {lastRowEmpty} && $in[3] > 0; # split lines over the gap if ( $self-> {lastColEmpty}) { my %excludes = ( $#hgrid => 1, $#hgrid - $in[3] => 1); $excludes{$in[1]-1} = 1 if $in[1] > 0; $i = 0; for ( @hgrid) { next if $excludes{$i++}; splice @$_, 2, 0, $colsDraw[-$in[2]][3], $colsDraw[-$in[2]-1][4]; } } } $self-> {hGrid} = \@hgrid; if ( $dv) { @vgrid = map {[ $$_[4] + 1, $rowsDraw[-1][3], $rowsDraw[0][4]]} @colsDraw; splice @vgrid, -$in[2], 0, [$colsDraw[-$in[2]][3] - $dv, $rowsDraw[-1][3], $rowsDraw[0][4]] if $self-> {colUnits} && $self-> {lastColEmpty} && $in[2] > 0; # split lines over the gap if ( $self-> {lastRowEmpty}) { my %excludes = ( $#vgrid => 1, $#vgrid - $in[2] => 1); $excludes{$in[0]-1} = 1 if $in[0] > 0; $i = 0; for ( @vgrid) { next if $excludes{$i++}; splice @$_, 2, 0, $rowsDraw[-$in[3]][4], $rowsDraw[-$in[3]-1][3]; } } } $self-> {vGrid} = \@vgrid; # scroll bars may change geometry and cause repaints $self-> end_paint_info unless $self-> {NoBulkPaintInfo}; # adjust scrollbars my @scrolls = ( $self-> {hScroll}, $self-> {vScroll}); if ( !($self-> {scrollTransaction} & 1)) { if ( $self-> {rowUnits}) { $self-> vScroll( $vr < $r) if $self-> {autoVScroll}; $self-> {vScrollBar}-> set( max => $self-> {rowMax} - $in[1], pageStep => $vr, whole => $r, partial => $vr, value => $self-> {topCell} - $in[1], ) if $self-> {vScroll}; } else { $self-> vScroll( $self-> {dy} < $self-> {rowSpan}) if $self-> {autoVScroll}; my @sz = $self-> get_active_area(2); $self-> {vScrollBar}-> set( max => $self-> {rowSpan} - $sz[1], pageStep => $sz[1], whole => $self-> {rowSpan}, partial => $sz[1], value => $self-> {dy}, ) if $self-> {vScroll}; } } if ( !($self-> {scrollTransaction} & 2)) { if ( $self-> {colUnits}) { $self-> hScroll( $vc < $c) if $self-> {autoHScroll}; $self-> {hScrollBar}-> set( max => $self-> {colMax} - $in[0], pageStep => $vc, whole => $c, partial => $vc, value => $self-> {leftCell} - $in[0], ) if $self-> {hScroll}; } else { $self-> hScroll( $self-> {dx} < $self-> {colSpan}) if $self-> {autoHScroll}; my @sz = $self-> get_active_area(2); $self-> {hScrollBar}-> set( max => $self-> {colSpan} - $sz[0], pageStep => $sz[0], whole => $self-> {colSpan}, partial => $sz[0], value => $self-> {dx}, ) if $self-> {hScroll}; } } # check if auto-scrolling changed the layout, and reset it again, # but no more than once for each dimension if ( $self-> {hScroll} != $scrolls[0] || $self-> {vScroll} != $scrolls[1] ) { $scroll_steps[0]++ if $self-> {hScroll} != $scrolls[0]; $scroll_steps[1]++ if $self-> {vScroll} != $scrolls[1]; if ( $scroll_steps[0] < 2 && $scroll_steps[1] < 2) { $lastw = $lasth = 0; $self-> begin_paint_info unless $self-> {NoBulkPaintInfo}; goto REPEAT_LAYOUT } } $self-> cache_geometry_requests(0); } sub select_all { my $self = $_[0]; $self-> selection(0,0,$self-> {columns},$self-> {rows}); } sub std_draw_text_cells { my ($self, $canvas, $cols, $rows, $active_area) = @_; my @colors = ( $self-> color, $self-> backColor, $self-> colorIndex( ci::HiliteText), $self-> colorIndex( ci::Hilite), $self-> indentCellColor, $self-> indentCellBackColor, $self-> gridColor, ); my @selection = $self-> selection; my @f = $self-> focused ? $self-> focusedCell : ( -1, -1); my @focRect; my $font_height = $self-> font-> height; my ( $xsel, $ysel); my ( $clipV, $clipH) = ( $self-> {clipCells} == 1, $self-> {clipCells} == 2); my @clipRect = $canvas-> clipRect; for ( @$cols) { my ( $col, $xtype, $br, $x1, $x2, $X1, $X2) = @$_; $canvas-> clipRect( $x1, $$active_area[1], $x2, $$active_area[3]) if $clipV; $xsel = ( $col >= $selection[0] && $col <= $selection[2] ) ? 1 : 0; my $last_type; my @bars; my @rects; my @cellids; for ( @$rows) { my ( $row, $ytype, $br, $y1, $y2, $Y1, $Y2) = @$_; $ysel = ( $row >= $selection[1] && $row <= $selection[3] ) ? 1 : 0 if $xsel; my $type = ($xtype || $ytype) ? 2 : (($xsel && $ysel) ? 1 : 0); if ( defined($last_type) && $type != $last_type) { $canvas-> set( color => $colors[$last_type * 2], backColor => $colors[$last_type * 2 + 1], ); $canvas-> clear(@$_) for @bars; $self-> draw_text_cells( $canvas, \@bars, \@rects, \@cellids, $font_height); @bars = (); @rects = (); @cellids = (); } $last_type = $type; push @bars, [$x1, $y1, $x2, $y2]; push @rects, [$X1, $Y1, $X2, $Y2]; push @cellids, [ $col, $row ]; @focRect = ($x1, $y1, $x2, $y2) if $col == $f[0] && $row == $f[1]; } if ( defined $last_type) { $canvas-> set( color => $colors[$last_type * 2], backColor => $colors[$last_type * 2 + 1], ); $canvas-> clear(@$_) for @bars; $self-> draw_text_cells( $canvas, \@bars, \@rects, \@cellids, $font_height); } } $canvas-> clipRect( @clipRect); $canvas-> rect_focus( @focRect) if @focRect; } sub on_size { my ( $self, $ox, $oy, $x, $y) = @_; $self-> reset( $x, $y); } sub on_disable { $_[0]-> repaint; } sub on_enable { $_[0]-> repaint; } sub on_enter { $_[0]-> redraw_cell( $_[0]-> focusedCell); } sub on_keydown { my ( $self, $code, $key, $mod) = @_; $self-> notify(q(MouseUp),0,0,0) if defined $self-> {mouseTransaction}; return if $mod & km::DeadKey; $mod &= ( km::Shift|km::Ctrl|km::Alt); if ( scalar grep { $key == $_ } (kb::Left,kb::Right,kb::Up,kb::Down,kb::Home,kb::End,kb::PgUp,kb::PgDn)) { my @f = @{$self-> {focusedCell}}; my $doSelect; if ( $mod == 0 || ( $mod & (km::Shift|km::Ctrl))) { if ( $key == kb::Up) { $f[1]-- } elsif ( $key == kb::Down) { $f[1]++ } elsif ( $key == kb::Left) { $f[0]-- } elsif ( $key == kb::Right){ $f[0]++ } elsif ( $key == kb::Home) { $f[0] = (($mod & km::Ctrl) ? 0 : ($self-> {leftCell} - (( $f[0] == $self-> {leftCell}) ? $self-> {fullCols} : 0))); } elsif ( $key == kb::End) { my $e = $self-> {leftCell} + $self-> {fullCols} - 1; $f[0] = (($mod & km::Ctrl) ? $self-> {columns} : $e + ( ($f[0] == $e) ? $self-> {fullCols} : 0 )); } elsif ( $key == kb::PgUp) { $f[1] = (($mod & km::Ctrl) ? 0 : ($self-> {topCell} - (( $f[1] == $self-> {topCell}) ? $self-> {fullRows} : 0) )); } elsif ( $key == kb::PgDn) { my $e = $self-> {topCell} + $self-> {fullRows} - 1; $f[1] = (($mod & km::Ctrl) ? $self-> {rows} : ($e + (($f[1] == $e ) ? $self-> {fullRows} : 0) )); } $doSelect = $mod & km::Shift; } if ( $doSelect ) { my @sel = exists($self-> {anchor}) ? @{$self-> {anchor}} : @{$self-> {focusedCell}}; $self-> selection( @sel, @f); $self-> {anchor} = [ $self-> focusedCell ] unless exists $self-> {anchor}; } else { $self-> selection( @f, @f ) if exists $self-> {anchor}; delete $self-> {anchor}; } $self-> focusedCell( @f); $self-> clear_event; return; } else { delete $self-> {anchor}; } if ( $mod == 0 && ( $key == kb::Space || $key == kb::Enter)) { $self-> clear_event; $self-> notify(q(Click)) if $key == kb::Enter; return; } } sub on_leave { my $self = $_[0]; if ( $self-> {mouseTransaction}) { $self-> capture(0) if $self-> {mouseTransaction}; $self-> {mouseTransaction} = undef; } $self-> redraw_cell( $self-> focusedCell); } sub on_mouseclick { my ( $self, $btn, $mod, $x, $y, $dbl) = @_; $self-> clear_event; return if $btn != mb::Left || !$dbl; my ( $cx, $cy, %hints) = $self-> point2cell( $x, $y); $self-> notify(q(Click)) if $hints{normal} || $hints{indent}; } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {mouseTransaction}; return if $btn != mb::Left; my ( $cx, $cy, %hints) = $self-> point2cell( $x, $y); # print "$_($hints{$_})," for keys %hints; print "X($cx),Y($cy)\n";return; if ( $hints{normal}) { if ( $self-> {multiSelect}) { if ( $mod & km::Shift) { $self-> selection( $cx, $cy, @{$self-> {focusedCell}}); } else { $self-> selection( $cx, $cy, $cx, $cy); } $self-> {anchor} = [ $cx, $cy ]; } $self-> focusedCell( $cx, $cy); $self-> {mouseTransaction} = 1; $self-> capture(1); $self-> clear_event; return; } if ( defined($hints{x_grid}) && $self-> allowChangeCellWidth) { $self-> pointerType( cr::SizeWE); my %d; if ( $hints{x_right}) { my @info = $self-> get_screen_cell_info( $cx, $self-> {topCell}); $d{range} = [ $self-> get_range( 0, $cx) ]; $d{v_begins} = $info[gsci::V_LEFT] - $self-> {lastColTail}; $d{v_ends} = $self-> right - $self-> {indents}-> [2] - 1; $d{index} = $cx; $d{mode} = 0; $d{offset} = $info[gsci::RIGHT]; } else { my @info = $self-> get_screen_cell_info( $cx, $self-> {topCell}); $d{range} = [ $self-> get_range( 0, $cx) ]; $d{offset} = $info[gsci::LEFT]; $d{v_begins} = $d{offset} + $d{range}-> [0]; $d{v_begins} = $info[gsci::V_LEFT] if $d{v_begins} < $info[gsci::V_LEFT]; $d{v_ends} = $self-> right - $self-> {indents}-> [2] - 1; $d{index} = $cx; $d{mode} = 1; } $d{breadth} = $self-> columnWidth($d{index}); $self-> {dragSizeInfo} = \%d; $self-> {mouseTransaction} = 2; $self-> capture(1); $self-> clear_event; return; } elsif ( defined($hints{y_grid}) && $self-> allowChangeCellHeight) { $self-> pointerType( cr::SizeNS); my %d; if ( $hints{y_bottom}) { my @info = $self-> get_screen_cell_info( $self-> {leftCell}, $cy); $d{range} = [ $self-> get_range( 1, $cy) ]; $d{v_begins} = $info[gsci::V_TOP] + $self-> {lastRowTail}; $d{v_ends} = $self-> bottom - $self-> {indents}-> [3] - 1; $d{index} = $cy; $d{mode} = 0; $d{offset} = $info[gsci::V_BOTTOM]; } else { my @info = $self-> get_screen_cell_info( $self-> {leftCell}, $cy); $d{range} = [ $self-> get_range( 1, $cy) ]; $d{offset} = $info[gsci::TOP]; $d{v_begins} = $d{offset} + $d{range}-> [0]; $d{v_begins} = $info[gsci::V_TOP] if $d{v_begins} < $info[gsci::V_TOP]; $d{v_ends} = $self-> bottom - $self-> {indents}-> [3] - 1; $d{index} = $cy; $d{mode} = 1; } $d{breadth} = $self-> rowHeight($d{index}); $self-> {dragSizeInfo} = \%d; $self-> {mouseTransaction} = 3; $self-> capture(1); $self-> clear_event; return; } } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; my ( $cx, $cy, %hints) = $self-> point2cell( $x, $y, defined($self-> {mouseTransaction})); $self-> clear_event; unless ( defined $self-> {mouseTransaction}) { if ( defined($hints{x_grid}) && $self-> allowChangeCellWidth) { $self-> pointerType( cr::SizeWE); } elsif ( defined($hints{y_grid}) && $self-> allowChangeCellHeight) { $self-> pointerType( cr::SizeNS); } else { $self-> pointerType( cr::Default); } return; } if ( $self-> {mouseTransaction} == 1) { unless ( $hints{normal}) { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); } else { $self-> scroll_timer_stop; } my ( $t, $o); if ( $hints{x} != 0 || (defined( $hints{x_type}) && $hints{x_type} != 0)) { my ( $x1, $x2) = ( $self-> {leftCell}, $self-> {leftCell} + $self-> {fullCols} - 1 ); my $xd = ( $hints{x} == 0) ? $hints{x_type} : $hints{x}; if ( $xd < 0) { if ( $self-> {focusedCell}-> [0] > $x1) { $cx = $x1; } else { $o = $self-> {leftCell} - 1; $cx = $x1 - 1; } } else { $cx = $self-> {focusedCell}-> [0] + 1; $cx = $x2 + 1 if $cx < $x1 || $cx > $x2 + 1; } } if ( $hints{y} != 0 || (defined( $hints{y_type}) && $hints{y_type} != 0)) { my ( $y1, $y2) = ( $self-> {topCell}, $self-> {topCell} + $self-> {fullRows} - 1 ); my $yd = ( $hints{y} == 0) ? $hints{y_type} : $hints{y}; if ( $yd < 0) { if ( $cy > $y1) { $cy = $y1; } else { $t = $self-> {topCell} - 1; $cy = $y1 - 1; } } else { $cy = $self-> {focusedCell}-> [1] + 1; $cy = $y2 + 1 if $cy < $y1 || $cy > $y2 + 1; } } $self-> selection( $cx, $cy, @{$self-> {anchor}}) if $self-> {anchor}; $self-> leftCell( $o) if defined $o; $self-> topCell( $t) if defined $t; $self-> focusedCell( $cx, $cy); } elsif ( $self-> {mouseTransaction} == 2) { my @a = $self-> get_active_area( 1); $x = $a[0] if $x < $a[0]; $x = $a[2] if $x > $a[2]; my $d = $self-> {dragSizeInfo}; $x = $d-> {v_begins} if $x < $d-> {v_begins}; $x = $d-> {v_ends} if $x > $d-> {v_ends}; $x = $d-> {mode} ? $x - $d-> {offset} : $d-> {offset} - $x; $x = $d-> {range}-> [0] if $x < $d-> {range}-> [0]; $x = $d-> {range}-> [1] if $x > $d-> {range}-> [1]; if ( $x != $d-> {breadth}) { $self-> columnWidth( $d-> {index}, $x); $d-> {breadth} = $self-> columnWidth( $d-> {index}); } } elsif ( $self-> {mouseTransaction} == 3) { my @a = $self-> get_active_area( 1); $y = $a[1] if $y < $a[1]; $y = $a[3] if $y > $a[3]; my $d = $self-> {dragSizeInfo}; $y = $d-> {v_begins} if $y > $d-> {v_begins}; $y = $d-> {v_ends} if $y < $d-> {v_ends}; $y = $d-> {mode} ? $d-> {offset} - $y :$y - $d-> {offset}; $y = $d-> {range}-> [0] if $y < $d-> {range}-> [0]; $y = $d-> {range}-> [1] if $y > $d-> {range}-> [1]; if ( $y != $d-> {breadth}) { $self-> rowHeight( $d-> {index}, $y); $d-> {breadth} = $self-> rowHeight( $d-> {index}); } } } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return if $btn != mb::Left; return unless defined $self-> {mouseTransaction}; delete $self-> {mouseTransaction}; delete $self-> {anchor}; delete $self-> {dragSizeInfo}; $self-> capture(0); $self-> clear_event; my ( $cx, $cy, %hints) = $self-> point2cell( $x, $y); if ( defined($hints{x_grid}) && $self-> allowChangeCellWidth) { $self-> pointerType( cr::SizeWE); } elsif ( defined($hints{y_grid}) && $self-> allowChangeCellHeight) { $self-> pointerType( cr::SizeNS); } else { $self-> pointerType( cr::Default); } } sub on_mousewheel { my ( $self, $mod, $x, $y, $z) = @_; $z = int( $z/120); $z *= ( $self-> {visibleRows} || 1) if $mod & km::Ctrl; my $newTop = $self-> {topCell} - $z; $self-> topCell( $newTop); } sub on_paint { my ($self,$canvas) = @_; my @size = $canvas-> size; unless ( $self-> enabled) { $self-> color( $self-> disabledColor); $self-> backColor( $self-> disabledBackColor); } my ( $r, $c, $o, $t, $dv, $dh, $dx, $dy) = ( $self-> {rows}, $self-> {columns}, $self-> {leftCell}, $self-> {topCell}, $self-> {drawVGrid}, $self-> {drawHGrid}, $self-> {dx}, $self-> {dy}, ); my @a = $self-> get_active_area( 1, @size); my ($i,$j); my @px = @{$self-> {pixelCellIndents}}; my @clipRect = $canvas-> clipRect; $self-> draw_border( $canvas, undef, @size); $canvas-> clipRect( @a); if ( $self-> {visibleCols} <= 0 || $self-> {visibleRows} <= 0) { $canvas-> clear( @a); return; } # intersect @clipRect with @a to avoid drawing cells behind scrollbars for ( 0, 1) { $clipRect[$_] = $a[$_] if $clipRect[$_] < $a[$_]; $clipRect[$_+2] = $a[$_+2] if $clipRect[$_+2] > $a[$_+2]; } my @clipCells; my @colsDraw = map { [ @$_ ] } @{$self-> {colsDraw}}; my @rowsDraw = map { [ @$_ ] } @{$self-> {rowsDraw}}; my @in = @{$self-> {cellIndents}}; # find columns to draw, by assigning @clipCells, a clipRect in cell units and # calculating the final geometry of cells $j = 0; for ( @colsDraw) { my $c = $_; $$c[$_] -= $dx for 3..6; $clipCells[0] = $j if !defined($clipCells[0]) && $$c[4] + $dv >= $clipRect[0]; $clipCells[2] = $j if !defined($clipCells[2]) && $$c[4] + $dv >= $clipRect[2]; $j++; } $clipCells[0] = 0 unless defined $clipCells[0]; $clipCells[2] = $#colsDraw unless defined $clipCells[2]; $j = 0; for ( @rowsDraw) { my $c = $_; $$c[$_] += $dy for 3..6; $clipCells[3] = $j if !defined($clipCells[3]) && $$c[3] - $dv <= $clipRect[3]; $clipCells[1] = $j if !defined($clipCells[1]) && $$c[3] - $dv <= $clipRect[1]; $j++; } $clipCells[3] = 0 unless defined $clipCells[3]; $clipCells[1] = $#rowsDraw unless defined $clipCells[1]; # if right and top indent cells present, the space for them must # be allocated +1 pixel for extra line between indent and empty space my @extras = ( ($px[0] > 0) ? $dv : 0, ($px[1] > 0) ? $dh : 0, ($px[2] > 0) ? $dv : 0, ($px[3] > 0) ? $dh : 0 ); # clear undrawable area if ( !$self-> {colUnits} || $px[2] == 0) { $canvas-> clear( $colsDraw[-1][4] + $dv + 1, @a[1..3]) if $colsDraw[-1][4] < $a[2]; } elsif ( $self-> {lastColEmpty}) { my $right = $a[2] - $px[2] - $extras[2]; my $left = $a[2] - $px[2] - $self-> {lastColTail} + 1; my $bk = $canvas-> backColor; if ( $self-> {lastColTail} > $dv) { if ( $self-> {rowUnits}) { $canvas-> clear( $left, $a[1] + $px[3] + $extras[3], $right, $a[3] - $px[1]); } else { $canvas-> clear( $left, $a[3] + $px[3] + $extras[3] + $dy - $self-> {rowSpan} + 1, $right, $a[3] - $px[1] + $dy); } } $canvas-> backColor( $self-> {indentCellBackColor}); if ( $self-> {rowUnits}) { $canvas-> clear( $left, $a[3] - $px[1] + $extras[1] + 1, $right, $a[3] ) if $px[1] > $dh; $canvas-> clear( $left, $a[1] + $dh, $right, $a[1] + $px[3] - 1 ) if $px[3] > $dh; } else { $canvas-> clear( $left, $a[3] - $px[1] + $extras[1] + 1 + $dy, $right, $a[3] + $dy ) if $px[1] > $dh; $canvas-> clear( $left, $a[3] - $self-> {rowSpan} + $dy + $dh, $right, $a[3] - $self-> {rowSpan} + $dy + $dh + $px[3] - 1 ) if $px[3] > $dh; } $canvas-> backColor( $bk); } # and horizontal area if ( !$self-> {rowUnits} || $in[3] == 0) { $canvas-> clear( @a[0..2], $rowsDraw[-1][3] - 1 - $dh) if $rowsDraw[-1][3] > $a[1]; } elsif ( $self-> {lastRowEmpty} ) { my $bottom = $a[1] + $px[3] + $extras[3]; my $top = $a[1] + $px[3] + $self-> {lastRowTail} - $dh; my $bk = $canvas-> backColor; if ( $self-> {lastRowTail} > $dh) { if ( $self-> {colUnits}) { $canvas-> clear( $a[0] + $px[0], $bottom, $a[2] - $px[2] - $extras[2], $top ); } else { $canvas-> clear( $a[0] + $px[0] - $dx, $bottom, $a[0] - $px[2] - $extras[2] - $dx - $dv + $self-> {colSpan}, $top ); } } $canvas-> backColor( $self-> {indentCellBackColor}); if ( $self-> {colUnits}) { $canvas-> clear( $a[0], $bottom, $a[0] + $px[0] - 1 - $extras[0], $top ) if $px[0] > $dv; $canvas-> clear( $a[2] - $px[2] + 1, $bottom, $a[2] - $dv, $top ) if $px[2] > $dv; } else { $canvas-> clear( $a[0] - $dx, $bottom, $a[0] + $px[0] - 1 - $extras[0] - $dx, $top ) if $px[0] > $dv; $canvas-> clear( $a[0] - $px[2] + $self-> {colSpan} - $dx , $bottom, $a[0] - $dx - $dv + $self-> {colSpan}, $top ) if $px[2] > $dv; } $canvas-> backColor( $bk); } # prepare indent grid line array my @grid; for ( @{$self-> {vGrid}}) { my $x = $$_[0] - $dx; for ( $i = 1; $i < @$_; $i += 2) { push @grid, $x, $$_[$i], $x, $$_[$i+1]; } } for ( @{$self-> {hGrid}}) { my $y = $$_[0] + $dy; for ( $i = 1; $i < @$_; $i += 2) { push @grid, $$_[$i], $y, $$_[$i+1], $y; } } # remove clipped cells splice( @colsDraw, $clipCells[2] + 1); splice( @colsDraw, 0, $clipCells[0]); @colsDraw = grep { $$_[2] > 0 } @colsDraw; splice( @rowsDraw, $clipCells[1] + 1); splice( @rowsDraw, 0, $clipCells[3]); @rowsDraw = grep { $$_[2] > 0 } @rowsDraw; # adjust cells rectangles not to overhang the active area for ( @colsDraw) { $$_[3] = $a[0] if $$_[3] < $a[0]; $$_[4] = $a[2] if $$_[4] > $a[2]; } for ( @rowsDraw) { $$_[3] = $a[1] if $$_[3] < $a[1]; $$_[4] = $a[3] if $$_[4] > $a[3]; } # draw cells $self-> draw_cells( $canvas, \@colsDraw, \@rowsDraw, \@a); # draw grid $canvas-> color( $self-> {gridColor}); $canvas-> clipRect( @a); $canvas-> lines( \@grid); } #sub on_stringify #{ # my ( $self, $index, $sref) = @_; # $$sref = ''; #} sub set_border_width { my ( $self, $bw) = @_; my $obw = $self-> {borderWidth}; $self-> SUPER::set_border_width( $bw); return if $obw == $self-> {borderWidth}; $self-> reset; $self-> repaint; } sub set_h_scroll { my ( $self, $hs) = @_; return if $hs == $self-> {hScroll}; $self-> SUPER::set_h_scroll( $hs); if ( !($self-> {scrollTransaction} & 2)) { $self-> {scrollTransaction} |= 2; $self-> reset; $self-> {scrollTransaction} &= ~2; } $self-> repaint; } sub set_v_scroll { my ( $self, $vs) = @_; return if $vs == $self-> {vScroll}; $self-> SUPER::set_v_scroll( $vs); if ( !($self-> {scrollTransaction} & 1)) { $self-> {scrollTransaction} |= 1; $self-> reset; $self-> {scrollTransaction} &= ~1; } $self-> repaint; } sub VScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction} & 1; $self-> {scrollTransaction} |= 1; $self-> {rowUnits} ? $self-> topCell( $scr-> value + $self-> {cellIndents}-> [1]) : $self-> dy( $scr-> value); $self-> {scrollTransaction} &= ~1; } sub HScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction} & 2; $self-> {scrollTransaction} |= 2; $self-> {colUnits} ? $self-> leftCell( $scr-> value + $self-> {cellIndents}-> [0]) : $self-> dx( $scr-> value); $self-> {scrollTransaction} &= ~2; } sub allowChangeCellHeight { return $_[0]-> {constantCellHeight} ? 0 : $_[0]-> {allowChangeCellHeight} unless $#_; my ( $self, $h) = @_; $self-> {allowChangeCellHeight} = $h; } sub allowChangeCellWidth { return $_[0]-> {constantCellWidth} ? 0 : $_[0]-> {allowChangeCellWidth} unless $#_; my ( $self, $w) = @_; $self-> {allowChangeCellWidth} = $w; } sub cellIndents { return wantarray ? @{$_[0]-> {cellIndents}} : [@{$_[0]-> {cellIndents}}] unless $#_; my ( $self, @indents) = @_; @indents = @{$indents[0]} if ( scalar(@indents) == 1) && ( ref($indents[0]) eq 'ARRAY'); for ( @indents) { $_ = 0 if $_ < 0; } if ( $indents[2] + $indents[0] > $self-> {columns}) { $indents[2] = $self-> {columns} - $indents[0]; if ( $indents[2] < 0) { $indents[2] = 0; $indents[0] = $self-> {columns}; } } if ( $indents[3] + $indents[1] > $self-> {columns}) { $indents[3] = $self-> {rows} - $indents[1]; if ( $indents[3] < 0) { $indents[3] = 0; $indents[1] = $self-> {rows}; } } $self-> {leftCell} += $indents[0] - $self-> {cellIndents}-> [0]; $self-> {topCell} += $indents[1] - $self-> {cellIndents}-> [1]; $self-> {focusedCell}-> [0] += $indents[0] - $self-> {cellIndents}-> [0]; $self-> {focusedCell}-> [1] += $indents[1] - $self-> {cellIndents}-> [1]; $self-> {cellIndents} = \@indents; $self-> reset; $self-> repaint; } sub clipCells { return $_[0]-> {clipCells} unless $#_; $_[0]-> {clipCells} = $_[1]; } sub colorIndex { my ( $self, $index, $color) = @_; if ( $#_ < 2) { return $self-> {gridColor} if $index == ci::Grid; return $self-> {indentCellColor} if $index == ci::IndentCellFore; return $self-> {indentCellBackColor} if $index == ci::IndentCellBack; return $self-> SUPER::colorIndex( $index) } else { my $notify = 1; if ( $index == ci::Grid) { $self-> gridColor( $color); } elsif ( $index == ci::IndentCellFore) { $self-> indentCellColor( $color); } elsif ( $index == ci::IndentCellBack) { $self-> indentCellBackColor( $color); } else { $self-> SUPER::colorIndex( $index, $color); $notify = 0; } $self-> notify(q(ColorChanged), $index) if $notify; } } sub columns { return $_[0]-> {columns} unless $#_; my ( $self, $c) = @_; my $lim = $self-> {cellIndents}-> [0] + $self-> {cellIndents}-> [2]; $lim = 1 if $lim < 1; $c = $lim if $c < $lim; $self-> {columns} = $c; $self-> reset; my @f = $self-> focusedCell; $self-> focusedCell( $c - $self-> {cellIndents}-> [2] - 1, $f[1]) if $f[0] >= $c - $self-> {cellIndents}-> [2]; $self-> reset; $self-> repaint; } sub columnWidth { my ( $self, $col, $width) = @_; if ( $#_ <= 1) { return $self-> {constantCellWidth} if $self-> {constantCellWidth}; return $self-> {geometry_cache_column}-> {$col} if $self-> {cache_geometry_requests} && exists $self-> {geometry_cache}-> {$col}; my $ref = 0; $self-> notify(q(Measure), 0, $col, \$ref); $ref = 1 if $ref < 1; $self-> {geometry_cache_column}-> {$col} = $ref if $self-> {cache_geometry_requests}; return $ref; } elsif ( !$self-> {constantCellWidth}) { $self-> notify(q(SetExtent), 0, $col, $width); $self-> reset; $self-> repaint; } else { $self-> constantCellWidth( $width); } } sub constantCellHeight { return $_[0]-> {constantCellHeight} unless $#_; my ( $self, $h) = @_; return if !defined( $self-> {constantCellHeight}) && !defined $h; return if defined($self-> {constantCellHeight}) && defined($h) && $self-> {constantCellHeight} == $h; $h = 1 if defined $h && $h < 1; $self-> {constantCellHeight} = $h; $self-> reset; $self-> repaint; } sub constantCellWidth { return $_[0]-> {constantCellWidth} unless $#_; my ( $self, $w) = @_; return if !defined( $self-> {constantCellWidth}) && !defined $w; return if defined($self-> {constantCellWidth}) && defined($w) && $self-> {constantCellWidth} == $w; $w = 1 if defined $w && $w < 1; $self-> {constantCellWidth} = $w; $self-> reset; $self-> repaint; } sub drawHGrid { return $_[0]-> {drawHGrid} unless $#_; my ( $self, $dh) = @_; $dh = $dh ? 1 : 0; return if $dh == $self-> {drawHGrid}; $self-> {drawHGrid} = $dh; $self-> reset; $self-> repaint; } sub drawVGrid { return $_[0]-> {drawVGrid} unless $#_; my ( $self, $dv) = @_; $dv = $dv ? 1 : 0; return if $dv == $self-> {drawVGrid}; $self-> {drawVGrid} = $dv; $self-> reset; $self-> repaint; } sub dx { return $_[0]-> {dx} unless $#_; my ( $self, $dx) = @_; return if $self-> {colUnits}; my @size = $self-> size; my @a = $self-> get_active_area(0, @size); my $w = $a[2] - $a[0]; $dx = 0 if $dx < 0; $dx = $self-> {colSpan} - $w if $dx > $self-> {colSpan} - $w; my $delta = $self-> {dx} - $dx; $self-> {dx} = $dx; if ( $self-> {hScroll} && !($self-> {scrollTransaction} & 2)) { $self-> {scrollTransaction} |= 2; $self-> {hScrollBar}-> value($dx); $self-> {scrollTransaction} &= ~2; } $self-> scroll( $delta, 0, clipRect => \@a); my @info = $self-> get_screen_cell_info( $self-> focusedCell); $self-> invalidate_rect( @info[ gsci::V_RECT] ) if scalar @info; } sub dy { return $_[0]-> {dy} unless $#_; my ( $self, $dy) = @_; return if $self-> {rowUnits}; my @size = $self-> size; my @a = $self-> get_active_area(0, @size); my $h = $a[3] - $a[1]; $dy = 0 if $dy < 0; $dy = $self-> {rowSpan} - $h if $dy > $self-> {rowSpan} - $h; my $delta = $dy - $self-> {dy}; $self-> {dy} = $dy; if ( $self-> {vScroll} && !($self-> {scrollTransaction} & 1)) { $self-> {scrollTransaction} |= 1; $self-> {vScrollBar}-> value($dy); $self-> {scrollTransaction} &= ~1; } $self-> scroll( 0, $delta, clipRect => \@a); my @info = $self-> get_screen_cell_info( $self-> focusedCell); $self-> invalidate_rect( gsci::V_RECT ) if scalar @info; } sub focusedCell { return @{$_[0]-> {focusedCell}} unless $#_; my ( $self, @f) = @_; @f = @{$f[0]} if ( scalar(@f) == 1) && ( ref($f[0]) eq 'ARRAY'); my @in = @{$self-> {cellIndents}}; my ( $c, $r) = ( $self-> {columns}, $self-> {rows}); $f[0] = $in[0] if $f[0] < $in[0]; $f[1] = $in[1] if $f[1] < $in[1]; $f[0] = $c - $in[2] - 1 if $f[0] >= $c - $in[2]; $f[1] = $r - $in[3] - 1 if $f[1] >= $r - $in[3]; my @o = @{$self-> {focusedCell}}; return if $o[0] == $f[0] && $o[1] == $f[1]; $self-> notify(q(SelectCell), @f); my @old = $self-> get_screen_cell_info( @o); my @new = $self-> get_screen_cell_info( @f); @{$self-> {focusedCell}} = @f; if ( $new[gsci::V_FULL ]) { # the new cell is fully visible, need no scrolling $self-> invalidate_rect( @new[gsci::V_RECT]); $self-> invalidate_rect( @old[gsci::V_RECT]) if @old; } else { my @r = $self-> get_cell_area; my ( $x1, $y1, $x2, $y2) = ( $self-> {leftCell}, $self-> {topCell}, $self-> {leftCell} + $self-> {fullCols} - 1, $self-> {topCell} + $self-> {fullRows} - 1 ); my ( $o, $t) = ( $x1, $y1); $self-> begin_paint_info unless $self-> {NoBulkPaintInfo}; if ( $f[0] > $x2) { $o = $f[0]; my $maxw = $r[2] - $r[0] + 1 - $self-> columnWidth( $o) - $self-> {drawVGrid}; while ( 1) { $maxw -= $self-> columnWidth( $o - 1) + $self-> {drawVGrid}; last if $maxw < 0; $o--; } } elsif ( $f[0] < $x1) { $o = $f[0]; } if ( $f[1] > $y2) { $t = $f[1]; my $maxh = $r[3] - $r[1] + 1 - $self-> rowHeight( $t) - $self-> {drawHGrid}; while ( 1) { $maxh -= $self-> rowHeight( $t - 1) + $self-> {drawHGrid}; last if $maxh < 0; $t--; } } elsif ( $f[1] < $y1) { $t = $f[1]; } $self-> end_paint_info unless $self-> {NoBulkPaintInfo}; $self-> leftCell( $o); $self-> topCell( $t); @old = $self-> get_screen_cell_info( @o); @new = $self-> get_screen_cell_info( @f); $self-> invalidate_rect( @new[gsci::V_RECT]) if @new; $self-> invalidate_rect( @old[gsci::V_RECT]) if @old; } } sub gridColor { return $_[0]-> {gridColor} unless $#_; my ( $self, $gc) = @_; return if $gc == $self-> {gridColor}; $self-> {gridColor} = $gc; $self-> repaint if $self-> {drawVGrid} || $self-> {drawHGrid}; } sub gridGravity { return $_[0]-> {gridGravity} unless $#_; my ( $self, $gg) = @_; $gg = 0 if $gg < 0; $self-> {gridGravity} = $gg; } sub indentCellBackColor { return $_[0]-> {indentCellBackColor} unless $#_; my ( $self, $c) = @_; return if $c == $self-> {indentCellBackColor}; $self-> {indentCellBackColor} = $c; $self-> repaint if grep { $_ > 0 } @{$self-> {cellIndents}}; } sub indentCellColor { return $_[0]-> {indentCellColor} unless $#_; my ( $self, $c) = @_; return if $c == $self-> {indentCellColor}; $self-> {indentCellColor} = $c; $self-> repaint if grep { $_ > 0 } @{$self-> {cellIndents}}; } sub leftCell { return $_[0]-> {leftCell} unless $#_; my ( $self, $c) = @_; return if defined( $self-> {mouseTransaction}) && $self-> {mouseTransaction} == 2; $c = $self-> {cellIndents}-> [0] if $c < $self-> {cellIndents}-> [0]; $c = $self-> {colMax} if $c > $self-> {colMax}; return if $c == $self-> {leftCell}; my ( $old, $unit, $span, $dv) = ( $self-> {leftCell}, $self-> {colUnits}, $self-> {colSpan}, $self-> {drawVGrid}); my @a = $self-> get_active_area( 0); my $width = $a[2] - $a[0] - $self-> {pixelCellIndents}-> [0] - $self-> {pixelCellIndents}-> [2]; $self-> {leftCell} = $c; $self-> reset; # see if the geometry changed too much after the reset if ( $unit != $self-> {colUnits}) { $self-> invalidate_rect( @a); return; } # When units are pixels, no scrolling can be done, just effective repaints. if ( !$unit) { $a[0] += $self-> {pixelCellIndents}-> [0]; $self-> invalidate_rect( @a); return; } # see if can do scrolling - calculate distance between # current and new x coordinates, not too far though my $w = 0; my $i = $old; $self-> begin_paint_info unless $self-> {NoBulkPaintInfo}; if ( $i < $c) { while ( $w < $width && $i < $c) { $w += $self-> columnWidth( $i++) + $dv; } } else { while ( $w < $width && $i > $c) { $w += $self-> columnWidth( --$i) + $dv; } } $self-> end_paint_info unless $self-> {NoBulkPaintInfo}; $a[0] += $self-> {pixelCellIndents}-> [0]; $a[2] -= $self-> {pixelCellIndents}-> [2] + $dv; if ( $w < $width) { $w *= -1 if $old < $c; $self-> scroll( $w, 0, clipRect => \@a); } else { $self-> invalidate_rect( @a); } } sub multiSelect { return $_[0]-> {multiSelect} unless $#_; my ( $self, $ms) = @_; return if $ms == $self-> {multiSelect}; $self-> selection(-1,-1,-1,-1) if $self-> {multiSelect}; $self-> {multiSelect} = $ms; } sub rows { return $_[0]-> {rows} unless $#_; my ( $self, $r) = @_; my $lim = $self-> {cellIndents}-> [1] + $self-> {cellIndents}-> [3]; $lim = 1 if $lim < 1; $r = $lim if $r < $lim; $self-> {rows} = $r; $self-> reset; my @f = $self-> focusedCell; $self-> focusedCell( $f[0], $r - $self-> {cellIndents}-> [3] - 1) if $f[1] >= $r - $self-> {cellIndents}-> [3]; $self-> reset; $self-> repaint; } sub topCell { return $_[0]-> {topCell} unless $#_; my ( $self, $c) = @_; return if defined( $self-> {mouseTransaction}) && $self-> {mouseTransaction} == 3; $c = $self-> {cellIndents}-> [1] if $c < $self-> {cellIndents}-> [1]; $c = $self-> {rowMax} if $c > $self-> {rowMax}; return if $c == $self-> {topCell}; my ( $old, $unit, $span, $dh) = ( $self-> {topCell}, $self-> {rowUnits}, $self-> {rowSpan}, $self-> {drawHGrid}); my @a = $self-> get_active_area( 0); my $height = $a[3] - $a[1] - $self-> {pixelCellIndents}-> [3] - $self-> {pixelCellIndents}-> [1]; $self-> {topCell} = $c; $self-> reset; # see if the geometry changed too much after the reset if ( $unit != $self-> {rowUnits}) { $self-> invalidate_rect( @a); return; } # When units are pixels, no scrolling can be done, just effective repaints. if ( !$unit) { $a[3] -= $self-> {pixelCellIndents}-> [1]; $self-> invalidate_rect( @a); return; } # see if can do scrolling - calculate distance between # current and new x coordinates, not too far though my $h = 0; my $i = $old; $self-> cache_geometry_requests(1); if ( $i < $c) { while ( $h < $height && $i < $c) { $h += $self-> rowHeight( $i++) + $dh; } } else { while ( $h < $height && $i > $c) { $h += $self-> rowHeight( --$i) + $dh; } } $self-> cache_geometry_requests(0); $a[1] += $self-> {pixelCellIndents}-> [3] + $dh; $a[3] -= $self-> {pixelCellIndents}-> [1]; if ( $h < $height) { $h *= -1 if $old > $c; $self-> scroll( 0, $h, clipRect => \@a); } else { $self-> invalidate_rect( @a); } } sub rowHeight { my ( $self, $row, $height) = @_; if ( $#_ <= 1) { return $self-> {constantCellHeight} if $self-> {constantCellHeight}; return $self-> {geometry_cache_row}-> {$row} if $self-> {cache_geometry_requests} && exists $self-> {geometry_cache}-> {$row}; my $ref = 0; $self-> notify(q(Measure), 1, $row, \$ref); $ref = 1 if $ref < 1; $self-> {geometry_cache_row}-> {$row} = $ref if $self-> {cache_geometry_requests}; return $ref; } elsif ( !$self-> {constantCellHeight}) { $self-> notify(q(SetExtent), 1, $row, $height); $self-> reset; $self-> repaint; } else { $self-> constantCellHeight( $height); } } sub selection { return $_[0]-> {multiSelect} ? @{$_[0]-> {selection}} : (@{$_[0]-> {focusedCell}}, @{$_[0]-> {focusedCell}}) unless $#_; return unless $_[0]-> {multiSelect}; my ( $self, $x1, $y1, $x2, $y2) = @_; ( $x1, $x2) = ( $x2, $x1) if $x1 > $x2; ( $y1, $y2) = ( $y2, $y1) if $y1 > $y2; my @in = @{$self-> {cellIndents}}; my ( $c, $r) = ( $self-> {columns}, $self-> {rows}); if ( $x1 < 0 || $y1 < 0 || $x2 < 0 || $y2 < 0) { $x1 = $y1 = $x2 = $y2 = -1; } else { $x1 = $in[0] if $x1 < $in[0]; $x1 = $c - $in[2] - 1 if $x1 >= $c - $in[2]; $x2 = $in[0] if $x2 < $in[0]; $x2 = $c - $in[2] - 1 if $x2 >= $c - $in[2]; $y1 = $in[1] if $y1 < $in[1]; $y1 = $r - $in[3] - 1 if $y1 >= $r - $in[3]; $y2 = $in[1] if $y2 < $in[1]; $y2 = $r - $in[3] - 1 if $y2 >= $r - $in[3]; } my ( $ox1, $oy1, $ox2, $oy2) = @{$self-> {selection}}; return if $x1 == $ox1 && $y1 == $oy1 && $x2 == $ox2 && $y2 == $oy2; $self-> {selection} = [$x1, $y1, $x2, $y2]; # union cell change $x1 = $ox1 if $x1 > $ox1; $x2 = $ox2 if $x2 < $ox2; $y1 = $oy1 if $y1 > $oy1; $y2 = $oy2 if $y2 < $oy2; # intersect with screen cells, leave if the result is empty $ox1 = $self-> {leftCell}; $oy1 = $self-> {topCell}; $ox2 = $ox1 + $self-> {visibleCols}; $oy2 = $oy1 + $self-> {visibleRows}; return if $x1 > $ox2 || $x2 < $ox1 || $y1 > $oy2 || $y2 < $oy1; $x1 = $ox1 if $x1 < $ox1; $x2 = $ox2 if $x2 > $ox2; $y1 = $oy1 if $y1 < $oy1; $y2 = $oy2 if $y2 > $oy2; # normalize ( $x1, $x2) = ( $x2, $x1) if $x1 > $x2; ( $y1, $y2) = ( $y2, $y1) if $y1 > $y2; # get pixel coordinates my @info1 = $self-> get_screen_cell_info( $x1, $y2); my @info2 = $self-> get_screen_cell_info( $x2, $y1); if ( @info1 && @info2) { $self-> invalidate_rect( @info1[gsci::V_LEFT,gsci::V_BOTTOM], @info2[gsci::V_RIGHT,gsci::V_TOP] ); } else { $self-> repaint; } } package Prima::AbstractGrid; use vars qw(@ISA); @ISA = qw(Prima::AbstractGridViewer); sub draw_cells { shift-> std_draw_text_cells(@_); } sub on_fontchanged { my $self = $_[0]; $self-> constantCellHeight( $self-> font-> height + 2 ) if $self-> constantCellHeight; } sub on_getrange { my ( $self, $column, $index, $min, $max) = @_; $$min = $self-> font-> height + 2 unless $column; } sub on_measure { my ( $self, $col, $row, $sref) = @_; $$sref = $self-> get_text_width( $self-> get_cell_text( $col, $row), 1); } package Prima::GridViewer; use vars qw(@ISA); @ISA = qw(Prima::AbstractGridViewer); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( allowChangeCellHeight => 1, allowChangeCellWidth => 1, cells => [['']], ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; $self-> {cells} = []; $self-> {widths} = []; $self-> {heights} = []; my %profile = $self-> SUPER::init(@_); $self-> cells($profile{cells}); return %profile; } sub columnWidth { my ( $self, $col, $width) = @_; if ( $#_ <= 1) { unless ( defined $self-> {widths}-> [$col]) { if ( defined $self-> {constantCellWidth}) { $self-> {widths}-> [$col] = $self-> {constantCellWidth}; } else { my $ref = 0; $self-> notify(q(Measure), 0, $col, \$ref); $ref = 1 if $ref < 1; $self-> {widths}-> [$col] = $ref; } } return $self-> {widths}-> [$col]; } elsif ( !$self-> {constantCellWidth}) { $width = 1 if $width < 1; return if defined($self-> {widths}-> [$col]) && $width == $self-> {widths}-> [$col]; $self-> {widths}-> [$col] = $width; $self-> notify(q(SetExtent), 0, $col, $width); $self-> reset; $self-> repaint; } else { $self-> constantCellWidth( $width); } } sub rowHeight { my ( $self, $row, $height) = @_; if ( $#_ <= 1) { unless ( defined $self-> {heights}-> [$row]) { if ( defined $self-> {constantCellHeight}) { $self-> {heights}-> [$row] = $self-> {constantCellHeight}; } else { my $ref = 0; $self-> notify(q(Measure), 1, $row, \$ref); $ref = 1 if $ref < 1; $self-> {heights}-> [$row] = $ref; } } return $self-> {heights}-> [$row]; } elsif ( !$self-> {constantCellHeight}) { $height = 1 if $height < 1; return if defined($self-> {heights}-> [$row]) && $height == $self-> {heights}-> [$row]; $self-> {heights}-> [$row] = $height; $self-> notify(q(SetExtent), 1, $row, $height); $self-> reset; $self-> repaint; } else { $self-> constantCellHeight( $height); } } sub columns { return $_[0]-> {columns} unless $#_; $_[0]-> raise_ro('columns'); } sub rows { return $_[0]-> {rows} unless $#_; $_[0]-> raise_ro('rows'); } sub constantCellWidth { return $_[0]-> {constantCellWidth} unless $#_; my ( $self, $w) = @_; $self-> {widths} = [( $self-> {constantCellWidth} ) x $self-> {columns}]; $self-> SUPER::constantCellWidth( $w); } sub constantCellHeight { return $_[0]-> {constantCellHeight} unless $#_; my ( $self, $h) = @_; $self-> {heights} = [( $self-> {constantCellHeight} ) x $self-> {rows}]; $self-> SUPER::constantCellHeight( $h); } sub cell { my ( $self, $x, $y, $data) = @_; my ( $r, $c) = ( $self-> {rows}, $self-> {columns}); return if $x < 0 || $x >= $c || $y < 0 || $y >= $c; if ( $#_ <= 2) { return $self-> {cells}-> [$y]-> [$x]; } else { $self-> {cells}-> [$y]-> [$x] = $data; } } sub cells { return map { [ @$_ ] } @{$_[0]-> {cells}} unless $#_; my ( $self, @cells) = @_; @cells = @{$cells[0]} if ( scalar(@cells) == 1) && ( ref($cells[0]) eq 'ARRAY'); $self-> {cells} = \@cells; $self-> SUPER::columns( scalar @{$cells[0]}); $self-> SUPER::rows( scalar @cells); $self-> {widths} = [( $self-> {constantCellWidth} ) x $self-> {columns}]; $self-> {heights} = [( $self-> {constantCellHeight} ) x $self-> {rows}]; } sub add_column { my $self = shift; $self-> insert_column( $self-> {columns}, @_); } sub add_columns { my $self = shift; $self-> insert_columns( $self-> {columns}, @_); } sub add_row { my $self = shift; $self-> insert_row( $self-> {rows}, @_); } sub add_rows { my $self = shift; $self-> insert_rows( $self-> {rows}, @_); } sub delete_columns { my ( $self, $column, $how_many) = @_; my $c = $self-> {columns}; $column = $c if $column > $c; splice( @$_, $column, $how_many) for @{$self-> {cells}}; splice( @{$self-> {widths}}, $column, $how_many); $self-> SUPER::columns( scalar @{$self-> {cells}-> [0]}); } sub delete_rows { my ( $self, $row, $how_many) = @_; my $r = $self-> {rows}; $row = $r if $row > $r; splice( @{$self-> {cells}}, $row, $how_many); splice( @{$self-> {heights}}, $row, $how_many); $self-> SUPER::rows( scalar @{$self-> {cells}}); } sub insert_column { my ( $self, $column, @cells) = @_; my $c = $self-> {columns}; $column = $c if $column > $c; my $i; my $lim = ( scalar(@cells) < $c) ? scalar(@cells) : $c; for ( $i = 0; $i < $lim; $i++) { $c = $self-> {cells}-> [$i]; splice( @$c, $column, 0, $cells[$i]); } splice( @{$self-> {widths}}, $column, 0, $self-> {constantCellWidths}); $self-> SUPER::columns( scalar @{$self-> {cells}-> [0]}); } sub insert_columns { my ( $self, $column, @cells) = @_; my $c = $self-> {columns}; $column = $c if $column > $c; my $i; my $lim = ( scalar(@cells) < $c) ? scalar(@cells) : $c; for ( $i = 0; $i < $lim; $i++) { $c = $self-> {cells}-> [$i]; splice( @$c, $column, 0, @{$cells[$i]}); } splice( @{$self-> {widths}}, $column, 0, ( $self-> {constantCellWidths} ) x scalar(@cells)); $self-> SUPER::columns( scalar @{$self-> {cells}-> [0]}); } sub insert_row { my ( $self, $row, @cells) = @_; my $r = $self-> {rows}; $row = $r if $row > $r; splice( @{$self-> {cells}}, $row, 0, [@cells]); splice( @{$self-> {heights}}, $row, 0, $self-> {constantCellHeight}); $self-> SUPER::rows( scalar @{$self-> {cells}}); } sub insert_rows { my ( $self, $row, @cells) = @_; my $r = $self-> {rows}; $row = $r if $row > $r; splice( @{$self-> {cells}}, $row, 0, @cells); splice( @{$self-> {heights}}, $row, 0, ( $self-> {constantCellHeight} ) x scalar(@cells)); $self-> SUPER::rows( scalar @{$self-> {cells}}); } package Prima::Grid; use vars qw(@ISA); @ISA = qw(Prima::GridViewer); sub draw_cells { shift-> std_draw_text_cells(@_); } sub get_cell_text { my ( $self, $col, $row) = @_; return $self-> {cells}-> [$row]-> [$col]; } sub on_getrange { my ( $self, $column, $index, $min, $max) = @_; $$min = $self-> font-> height + 2 unless $column; } sub on_fontchanged { my $self = $_[0]; $self-> constantCellHeight( $self-> font-> height + 2 ) if $self-> constantCellHeight; } sub on_measure { my ( $self, $column, $index, $sref) = @_; if ( $column) { $$sref = $self-> get_text_width( $self-> {cells}-> [0]-> [$index], 1); } else { $$sref = $self-> font-> height + 2; } } sub on_stringify { my ( $self, $col, $row, $sref) = @_; $$sref = $self-> {cells}-> [$row]-> [$col]; } 1; =pod =head1 NAME Prima::Grids - grid widgets =head2 SYNOPSIS use Prima::Grids; $grid = Prima::Grid-> create( cells => [ [qw(1.First 1.Second 1.Third)], [qw(2.First 2.Second 2.Third)], [qw(3.First 3.Second 3.Third)], ], onClick => sub { print $_[0]-> get_cell_text( $_[0]-> focusedCell), " is selected\n"; } ); =head1 DESCRIPTION The module provides classes for several abstraction layers of grid representation. The classes hierarchy is as follows: AbstractGridViewer AbstractGrid GridViewer Grid The root class, C, provides common interface, while by itself it is not directly usable. The main differences between classes are centered around the way the cell data are stored. The simplest organization of a text-only cell, provided by C, stores data as a two-dimensional array of text scalars. More elaborated storage and representation types are not realized, and the programmer is urged to use the more abstract classes to derive own mechanisms. To organize an item storage, different from C, it is usually enough to overload either the C, C, and C events, or their method counterparts: C, C, C, and C. The grid widget is designed to contain cells of variable extents, of two types, normal and indent. The indent rows and columns are displayed in grid margins, and their cell are drawn with distinguished colors. An example use for a bottom indent row is a sum row in a spreadsheet application; the top indent row can be used for displaying columns' headers. The normal cells can be selected by the user, scrolled, and selected. The cell selection can only contain rectangular areas, and therefore is operated with two integer pairs with the beginning and the end of the selection. The widget operates in two visual scrolling modes; when the space allows, the scrollbars affect the leftmost and the topmost cell. When the widget is not large enough to accommodate at least one cell and all indent cells, the layout is scrolled pixel-wise. These modes are named 'cell' and 'pixel', after the scrolling units. The widget allows the interactive changing of cell widths and heights by dragging the grid lines between the cells. =head1 Prima::AbstractGridViewer C, the base for all grid widgets in the module, provides interface to generic grid browsing functionality, plus functionality for text-oriented grids. The class is not usable directly. C is a descendant of C, and some properties are not described here. See L. =head2 Properties =over =item allowChangeCellHeight BOOLEAN If 1, the user is allowed to change vertical extents of cells by dragging the horizontal grid lines. Prerequisites to the options are: the lines must be set visible via C property, C property set to 0, and the changes to the vertical extents can be recorded via C notification. Default value: 0 =item allowChangeCellWidth BOOLEAN If 1, the user is allowed to change horizontal extents of cells by dragging the horizontal grid lines. Prerequisites to the options are: the lines must be set visible via C property, C property set to 0, and the changes to the horizontal extents can be recorded via C notification. Default value: 0 =item cellIndents X1, Y1, X2, Y2 Marks the marginal rows and columns as 'indent' cells. The indent cells are drawn with another color pair ( see L, L ), cannot be selected and scrolled. X1 and X2 correspond to amount of indent columns, and Y1 and Y2, - to the indent rows. C and C do not count the indent cells as the leftmost or topmost visible cell; in other words, X1 and Y1 are minimal values for C and C properties. Default value: 0,0,0,0 =item clipCells INTEGER A three-state integer property, that governs the way clipping is applied when cells are drawn. Depending on kind of graphic in cells, the clipping may be necessary, or unnecessary. If the value is 1, the clipping is applied for every column drawn, as the default drawing routines proceed column-wise. If the value is 2, the clipping as applied for every cell. This setting reduces the drawing speed significantly. If the value is 0, no clipping is applied. This property is destined for custom-drawn grid widgets, when it is the developer's task to decide what kind of clipping suits better. Text grid widgets, C and C, are safe with C set to 1. Default value: 1 =item columns INTEGER Sets number of columns, including the indent columns. The number of columns must be larger than the number of indent columns. Default value: 0. =item columnWidth COLUMN [ WIDTH ] A run-time property, selects width of a column. To acquire or set the width, C and C notifications can be invoked. Result of C may be cached internally using C method. The width does not include widths of eventual vertical grid lines. If C is defined, the property is used as its alias. =item constantCellHeight HEIGHT If defined, all rows have equal height, HEIGHT pixels. If C, rows have different heights. Default value: undef =item constantCellWidth WIDTH If defined, all rows have equal width, WIDTH pixels. If C, columns have different widths. Default value: undef =item drawHGrid BOOLEAN If 1, horizontal grid lines between cells are drawn with C. Default value: 1 =item drawVGrid If 1, vertical grid lines between cells are drawn with C. Default value: 1 =item dx INTEGER A run-time property. Selects horizontal offset in pixels of grid layout in pixel mode. =item dy INTEGER A run-time property. Selects vertical offset in pixels of grid layout in pixel mode. =item focusedCell X, Y Selects coordinates or the focused cell. =item gridColor COLOR Selects the color of grid lines. Default value: C . =item gridGravity INTEGER The property selects the breadth of area around the grid lines, that reacts on grid-dragging mouse events. The minimal value, 0, marks only grid lines as the drag area, but makes the dragging operation inconvenient for the user. Larger values make the dragging more convenient, but increase the chance that the user will not be able to select too narrow cells with the mouse. Default value: 3 =item indentCellBackColor COLOR Selects the background color of indent cells. Default value: C . =item indentCellColor Selects the foreground color of indent cells. Default value: C . =item leftCell INTEGER Selects index of the leftmost visible normal cell. =item multiSelect BOOLEAN If 1, the normal cells in an arbitrary rectangular area can be marked as selected ( see L ). If 0, only one cell at a time can be selected. Default value: 0 =item rows INTEGER Sets number of rows, including the indent rows. The number of rows must be larger than the number of indent rows. Default value: 0. =item topCell Selects index of the topmost visible normal cell. =item rowHeight INTEGER A run-time property, selects height of a row. To acquire or set the height, C and C notifications can be invoked. Result of C may be cached internally using C method. The height does not include widths of eventual horizontal grid lines. If C is defined, the property is used as its alias. =item selection X1, Y1, X2, Y2 If C is 1, governs the extents of a rectangular area, that contains selected cells. If no such area is present, selection is (-1,-1,-1,-1), and C returns 0 . If C is 0, in get-mode returns the focused cell, and discards the parameters in the set-mode. =back =head2 Methods =over =item cache_geometry_requests CACHE If CACHE is 1, starts caching results of C notification, thus lighting the subsequent C and C calls; if CACHE is 0, flushes the cache. If a significant geometry change was during the caching, the cache is not updated, so it is the caller's responsibility to flush the cache. =item deselect_all Nullifies the selection, if C is 1. =item draw_cells CANVAS, COLUMNS, ROWS, AREA A bulk draw routine, called from C to draw cells. AREA is an array of four integers with inclusive-inclusive coordinates of the widget inferior without borders and scrollbars ( result of C call; see L ). COLUMNS and ROWS are structures that reflect the columns and rows of the cells to be drawn. Each item in these corresponds to a column or row, and is an array with the following layout: 0: column or row index 1: type; 0 - normal cell, 1 - indent cell 2: visible cell breadth 3: visible cell start 4: visible cell end 5: real cell start 6: real cell end The coordinates are in inclusive-inclusive coordinate system, and do not include eventual grid space, nor gaps between indent and normal cells. By default, internal arrays C<{colsDraw}> and C<{rowsDraw}> are passed as COLUMNS and ROWS parameters. In C and C classes is overloaded to transfer the call to C, the text-oriented optimized routine. =item draw_text_cells SCREEN_RECTANGLES, CELL_RECTANGLES, CELL_INDECES, FONT_HEIGHT A bulk routine for drawing text cells, called from C . SCREEN_RECTANGLES and CELL_RECTANGLES are arrays, where each item is a rectangle with exterior of a cell. SCREEN_RECTANGLES contains rectangles that cover the cell visible area; CELL_RECTANGLES contains rectangles that span the cell extents disregarding its eventual partial visibility. For example, a 100-pixel cell with only its left half visible, would contain corresponding arrays [150,150,200,250] in SCREEN_RECTANGLES, and [150,150,250,250] in CELL_RECTANGLES. CELL_INDECES contains arrays of the cell coordinates; each array item is an array of integer pair where item 0 is column, and item 1 is row of the cell. FONT_HEIGHT is a current font height value, cached since C is often used for text operations and may require vertical text justification. =item get_cell_area [ WIDTH, HEIGHT ] Returns screen area in inclusive-inclusive pixel coordinates, that is used to display normal cells. The extensions are related to the current size of a widget, however, can be overridden by specifying WIDTH and HEIGHT. =item get_cell_text COLUMN, ROW Returns text string assigned to cell in COLUMN and ROW. Since the class does not assume the item storage organization, the text is queried via C notification. =item get_range AXIS, INDEX Returns a pair of integers, minimal and maximal breadth of INDEXth column or row in pixels. If AXIS is 1, the rows are queried; if 0, the columns. The method calls C notification. =item get_screen_cell_info COLUMN, ROW Returns information about a cell in COLUMN and ROW, if it is currently visible. The returned parameters are indexed by C constants, and explained below: gsci::COL_INDEX - visual column number where the cell displayed gsci::ROW_INDEX - visual row number where the cell displayed gsci::V_FULL - cell is fully visible gsci::V_LEFT - inclusive-inclusive rectangle of the visible gsci::V_BOTTOM part of the cell. These four indices are grouped gsci::V_RIGHT under list constant, gsci::V_RECT. gsci::V_TOP gsci::LEFT - inclusive-inclusive rectangle of the cell, as if gsci::BOTTOM it is fully visible. These four indices are grouped gsci::RIGHT under list constant, gsci::RECT. If gsci::V_FULL gsci::TOP is 1, these values are identical to these in gsci::V_RECT. If the cell is not visible, returns empty array. =item has_selection Returns a boolean value, indicating whether the grid contains a selection (1) or not (0). =item point2cell X, Y, [ OMIT_GRID = 0 ] Return information about point X, Y in widget coordinates. The method returns two integers, CX and CY, with cell coordinates, and eventual HINTS hash, with more information about pixe localtion. If OMIT_GRID is set to 1 and the pixel belongs to a grid, the pixels is treated a part of adjacent cell. The call syntax: ( $CX, $CY, %HINTS) = $self->point2cell( $X, $Y); If the pixel lies within cell boundaries by either coordinate, CX and/or CY are correspondingly set to cell column and/or row. When the pixel is outside cell space, CX and/or CY are set to -1. HINTS may contain the following values: =over =item C and C If 0, the coordinate lies within boundaries of a cell. If -1, the coordinate is on the left/top to the cell body. If +1, the coordinate is on the right/bottom to the cell body, but within the widget. If +2, the coordinate is on the right/bottom to the cell body, but outside the widget. =item C and C Present when C or C values are 0. If 0, the cell is a normal cell. If -1, the cell is left/top indent cell. If +1, the cell is right/bottom indent cell. =item C and C If 1, the point is over a grid line. This case can only happen when OMIT_GRID is 0. If C and/or C are set, treats also C-broad pixels strips on both sides of the line as the grid area. Also values of C/C or C/C might be set. =item C/C and C/C Present together with C or C. Select indices of cells adjacent to the grid line. =item C and C If 1, the point is within a gap between the last normal cell and the first right/bottom indent cell. =item C If 1, the point lies within the boundaries of a normal cell. =item C If 1, the point lies within the boundaries of an indent cell. =item C If 1, the point is over a grid line. =item C If 1, the point is in inoperable area or outside the widget boundaries. =back =item redraw_cell X, Y Repaints cell with coordinates X and Y. =item reset Recalculates internal geometry variables. =item select_all Marks all cells as selected, if C is 1. =item std_draw_text_cells CANVAS, COLUMNS, ROWS, AREA An optimized bulk routine for text-oriented grid widgets. The optimization is achieved under assumption that each cell is drawn with two colors only, so the color switching can be reduced. The routine itself paints the cells background, and calls C to draw text and/or otherwise draw the cell content. For explanation of COLUMNS, ROWS, and AREA parameters see L . =back =head2 Events =over =item DrawCell CANVAS, COLUMN, ROW, INDENT, @SCREEN_RECT, @CELL_RECT, SELECTED, FOCUSED Called when a cell with COLUMN and ROW coordinates is to be drawn on CANVAS. SCREEN_RECT is a cell rectangle in widget coordinates, where the item is to be drawn. CELL_RECT is same as SCREEN_RECT, but calculated as if the cell is fully visible. SELECTED and FOCUSED are boolean flags, if the cell must be drawn correspondingly in selected and focused states. =item GetRange AXIS, INDEX, MIN, MAX Puts minimal and maximal breadth of INDEXth column ( AXIS = 0 ) or row ( AXIS = 1) in corresponding MIN and MAX scalar references. =item Measure AXIS, INDEX, BREADTH Puts breadth in pixels of INDEXth column ( AXIS = 0 ) or row ( AXIS = 1) into BREADTH scalar reference. This notification by default may be called from within C brackets. To disable this feature set internal flag C<{NoBulkPaintInfo}> to 1. =item SelectCell COLUMN, ROW Called when a cell with COLUMN and ROW coordinates is focused. =item SetExtent AXIS, INDEX, BREADTH Reports breadth in pixels of INDEXth column ( AXIS = 0 ) or row ( AXIS = 1), as a response to C and C calls. =item Stringify COLUMN, ROW, TEXT_REF Puts text string, assigned to cell with COLUMN and ROW coordinates, into TEXT_REF scalar reference. =back =head1 Prima::AbstractGrid Exactly the same as its ascendant, C, except that it does not propagate C message, assuming that the items must be drawn as text. =head1 Prima::GridViewer The class implements cells data and geometry storage mechanism, but leaves the cell data format to the programmer. The cells are accessible via C property and several other helper routines. The cell data are stored in an array, where each item corresponds to a row, and contains array of scalars, where each corresponds to a column. All data managing routines, that accept two-dimensional arrays, assume that the columns arrays are of the same widths. For example, C<[[1,2,3]]]> is a valid one-row, three-column structure, and C<[[1,2],[2,3],[3,4]]> is a valid three-row, two-column structure. The structure C<[[1],[2,3],[3,4]]> is invalid, since its first row has one column, while the others have two. C is derived from C. =head2 Properties =over =item allowChangeCellHeight Default value: 1 =item allowChangeCellWidth Default value: 1 =item cell COLUMN, ROW, [ DATA ] Run-time property. Selects the data in cell with COLUMN and ROW coordinates. =item cells [ ARRAY ] The property accepts or returns all cells as a two-dimensional rectangular array or scalars. =item columns INDEX A read-only property; returns number of columns. =item rows INDEX A read-only property; returns number of rows. =back =head2 Methods =over =item add_column CELLS Inserts one-dimensional array of scalars to the end of columns. =item add_columns CELLS Inserts two-dimensional array of scalars to the end of columns. =item add_row CELLS Inserts one-dimensional array of scalars to the end of rows. =item add_rows CELLS Inserts two-dimensional array of scalars to the end of rows. =item delete_columns OFFSET, LENGTH Removes LENGTH columns starting from OFFSET. Negative values are accepted. =item delete_rows OFFSET, LENGTH Removes LENGTH rows starting from OFFSET. Negative values are accepted. =item insert_column OFFSET, CELLS Inserts one-dimensional array of scalars as column OFFSET. Negative values are accepted. =item insert_columns OFFSET, CELLS Inserts two-dimensional array of scalars in column OFFSET. Negative values are accepted. =item insert_row Inserts one-dimensional array of scalars as row OFFSET. Negative values are accepted. =item insert_rows Inserts two-dimensional array of scalars in row OFFSET. Negative values are accepted. =back =head1 Prima::Grid Descendant of C, declares format of cells as a single text string. Incorporating all functionality of its ascendants, provides a standard text grid widget. =head2 Methods =over =item get_cell_text COLUMN, ROW Returns text string assigned to cell in COLUMN and ROW. Since the item storage organization is implemented, does so without calling C notification. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, F =cut Prima-1.28/Prima/Header.pm0000644000175100017510000004327411150770061013102 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # Modifications by Anton Berezin # # $Id: Header.pm,v 1.15 2005/10/13 17:22:50 dk Exp $ package Prima::Header; use strict; use Prima::Classes; use vars qw(@ISA); @ISA = qw(Prima::Widget); use constant CaptureBrimWidth => 2; { my %RNT = ( %{Prima::Widget-> notification_types()}, DrawItem => nt::Action, MeasureItem => nt::Action, MoveItem => nt::Action, SizeItem => nt::Action, SizeItems => nt::Action, ); sub notification_types { return \%RNT; } } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( offset => 0, items => [], widths => [], pressed => -1, clickable => 1, scalable => 1, dragable => 1, minTabWidth => 2, vertical => 0, selectable => 0, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; $self-> {$_} = 0 for qw(offset count maxWidth clickable scalable minTabWidth vertical dragable); $self-> {$_} = -1 for qw(pressed); $self-> {widths} = []; $self-> {items} = []; my %profile = $self-> SUPER::init(@_); $self-> {fontHeight} = $self-> font-> height; $self-> {resetDisabled} = 1; $self-> $_( $profile{$_}) for ( qw( vertical minTabWidth items widths offset pressed clickable scalable dragable)); if ( scalar @{$profile{widths}} == 0) { $self-> autowidths; $self-> repaint; } return %profile; } sub on_paint { my ( $self, $canvas) = @_; my @size = $canvas-> size; my @c = $self-> enabled ? ( $self-> color, $self-> backColor) : ( $self-> disabledColor, $self-> disabledBackColor); my @c3d = ( $self-> light3DColor, $self-> dark3DColor); $self-> rect3d( 0, 0, $size[0]-1, $size[1]-1, 1, @c3d, $c[1]); my $v = $self-> {vertical}; my ( $x, $y) = ( - $self-> {offset}, ( $size[1] - $self-> {fontHeight}) / 2); my $i; my $pressed = $self-> {pressed}; @c3d = reverse @c3d if $v; my ( $wx, $cx) = ( $self-> {widths}, $self-> {count}); my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(DrawItem)); $self-> push_event; my ( $d, $lim) = $v ? ( $x, $size[1]) : ( $x, $size[0]); for ( $i = 0; $i < $cx; $i++) { next unless $$wx[$i]; if ( $d + $$wx[$i] + 2 < 1) { $d += $$wx[$i] + 2; next; } my $mx = ( $d + $$wx[$i] + 1 > $lim - 2) ? ($lim - 2) : ($d + $$wx[$i] + 1); $v ? $self-> clipRect( 1, $d < 1 ? 1 : $d, $size[0] - 2, $mx) : $self-> clipRect( $d < 1 ? 1 : $d, 1, $mx, $size[1] - 2); $self-> color( $c[0]); $v ? $notifier-> ( @notifyParms, $canvas, $i, 1, $d + 1, $size[0] - 2, $mx - 1, $d + 4) : $notifier-> ( @notifyParms, $canvas, $i, $d + 1, 1, $mx - 1, $size[1] - 2, $y); if ( $i == $pressed) { $self-> color( $c3d[1]); $v ? $self-> line( $size[0] - 2, $d, $size[0] - 2, $d + $$wx[$i]) : $self-> line( $d, $size[1] - 2, $d + $$wx[$i], $size[1] - 2); } else { $self-> color( $c3d[0]); } $v ? $self-> line( 1, $d, $size[0] - 2, $d) : $self-> line( $d, 1, $d, $size[1] - 2); if ( $i == $pressed) { $self-> color( $c3d[0]); $v ? $self-> line( 1, $d, 1, $d + $$wx[$i]) : $self-> line( $d, 1, $d + $$wx[$i], 1); } else { $self-> color( $c3d[1]); } $d += $$wx[$i] + 1; $v ? $self-> line( 1, $d, $size[0] - 2, $d) : $self-> line( $d, 1, $d, $size[1] - 2); last if $d > $lim - 3; $d++; } $self-> pop_event; } sub on_fontchanged { my $self = $_[0]; $self-> {fontHeight} = $self-> font-> height; } sub on_drawitem { my ( $self, $canvas, $index, $left, $bottom, $right, $top, $y) = @_; $canvas-> text_out( $self-> {items}-> [$index], $left, $y); } sub on_measureitem { my ( $self, $index, $result) = @_; $$result = $self-> {vertical} ? $self-> {fontHeight} : $self-> get_text_width( $self-> {items}-> [$index]); } sub point2area { my ( $self, $x, $y, $useBorders) = @_; my $i; my $pressable = $self-> {clickable} || $self-> {dragable}; return if !$self-> {scalable} && !$pressable; my $lim; if ( $self-> {vertical}) { return undef if ( $x < 1 || $x > $self-> width - 1) && !$useBorders; $lim = $y; } else { return undef if ( $y < 1 || $y > $self-> height - 1) && !$useBorders; $lim = $x; } my $cbw = $self-> {scalable} ? CaptureBrimWidth : 0; my $sx = - $self-> {offset} + 1 + $cbw; my $c = $self-> {count}; my $wx = $self-> {widths}; for ( $i = 0; $i < $c; $i++) { next unless $$wx[$i]; $sx += $$wx[$i] - $cbw * 2; if ( $lim < $sx) { return $pressable ? $i : undef; } $sx += $cbw * 2 + 2; if ( $lim < $sx) { return $self-> {scalable} ? -($i+1) : $i; } } return undef; } sub tab2offset { my ( $self, $item) = @_; my $i; my $c = $self-> {count}; my $x = 1; for ( $i = 0; $i < $item; $i++) { next unless $self-> {widths}-> [$i]; $x += $self-> {widths}-> [$i] + 2; } return $x; } sub tab2rect { my ( $self, $id) = @_; my $offset = $self-> tab2offset( $id) - $self-> {offset} - 1; return $self-> {vertical} ? ( 1, $offset, $self-> width - 1, $offset + $self-> {widths}-> [$id] + 2) : ( $offset, 1, $offset + $self-> {widths}-> [$id] + 2, $self-> height - 1); } sub reset_transaction { my $self = $_[0]; my $lim = $self-> {vertical} ? $self-> height : $self-> width; $self-> {swidth} = $self-> tab2offset( $self-> {tabId}) - $self-> {offset}; $self-> {maxwidth} = $lim - $self-> {swidth} - 2; $self-> {maxwidth} -= $self-> {minTabWidth} if $self-> {tabId} < $self-> {count} - 1; if ( $self-> {swidth} < 0) { $self-> {minwidth} = -$self-> {swidth} - 1; $self-> {minwidth} = $self-> {minTabWidth} if $self-> {minwidth} > $self-> {minTabWidth}; } else { $self-> {minwidth} = $self-> {minTabWidth}; } } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return unless $btn == mb::Left; return if $self-> {transaction}; my $id = $self-> point2area( $x, $y); return unless defined $id; $self-> capture(1); if ( $id < 0) { $self-> {transaction} = 2; $self-> {anchor} = $self-> {vertical} ? $y : $x; $self-> {tabId} = - $id - 1; $self-> {owidth} = $self-> {widths}-> [$self-> {tabId}]; $self-> reset_transaction; } else { $self-> {transaction} = 1; $self-> {tabId} = $id; $self-> pressed( $id); $self-> {clickAllowed} = $self-> {clickable}; $self-> {anchor} = $self-> {vertical} ? $y : $x; $self-> {anchor} -= $self-> tab2offset( $id) - $self-> {offset}; } $self-> {pointerPos} = [$self-> pointerPos]; delete $self-> {pointerSet}; } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return unless $self-> {transaction}; return unless $btn == mb::Left; my $id = $self-> point2area( $x, $y); $self-> capture(0); if ( $self-> {transaction} == 1) { my @a = $self-> tab2rect( $self-> {tabId}); if ( $x >= $a[0] && $x < $a[2] && $y >= $a[1] && $y < $a[3]) { $self-> notify(q(Click), $self-> {tabId}) if $self-> {clickAllowed}; } $self-> pressed(-1); } else { $self-> recalc_maxwidth; } $self-> {transaction} = undef; } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; unless ( $self-> {transaction}) { my $p = $self-> point2area( $x, $y); my $ptr; if ( defined $p && $p < 0) { $ptr = $self-> {vertical} ? cr::SizeNS : cr::SizeWE; } elsif ( $self-> {dragable} && !$self-> {clickable} && defined $p) { $ptr = cr::Move; } else { $ptr = cr::Default; } $self-> pointer( $ptr); return; } if ( $self-> {transaction} == 1) { my @a = $self-> tab2rect( $self-> {tabId}); $self-> pressed( ( $x >= $a[0] && $x < $a[2] && $y >= $a[1] && $y < $a[3]) ? $self-> {tabId} : -1 ); return unless $self-> {dragable}; my @ppos = $self-> pointerPos; if ( $self-> {clickable} && !$self-> {pointerSet}) { my @p = @{$self-> {pointerPos}}; if ( abs( $p[0] - $ppos[0]) > 2 || abs( $p[1] - $ppos[1]) > 2) { $self-> pointer( cr::Move); delete $self-> {pointerPos}; $self-> {pointerSet} = 1; } } my @lx = $self-> {vertical} ? @a[1,3] : @a[0,2]; my $d = $self-> {vertical} ? $y : $x; return if $d >= $lx[0] && $d < $lx[1]; my $osc = $self-> {scalable}; $self-> {scalable} = 0; my $p = $self-> point2area( $x, $y, 1); # exclude borders $self-> {scalable} = $osc; my $o = $self-> {tabId}; return unless defined $p; return if $p == $o; $self-> {clickAllowed} = 0; my $newpos; if ( $self-> {widths}-> [$p] > $self-> {widths}-> [$o]) { $ppos[$self-> {vertical} ? 1 : 0] += ( $self-> {widths}-> [$p] - $self-> {widths}-> [$o]) * (( $p > $o) ? 1 : -1); $newpos = 1; } splice( @{$self-> {items}}, $p, 0, splice( @{$self-> {items}}, $o, 1)); splice( @{$self-> {widths}}, $p, 0, splice( @{$self-> {widths}}, $o, 1)); $self-> {tabId} = $p; $self-> repaint; $self-> notify(q(MoveItem), $o, $p); $self-> pointerPos( @ppos) if $newpos; } else { my @sz = $self-> size; my $d = $self-> {vertical} ? $y : $x; my $nw = $self-> {owidth} + $d - $self-> {anchor}; $nw = $self-> {maxwidth} if $nw > $self-> {maxwidth}; $nw = $self-> {minwidth} if $nw < $self-> {minwidth}; $nw = $self-> {minTabWidth} if $nw < $self-> {minTabWidth}; my $ow = $self-> {widths}-> [$self-> {tabId}]; return if $nw == $ow; $self-> {widths}-> [$self-> {tabId}] = $nw; my $o = $self-> {swidth} + $ow; $self-> {maxWidth} += $nw - $ow; $self-> {vertical} ? $self-> scroll( 0, $nw - $ow, confineRect => [ 1, $o, $sz[0] - 1, $sz[1] - 1 + abs($nw - $ow)], clipRect => [ 1, 1, $sz[0]-1, $sz[1]-1], ) : $self-> scroll( $nw - $ow, 0, confineRect => [ $o, 1, $sz[0] - 1 + abs($nw - $ow), $sz[1] - 1], clipRect => [ 1, 1, $sz[0]-1, $sz[1]-1], ); $self-> notify(q(SizeItem), $self-> {tabId}, $ow, $nw); } } sub on_mouseclick { $_[0]-> clear_event; return unless $_[5]; shift-> notify(q(MouseDown), @_); } sub on_click { # my ( $self, $index) = @_; } sub protect { die "Prima::Header: Cannot change parameters during transaction\n" if $_[0]-> {transaction}; } sub autowidths { my ($self) = @_; my @r = $self-> calc_autowidths; $self-> {widths} = \@r; $self-> recalc_maxwidth; $self-> notify(q(SizeItems)); } sub calc_autowidths { my $self = $_[0]; $self-> protect; my $cx = $self-> {count}; my $i; $self-> begin_paint_info; my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureItem)); my @r; for ( $i = 0; $i < $cx; $i++) { my $result = 0; $notifier-> ( @notifyParms, $i, \$result); $result = $self-> {minTabWidth} if $result < $self-> {minTabWidth}; push @r, $result; next unless $result; } $self-> end_paint_info; return @r; } sub recalc_maxwidth { my $self = $_[0]; my $mxw = 2; for ( @{$self-> {widths}}) { $mxw += $_ + 2 if $_; } $self-> {maxWidth} = $mxw; } sub offset { return $_[0]-> {offset} unless $#_; my ( $self, $offset) = @_; $offset = 0 if $offset < 0; $offset = $self-> {maxWidth} - 5 if $offset >= $self-> {maxWidth} - 4; return if $offset == $self-> {offset}; $self-> {offset} = $offset; $self-> reset_transaction if $self-> {transaction}; $self-> repaint; } sub clickable { return $_[0]-> {clickable} unless $#_; $_[0]-> {clickable} = $_[1]; } sub vertical { return $_[0]-> {vertical} unless $#_; return if $_[0]-> {vertical} == $_[1]; $_[0]-> protect; $_[0]-> {vertical} = $_[1]; $_[0]-> repaint; } sub scalable { return $_[0]-> {scalable} unless $#_; $_[0]-> {scalable} = $_[1]; } sub dragable { return $_[0]-> {dragable} unless $#_; $_[0]-> {dragable} = $_[1]; } sub minTabWidth { return $_[0]-> {minTabWidth} unless $#_; my $changed = 0; my $m = $_[1]; $m = 0 if $m < 0; $_[0]-> {minTabWidth} = $m; for (@{$_[0]-> {widths}}) { $_ = $m, $changed = 1 if $_ < $m; } $_[0]-> recalc_maxwidth; $_[0]-> notify(q(SizeItems)) if $changed; } sub items { unless ( $#_) { return wantarray ? @{$_[0]-> {items}} : [@{$_[0]-> {items}}]; } my ( $self, @items) = @_; $self-> protect; @items = @{$items[0]} if scalar(@items) == 1 && ref($items[0]) eq 'ARRAY'; $self-> {items} = [@items]; my $oc = $self-> {count}; $self-> {count} = scalar @items; if ( $oc > $self-> {count}) { splice( @{$self-> {widths}}, $self-> {count}); $self-> notify(q(SizeItems)); } elsif ( $oc < $self-> {count}) { push( @{$self-> {widths}}, (( $self-> {minTabWidth}) x ( $self-> {count} - $oc))); $self-> notify(q(SizeItems)); } $self-> recalc_maxwidth; $self-> offset( $self-> offset); $self-> repaint; } sub widths { unless ( $#_) { return wantarray ? @{$_[0]-> {widths}} : [@{$_[0]-> {widths}}]; } my ( $self, @widths) = @_; $self-> protect; @widths = @{$widths[0]} if scalar(@widths) == 1 && ref($widths[0]) eq 'ARRAY'; $self-> {widths} = [@widths]; if ( scalar @widths > $self-> {count}) { splice( @{$self-> {widths}}, $self-> {count}); } elsif ( scalar @widths < $self-> {count}) { push( @{$self-> {widths}}, (( $self-> {minTabWidth}) x ( $self-> {count} - scalar @widths))); } for ( @{$self-> {widths}}) { $_ = $self-> {minTabWidth} if $_ < $self-> {minTabWidth}; } $self-> recalc_maxwidth; $self-> offset( $self-> offset); $self-> repaint; $self-> notify(q(SizeItems)); } sub pressed { return $_[0]-> {pressed} unless $#_; my ( $self, $pid) = @_; $pid = -1 if $pid < 0 || $pid >= $self-> {count}; return if $pid == $self-> {pressed}; my $opid = $self-> {pressed}; $self-> {pressed} = $pid; if (( $opid < 0) || ( $pid < 0)) { $self-> invalidate_rect( $self-> tab2rect( ( $pid < 0) ? $opid : $pid)); } else { $self-> repaint; } } 1; __DATA__ =head1 NAME Prima::Header - a multi-tabbed header widget. =head1 DESCRIPTION The widget class provides functionality of several button-like caption tabs, that can be moved and resized by the user. The class was implemented with a view to serve as a table header for list and grid widgets. =head1 API =head2 Events =over =item Click INDEX Called when the user clicks on the tab, positioned at INDEX. =item DrawItem CANVAS, INDEX, X1, Y1, X2, Y2, TEXT_BASELINE A callback used to draw the tabs. CANVAS is the output object; INDEX is the index of a tab. X1,Y2,X2,Y2 are the coordinates of the boundaries of the tab rectangle; TEXT_BASELINE is a pre-calculated vertical position for eventual centered text output. =item MeasureItem INDEX, RESULT Stores in scalar, referenced by RESULT, the width or height ( depending on L property value ) of the tab in pixels. =item MoveItem OLD_INDEX, NEW_INDEX Called when the user moves a tab from its old location, specified by OLD_INDEX, to the NEW_INDEX position. By the time of call, all internal structures are updated. =item SizeItem INDEX, OLD_EXTENT, NEW_EXTENT Called when the user resizes a tab in INDEX position. OLD_EXTENT and NEW_EXTENT are either width or height of the tab, depending on L property value. =item SizeItems Called when more than one tab has changed its extent. This might happen as a result of user action, as well as an effect of set-calling to some properties. =back =head2 Properties =over =item clickable BOOLEAN Selects if the user is allowed to click the tabs. Default value: 1 =item dragable BOOLEAN Selects if the user is allowed to move of the tabs. Default value: 1 =item items ARRAY Array of scalars, representing the internal data of the tabs. By default the scalars are treated as text strings. =item minTabWidth INTEGER A minimal extent in pixels a tab must occupy. Default value: 2 =item offset INTEGER An offset on the major axis ( depends on L property value ) that the widget is drawn with. Used for the conjunction with list widgets ( see L ), when the list is horizontally or vertically scrolled. Default value: 0 =item pressed INTEGER Contains the index of the currently pressed tab. A -1 value is selected when no tabs are pressed. Default value: -1 =item scalable BOOLEAN Selects if the user is allowed to resize the tabs. Default value: 1 =item vertical BOOLEAN If 1, the tabs are aligned vertically; the L, L property and extent parameters of the callback notification assume heights of the tabs. If 0, the tabs are aligned horizontally, and the extent properties and parameters assume tab widths. =item widths ARRAY Array of integer values, corresponding to the extents of the tabs. The extents are widths ( C is 0 ) or heights ( C is 1 ). =back =head2 Methods =over =item tab2offset INDEX Returns offset of the INDEXth tab ( without regard to L property value ). =item tab2rect INDEX Returns four integers, representing the rectangle area, occupied by the INDEXth tab ( without regard to L property value ). =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, F. =cut Prima-1.28/Prima/InputLine.pm0000644000175100017510000007123711150770061013621 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # Modifications by Anton Berezin # # $Id: InputLine.pm,v 1.33 2008/10/29 19:40:52 dk Exp $ package Prima::InputLine; use vars qw(@ISA); @ISA = qw(Prima::Widget Prima::MouseScroller); use strict; use Prima::Const; use Prima::Classes; use Prima::IntUtils; sub profile_default { my %def = %{$_[ 0]-> SUPER::profile_default}; my $font = $_[ 0]-> get_default_font; return { %def, alignment => ta::Left, autoHeight => 1, autoSelect => 1, autoTab => 0, borderWidth => 1, charOffset => 0, cursorVisible => 1, cursorSize => [ Prima::Application-> get_default_cursor_width, $font-> { height}], firstChar => 0, height => 2 + $font-> { height} + 2, insertMode => 0, maxLen => 256, # length $def{ text}, passwordChar => '*', pointerType => cr::Text, popupItems => [ [ cut => 'Cu~t' => 'cut' ], [ copy => '~Copy' => 'copy' ], [ paste => '~Paste' => 'paste' ], [ delete => '~Delete' => 'delete' ], [], [select_all => 'Select ~All' => 'select_all'], ], readOnly => 0, selection => [0, 0], selStart => 0, selEnd => 0, selectable => 1, textRef => undef, widgetClass => wc::InputLine, width => 96, wordDelimiters => ".()\"',#$@!%^&*{}[]?/|;:<>-= \xff\t", writeOnly => 0, } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> {autoHeight} = 0 if exists $p-> {height} || exists $p-> {size} || exists $p-> {rect} || ( exists $p-> {top} && exists $p-> {bottom}); $self-> SUPER::profile_check_in( $p, $default); ($p-> { selStart}, $p-> { selEnd}) = @{$p-> { selection}} if exists( $p-> { selection}); } sub init { my $self = shift; for ( qw( borderWidth passwordChar maxLen alignment autoTab autoSelect firstChar charOffset readOnly)) { $self-> {$_} = 1; } for ( qw( selStart selEnd atDrawX autoHeight)) { $self-> {$_} = 0;} $self-> { insertMode} = $::application-> insertMode; $self-> { maxLen} = -1; for( qw( line wholeLine)) { $self-> {$_} = ''; } $self-> {writeOnly} = 0; $self-> {defcw} = $::application-> get_default_cursor_width; $self-> {resetDisabled} = 1; my %profile = $self-> SUPER::init(@_); for ( qw( textRef writeOnly borderWidth passwordChar maxLen alignment autoTab autoSelect readOnly selEnd selStart charOffset firstChar wordDelimiters)) { $self-> $_( $profile{ $_}); } $self-> {resetDisabled} = 0; $self-> {resetLevel} = 0; my $font = $self-> font; $self-> {font_height} = $font-> height; $self-> {font_width} = $font-> width; $self-> reset; $self-> autoHeight( $profile{autoHeight}); return %profile; } sub on_paint { my ($self,$canvas) = @_; my @size = $canvas-> size; my @clr; my @selClr; @clr = $self-> enabled ? ($self-> color, $self-> backColor) : ($self-> disabledColor, $self-> disabledBackColor); @selClr = ($self-> hiliteColor, $self-> hiliteBackColor); my $border = $self-> {borderWidth}; if ( $self-> {borderWidth} == 0) { $canvas-> color( $clr[1]); $canvas-> bar(0,0,@size); } else { $canvas-> rect3d( 0, 0, $size[0]-1, $size[1]-1, $border, $self-> dark3DColor, $self-> light3DColor, $clr[1]); } return if $size[0] <= $border * 2 + 2; my $cap = $self-> {line}; $canvas-> clipRect ( $border + 1, $border + 1, $size[0] - $border - 2, $size[1] - $border - 2 ); $canvas-> translate ( $border + 1, $border + 1); $size[0] -= ( $border + 1) * 2; $size[1] -= ( $border + 1) * 2; my ( $fh, $useSel) = ( $self-> {font_height}, ( $self-> {selStart} < $self-> {selEnd}) && $self-> focused && $self-> enabled ); $useSel = 0 if $self-> {selEnd} <= $self-> {firstChar}; my ( $x, $y) = ( $self-> {atDrawX}, $self-> {atDrawY}); if ( $useSel) { my $actSelStart = $self-> {selStart} - $self-> {firstChar}; my $actSelEnd = $self-> {selEnd} - $self-> {firstChar}; $actSelStart = 0 if $actSelStart < 0; $actSelEnd = 0 if $actSelEnd < 0; my ( $left, $sel, $right) = ( substr( $cap, 0, $actSelStart), substr( $cap, $actSelStart, $actSelEnd - $actSelStart), substr( $cap, $actSelEnd, length( $cap) - $actSelEnd) ); my ( $a, $b) = ( $canvas-> get_text_width( $left), $canvas-> get_text_width( $left.$sel), ); $canvas-> color( $clr[0]); $canvas-> text_out( $left, $x, $y); $canvas-> text_out( $right, $x + $b, $y); $canvas-> color( $self-> hiliteBackColor); $canvas-> bar( $x + $a, 0, $x + $b - 1, $size[1]-1); $canvas-> color( $self-> hiliteColor); $canvas-> text_out( $sel, $x + $a, $y); } else { $canvas-> color( $clr[0]); $canvas-> text_out( $cap, $x, $y); } } sub reset_cursor { my $self = $_[0]; $self-> {resetLevel} = 1; $self-> reset; $self-> {resetLevel} = 0; } sub reset { my $self = $_[0]; return if $self-> {resetDisabled}; my @size = $self-> size; my $cap = $self-> {wholeLine}; my $border= $self-> {borderWidth}; my $width = $size[0] - ( $border + 1) * 2; my $fcCut = $self-> {firstChar}; my $reCalc = 0; if ( $self-> {resetLevel} == 0) { $self-> { atDrawY} = ( $size[1] - ( $border + 1) * 2 - $self-> {font_height}) / 2; while (1) { if (( $self-> {alignment} == ta::Left) || $reCalc) { $self-> { atDrawX} = 0; $self-> { line} = substr( $cap, $fcCut, length($cap)); $self-> { lineWidth} = $self-> get_text_width( $self-> {line}); } else { $self-> { line} = $cap; $self-> { lineWidth} = $self-> get_text_width( $cap); if ( $self-> { lineWidth} > $width) { $reCalc = 1; next; } $self-> { atDrawX} = ( $self-> {alignment} == ta::Center) ? (( $width - $self-> {lineWidth}) / 2) : ( $width - $self-> {lineWidth}); } last; } } my $ofs = $self-> {charOffset} - $fcCut; $cap = substr( $self-> {line}, 0, $ofs); my $x = $self-> get_text_width( $cap) + $self-> {atDrawX} + $border; my $curWidth = $self-> {insertMode} ? $self-> {defcw} : $self-> get_text_width( substr( $self-> {line}, $ofs, 1)) + 1; $curWidth = $size[0] - $x - $border if $curWidth + $x > $size[0] - $border; $self-> cursorSize( $curWidth, $size[1] - $border * 2 - 2); $self-> cursorPos( $x, $border + 1); } sub text { return ( defined($_[0]-> {textRef}) ? ${$_[0]-> {textRef}} : $_[0]-> SUPER::text ) unless $#_; my ( $self, $cap) = @_; $cap = '' unless defined $cap; $cap = substr( $cap, 0, $self-> {maxLen}) if $self-> {maxLen} >= 0 and length($cap) > $self-> {maxLen}; defined ( $self-> {textRef} ) ? ${$self-> {textRef}} = $cap : $self-> SUPER::text( $cap); $cap = $self-> {passwordChar} x length $cap if $self-> {writeOnly}; $self-> {wholeLine} = $cap; $self-> charOffset( length $cap) if $self-> {charOffset} > length $cap; $self-> set_selection(0,0); $self-> reset; $self-> repaint; $self-> notify(q(Change)); } sub textRef { return $_[0]-> {textRef} unless $#_; $_[0]-> text( $_[0]-> text) if defined ( $_[0]-> {textRef} = $_[1] ); } sub on_keydown { my ( $self, $code, $key, $mod) = @_; return if $mod & km::DeadKey; $mod &= ( km::Shift|km::Ctrl|km::Alt); $self-> notify(q(MouseUp),0,0,0) if defined $self-> {mouseTransaction}; my $offset = $self-> charOffset; my $cap = $self-> text; my $caplen = length( $cap); # navigation part if ( scalar grep { $key == $_ } (kb::Left,kb::Right,kb::Home,kb::End)) { return if $mod & km::Alt; my $delta = 0; if ( $key == kb::Left) { $delta = -1;} elsif ( $key == kb::Right) { $delta = 1;} elsif ( $key == kb::Home) { $delta = -$offset;} elsif ( $key == kb::End) { $delta = $caplen - $offset;} if (( $mod & km::Ctrl) && ( $key == kb::Left || $key == kb::Right)) { my $orgd = $delta; if ( $offset + $delta > 0 && $offset + $delta < $caplen) { my $w = $self-> {wordDelimiters}; if ( $key == kb::Right) { if (!($w =~ quotemeta(substr( $cap, $offset, 1)))) { $delta++ while (!($w =~ quotemeta( substr( $cap, $offset + $delta, 1))) && ( $offset + $delta < $caplen) ) } if ( $offset + $delta < $caplen) { $delta++ while (( $w =~ quotemeta( substr( $cap, $offset + $delta, 1))) && ( $offset + $delta < $caplen)) } } else { if ( $w =~ quotemeta( substr( $cap, $offset - 1, 1))) { $delta-- while (( $w =~ quotemeta( substr( $cap, $offset + $delta - 1, 1))) && ( $offset + $delta > 0)); } if ( $offset + $delta > 0) { $delta-- while (!( $w =~ quotemeta( substr( $cap, $offset + $delta - 1, 1))) && ( $offset + $delta > 0) ); } } } } if (( $offset + $delta >= 0) && ( $offset + $delta <= $caplen)) { if ( $mod & km::Shift) { my ( $start, $end) = $self-> selection; ($start, $end) = ( $offset, $offset) if $start == $end; if ( $start == $offset) { $start += $delta; } else { $end += $delta; } $self-> {autoAdjustDisabled} = 1; $self-> selection( $start, $end); delete $self-> {autoAdjustDisabled}; } else { $self-> selection(0,0) if $self-> {selStart} != $self-> {selEnd}; } $self-> charOffset( $offset + $delta); $self-> clear_event; return; } else { # boundary exceeding: $self-> clear_event unless $self-> {autoTab}; } } if ( $key == kb::Insert && $mod == 0) { $self-> insertMode( !$self-> insertMode); $self-> clear_event; return; } # edit part my ( $start, $end) = $self-> selection; ($start, $end) = ( $offset, $offset) if $start == $end; if ( $key == kb::Backspace) { if ( !$self-> {readOnly} && ($offset > 0 || $start != $end)) { if ( $start != $end) { substr( $cap, $start, $end - $start) = ''; $self-> set_selection(0,0); $self-> text( $cap); $self-> charOffset( $start); } else { substr( $cap, $offset - 1, 1) = ''; $self-> text( $cap); $self-> charOffset ( $offset - 1); } } $self-> clear_event; return; } if ( $key == kb::Delete) { if ( !$self-> {readOnly} && ( $offset < $caplen || $start != $end)) { my $del; if ( $start != $end) { $del = substr( $cap, $start, $end - $start); substr( $cap, $start, $end - $start) = ''; $self-> set_selection(0,0); $self-> text( $cap); $self-> charOffset( $start); } else { $del = substr( $cap, $offset, 1); substr( $cap, $offset, 1) = ''; $self-> text( $cap); } $::application-> Clipboard-> text( $del) if $mod & ( km::Ctrl|km::Shift); } $self-> clear_event; return; } if ( $key == kb::Insert && ( $mod & ( km::Ctrl|km::Shift))) { if ( $mod & km::Ctrl) { $self-> copy if $start != $end; } else { $self-> paste; } $self-> clear_event; return; } if ($code == ord("\cC")) { $self-> copy if $start != $end; $self-> clear_event; return; } elsif ($code == ord("\cA")) { $self-> select_all; $self-> clear_event; return; } elsif ($code == ord("\cV")) { $self-> paste; $self-> clear_event; return; } elsif ($code == ord("\cX")) { if ( !$self-> {readOnly} && $start != $end) { my $del; $del = substr( $cap, $start, $end - $start); substr( $cap, $start, $end - $start) = ''; $self-> set_selection(0,0); $self-> text( $cap); $self-> charOffset( $start); $::application-> Clipboard-> text( $del); } $self-> clear_event; return; } # typing part if ( !$self-> {readOnly} && ( $code >= ord(' ')) && (( $mod & (km::Alt | km::Ctrl)) == 0) && (( $key == kb::NoKey) || ( $key == kb::Space)) ) { if ( $start != $end) { $offset = $start; } elsif ( !$self-> {insertMode}) { $end++; } substr( $cap, $start, $end - $start) = chr $code; $self-> selection(0,0); if ( $self-> maxLen >= 0 and length ( $cap) > $self-> maxLen) { $self-> event_error; } else { $self-> text( $cap); $self-> charOffset( $offset + 1) } $self-> clear_event; return; } } sub on_popup { my $self = $_[0]; my $p = $self-> popup; my $sel = $self-> {selStart} != $self-> {selEnd}; my $c = $::application-> Clipboard; $c-> open; my $clip = $c-> format_exists('Text'); $c-> close; $p-> enabled( 'copy', $sel && not($self-> {writeOnly})); $p-> enabled( 'cut', $sel && not($self-> {writeOnly})); $p-> enabled( 'delete', $sel); $p-> enabled( 'paste', $clip); $p-> enabled( 'select_all', length($self-> {wholeLine})); } sub check_auto_size { my $self = $_[0]; $self-> geomHeight( $self-> font-> height + 2 + $self-> {borderWidth} * 2) if $self-> {autoHeight}; } sub copy { my $self = $_[0]; my ( $start, $end) = $self-> selection; return if $start == $end; return if $self-> {writeOnly}; my $cap = $self-> text; $::application-> Clipboard-> text( substr( $cap, $start, $end - $start)); } sub paste { my $self = $_[0]; return if $self-> {readOnly}; my $cap = $self-> text; my ( $start, $end) = $self-> selection; ($start, $end) = ( $self-> charOffset, $self-> charOffset) if $start == $end; my $s = $::application-> Clipboard-> text; return if !defined($s) or length( $s) == 0; substr( $cap, $start, $end - $start) = $s; $self-> selection(0,0); $self-> text( $cap); $self-> charOffset( $start + length( $s)); } sub delete { my $self = $_[0]; my ( $start, $end) = $self-> selection; return if $start == $end; my $cap = $self-> text; substr( $cap, $start, $end - $start) = ''; $self-> selection(0,0); $self-> text( $cap) unless $self-> {readOnly}; } sub cut { my $self = $_[0]; my ( $start, $end) = $self-> selection; return if $start == $end; my $cap = $self-> text; my $del = substr( $cap, $start, $end - $start); substr( $cap, $start, $end - $start) = ''; $self-> selection(0,0); $self-> text( $cap) unless $self-> {readOnly}; $::application-> Clipboard-> text( $del) unless $self-> {writeOnly}; } sub x2offset { my ( $self, $x) = @_; $x -= $self-> {atDrawX} + $self-> {borderWidth} + 1; return $self-> {firstChar} if $x <= 0; return $self-> {firstChar} + length( $self-> {line}) if $x >= $self-> {lineWidth}; return $self-> {firstChar} + $self-> text_wrap( $self-> {line}, $x, tw::ReturnFirstLineLength); } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if defined $self-> {mouseTransaction}; if ( $btn == mb::Middle) { my $cp = $::application-> bring('Primary'); return unless $cp; return if $self-> {readOnly}; my $cap = $self-> text; my ( $start, $end) = $self-> selection; ($start, $end) = ( $self-> charOffset, $self-> charOffset) if $start == $end; my $s = $cp-> text; return if !defined($s) or length( $s) == 0; substr( $cap, $start, $end - $start) = $s; $self-> selection(0,0); $self-> text( $cap); $self-> charOffset( $start + length( $s)); $self-> clear_event; return; } elsif ( $btn == mb::Right) { return; } $self-> {mouseTransaction} = 1; $self-> selection(0,0); $self-> charOffset( $self-> x2offset( $x)); $self-> {anchor} = $self-> charOffset; $self-> capture(1); $self-> clear_event; } sub new_offset { my ( $self, $ofs) = @_; $self-> {autoAdjustDisabled} = 1; $self-> charOffset( $ofs); $self-> selection( $self-> {anchor}, $self-> charOffset); delete $self-> {autoAdjustDisabled}; } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; $self-> clear_event; return unless defined $self-> {mouseTransaction}; my $border = $self-> {borderWidth}; my $width = $self-> width; if (( $x >= $border + 1) && ( $x <= $width - $border - 1)) { $self-> new_offset( $self-> x2offset( $x)); $self-> scroll_timer_stop; return; } my $firstAct = ! $self-> scroll_timer_active; $self-> scroll_timer_start if $firstAct; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); if ( $firstAct) { if ( $x <= $border + $self-> {atDrawX}) { $self-> new_offset( $self-> firstChar); } else { $x = $width - $border if $x > $width - $border; $self-> new_offset( $self-> x2offset( $x)); } } else { $self-> {autoAdjustDisabled} = 1; my $delta = 1; my $fw = $self-> {font_width}; $delta = ($width - $border * 2)/($fw*6) if $width - $border * 2 > $fw * 6; $delta = int( $delta); my $nSel = $self-> charOffset + $delta * ( $x <= $border ? -1 : 1); $nSel = 0 if $nSel < 0; $self-> lock; $self-> selection( $self-> {anchor}, $nSel); my $newFc = $self-> firstChar + $delta * ( $x <= $border ? -1 : 1); my $caplen = length $self-> {wholeLine}; $newFc = $caplen - $delta if $newFc + $delta > $caplen; $self-> firstChar ( $newFc); $self-> charOffset( $nSel); $self-> unlock; delete $self-> {autoAdjustDisabled}; } } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return unless defined $self-> {mouseTransaction}; delete $self-> {mouseTransaction}; $self-> scroll_timer_stop; $self-> capture(0); return if $self-> {writeOnly}; my $cp = $::application-> bring('Primary'); return unless $cp; my ( $start, $end) = $self-> selection; $cp-> text(substr( $self-> text, $start, $end - $start)) if $start != $end; } sub on_size { my $self = $_[0]; $self-> reset; $self-> firstChar( $self-> firstChar) if $self-> alignment != ta::Left; } sub on_fontchanged { my $self = shift; my $font = $self-> font; $self-> {font_height} = $font-> height; $self-> {font_width} = $font-> width; $self-> check_auto_size; $self-> reset; } sub set_alignment { my ( $self, $align) = @_; $self-> {alignment} = $align; $align = ta::Left if $align != ta::Left && $align != ta::Right && $align != ta::Center; $self-> reset; $self-> repaint; } sub set_border_width { my ( $self, $width) = @_; $width = 0 if $width < 0; $self-> {borderWidth} = $width; $self-> check_auto_size; $self-> reset; $self-> repaint; } sub set_char_offset { my ( $self, $offset) = @_; my $cap = $self-> text; my $l = length($cap); $offset = $l if $offset > $l; $offset = 0 if $offset < 0; return if $self-> {charOffset} == $offset; my $border = $self-> {borderWidth}; $self-> {charOffset} = $offset; my $w = $self-> width - ( $border + 1) * 2; my $fc = $self-> {firstChar}; if ( $fc > $offset) { $self-> firstChar( $offset); } else { my $gapWidth = $self-> get_text_width( substr( $self-> {line}, 0, $offset - $fc)); if ( $gapWidth > $w) { my $wrapRec = $self-> text_wrap( substr( $self-> {line}, 0, $offset - $fc), $w, tw::ReturnChunks); if ( scalar @{$wrapRec} < 5) { $self-> firstChar( $fc + $$wrapRec[-1] + 1); } else { $self-> firstChar( $fc + $$wrapRec[-4] + $$wrapRec[-1] + 1); } } else { $self-> reset_cursor; } } } sub set_max_len { my ( $self, $len) = @_; my $cap = $self-> text; $len = -1 if $len < 0; $self-> {maxLen} = $len; $self-> text( substr( $cap, 0, $len)) if $len >= 0 and length($cap) > $len; } sub set_first_char { my ( $self, $pos) = @_; my $l = length $self-> {wholeLine}; $pos = $l if $pos > $l; $pos = 0 if $pos < 0; $pos = 0 if ( $self-> {alignment} != ta::Left) && ( $self-> get_text_width( $self-> {wholeLine}) <= $self-> width - $self-> {borderWidth} * 2 - 2); my $ofc = $self-> {firstChar}; return if $self-> {firstChar} == $pos; my $oline = $self-> {line}; $self-> {firstChar} = $pos; $self-> reset; my $border = $self-> {borderWidth} + 1; my @size = $self-> size; $self-> scroll( ( $ofc > $pos) ? $self-> get_text_width( substr( $self-> {line}, 0, $ofc - $pos)) : - $self-> get_text_width( substr( $oline, 0, $pos - $ofc)), 0, clipRect => [ $border, $border, $size[0] - $border, $size[1] - $border] ); } sub set_write_only { my ( $self, $wo) = @_; return if $wo == $self-> {writeOnly}; $self-> {writeOnly} = $wo; $self-> text( $self-> text); } sub set_password_char { my ( $self, $pc) = @_; return if $pc eq $self-> {passwordChar}; $self-> {passwordChar} = $pc; $self-> text( $self-> text) if $self-> {writeOnly}; } sub set_insert_mode { my ( $self, $insert) = @_; my $oi = $self-> {insertMode}; $self-> {insertMode} = $insert; $self-> reset if $oi != $insert; $::application-> insertMode( $insert); } sub set_selection { my ( $self, $start, $end) = @_; my $l = length $self-> {wholeLine}; my ( $ostart, $oend) = $self-> selection; my $onsel = $ostart == $oend; $end = $l if $end < 0; $start = $l if $start < 0; ( $start, $end) = ( $end, $start) if $start > $end; $start = $l if $start > $l; $end = $l if $end > $l; $start = $end if $start > $end; $self-> {selStart} = $start; $self-> {selEnd} = $end; return if $start == $end && $onsel; my $ooffset = $self-> charOffset; $self-> charOffset( $end) if ( $start != $end) && !defined $self-> {autoAdjustDisabled}; return if ( $start == $ostart && $end == $oend); $self-> reset; if (( $start == $ostart || $end == $oend) && ( $ooffset == $self-> charOffset)) { my ( $a1, $a2) = ( $start == $ostart) ? ( $end, $oend) : ( $start, $ostart); ( $a1, $a2) = ( $a2, $a1) if ( $a2 < $a1); my $fcCut = $self-> firstChar; $a1 -= $fcCut; $a2 -= $fcCut; return if $a1 < 0 && $a2 < 0; my @r; $a1 = 0 if $a1 < 0; $a2 = 0 if $a2 < 0; my $border = $self-> {borderWidth}; $r[0] = $a1 > 0 ? $self-> get_text_width( substr( $self-> {line}, 0, $a1)) : 0; $r[0] += $self-> {atDrawX} + $border; my @size = $self-> size; $r[1] = $self-> get_text_width( substr( $self-> {line}, 0, $a2)); $r[1] += $self-> {atDrawX} + $border + 2; $self-> invalidate_rect( $r[0], $border + 1, $r[1], $size[1]-$border-1); return; } $self-> repaint; } sub on_enable { $_[0]-> repaint; } sub on_disable { $_[0]-> repaint; } sub on_leave { my @s = $_[0]-> selection; $_[0]-> repaint if $s[0] != $s[1]; } sub on_enter { my $self = $_[0]; $self-> insertMode( $::application-> insertMode); if ( $self-> {autoSelect}) { my @s = $self-> selection; $self-> {autoAdjustDisabled} = 1; $self-> select_all; $self-> {autoAdjustDisabled} = undef; my @s2 = $self-> selection; $self-> repaint if $s[0] == $s2[0] and $s[1] == $s2[1]; } else { my @s = $self-> selection; $self-> repaint if $s[0] != $s[1]; } } sub select_all { $_[0]-> selection(0,-1); } sub autoHeight { return $_[0]-> {autoHeight} unless $#_; $_[0]-> {autoHeight} = $_[1]; $_[0]-> check_auto_size; } sub autoSelect {($#_)?($_[0]-> {autoSelect} = $_[1]) :return $_[0]-> {autoSelect} } sub autoTab {($#_)?($_[0]-> {autoTab} = $_[1]) :return $_[0]-> {autoTab} } sub readOnly {($#_)?($_[0]-> {readOnly } = $_[1]) :return $_[0]-> {readOnly } } sub wordDelimiters{($#_)?($_[0]-> {wordDelimiters}= $_[1]) :return $_[0]-> {wordDelimiters}} sub alignment {($#_)?($_[0]-> set_alignment( $_[1])) :return $_[0]-> {alignment} } sub borderWidth {($#_)?($_[0]-> set_border_width( $_[1])) :return $_[0]-> {borderWidth} } sub charOffset {($#_)?($_[0]-> set_char_offset( $_[1])) :return $_[0]-> {charOffset} } sub maxLen {($#_)?($_[0]-> set_max_len ( $_[1])) :return $_[0]-> {maxLen } } sub firstChar {($#_)?($_[0]-> set_first_char( $_[1])) :return $_[0]-> {firstChar} } sub writeOnly {($#_)?($_[0]-> set_write_only( $_[1])) :return $_[0]-> {writeOnly} } sub passwordChar {($#_)?($_[0]-> set_password_char($_[1])) :return $_[0]-> {passwordChar} } sub insertMode {($#_)?($_[0]-> set_insert_mode ( $_[1])) :return $_[0]-> {insertMode} } sub selection {($#_)? $_[0]-> set_selection ($_[1], $_[2]) : return ($_[0]-> {selStart},$_[0]-> {selEnd})} sub selStart {($#_)? $_[0]-> set_selection ($_[1], $_[0]-> {selEnd}): return $_[0]-> {'selStart'}} sub selEnd {($#_)? $_[0]-> set_selection ($_[0]-> {'selStart'}, $_[1]):return $_[0]-> {'selEnd'}} sub selText { my( $f, $t) = ( $_[0]-> {q(selStart)}, $_[0]-> {q(selEnd)}); $f = $t = $_[0]-> {q(charOffset)} if $f == $t; ($#_) ? do { my $x = $_[ 0]-> text; substr( $x, $f, $t - $f) = $_[ 1]; $_[0]-> text( $x); $_[0]-> set_selection( $f, $f + length $_[ 1]); } : return substr( $_[ 0]-> text, $f, $t - $f); } 1; __DATA__ =pod =head1 NAME Prima::InputLine - standard input line widget =head1 DESCRIPTION The class provides basic functionality of an input line, including hidden input, read-only state, selection, and clipboard operations. The input line text data is contained in L property. =head1 API =head2 Events =over =item Change The notification is called when the L property is changed, either interactively or as a result of direct call. =back =head2 Properties =over =item alignment INTEGER One of the following C constants, defining the text alignment: ta::Left ta::Right ta::Center Default value: C =item autoHeight BOOLEAN If 1, adjusts the height of the widget automatically when its font changes. Default value: 1 =item autoSelect BOOLEAN If 1, all the text is selected when the widget becomes focused. Default value: 1 =item autoTab BOOLEAN If 1, the keyboard C and C commands, if received when the cursor is at the beginning or at the end of text, and cannot be mover farther, not processed. The result of this is that the default handler moves focus to a neighbor widget, in a way as if the Tab key was pressed. Default value: 0 =item borderWidth INTEGER Width of 3d-shade border around the widget. Default value: 2 =item charOffset INTEGER Selects the position of the cursor in characters starting from the beginning of text. =item firstChar Selects the first visible character of text =item insertMode BOOLEAN Governs the typing mode - if 1, the typed text is inserted, if 0, the text overwrites the old text. When C is 0, the cursor shape is thick and covers the whole character; when 1, it is of default width. Default toggle key: Insert =item maxLen INTEGER The maximal length of the text, that can be stored into L or typed by the user. Default value: 256 =item passwordChar CHARACTER A character to be shown instead of the text letters when L property value is 1. Default value: C<'*'> =item readOnly BOOLEAN If 1, the text cannot be edited by the user. Default value: 0 =item selection START, END Two integers, specifying the beginning and the end of the selected text. A case with no selection is when START equals END. =item selStart INTEGER Selects the start of text selection. =item selEnd INTEGER Selects the end of text selection. =item textRef SCALAR_REF If not undef, contains reference to the scalar that holds the text of the input line. All changes to ::text property are reflected there. The direct write access to the scalar is not recommended because it leaves internal structures inconsistent, and the only way to synchronize structures is to set-call either ::textRef or ::text after every such change. If undef, the internal text container is used. Default value: undef =item wordDelimiters STRING Contains string of character that are used for locating a word break. Default STRING value consists of punctuation marks, space and tab characters, and C<\xff> character. =item writeOnly BOOLEAN If 1, the input is not shown but mapped to L characters. Useful for a password entry. Default value: 0 =back =head2 Methods =over =item copy Copies the selected text, if any, to the clipboard. Default key: Ctrl+Insert =item cut Cuts the selected text into the clipboard. Default key: Shift+Delete =item delete Removes the selected text. Default key: Delete =item paste Copies text from the clipboard and inserts it in the cursor position. Default key: Shift+Insert =item select_all Selects all text =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, F. =cut Prima-1.28/Prima/Themes.pm0000644000175100017510000002506711150770061013137 0ustar dkdk# # Copyright (c) 1997-2003 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: Themes.pm,v 1.7 2007/09/13 15:12:25 dk Exp $ use strict; use Prima; package Prima::Themes; use vars qw(%themes %data $load_rc_file); use constant INSTALLED => 0; use constant CALLBACK => 1; use constant PROFILE => 2; use constant MODULE => 3; use constant INSTALL => 4; # install implicit property 'theme' selector push @Prima::Object::hooks, \&hook; # load and execute theme from rc file load_rc(1) if $load_rc_file || !defined $load_rc_file; sub hook { my ( $object, $profile, $default) = @_; if ( exists $default-> {theme} || exists $profile-> {theme}) { my $theme = exists($profile-> {theme}) ? $profile-> {theme} : $default-> {theme}; # execute explicitly selected theme execute( $themes{$theme}, $object, $profile, $default) if exists $themes{$theme}; } else { # execute for all installed themes execute( $themes{$_}, $object, $profile, $default) for grep { $themes{$_}-> [INSTALLED] } keys %themes; } }; sub load_rc { my $install = defined( $_[0]) ? $_[0] : 1; eval "use Prima::Utils;"; die $@ if $@; my $f = Prima::Utils::path('themes'); if ( $f && -f $f && open F, '<'.$f) { while ( ) { next if m/^\s*#/; chomp; my @r = split(',', $_, 3); next unless defined $r[0] && defined $r[1]; $data{$r[1]} = $r[2]; eval "use $r[0];"; warn( "** warning: error loading module `$r[0]': $@\n"), next if $@; warn( "** warning: theme `$r[1]' is not defined\n"), next unless loaded($r[1]); install($r[1]) if $install; } close F; } } # saves currently installed modules sub save_rc { eval "use Prima::Utils;"; die $@ if $@; my $f = Prima::Utils::path('themes'); return 0 unless open F, '>'.$f; for ( keys %themes) { next unless $themes{$_}-> [INSTALLED] && $themes{$_}-> [MODULE]; my $data = defined($data{$_}) ? $data{$_} : ''; print F "$themes{$_}->[MODULE],$_,$data\n"; } return close F; } # register theme sub register { my ( $file, $theme, $profile, $merger, $installer) = @_; deregister($_) if $themes{$theme}; $themes{$theme} = [ 0, # activity flag $merger, # merger routine, our own if undef $profile, # theme profile $file, # theme file $installer,# installer/uninstaller routine ]; } # kill theme sub deregister { uninstall($_[0]); delete $themes{$_[0]}; } # list registered themes sub list { keys %themes } # list active themes sub list_active { grep { $themes{$_}-> [INSTALLED] } keys %themes } # checks if theme is loaded sub loaded { defined($_[0]) ? exists $themes{$_[0]} : undef } # checks if theme is active sub active { (defined($_[0]) && exists $themes{$_[0]}) ? $themes{$_[0]}-> [INSTALLED] : undef } # unistall all themes and select new sub select { my @themes = @_; uninstall (keys %themes); install (@themes); } # load themes from files sub load { for ( @_) { eval "use Prima::themes::$_"; die $@ if $@ }} # makes 'use Prima::Themes qw(mytheme theme1);' possible sub import { shift; my $install; for ( @_ ) { if ( $_ eq ':install') { $install = 1; } else { $install ? install($_) : load($_); } } } # install themes sub install { for ( @_) { my $theme = $_; next if !exists $themes{$theme} || $themes{$theme}-> [INSTALLED]; if ( $themes{$theme}-> [INSTALL]) { $themes{$theme}-> [INSTALLED] = $themes{$theme}-> [INSTALL]-> ($theme, 1); } else { $themes{$theme}-> [INSTALLED] = 1; } } } # uninstall themes sub uninstall { for ( @_) { my $theme = $_; next if !exists $themes{$theme} || !$themes{$theme}-> [INSTALLED]; $themes{$theme}-> [INSTALL]-> ($theme, 0) if $themes{$theme}-> [INSTALL]; $themes{$theme}-> [INSTALLED] = 0; } } # theme data property sub data { return $data{$_[0]} unless $#_; $data{$_[0]} = $_[1]; } # default merger procedure sub merger { my ( $object, $profile, $default, $new) = @_; $profile-> {$_} = $new-> {$_} for keys %$new; } # applies theme during Object::profile_add sub execute { my ( $instance, $object, $profile, $default) = @_; my $merger = $instance-> [CALLBACK] || \&merger; my $profiles = $instance-> [PROFILE]; return unless $profiles; my $i; for ( $i = 0; $i < @$profiles; $i += 2) { $merger-> ( $object, $profile, $default, $$profiles[$i+1]) if $object-> isa($$profiles[$i]); } } package Prima::Themes::Proxy; sub new { return bless { object => $_[1] }, $_[0]; } sub AUTOLOAD { no strict; my ($method) = $AUTOLOAD =~ /::([^:]+)$/; return shift-> {object}-> $method( @_); } # do not fordward DESTROY sub DESTROY {} 1; =pod =head1 NAME Prima::Themes - object themes management =head1 DESCRIPTION Provides layer for theme registration in Prima. Themes are loosely grouped alternations of default class properties and behavior, by default stored in C subdirectory. The theme realization is implemented as interception of object profile during its creation, inside C<::profile_add>. Various themes apply various alterations, one way only - once an object is applied a theme, it cannot be neither changed nor revoked thereafter. Theme configuration can be stored in an rc file, F<~/.prima/themes>, and is loaded automatically, unless C<$Prima::Themes::load_rc_file> explicitly set to C<0> before loading the C module. In effect, any Prima application not aware of themes can be coupled with themes in the rc file by the following: perl -MPrima::Themes program C namespace provides registration and execution functionality. C is a class for overriding certain methods, for internal realization of a theme. For interactive theme selection use F sample program. =head1 SYNOPSIS # register a theme file use Prima::Themes qw(color); # or use Prima::Themes; load('color'); # list registered themes print Prima::Themes::list; # install a theme Prima::Themes::install('cyan'); # list installed themes print Prima::Themes::list_active; # create object with another theme while 'cyan' is active Class->create( theme => 'yellow'); # remove a theme Prima::Themes::uninstall('cyan'); =head1 Prima::Themes =over 4 =item load @THEME_MODULES Load THEME_MODULES from files via C clause, dies on error. Can be used instead of explicit C. A loaded theme file may register one or more themes. =item register $FILE, $THEME, $MATCH, $CALLBACK, $INSTALLER Registers a previously loaded theme. $THEME is a unique string identifier. $MATCH is an array of pairs, where the first item is a class name, and the second is an arbitrary scalar parameter. When a new object is created, its class is matched via C to each given class name, and if matched, the $CALLBACK routine is called with the following parameters: object, default profile, user profile, second item of the matched pair. If $CALLBACK is C, the default L routine is called, which treats the second items of the pairs as hashes of the same format as the default and user profiles. The theme is inactive until C is called. If $INSTALLER subroutine is passed, it is called during install and uninstall, with two parameters, the name of the theme and boolean install/uninstall flag. When install flag is 1, the theme is about to be installed; the subroutine is expected to return a boolean success flag. Otherwise, subroutine return value is not used. $FILE is used to indicate the file in which the theme is stored. =item deregister $THEME Un-registers $THEME. =item install @THEMES Installs previosuly loaded and registered loaded THEMES; the installed themes are now used to match new objects. =item uninstall @THEMES Uninstalls loaded THEMES. =item list Returns the list of registered themes. =item list_active Returns the list of installed themes. =item loaded $THEME Return 1 if $THEME is registered, 0 otherwise. =item active $THEME Return 1 if $THEME is installed, 0 otherwise. =item select @THEMES Uninstalls all currently installed themes, and installs THEMES instead. =item merger $OBJECT, $PROFILE_DEFAULT, $PROFILE_USER, $PROFILE_THEME Default profile merging routine, merges $PROFILE_THEME into $PROFILE_USER by keys from $PROFILE_DEFAULT. =item load_rc [ $INSTALL = 1 ] Reads data F<~/.prima/themes> and loads listed modules. If $INSTALL = 1, installs the themes from the rc file. =item save_rc Writes configuration of currently installed themes into rc file, returns success flag. If success flag is 0, C<$!> contains the error. =back =head1 Prima::Themes::Proxy An instance of C, created as Prima::Themes::Proxy-> new( $OBJECT) is a non-functional wrapper for any Perl object $OBJECT. All methods of $OBJECT, except C, C, and C, are forwarded to $OBJECT itself transparently. The class can be used, for example, to deny all changes to C inside object's painting routine: package ConstLineWidth; use vars qw(@ISA); @ISA = qw(Prima::Themes::Proxy); sub lineWidth { 1 } # line width is always 1 now! Prima::Themes::register( '~/lib/constlinewidth.pm', 'constlinewidth', [ 'Prima::Widget' => { onPaint => sub { my ( $object, $canvas) = @_; $object-> on_paint( ConstLineWidth-> new( $canvas)); }, } ] ); =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 FILES F<~/.prima/themes> =head1 SEE ALSO L, L, F =cut Prima-1.28/Prima/Config.pm0000644000175100017510000001045311150770061013110 0ustar dkdk# This file was automatically generated. # Do not edit, you'll loose your changes anyway. package Prima::Config; use vars qw(%Config %Config_inst); %Config_inst = ( incpaths => [ '/usr/local/lib/perl/5.10.0/Prima/CORE','/usr/local/lib/perl/5.10.0/Prima/CORE/generic','/usr/lib/perl/5.10/CORE','/usr/local/include','/usr/include/freetype2','/usr/include/gtk-2.0','/usr/lib/gtk-2.0/include','/usr/include/atk-1.0','/usr/include/cairo','/usr/include/pango-1.0','/usr/include/glib-2.0','/usr/lib/glib-2.0/include','/usr/include/directfb','/usr/include/libpng12','/usr/include/pixman-1' ], gencls => '/usr/bin/gencls', tmlink => '/usr/bin/tmlink', libname => '/usr/local/lib/perl/5.10.0/auto/Prima/Prima.a', dlname => '/usr/local/lib/perl/5.10.0/auto/Prima/Prima.so', ldpaths => ['/usr/local/lib','/lib','/usr/lib','/lib64','/usr/lib64','/usr/local/lib','/lib'], libs => '', define => '-DHAVE_CONFIG_H=1', inc => '-I/usr/local/lib/perl/5.10.0/Prima/CORE -I/usr/local/lib/perl/5.10.0/Prima/CORE/generic -I/usr/lib/perl/5.10/CORE -I/usr/local/include -I/usr/include/freetype2 -I/usr/include/gtk-2.0 -I/usr/lib/gtk-2.0/include -I/usr/include/atk-1.0 -I/usr/include/cairo -I/usr/include/pango-1.0 -I/usr/include/glib-2.0 -I/usr/lib/glib-2.0/include -I/usr/include/directfb -I/usr/include/libpng12 -I/usr/include/pixman-1', ); %Config = ( ifs => '/', quote => '\'', platform => 'unix', compiler => 'gcc', incpaths => [ '/home/dk/src/Prima/include','/home/dk/src/Prima/include/generic','/usr/lib/perl/5.10/CORE','/usr/local/include','/usr/include/freetype2','/usr/include/gtk-2.0','/usr/lib/gtk-2.0/include','/usr/include/atk-1.0','/usr/include/cairo','/usr/include/pango-1.0','/usr/include/glib-2.0','/usr/lib/glib-2.0/include','/usr/include/directfb','/usr/include/libpng12','/usr/include/pixman-1' ], platform_path => '/home/dk/src/Prima/unix', gencls => '\'/usr/bin/perl\' /home/dk/src/Prima/utils/gencls.pl', tmlink => '\'/usr/bin/perl\' /home/dk/src/Prima/utils/tmlink.pl', scriptext => '', genclsoptions => '--tml --h --inc', cc => 'cc', cflags => '-c -D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -O2 -g ', cdebugflags => '-g -O -Wall', cincflag => '-I', cobjflag => '-o ', cdefflag => '-D', cdefs => ['HAVE_CONFIG_H=1'], objext => '.o', lib => '', liboutflag => '', libext => '.a', libprefix => '', libname => '/home/dk/src/Prima/auto/Prima/Prima.a', libs => '/home/dk/src/Prima/auto/Prima/Prima.a', dlname => '/home/dk/src/Prima/auto/Prima/Prima.so', dlext => '.so', ld => 'cc', ldflags => ' -shared -O2 -g -L/usr/local/lib ', lddefflag => '', lddebugflags => '-g', ldoutflag => '-o ', ldlibflag => '-l', ldlibpathflag => '-L', ldpaths => ['/usr/local/lib','/lib','/usr/lib','/lib64','/usr/lib64','/usr/local/lib','/lib'], ldlibs => ['Xpm','ungif','tiff','png','jpeg','db','dl','m','pthread','c','crypt','gcc','X11','Xext','freetype','fontconfig','Xrender','Xft','gtk-x11-2.0','gdk-x11-2.0','atk-1.0','gdk_pixbuf-2.0','pangocairo-1.0','pango-1.0','cairo','gobject-2.0','gmodule-2.0','glib-2.0'], ldlibext =>'', inline => 'inline', perl => '/usr/bin/perl', dl_load_flags => 1, libs => '', define => '-DHAVE_CONFIG_H=1', inc => '-I/usr/local/lib/perl/5.10.0/Prima/CORE -I/usr/local/lib/perl/5.10.0/Prima/CORE/generic -I/usr/lib/perl/5.10/CORE -I/usr/local/include -I/usr/include/freetype2 -I/usr/include/gtk-2.0 -I/usr/lib/gtk-2.0/include -I/usr/include/atk-1.0 -I/usr/include/cairo -I/usr/include/pango-1.0 -I/usr/include/glib-2.0 -I/usr/lib/glib-2.0/include -I/usr/include/directfb -I/usr/include/libpng12 -I/usr/include/pixman-1', ); 1; Prima-1.28/Prima/Label.pm0000644000175100017510000003042311150770061012721 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: Label.pm,v 1.25 2005/12/05 21:48:12 dk Exp $ package Prima::Label; use vars qw(@ISA); @ISA = qw(Prima::Widget); use Carp; use Prima::Const; use Prima::Classes; use strict; sub profile_default { my $font = $_[ 0]-> get_default_font; return { %{$_[ 0]-> SUPER::profile_default}, alignment => ta::Left, autoHeight => 0, autoWidth => 1, focusLink => undef, height => 4 + $font-> { height}, ownerBackColor => 1, selectable => 0, showAccelChar => 0, showPartial => 1, tabStop => 0, valignment => ta::Top, widgetClass => wc::Label, wordWrap => 0, } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> { autoWidth} = 0 if ! exists $p->{autoWidth} and ( exists $p-> {width} || exists $p-> {size} || exists $p-> {rect} || ( exists $p-> {left} && exists $p-> {right}) ); $p-> {autoHeight} = 0 if ! exists $p-> {autoHeight} and ( exists $p-> {height} || exists $p-> {size} || exists $p-> {rect} || ( exists $p-> {top} && exists $p-> {bottom}) ); $self-> SUPER::profile_check_in( $p, $default); my $vertical = exists $p-> {vertical} ? $p-> {vertical} : $default-> { vertical}; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> { alignment} = $profile{ alignment}; $self-> { valignment} = $profile{ valignment}; $self-> { autoHeight} = $profile{ autoHeight}; $self-> { autoWidth} = $profile{ autoWidth}; $self-> { wordWrap} = $profile{ wordWrap}; $self-> { focusLink} = $profile{ focusLink}; $self-> { showAccelChar} = $profile{ showAccelChar}; $self-> { showPartial} = $profile{ showPartial}; $self-> check_auto_size; return %profile; } sub on_paint { my ($self,$canvas) = @_; my @size = $canvas-> size; my @clr; if ( $self-> enabled) { if ( $self-> focused) { @clr = ($self-> hiliteColor, $self-> hiliteBackColor); } else { @clr = ($self-> color, $self-> backColor); } } else { @clr = ($self-> disabledColor, $self-> disabledBackColor); } unless ( $self-> transparent) { $canvas-> color( $clr[1]); $canvas-> bar(0,0,@size); } my $fh = $canvas-> font-> height; my $ta = $self-> {alignment}; my $wx = $self-> {widths}; my $ws = $self-> {words}; my ($starty,$ycommon) = (0, scalar @{$ws} * $fh); if ( $self-> {valignment} == ta::Top) { $starty = $size[1] - $fh; } elsif ( $self-> {valignment} == ta::Bottom) { $starty = $ycommon - $fh; } else { $starty = ( $size[1] + $ycommon)/2 - $fh; } my $y = $starty; my $tl = $self-> {tildeLine}; my $i; my $paintLine = !$self-> {showAccelChar} && defined($tl) && $tl < scalar @{$ws}; unless ( $self-> enabled) { $canvas-> color( $self-> light3DColor); for ( $i = 0; $i < scalar @{$ws}; $i++) { my $x = 0; if ( $ta == ta::Center) { $x = ( $size[0] - $$wx[$i]) / 2; } elsif ( $ta == ta::Right) { $x = $size[0] - $$wx[$i]; } $canvas-> text_out( $$ws[$i], $x + 1, $y - 1); $y -= $fh; } $y = $starty; if ( $paintLine) { my $x = 0; if ( $ta == ta::Center) { $x = ( $size[0] - $$wx[$tl]) / 2; } elsif ( $ta == ta::Right) { $x = $size[0] - $$wx[$tl]; } $canvas-> line( $x + $self-> {tildeStart} + 1, $starty - $fh * $tl - 1, $x + $self-> {tildeEnd} + 1, $starty - $fh * $tl - 1 ); } } $canvas-> color( $clr[0]); for ( $i = 0; $i < scalar @{$ws}; $i++) { my $x = 0; if ( $ta == ta::Center) { $x = ( $size[0] - $$wx[$i]) / 2; } elsif ( $ta == ta::Right) { $x = $size[0] - $$wx[$i]; } $canvas-> text_out( $$ws[$i], $x, $y); $y -= $fh; } if ( $paintLine) { my $x = 0; if ( $ta == ta::Center) { $x = ( $size[0] - $$wx[$tl]) / 2; } elsif ( $ta == ta::Right) { $x = $size[0] - $$wx[$tl]; } $canvas-> line( $x + $self-> {tildeStart}, $starty - $fh * $tl, $x + $self-> {tildeEnd}, $starty - $fh * $tl ); } } sub text { return $_[0]-> SUPER::text unless $#_; my $self = $_[0]; $self-> SUPER::text( $_[1]); $self-> check_auto_size; $self-> repaint; } sub on_translateaccel { my ( $self, $code, $key, $mod) = @_; if ( !$self-> {showAccelChar} && defined $self-> {accel} && ( $key == kb::NoKey) && lc chr $code eq $self-> { accel} ) { $self-> clear_event; $self-> notify( 'Click'); } } sub on_click { my ( $self, $f) = ( $_[0], $_[0]-> {focusLink}); $f-> select if defined $f && $f-> alive && $f-> enabled; } sub on_keydown { my ( $self, $code, $key, $mod) = @_; if ( defined $self-> {accel} && ( $key == kb::NoKey) && lc chr $code eq $self-> { accel} ) { $self-> notify( 'Click'); $self-> clear_event; } } sub on_mousedown { my $self = $_[0]; $self-> notify( 'Click'); $self-> clear_event; } sub on_fontchanged { $_[0]-> check_auto_size; } sub on_size { $_[0]-> reset_lines; } sub on_enable { $_[0]-> repaint } sub on_disable { $_[0]-> repaint } sub set_alignment { $_[0]-> {alignment} = $_[1]; $_[0]-> repaint; } sub set_valignment { $_[0]-> {valignment} = $_[1]; $_[0]-> repaint; } sub reset_lines { my $self = $_[0]; my @res; my $maxLines = int($self-> height / $self-> font-> height); $maxLines++ if $self-> {showPartial} and (($self-> height % $self-> font-> height) > 0); my $opt = tw::NewLineBreak|tw::ReturnLines|tw::WordBreak|tw::CalcMnemonic|tw::ExpandTabs|tw::CalcTabs; my $width = 1000000; $opt |= tw::CollapseTilde unless $self-> {showAccelChar}; $width = $self-> width if $self-> {wordWrap}; $self-> begin_paint_info; my $lines = $self-> text_wrap( $self-> text, $width, $opt); my $lastRef = pop @{$lines}; $self-> {textLines} = scalar @$lines; for( qw( tildeStart tildeEnd tildeLine)) {$self-> {$_} = $lastRef-> {$_}} $self-> {accel} = defined($self-> {tildeStart}) ? lc( $lastRef-> {tildeChar}) : undef; splice( @{$lines}, $maxLines) if scalar @{$lines} > $maxLines; $self-> {words} = $lines; my @len; for ( @{$lines}) { push @len, $self-> get_text_width( $_); } $self-> {widths} = [@len]; $self-> end_paint_info; } sub check_auto_size { my $self = $_[0]; my $cap = $self-> text; $cap =~ s/~//s unless $self-> {showAccelChar}; my %sets; if ( $self-> {wordWrap}) { $self-> reset_lines; if ( $self-> {autoHeight}) { $self-> geomHeight( $self-> {textLines} * $self-> font-> height + 2); } } else { my @lines = split "\n", $cap; if ( $self-> {autoWidth}) { $self-> begin_paint_info; $sets{geomWidth} = 0; for my $line ( @lines) { my $width = $self-> get_text_width( $line); $sets{geomWidth} = $width if $sets{geomWidth} < $width; } $sets{geomWidth} += 6; $self-> end_paint_info; } $sets{ geomHeight} = scalar(@lines) * $self-> font-> height + 2 if $self-> {autoHeight}; $self-> set( %sets); $self-> reset_lines; } } sub set_auto_width { my ( $self, $aw) = @_; return if $self-> {autoWidth} == $aw; $self-> {autoWidth} = $aw; $self-> check_auto_size; } sub set_auto_height { my ( $self, $ah) = @_; return if $self-> {autoHeight} == $ah; $self-> {autoHeight} = $ah; $self-> check_auto_size; } sub set_word_wrap { my ( $self, $ww) = @_; return if $self-> {wordWrap} == $ww; $self-> {wordWrap} = $ww; $self-> check_auto_size; } sub set_show_accel_char { my ( $self, $sac) = @_; return if $self-> {showAccelChar} == $sac; $self-> {showAccelChar} = $sac; $self-> check_auto_size; } sub set_show_partial { my ( $self, $sp) = @_; return if $self-> {showPartial} == $sp; $self-> {showPartial} = $sp; $self-> check_auto_size; } sub get_lines { return @{$_[0]-> {words}}; } sub showAccelChar {($#_)?($_[0]-> set_show_accel_char($_[1])) :return $_[0]-> {showAccelChar}} sub showPartial {($#_)?($_[0]-> set_show_partial($_[1])) :return $_[0]-> {showPartial}} sub focusLink {($#_)?($_[0]-> {focusLink} = $_[1]) :return $_[0]-> {focusLink} } sub alignment {($#_)?($_[0]-> set_alignment( $_[1])) :return $_[0]-> {alignment} } sub valignment {($#_)?($_[0]-> set_valignment( $_[1])) :return $_[0]-> {valignment} } sub autoWidth {($#_)?($_[0]-> set_auto_width( $_[1])) :return $_[0]-> {autoWidth} } sub autoHeight {($#_)?($_[0]-> set_auto_height( $_[1])) :return $_[0]-> {autoHeight} } sub wordWrap {($#_)?($_[0]-> set_word_wrap( $_[1])) :return $_[0]-> {wordWrap} } 1; __DATA__ =pod =head1 NAME Prima::Label - static text widget =head1 DESCRIPTION The class is designed for display of text, and assumes no user interaction. The text output capabilities include wrapping, horizontal and vertical alignment, and automatic widget resizing to match text extension. If text contains a tilde-escaped ( hot ) character, the label can explicitly focus the specified widget upon press of the character key, what feature is useful for dialog design. =head1 SYNOPSIS my $label = Prima::Label-> create( text => 'Enter ~name:', focusLink => $name_inputline, alignment => ta::Center, ); =head1 API =head2 Properties =over =item alignment INTEGER One of the following C constants: ta::Left ta::Center ta::Right Selects the horizontal text alignment. Default value: C =item autoHeight BOOLEAN If 1, the widget height is automatically changed as text extensions change. Default value: 0 =item autoWidth BOOLEAN If 1, the widget width is automatically changed as text extensions change. Default value: 1 =item focusLink WIDGET Points to a widget, which is explicitly focused when the user presses the combination of a hot key with the C key. Prima::Label does not provide a separate property to access the hot key value, however it can be read from the C<{accel}> variable. Default value: C. =item showAccelChar BOOLEAN If 0, the tilde ( ~ ) character is collapsed from the text, and the hot character is underlined. When the user presses combination of the escaped character with the C key, the C widget is explicitly focused. If 1, the text is showed as is, and no hot character is underlined. Key combinations with C key are not recognized. Default value: 0 =item showPartial BOOLEAN Used to determine if the last line of text should be drawn if it can not be vertically fit in the widget interior. If 1, the last line is shown even if not visible in full. If 0, only full lines are drawn. Default value: 1 =item wordWrap BOOLEAN If 1, the text is wrapped if it can not be horizontally fit in the widget interior. If 0, the text is not wrapped unless new line characters are present in the text. New line characters signal line wrapping with no respect to C property value. Default value: 0 =item valignment INTEGER One of the following C constants: ta::Top ta::Middle or ta::Center ta::Bottom Selects the vertical text alignment. NB: C value is not equal to C's, however the both constants produce equal effect here. Default value: C =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, F =cut Prima-1.28/Prima/noARGV.pm0000644000175100017510000000031011150770061012766 0ustar dkdk# # Created by Dmitry Karasik # # $Id: noARGV.pm,v 1.1 2007/08/17 20:19:38 dk Exp $ # # Initializes Prima so that it skips parsing @ARGV; push @Prima::preload, 'noargv'; 1; Prima-1.28/Prima/StdDlg.pm0000644000175100017510000001724511150770061013072 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by: # Anton Berezin # Dmitry Karasik # # $Id: StdDlg.pm,v 1.28 2007/09/13 15:12:25 dk Exp $ # Contains stubs for load-on-demand of the following modules: # Prima::OpenDialog => Prima/FileDialog.pm # Prima::SaveDialog => Prima/FileDialog.pm # Prima::ChDirDialog => Prima/FileDialog.pm # Prima::FontDialog => Prima/FontDialog.pm # Prima::FindDialog => Prima/EditDialog.pm # Prima::ReplaceDialog => Prima/EditDialog.pm # Prima::PrintSetupDialog => Prima/PrintDialog.pm # Prima::ColorDialog => Prima/ColorDialog.pm # Prima::ImageOpenDialog => Prima/ImageDialog.pm # Prima::ImageSaveDialog => Prima/ImageDialog.pm no strict; package Prima::ColorDialog; sub AUTOLOAD { my ($method) = $Prima::ColorDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::ColorDialog::}{AUTOLOAD}; eval "use Prima::ColorDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima::FontDialog; sub AUTOLOAD { my ($method) = $Prima::FontDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::FontDialog::}{AUTOLOAD}; eval "use Prima::FontDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima::OpenDialog; sub AUTOLOAD { my ($method) = $Prima::OpenDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::OpenDialog::}{AUTOLOAD}; delete ${Prima::SaveDialog::}{AUTOLOAD}; delete ${Prima::ChDirDialog::}{AUTOLOAD}; eval "use Prima::FileDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima::SaveDialog; sub AUTOLOAD { my ($method) = $Prima::SaveDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::OpenDialog::}{AUTOLOAD}; delete ${Prima::SaveDialog::}{AUTOLOAD}; delete ${Prima::ChDirDialog::}{AUTOLOAD}; eval "use Prima::FileDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima; my ($openFileDlg, $saveFileDlg); my @fileDlgProps = qw( defaultExt fileName filter filterIndex directory createPrompt multiSelect noReadOnly noTestFileCreate overwritePrompt pathMustExist fileMustExist sorted showDotFiles); sub open_file { my %profile = @_; $openFileDlg = Prima::OpenDialog-> create( system => exists($profile{system}) ? $profile{system} : 1, onDestroy => sub { undef $openFileDlg}, ) unless $openFileDlg; delete $profile{system}; my %a = %{$openFileDlg-> profile_default}; $openFileDlg-> set(( map { $_ => $a{$_}} @fileDlgProps), %profile); return $openFileDlg-> execute; } sub save_file { my %profile = @_; $saveFileDlg = Prima::SaveDialog-> create( system => exists($profile{system}) ? $profile{system} : 1, onDestroy => sub { undef $saveFileDlg}, ) unless $saveFileDlg; delete $profile{system}; my %a = %{$saveFileDlg-> profile_default}; $saveFileDlg-> set(( map { $_ => $a{$_}} @fileDlgProps), %profile); return $saveFileDlg-> execute; } package Prima::ChDirDialog; sub AUTOLOAD { my ($method) = $Prima::ChDirDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::OpenDialog::}{AUTOLOAD}; delete ${Prima::SaveDialog::}{AUTOLOAD}; delete ${Prima::ChDirDialog::}{AUTOLOAD}; eval "use Prima::FileDialog"; die "$@\n" if $@; shift-> $method(@_); } package mb; use constant ChangeAll => 0xCA11; package Prima::FindDialog; sub AUTOLOAD { my ($method) = $Prima::FindDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::FindDialog::}{AUTOLOAD}; delete ${Prima::ReplaceDialog::}{AUTOLOAD}; eval "use Prima::EditDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima::ReplaceDialog; sub AUTOLOAD { my ($method) = $Prima::ReplaceDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::FindDialog::}{AUTOLOAD}; delete ${Prima::ReplaceDialog::}{AUTOLOAD}; eval "use Prima::EditDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima::PrintSetupDialog; sub AUTOLOAD { my ($method) = $Prima::PrintSetupDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::PrintSetupDialog::}{AUTOLOAD}; eval "use Prima::PrintDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima::ImageOpenDialog; sub AUTOLOAD { my ($method) = $Prima::ImageOpenDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::ImageOpenDialog::}{AUTOLOAD}; delete ${Prima::ImageSaveDialog::}{AUTOLOAD}; eval "use Prima::ImageDialog"; die "$@\n" if $@; shift-> $method(@_); } package Prima::ImageSaveDialog; sub AUTOLOAD { my ($method) = $Prima::ImageSaveDialog::AUTOLOAD =~ /::([^:]+)$/; delete ${Prima::ImageOpenDialog::}{AUTOLOAD}; delete ${Prima::ImageSaveDialog::}{AUTOLOAD}; eval "use Prima::ImageDialog"; die "$@\n" if $@; shift-> $method(@_); } 1; __DATA__ =pod =head1 NAME Prima::StdDlg - wrapper module to the toolkit standard dialogs =head1 DESCRIPTION Provides a unified access to the toolkit dialogs, so there is no need to C the corresponding module explicitly. =head1 SYNOPSIS use Prima::StdDlg; Prima::FileDialog-> create-> execute; Prima::FontDialog-> create-> execute; # open standard file open dialog my $file = Prima::open_file; print "You've selected: $file\n" if defined $file; =head1 API The module accesses the following dialog classes: =over =item Prima::open_file Invokes standard file open dialog and return the selected file(s). Uses system-specific standard file open dialog, if available. =item Prima::save_file Invokes standard file save dialog and return the selected file(s). Uses system-specific standard file save dialog, if available. =item Prima::OpenDialog File open dialog. See L =item Prima::SaveDialog File save dialog. See L =item Prima::ChDirDialog Directory change dialog. See L =item Prima::FontDialog Font selection dialog. See L. =item Prima::FindDialog Generic 'find text' dialog. See L. =item Prima::ReplaceDialog Generic 'find and replace text' dialog. See L. =item Prima::PrintSetupDialog Printer selection and setup dialog. See L. =item Prima::ColorDialog Color selection dialog. See L. =item Prima::ImageOpenDialog Image file load dialog. See L. =item Prima::ImageSaveDialog Image file save dialog. See L. =back =head1 AUTHORS Anton Berezin Etobez@plab.ku.dkE, Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L =cut Prima-1.28/Prima/CurvedText.pm0000644000175100017510000004016311150770061014001 0ustar dkdk# Copyright (c) 1997-2007 Dmitry Karasik # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: CurvedText.pm,v 1.2 2007/11/01 11:41:55 dk Exp $ package Prima::CurvedText; use strict; use warnings; *Prima::Drawable::curved_text_out = \&curved_text_out; sub init_pointer { my ( $p, $beginning) = @_; my $P = { x => $p-> [0], # current coordinates of the aperture point y => $p-> [1], # i => 0, # index of the current segment in polygon n => scalar(@$p)-2,# number of points end => 0, # end of polygon? p => $p, # polygon a => undef, # angle of the current segment l => undef, # length of the current segment lleft => undef, # length of line between (x,y) and the end of the curr segment dx => undef, # tangent of the current segment dy => undef, # }; $P->{i} = $P->{n} - 2 unless $beginning; calc_segment( $P); $P->{lleft} = 0 unless $beginning; return $P; } sub calc_segment { my $p = $_[0]; my ($P,$I) = ($p->{p}, $p->{i}); my $x = $p-> {dx} = $$P[$I + 2] - $$P[$I]; my $y = $p-> {dy} = $$P[$I + 3] - $$P[$I + 1]; $p-> {l} = $p->{lleft} = int( 0.5 + sqrt( $y * $y + $x * $x)); $p-> {a} = atan2($y, $x) * 180 / 3.14159265358; #print "next segment $$P[$I],$$P[$I+1]-$$P[$I+2],$$P[$I+3] len $p->{l} angle $p->{a}\n"; } # skip to next segment sub next_segment { my $p = $_[0]; my $P = $p->{p}; while ( not $p-> {end}) { $p-> {i} += 2; $p-> {end}++, return 0 if $p-> {i} >= $p->{n}; calc_segment( $p); $p-> {x} = $$P[ $p->{i} ]; $p-> {y} = $$P[ $p->{i} + 1 ]; last if $p-> {l} > 0; } return 1; } # track back to previous segment sub prev_segment { my $p = $_[0]; my $P = $p->{p}; $p-> {end} = 0; $p-> {lleft} = 0; while ( 1) { return 0 if $p-> {i} == 0; $p-> {i} -= 2; calc_segment( $p); $p-> {x} = $$P[ $p->{i} ]; $p-> {y} = $$P[ $p->{i} + 1 ]; last if $p-> {l} > 0; } return 1; } # move the pointer to a given offset, return the average angle of the passed path sub move_pointer { my ( $p, $o) = @_; #print "shift $o pixels i=$p->{i} llen=$p->{lleft} l=$p->{l}\n"; my $O = $o; my ($ox,$oy) = ($p->{x}, $p->{y}); my $i = $p-> {i}; if ( $o < 0) { $o = -$o; $o = int($o + 0.5); while ( $o + $p->{lleft} > $p-> {l} or $p-> {l} == 0) { $o -= $p->{l} - $p-> {lleft}; goto EXIT unless prev_segment($p); #print "prev segment $p->{i} o=$o lleft=$p->{lleft} l=$p->{l}\n"; } goto EXIT if $o <= 0; $o = -$o; } else { $o = int($o + 0.5); while ( $o > $p->{lleft} or $p-> {l} == 0) { $o -= $p-> {lleft}; goto EXIT unless next_segment($p); #print "next segment $p->{i} o=$o\n"; } goto EXIT if $o <= 0; } my $l = $p-> {l} - $p-> {lleft} + $o; $p-> {lleft} = $p-> {l} - $l; if ( $p-> {lleft} > 0) { my $P = $p->{p}; $p-> {x} = $$P[ $p-> {i} ] + $p-> {dx} * $l / $p-> {l}; $p-> {y} = $$P[ $p-> {i} + 1 ] + $p-> {dy} * $l / $p-> {l}; $_ = ( $_ < 0) ? int( $_ - 0.5) : int( $_ + 0.5) for ($p-> {x}, $p->{y}); #print "offset pointer to $p->{x},$p->{y}, lleft $p->{lleft}\n"; } else { next_segment($p); } EXIT: return $p-> {a} if $i == $p-> {i}; # same segment, don't recalculate the angle $ox = $p->{x} - $ox; $oy = $p->{y} - $oy; return $p->{a} if $ox == 0 and $oy == 0; # last point of the segment return atan2($oy, $ox) * 180 / 3.14159265358; } # changes current coordinates to a point within given segment sub set_pointer { my ( $p, $x, $y) = @_; $p-> {x} = $x; $p-> {y} = $y; my $dx = $p-> {p}-> [$p-> {i} ] - $x; my $dy = $p-> {p}-> [$p-> {i} + 1] - $y; my $l = int( 0.5 + sqrt( $dy * $dy + $dx * $dx)); $p-> {lleft} = $p-> {l} - $l; #print "move pointer to $x,$y, set llen $p->{lleft}\n"; next_segment($p) if $p->{lleft} <= 0; } sub update_box { my ( $self, $x, $y, $angle, $t, $box) = @_; $self-> font-> direction( $angle) if defined $angle; @$box = @{$self-> get_text_box( $$t)}; for ( my $j = 0; $j < 10; $j += 2) { $box-> [$j] += $x; $box-> [$j+1] += $y; } } # rotate back @$a to angle=0, calculate transformation matrix, # and store all in the cache sub precalc_box { my ( $angle, $box, $cache) = @_; my ($dx, $dy) = @$box[2,3]; $cache-> [0] = $dx; # offset x $cache-> [1] = $dy; # offset y my ($x, $y) = @$box[0,1]; # height $cache-> [2] = sqrt(($dx - $x) * ($dx - $x) + ($dy - $y) * ($dy - $y)); ($x, $y) = @$box[6,7]; # width $cache-> [3] = sqrt(($dx - $x) * ($dx - $x) + ($dy - $y) * ($dy - $y)); #print "precalc box @$box to $cache->[3],$cache->[2] shift $dx,$dy rotated to $angle\n"; $angle *= -3.14159265358/180; $cache-> [4] = sin($angle); $cache-> [5] = cos($angle); } # check whether rotated rectangle $b is inside box $a. # $a is calculated from a rotated rectangle box by precalc_box() sub boxes_overlap { my ( $a, $b) = @_; #print "overlap? @$b\n"; my (@b,$i); my ($dx,$dy,$h,$w,$sin,$cos) = @$a; # rotate and shift $b for ( $i = 0; $i < 8; $i+=2) { my ( $x, $y) = @$b[$i,$i+1]; $x -= $dx; $y -= $dy; my $X = $x * $cos - $y * $sin; my $Y = $x * $sin + $y * $cos; # check immediately if the point is inside the box if ( ( $X >= 0 and $X < $w) and ( $Y >= 0 and $Y < $h) ) { #print "point $X,$Y is inside 0,0-$w,$h\n"; return 1; } @b[$i,$i+1] = ($X,$Y); } # check whether any segment that forms @b intesects with $a # reshuffle order of get_text_box() points so [0] is lower left, [1] is upper left, [2] is upper right # also, point 8,9->0,1 for easier looping @b[0..3,8,9] = @b[2,3,0..3]; for ( $i = 0; $i < 8; $i +=2 ) { my ($x1, $y1, $x2, $y2) = @b[$i .. $i + 3]; my ( $dx, $dy) = ( $x2 - $x1, $y2 - $y1); # check intersections with vertical axes if ( $dx != 0) { my $tangent = $dy / $dx; for (0, $w) { next if ( $_ > $x1 and $_ > $x2) or ( $_ < $x1 and $_ < $x2); my $p = $y2 - $tangent * ( $x2 - $_ ); next unless $p >= 0 and $p < $h; #print "segment $x1,$y1-$x2,$y2 crosses vertical line x=$_ at y=0<=$p=>$h\n"; return 1; } } # check intersections with horizontal axes if ( $dy != 0) { my $tangent = $dx / $dy; for (0, $h) { next if ( $_ > $y1 and $_ > $y2) or ( $_ < $y1 and $_ < $y2); my $p = $x2 - $tangent * ( $y2 - $_ ); next unless $p >= 0 and $p < $w; #print "segment $x1,$y1-$x2,$y2 crosses horizontal line y=$_ at x=0<=$p=>$w\n"; return 1; } } } return 0; } sub curved_text_out { my ( $self, $text, $polyline, %options) = @_; return unless 4 == grep { defined } @$polyline[0..3]; my $retval = 1; my $fa = $self-> font-> direction; my $collisions = $options{collisions} || 0; my $bevel = not (exists $options{bevel}) || $options{bevel}; my $offset = $options{offset} || 0; my $p = init_pointer( $polyline, $offset >= 0); move_pointer( $p, $offset); my ( @chunks, $try_text_wrap, $angle, @box); my ( %start, @walkback, @translated_box, @all_boxes, $fitting_direction); # collision detection $try_text_wrap = 1; @box[8,9] = ( $p->{x}, $p->{y}); push @all_boxes, \@translated_box if $collisions == 1; while ( not $p-> {end} and length ($text) ) { # Try to fit next glyphs in the string. We don't know whether more than 1 glyph # fits, but if yes, text_wrap() will speed up things a lot. Otherwise, fit each # character individually my ( $t); my ( $x, $y) = @$p{qw(x y)}; #print "* point $x $y\n"; # obtain next position if ( $try_text_wrap) { my $chunk = $self-> text_wrap( $text, $p-> {lleft}, tw::BreakSingle|tw::ReturnFirstLineLength ); $t = substr( $text, 0, $chunk, ''); unless ( $collisions) { #print "'$t' text_wrap plot at $x,$y,$p->{a}\n" if $chunk; push @chunks, [ $t, $p->{a}, $x, $y] if $chunk; unless ( $bevel) { # simple case update_box( $self, $x, $y, $angle = $p->{a}, \$t, \@box); set_pointer( $p, @box[8,9]); next_segment($p); next; } } unless ( $chunk) { $try_text_wrap = 0; goto SINGLE_GLYPH; } update_box( $self, $x, $y, $angle = $p->{a}, \$t, \@box); set_pointer( $p, @box[8,9]); #print "text_wrap '$t' move to $p->{x},$p->{y}\n"; } else { SINGLE_GLYPH: $t = substr( $text, 0, 1, ''); my ( $a, $b, $c) = @{ $self-> get_font_abc( ord($t), ord($t), utf8::is_utf8($t) )}; my $w = $a + $b + $c; $angle = move_pointer( $p, $w); update_box( $self, $x, $y, $angle, \$t, \@box); #print "'$t' single, move to $p->{x},$p->{y}\n"; unless ( $collisions) { push @chunks, [ $t, $angle, $x, $y ]; $try_text_wrap = 1; #print "'$t' bevel plot at $x,$y,".(defined($angle)?$angle:"undef")."\n"; } } next unless $collisions; # first glyphs don't need to be checked for collisions unless ( @translated_box) { %start = %$p; precalc_box( $angle, \@box, \@translated_box); push @all_boxes, [@translated_box] if $collisions > 1; push @chunks, [ $t, $angle, $x, $y ]; #print "plot '$t' at $x,$y,$angle init non-overlap\n"; next; } # if glyphs overlap, move the pointer forwards, # otherwise backwards until the overlapping occurs my $start_direction = -1; for ( @all_boxes) { next unless boxes_overlap( $_, \@box); $start_direction = 1; last; } $fitting_direction = ( not defined($fitting_direction) or $fitting_direction == $start_direction ) ? $start_direction : undef ; if ( defined $fitting_direction) { # retry @walkback = ($x, $y, $angle) if $fitting_direction < 0; move_pointer( \%start, $fitting_direction); %$p = %start; #print "retry direction=$start_direction from $start{x} $start{y}\n"; $text = $t . $text; } else { # done if ( $start_direction > 0) { # was moving backwards ($x, $y, $angle) = @walkback; } $try_text_wrap = 1; %start = %$p; #print "plot '$t' at $x,$y,$angle non-overlap\n"; push @chunks, [ $t, $angle, $x, $y]; precalc_box( $angle, \@box, \@translated_box); push @all_boxes, [@translated_box] if $collisions > 1; %start = %$p; } } if ( length $text and not $options{skiptail}) { $angle = $p-> {a} unless $bevel; #print "'$text' at @box[8,9] ".(defined($angle)?$angle:"undef")." tail\n"; push @chunks, [ $text, $angle, @box[8,9]]; } $options{callback}->( $self, $p, \@chunks) if $options{callback}; unless ( $options{nodraw}) { for ( @chunks) { my ( $text, $angle, $x, $y) = @$_; $self-> font-> direction($angle) if defined $angle; last unless $retval = $self-> text_out( $text, $x, $y); } } $self-> font-> direction($fa); return wantarray ? @chunks : $retval; } 1; __END__ =pod =head1 NAME Prima::CurvedText - fit text to path =head1 DESCRIPTION The module registers single function C in C namespace. The function plots the line of text along the path, which given as a set of points. Various options regulate behavior of the function when glyphs collide with the path boundaries and each other. =head1 SYNOPSIS use Prima qw(Application CurvedText); $::application-> begin_paint; $::application-> curved_text_out( 'Hello, world!', $::application-> render_spline( [qw(100 100 150 150 200 100)])); =head2 curved_text_out $TEXT, $POLYLINE, %OPTIONS C<$TEXT> is a line of text, no special treatment is given to tab and newline characters. The text is plotted over C<$POLYLINE> path that should be an array of coordinate numeric pairs, in the same format as C expects. The text begins to plot by drawing the first glyphs at the first path point, unless specified otherwise with the C option. The glyph is plotted with the angle perpendicular to the path segment; therefore the path may contain floating point numbers if futher plotting angle accuracy is desired. When text cannot be fit along a single segment, it is plotted along the next segment in the path. Depending on the C boolean option, the next glyph is either simply drawn on the next segment with the angle corresponding to the tangent of that segment (value 0), or is drawn with the normal text concatenation offset, with the angle averaged between tangents of the two segments it is plotted between (value 1). The default value of C option is 1. The glyph positioning rules differ depending on C integer option. If 0 (default), the next glyph position always corresponds with the glyph width as projected to the path. That means, that glyphs will overlap when plotted inside segments forming an acute angle. Also, when plotting along a reflex angle, the glyphs will be visually more distant from each other that when plotted along the straight line. Simple collision detection can be turned on with setting C to 1 so that no two neighbour glyphs may overlap. Also, the glyphs will be moved together to the minimal distance, when possible. With this option set the function will behave slower. If detection of not only neighbouring glyphs is required, C value can be set to 2, in which case a glyph is guaranteedly will never overlap any other glyph. This option may be needed when, for example, text is plotted inside an acute angle and upper parts of glyphs plotted along one segment will overlap with lower parts of glyphs plotted along the other one. Setting C to 2 will slow the function even more. The function internally creates an array of tuples where each contains text, plotting angle, and horisontal and vertical coordinates for the text to be plotted. In the array context the function returns this array. In the scalar context the function returns the success flag that is the result of last call to C. Options: =over =item bevel BOOLEAN=true If set, glyphs between two adjoining segments will be plotted with bevelled angle. Otherwise glyphs will strictly follow the angles of the segments in the path. =item callback CODE($SELF, $POLYLINE, $CHUNKS) If set, the callback is called with C<$CHUNKS> after the calculations were made but before the text is plotted. C<$CHUNKS> is an array of tuples where each consists of text, angle, x and y coordinates for each text. The callback is free to modify the array. =item collisions INTEGER=0 If 0, collision detection is disabled, glyphs plotted along the path. If 1, no two neighbour glyphs may overlap, and no two neighbour glyph will be situated further away from each other than it is necessary. If 2, same functionality as with 1, and also two glyphs (in all text) will overlap. =item nodraw BOOLEAN=false If set, calculate glyph positions but do not draw them. =item offset INTEGER=0 Sets offset from the beginning of the path where the first glyph is plotted. If offset is negative, it is calculated from the end of the path. =item skiptail BOOLEAN=false If set, the remainder of the text that is left after the path is completely traversed, is not shown. Otherwise (default), the tail text is shown with the angle used to plot the last glyph (if bevelling was requested) or the angle perpendicular to the last path segment (otherwise). =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L =cut Prima-1.28/Prima/Buttons.pm0000644000175100017510000012067211150770061013346 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: Buttons.pm,v 1.43 2008/04/09 16:58:10 dk Exp $ # contains: # Button # CheckBox # Radio # SpeedButton # RadioGroup ( obsolete ) # GroupBox # CheckBoxGroup ( obsolete ) # # AbstractButton # Cluster use Carp; use Prima::Const; use Prima::Classes; use Prima::IntUtils; use Prima::StdBitmap; use strict; package Prima::AbstractButton; use vars qw(@ISA); @ISA = qw(Prima::Widget Prima::MouseScroller); { my %RNT = ( %{Prima::Widget-> notification_types()}, Check => nt::Default, ); sub notification_types { return \%RNT; } } sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, pressed => 0, selectable => 1, autoHeight => 1, autoWidth => 1, } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> { autoWidth} = 0 if exists $p-> {width} || exists $p-> {size} || exists $p-> {rect} || ( exists $p-> {left} && exists $p-> {right}); $p-> {autoHeight} = 0 if exists $p-> {height} || exists $p-> {size} || exists $p-> {rect} || ( exists $p-> {top} && exists $p-> {bottom}); $self-> SUPER::profile_check_in( $p, $default); } sub on_translateaccel { my ( $self, $code, $key, $mod) = @_; if ( defined $self-> {accel} && ($key == kb::NoKey) && lc chr $code eq $self-> { accel} ) { $self-> clear_event; $self-> notify( 'Click'); } if ( $self-> { default} && $key == kb::Enter) { $self-> clear_event; $self-> notify( 'Click'); } } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> { pressed} = $profile{ pressed}; $self-> { autoHeight} = $profile{ autoHeight}; $self-> { autoWidth} = $profile{ autoWidth}; return %profile; } sub cancel_transaction { my $self = $_[0]; if ( $self-> {mouseTransaction} || $self-> {spaceTransaction}) { $self-> {spaceTransaction} = undef; $self-> capture(0) if $self-> {mouseTransaction}; $self-> {mouseTransaction} = undef; $self-> pressed( 0); } } sub on_keydown { my ( $self, $code, $key, $mod, $repeat) = @_; if ( $key == kb::Space) { $self-> clear_event; return if $self-> {spaceTransaction} || $self-> {mouseTransaction}; $self-> { spaceTransaction} = 1; $self-> pressed( 1); } if ( defined $self-> {accel} && ($key == kb::NoKey) && lc chr $code eq $self-> { accel} ) { $self-> clear_event; $self-> notify( 'Click'); } } sub on_keyup { my ( $self, $code, $key, $mod) = @_; if ( $key == kb::Space && $self-> {spaceTransaction}) { $self-> {spaceTransaction} = undef; $self-> capture(0) if $self-> {mouseTransaction}; $self-> {mouseTransaction} = undef; $self-> pressed( 0); $self-> update_view; $self-> clear_event; $self-> notify( 'Click') } } sub on_leave { my $self = $_[0]; if ( $self-> {spaceTransaction} || $self-> {mouseTransaction}) { $self-> cancel_transaction; } else { $self-> repaint; } } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {mouseTransaction} || $self-> {spaceTransaction}; return if $btn != mb::Left; $self-> { mouseTransaction} = 1; $self-> { lastMouseOver} = 1; $self-> pressed( 1); $self-> capture(1); $self-> clear_event; $self-> scroll_timer_start if $self-> {autoRepeat}; } sub on_mouseclick { my ( $self, $btn, $mod, $x, $y, $dbl) = @_; return unless $dbl; return if $btn != mb::Left; return if $self-> {mouseTransaction} || $self-> {spaceTransaction}; $self-> { mouseTransaction} = 1; $self-> { lastMouseOver} = 1; $self-> pressed( 1); $self-> capture(1); $self-> clear_event; } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return if $btn != mb::Left; return unless $self-> {mouseTransaction}; my @size = $self-> size; $self-> {mouseTransaction} = undef; $self-> {spaceTransaction} = undef; $self-> {lastMouseOver} = undef; $self-> capture(0); $self-> pressed( 0); if ( $x > 0 && $y > 0 && $x < $size[0] && $y < $size[1] ) { $self-> clear_event; $self-> update_view; $self-> notify( 'Click'); } } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; return unless $self-> {mouseTransaction}; return if $self-> {autoRepeat} && !$self-> scroll_timer_semaphore; my @size = $self-> size; my $mouseOver = $x > 0 && $y > 0 && $x < $size[0] && $y < $size[1]; $self-> pressed( $mouseOver) if $self-> { lastMouseOver} != $mouseOver; $self-> { lastMouseOver} = $mouseOver; return unless $self-> {autoRepeat}; $self-> scroll_timer_stop, return unless $mouseOver; $self-> scroll_timer_start, return unless $self-> scroll_timer_active; $self-> scroll_timer_semaphore(0); $self-> notify(q(Click)); } sub on_fontchanged { $_[0]-> check_auto_size; } sub draw_veil { my ($self,$canvas) = (shift, shift); my $back = $self-> backColor; $canvas-> set( color => cl::Clear, backColor => cl::Set, fillPattern => fp::SimpleDots, rop => rop::AndPut ); $canvas-> bar( @_); $canvas-> set( color => $back, backColor => cl::Clear, rop => rop::OrPut ); $canvas-> bar( @_); $canvas-> set( rop => rop::CopyPut, backColor => $back, ); } sub draw_caption { my ( $self, $canvas, $x, $y) = @_; my $cap = $self-> text; $cap =~ s/^([^~]*)\~(.*)$/$1$2/; my ( $leftPart, $accel) = ( $1, ( defined ($2) && length($2)) ? substr( $2, 0, 1) : undef); my ( $fw, $fh, $enabled) = ( $canvas-> get_text_width( $cap), $canvas-> font-> height, $self-> enabled ); if ( defined $accel) { my ( $a, $b, $c) = ( $canvas-> get_text_width( $leftPart), $canvas-> get_text_width( $leftPart.$accel), $canvas-> get_text_width( $accel) ); unless ( $enabled) { my $z = $canvas-> color; $canvas-> color( cl::White); $canvas-> line( $x + $b - $c + 1, $y - 1, $x + $b * 2 - $a - $c, $y - 1); $canvas-> color( $z); } $canvas-> line( $x + $b - $c, $y, $x + $b * 2 - $a - $c - 1, $y); } unless ( $enabled) { my $c = $canvas-> color; $canvas-> color( cl::White); $canvas-> text_out( $cap, $x+1, $y-1); $canvas-> color( $c); } $canvas-> text_out( $cap, $x, $y); $canvas-> rect_focus( $x - 2, $y - 2, $x + 2 + $fw, $y + 2 + $fh) if $self-> focused; } sub caption_box { my ($self,$canvas) = @_; my $cap = $self-> text; $cap =~ s/~//; $canvas = $self unless $canvas; return $canvas-> get_text_width( $cap), $canvas-> font-> height; } sub calc_geom_size { $_[0]-> caption_box } sub pressed { return $_[0]-> {pressed} unless $#_; $_[0]-> { pressed} = $_[1]; $_[0]-> repaint; } sub text { return $_[0]-> SUPER::text unless $#_; my ( $self, $caption) = @_; my $cap = $caption; $cap =~ s/^([^~]*)\~(.*)$/$1$2/; my $ac = $self-> { accel} = (defined($2) && length($2)) ? lc substr( $2, 0, 1) : undef; $self-> SUPER::text( $caption); $self-> check_auto_size; $self-> repaint; } sub on_enable { $_[0]-> repaint; } sub on_disable { $_[0]-> cancel_transaction; $_[0]-> repaint; } sub on_enter { $_[0]-> repaint; } sub autoHeight { return $_[0]-> {autoHeight} unless $#_; my ( $self, $a) = @_; return if ( $self-> {autoHeight} ? 1 : 0) == ( $a ? 1 : 0); $self-> {autoHeight} = ( $a ? 1 : 0); $self-> check_auto_size if $a; } sub autoWidth { return $_[0]-> {autoWidth} unless $#_; my ( $self, $a) = @_; return if ( $self-> {autoWidth} ? 1 : 0) == ( $a ? 1 : 0); $self-> {autoWidth} = ( $a ? 1 : 0); $self-> check_auto_size if $a; } sub check_auto_size { my $self = $_[0]; my %sets; if ( $self-> {autoWidth} || $self-> {autoHeight}) { my @geomSize = $self-> calc_geom_size; $sets{ geomWidth} = $geomSize[0] if $self-> {autoWidth}; $sets{ geomHeight} = $geomSize[1] if $self-> {autoHeight}; $self-> set( %sets); } } package Prima::Button; use vars qw(@ISA); @ISA = qw(Prima::AbstractButton); my %standardGlyphScheme = ( glyphs => 4, defaultGlyph => 0, hiliteGlyph => 0, disabledGlyph => 1, pressedGlyph => 2, holdGlyph => 3, ); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, autoRepeat => 0, borderWidth => 2, checkable => 0, checked => 0, default => 0, flat => 0, glyphs => 1, height => 36, image => undef, imageFile => undef, imageScale => 1, modalResult => 0, vertical => 0, width => 96, widgetClass => wc::Button, defaultGlyph => 0, hiliteGlyph => 0, disabledGlyph => 1, pressedGlyph => 2, holdGlyph => 3, } } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); my $checkable = exists $p-> {checkable} ? $p-> {checkable} : $default-> {checkable}; $p-> { checked} = 0 unless $checkable; } sub init { my $self = shift; $self-> {$_} = 0 for ( qw( borderWidth checkable checked default vertical defaultGlyph hiliteGlyph disabledGlyph pressedGlyph holdGlyph flat modalResult autoRepeat )); $self-> {imageScale} = $self-> {glyphs} = 1; $self-> {image} = undef; my %profile = $self-> SUPER::init(@_); defined $profile{image} ? $self-> image( $profile{image}) : $self-> imageFile( $profile{imageFile}); $self-> $_( $profile{$_}) for ( qw( borderWidth checkable checked default imageScale glyphs vertical defaultGlyph hiliteGlyph disabledGlyph pressedGlyph holdGlyph flat modalResult autoRepeat )); return %profile; } sub on_paint { my ($self,$canvas) = @_; my @clr = ( $self-> color, $self-> backColor); @clr = ( $self-> hiliteColor, $self-> hiliteBackColor) if $self-> { default}; @clr = ( $self-> disabledColor, $self-> disabledBackColor) if !$self-> enabled; my @size = $canvas-> size; my @fbar = $self-> {default} ? ( 1, 1, $size[0] - 2, $size[1] - 2): ( 0, 0, $size[0] - 1, $size[1] - 1); if ( !$self-> {flat} || $self-> {hilite}) { $self-> rect_bevel( $canvas, @fbar, fill => ( $self-> transparent ? undef : $clr[1]), width => $self-> {borderWidth}, concave => ( $_[0]-> { pressed} || $_[0]-> { checked}), ); } else { $canvas-> color( $clr[ 1]); $canvas-> bar( @fbar) unless $self-> transparent; } if ( $self-> {default}) { $canvas-> color( cl::Black); $canvas-> rectangle( 0, 0, $size[0]-1, $size[1]-1); } my $shift = $self-> {checked} ? 1 : 0; $shift += $self-> {pressed} ? 2 : 0; my $capOk = length($self-> text) > 0; my ( $fw, $fh) = $capOk ? $self-> caption_box($canvas) : ( 0, 0); my ( $textAtX, $textAtY); if ( defined $self-> {image}) { my $pw = $self-> {image}-> width / $self-> { glyphs}; my $ph = $self-> {image}-> height; my $sw = $pw * $self-> {imageScale}; my $sh = $ph * $self-> {imageScale}; my $imgNo = $self-> {defaultGlyph}; my $useVeil = 0; if ( $self-> {hilite}) { $imgNo = $self-> {hiliteGlyph} if $self-> {glyphs} > $self-> {hiliteGlyph} && $self-> {hiliteGlyph} >= 0; } if ( $self-> {checked}) { $imgNo = $self-> {holdGlyph} if $self-> {glyphs} > $self-> {holdGlyph} && $self-> {holdGlyph} >= 0; } if ( $self-> {pressed}) { $imgNo = $self-> {pressedGlyph} if $self-> {glyphs} > $self-> {pressedGlyph} && $self-> {pressedGlyph} >= 0; } if ( !$self-> enabled) { ( $self-> {glyphs} > $self-> {disabledGlyph} && $self-> {disabledGlyph} >= 0) ? $imgNo = $self-> {disabledGlyph} : $useVeil = 1; } my ( $imAtX, $imAtY); if ( $capOk) { if ( $self-> { vertical}) { $imAtX = ( $size[ 0] - $sw) / 2 + $shift; $imAtY = ( $size[ 1] - $fh - $sh) / 3; $textAtX = ( $size[0] - $fw) / 2 + $shift; $textAtY = $size[ 1] - 2 * $imAtY - $fh - $sh - $shift; $imAtY = $size[ 1] - $imAtY - $sh - $shift; } else { $imAtX = ( $size[ 0] - $fw - $sw) / 3; $imAtY = ( $size[ 1] - $sh) / 2 - $shift; $textAtX = 2 * $imAtX + $sw + $shift; $textAtY = ( $size[1] - $fh) / 2 - $shift; $imAtX += $shift; } } else { $imAtX = ( $size[0] - $sw) / 2 + $shift; $imAtY = ( $size[1] - $sh) / 2 - $shift; } $canvas-> put_image_indirect( $self-> {image}, $imAtX, $imAtY, $imgNo * $pw, 0, $sw, $sh, $pw, $ph, rop::CopyPut ); $self-> draw_veil( $canvas, $imAtX, $imAtY, $imAtX + $sw, $imAtY + $sh) if $useVeil; } else { $textAtX = ( $size[0] - $fw) / 2 + $shift; $textAtY = ( $size[1] - $fh) / 2 - $shift; } $canvas-> color( $clr[0]); $self-> draw_caption( $canvas, $textAtX, $textAtY) if $capOk; $canvas-> rect_focus( 4, 4, $size[0] - 5, $size[1] - 5 ) if !$capOk && $self-> focused; } sub on_keydown { my ( $self, $code, $key, $mod, $repeat) = @_; if ( $key == kb::Enter) { $self-> clear_event; return $self-> notify( 'Click') } $self-> SUPER::on_keydown( $code, $key, $mod, $repeat); } sub on_click { my $self = $_[0]; $self-> checked( !$self-> checked) if $self-> { checkable}; my $owner = $self-> owner; if ( $owner-> isa(q(Prima::Window)) && $owner-> get_modal && $self-> modalResult ) { $owner-> modalResult( $self-> modalResult); $owner-> end_modal; } } sub on_check {} sub on_mouseenter { my $self = $_[0]; if ( !$self-> {spaceTransaction} && !$self-> {mouseTransaction} && $self-> enabled ) { $self-> {hilite} = 1; $self-> repaint if $self-> {flat} || $self-> {defaultGlyph} != $self-> {hiliteGlyph}; } } sub on_mouseleave { my $self = $_[0]; if ( $self-> {hilite}) { undef $self-> {hilite}; $self-> repaint if $self-> {flat} || $self-> {defaultGlyph} != $self-> {hiliteGlyph}; } } sub std_calc_geom_size { my $self = $_[0]; my $capOk = length($self-> text); my @sz = $capOk ? $self-> caption_box : (0,0); $sz[$_] += 10 for 0,1; if ( defined $self-> {image}) { my $imw = $self-> {image}-> width / $self-> { glyphs} * $self-> {imageScale}; my $imh = $self-> {image}-> height / $self-> { glyphs} * $self-> {imageScale}; if ( $capOk) { if ( $self-> { vertical}) { $sz[0] = $imw if $sz[0] < $imw; $sz[1] += 2 + $imh; } else { $sz[0] += 2 + $imw; $sz[1] = $imh if $sz[1] < $imh; } } else { $sz[0] += $imw; $sz[1] += $imh; } } $sz[$_] += 2 for 0,1; $sz[$_] += $self-> {borderWidth} * 2 for 0,1; return @sz; } sub calc_geom_size { my @sz = $_[0]-> std_calc_geom_size; $sz[0] = 96 if $sz[0] < 96; $sz[1] = 36 if $sz[1] < 36; return @sz; } sub autoRepeat { return $_[0]-> {autoRepeat} unless $#_; $_[0]-> {autoRepeat} = $_[1]; } sub borderWidth { return $_[0]-> {borderWidth} unless $#_; my ( $self, $bw) = @_; $bw = 0 if $bw < 0; $bw = int( $bw); return if $bw == $self-> {borderWidth}; $self-> {borderWidth} = $bw; $self-> check_auto_size; $self-> repaint; } sub checkable { return $_[0]-> {checkable} unless $#_; $_[0]-> checked( 0) unless $_[0]-> {checkable} == $_[1]; $_[0]-> {checkable} = $_[1]; } sub checked { return $_[0]-> {checked} unless $#_; return unless $_[0]-> { checkable}; return if $_[0]-> {checked}+0 == $_[1]+0; $_[0]-> {checked} = $_[1]; $_[0]-> repaint; $_[0]-> notify( 'Check', $_[0]-> {checked}); } sub default { return $_[0]-> {default} unless $#_; my $self = $_[0]; return if $self-> {default} == $_[1]; if ( $self-> { default} = $_[1]) { my @widgets = $self-> owner-> widgets; for ( @widgets) { last if $_ == $self; $_-> default(0) if $_-> isa(q(Prima::Button)) && $_-> default; } } $self-> repaint; } sub defaultGlyph {($#_)?($_[0]-> {defaultGlyph} = $_[1],$_[0]-> repaint) :return $_[0]-> {defaultGlyph}} sub hiliteGlyph {($#_)?($_[0]-> {hiliteGlyph} = $_[1],$_[0]-> repaint) :return $_[0]-> {hiliteGlyph}} sub disabledGlyph{($#_)?($_[0]-> {disabledGlyph}= $_[1],$_[0]-> repaint) :return $_[0]-> {disabledGlyph}} sub pressedGlyph {($#_)?($_[0]-> {pressedGlyph} = $_[1],$_[0]-> repaint) :return $_[0]-> {pressedGlyph}} sub holdGlyph {($#_)?($_[0]-> {holdGlyph} = $_[1],$_[0]-> repaint) :return $_[0]-> {holdGlyph}} sub flat {($#_)?($_[0]-> {flat} = $_[1],$_[0]-> repaint) :return $_[0]-> {flat}} sub image { return $_[0]-> {image} unless $#_; my ( $self, $image) = @_; $self-> {image} = $image; $self-> check_auto_size; $self-> repaint; } sub imageFile { return $_[0]-> {imageFile} unless $#_; my ($self,$file) = @_; $self-> image(undef), return unless defined $file; my $img = Prima::Icon-> create; my @fp = ($file); $fp[0] =~ s/\:(\d+)$//; push( @fp, 'index', $1) if defined $1; return unless $img-> load(@fp); $self-> {imageFile} = $file; $self-> image($img); } sub imageScale { return $_[0]-> {imageScale} unless $#_; my ( $self, $imageScale) = @_; $self-> {imageScale} = $imageScale; if ( $self-> {image}) { $self-> check_auto_size; $self-> repaint; } } sub vertical { return $_[0]-> {vertical} unless $#_; my ( $self, $vertical) = @_; $self-> {vertical} = $vertical; $self-> check_auto_size; $self-> repaint; } sub modalResult { return $_[0]-> {modalResult} unless $#_; my $self = $_[0]; $self-> { modalResult} = $_[1]; my $owner = $self-> owner; if ( $owner-> isa(q(Prima::Window)) && $owner-> get_modal && $self-> {modalResult} ) { $owner-> modalResult( $self-> { modalResult}); $owner-> end_modal; } } sub glyphs { return $_[0]-> {glyphs} unless $#_; my $maxG = defined $_[0]-> {image} ? $_[0]-> {image}-> width : 1; $maxG = 1 unless $maxG; if ( $_[1] > 0 && $_[1] <= $maxG) { $_[0]-> {glyphs} = $_[1]; $_[0]-> repaint; } } package Prima::Cluster; use vars qw(@ISA @images); @ISA = qw(Prima::AbstractButton); my @images; { my $i = 0; for ( sbmp::CheckBoxUnchecked, sbmp::CheckBoxUncheckedPressed, sbmp::CheckBoxChecked, sbmp::CheckBoxCheckedPressed, sbmp::RadioUnchecked, sbmp::RadioUncheckedPressed, sbmp::RadioChecked, sbmp::RadioCheckedPressed ) { $images[ $i] = ( $i > 3) ? Prima::StdBitmap::icon( $_) : Prima::StdBitmap::image( $_); $i++; } } sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, auto => 1, checked => 0, height => 36, ownerBackColor => 1, } } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> { auto } = $profile{ auto }; $self-> { checked} = $profile{ checked}; $self-> check_auto_size; return %profile; } sub on_keydown { my ( $self, $code, $key, $mod, $repeat) = @_; if ( $key == kb::Tab || $key == kb::BackTab) { my ( $next, $owner) = ( $self, $self-> owner); while ( $next) { last unless $next-> owner == $owner && $next-> isa('Prima::Cluster'); $next = $next-> next_tab( $key == kb::Tab); } $next-> select if $next; $self-> clear_event; return; } $self-> SUPER::on_keydown( $code, $key, $mod, $repeat); } sub on_click { my $self = $_[0]; $self-> focus; $self-> checked( !$self-> checked); } sub on_enter { my $self = $_[0]; $self-> check if $self-> auto; $self-> SUPER::on_enter; } sub auto { ($#_) ? $_[0]-> {auto} = $_[1] : return $_[0]-> {auto}} sub checked { return $_[0]-> {checked} unless $#_; my $old = $_[0]-> {checked}; my $new = $_[1] ? 1 : 0; if ( $old != $new) { $_[0]-> {checked} = $new; $_[0]-> repaint; $_[0]-> notify( 'Check', $_[0]-> {checked}); } } sub toggle { my $i = $_[0]-> checked; $_[0]-> checked( !$i); return !$i;} sub check { $_[0]-> checked(1)} sub uncheck { $_[0]-> checked(0)} my @static_image0_size; sub calc_geom_size { my $self = $_[0]; my @sz = $self-> caption_box; $sz[$_] += 12 for 0,1; if ( $images[0]) { @static_image0_size = $images[0]-> size unless @static_image0_size; $sz[0] += $static_image0_size[0] + 2; $sz[1] = $static_image0_size[1] if $sz[1] < $static_image0_size[1]; } else { $sz[0] += 16; $sz[1] = 16 if $sz[1] < 16; } return @sz; } package Prima::CheckBox; use vars qw(@ISA); @ISA = qw(Prima::Cluster); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, auto => 0, widgetClass => wc::CheckBox, } } sub on_paint { my ($self,$canvas) = @_; my @clr; if ( $self-> enabled) { if ( $self-> focused) { @clr = ($self-> hiliteColor, $self-> hiliteBackColor); } else { @clr = ($self-> color, $self-> backColor); } } else { @clr = ($self-> disabledColor, $self-> disabledBackColor); } my @size = $canvas-> size; unless ( $self-> transparent) { $canvas-> color( $clr[ 1]); $canvas-> bar( 0, 0, @size); } my ( $image, $imNo); if ( $self-> { checked}) { $imNo = $self-> { pressed} ? 3 : 2; } else { $imNo = $self-> { pressed} ? 1 : 0; }; my $xStart; $image = $images[ $imNo]; my @c3d = ( $self-> light3DColor, $self-> dark3DColor); if ( $image) { $canvas-> put_image( 0, ( $size[1] - $image-> height) / 2, $image); $xStart = $image-> width; } else { $xStart = 16; push ( @c3d, shift @c3d) if $self-> { pressed}; $canvas-> rect3d( 1, ( $size[1] - 14) / 2, 15, ( $size[1] + 14) / 2, 1, @c3d, $clr[ 1]); if ( $self-> { checked}) { my $at = $self-> { pressed} ? 1 : 0; $canvas-> color( cl::Black); $canvas-> lineWidth( 2); my $yStart = ( $size[1] - 14) / 2; $canvas-> line( $at + 4, $yStart - $at + 8, $at + 5 , $yStart - $at + 3 ); $canvas-> line( $at + 5 , $yStart - $at + 3, $at + 12, $yStart - $at + 12 ); $canvas-> lineWidth( 0); } } $canvas-> color( $clr[ 0]); my ( $fw, $fh) = $self-> caption_box( $canvas); $self-> draw_caption( $canvas, $xStart * 1.5, ( $size[1] - $fh) / 2 ); } package Prima::Radio; use vars qw(@ISA @images); @ISA = qw(Prima::Cluster); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; @$def{qw(widgetClass)} = (wc::Radio, undef); return $def; } sub on_paint { my ($self,$canvas) = @_; my @clr; if ( $self-> enabled) { if ( $self-> focused) { @clr = ($self-> hiliteColor, $self-> hiliteBackColor); } else { @clr = ($self-> color, $self-> backColor); } } else { @clr = ($self-> disabledColor, $self-> disabledBackColor); } my @size = $canvas-> size; unless ( $self-> transparent) { $canvas-> color( $clr[ 1]); $canvas-> bar( 0, 0, @size); } my ( $image, $imNo); if ( $self-> { checked}) { $imNo = $self-> { pressed} ? 7 : 6; } else { $imNo = $self-> { pressed} ? 5 : 4; }; my $xStart; $image = $images[ $imNo]; if ( $image) { $canvas-> put_image( 0, ( $size[1] - $image-> height) / 2, $image); $xStart = $image-> width; } else { $xStart = 16; my $y = ( $size[1] - 16) / 2; my @xs = ( 0, 8, 16, 8); my @ys = ( 8, 16, 8, 0); for ( @ys) {$_+=$y}; my $i; if ( $self-> { pressed}) { $canvas-> color( cl::Black); for ( $i = -1; $i < 3; $i++) { $canvas-> line( $xs[$i], $ys[$i], $xs[$i + 1], $ys[$i + 1] ) }; } else { my @clr = $self-> {checked} ? ( $self-> light3DColor, $self-> dark3DColor) : ( $self-> dark3DColor, $self-> light3DColor); $canvas-> color( $clr[1]); for ( $i = -1; $i < 1; $i++) { $canvas-> line( $xs[$i], $ys[$i], $xs[$i + 1],$ys[$i + 1] ) }; $canvas-> color( $clr[0]); for ( $i = 1; $i < 3; $i++) { $canvas-> line( $xs[$i], $ys[$i], $xs[$i + 1],$ys[$i + 1] ) }; } if ( $self-> checked) { $canvas-> color( cl::Black); $canvas-> fillpoly( [ 6, $y+8, 8, $y+10, 10, $y+8, 8, $y+6]); } } $canvas-> color( $clr[ 0]); my ( $fw, $fh) = $self-> caption_box( $canvas); $self-> draw_caption( $canvas, $xStart * 1.5, ( $size[1] - $fh) / 2 ); } sub on_click { my $self = $_[0]; $self-> focus; $self-> checked( 1) unless $self-> checked; } sub checked { return $_[0]-> {checked} unless $#_; my $self = $_[0]; my $chkOk = $self-> {checked}; my $old = $self-> {checked} + 0; $self-> {checked} = $_[1] + 0; if ( $old != $_[1] + 0) { $self-> repaint; $chkOk = ( $self-> {checked} != $chkOk) && $self-> {checked}; my $owner = $self-> owner; $owner-> notify( 'RadioClick', $self) if $chkOk && exists $owner-> notification_types-> {RadioClick}; $self-> notify( 'Check', $self-> {checked}); } } package Prima::SpeedButton; use vars qw(@ISA); @ISA = qw(Prima::Button); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; @$def{qw(selectable width height text)} = (0, 36, 36, ""); return $def; } sub calc_geom_size { my @sz = $_[0]-> std_calc_geom_size; $sz[0] = 36 if $sz[0] < 36; $sz[1] = 36 if $sz[1] < 36; return @sz; } package Prima::GroupBox; use vars qw(@ISA); @ISA=qw(Prima::Widget); { my %RNT = ( %{Prima::Cluster-> notification_types()}, RadioClick => nt::Default, ); sub notification_types { return \%RNT; } } sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, ownerBackColor => 1, autoEnableChildren => 1, } } sub on_radioclick { my ($me,$rd) = @_; for ($me-> widgets) { next if "$rd" eq "$_"; next unless $_-> isa(q(Prima::Radio)); $_-> checked(0); } } sub on_paint { my ( $self, $canvas) = @_; my @size = $canvas-> size; my @clr = $self-> enabled ? ( $self-> color, $self-> backColor) : ( $self-> disabledColor, $self-> disabledBackColor); unless ( $self-> transparent) { $canvas-> color( $clr[1]); $canvas-> bar( 0, 0, @size); } my $fh = $canvas-> font-> height; $canvas-> color( $self-> light3DColor); $canvas-> rectangle( 1, 0, $size[0] - 1, $size[1] - $fh / 2 - 2); $canvas-> color( $self-> dark3DColor); $canvas-> rectangle( 0, 1, $size[0] - 2, $size[1] - $fh / 2 - 1); my $c = $self-> text; if ( length( $c) > 0) { $canvas-> color( $clr[1]); $canvas-> bar ( 8, $size[1] - $fh - 1, 16 + $canvas-> get_text_width( $c), $size[1] - 1 ); $canvas-> color( $clr[0]); $canvas-> text_out( $c, 12, $size[1] - $fh - 1); } } sub index { my $self = $_[0]; my @c = grep { $_-> isa(q(Prima::Radio))} $self-> widgets; if ( $#_) { my $i = $_[1]; $i = 0 if $i < 0; $i = $#c if $i > $#c; $c[$i]-> check if $c[$i]; } else { my $i; for ( $i = 0; $i < scalar @c; $i++) { return $i if $c[$i]-> checked; } return -1; } } sub text { return $_[0]-> SUPER::text unless $#_; $_[0]-> SUPER::text($_[1]); $_[0]-> repaint; } sub value { my $self = $_[0]; my @c = grep { $_-> isa(q(Prima::CheckBox))} $self-> widgets; my $i; if ( $#_) { my $value = $_[1]; for ( $i = 0; $i < scalar @c; $i++) { $c[$i]-> checked( $value & ( 1 << $i)); } } else { my $value = 0; for ( $i = 0; $i < scalar @c; $i++) { $value |= 1 << $i if $c[$i]-> checked; } return $value; } } package Prima::RadioGroup; use vars qw(@ISA); @ISA=qw(Prima::GroupBox); package Prima::CheckBoxGroup; use vars qw(@ISA); @ISA=qw(Prima::GroupBox); 1; __DATA__ =pod =head1 NAME Prima::Buttons - button widgets and grouping widgets. =head1 SYNOPSIS use Prima qw(Application Buttons StdBitmap); my $window = Prima::MainWindow-> create; Prima::Button-> new( owner => $window, text => 'Simple button', pack => {}, ); $window-> insert( 'Prima::SpeedButton' , pack => {}, image => Prima::StdBitmap::icon(0), ); run Prima; =head1 DESCRIPTION Prima::Buttons provides two separate sets of classes: the button widgets and the grouping widgets. The button widgets include push buttons, check-boxes and radio buttons. The grouping widgets are designed for usage as containers for the check-boxes and radio buttons, however, any widget can be inserted in a grouping widget. The module provides the following classes: *Prima::AbstractButton ( derived from Prima::Widget and Prima::MouseScroller ) Prima::Button Prima::SpeedButton *Prima::Cluster Prima::CheckBox Prima::Radio Prima::GroupBox ( derived from Prima::Widget ) Prima::RadioGroup ( obsolete ) Prima::CheckBoxGroup ( obsolete ) Note: C<*> - marked classes are abstract. =head1 USAGE use Prima::Buttons; my $button = $widget-> insert( 'Prima::Button', text => 'Push button', onClick => sub { print "hey!\n" }, ); $button-> flat(1); my $group = $widget-> insert( 'Prima::GroupBox', onRadioClick => sub { print $_[1]-> text, "\n"; } ); $group-> insert( 'Prima::Radio', text => 'Selection 1'); $group-> insert( 'Prima::Radio', text => 'Selection 2', pressed => 1); $group-> index(0); =head1 Prima::AbstractButton Prima::AbstractButton realizes common functionality of buttons. It provides reaction on mouse and keyboard events, and calls L notification when the user activates the button. The mouse activation is performed either by mouse double click or successive mouse down and mouse up events within the button boundaries. The keyboard activation is performed on the following conditions: =over =item * The spacebar key is pressed =item * C<{default}> ( see L property ) boolean variable is set and enter key is pressed. This condition holds even if the button is out of focus. =item * C<{accel}> character variable is assigned and the corresponding character key is pressed. C<{accel}> variable is extracted automatically from the text string passed to L property. This condition holds even if the button is out of focus. =back =head2 Events =over =item Check Abstract callback event. =item Click Called whenever the user presses the button. =back =head2 Properties =over =item pressed BOOLEAN Represents the state of button widget, whether it is pressed or not. Default value: 0 =item text STRING The text that is drawn in the button. If STRING contains ~ ( tilde ) character, the following character is treated as a hot key, and the character is underlined. If the user presses the corresponding character key then L event is called. This is true even when the button is out of focus. =back =head2 Methods =over =item draw_veil CANVAS, X1, Y1, X2, Y2 Draws a rectangular veil shape over CANVAS in given boundaries. This is the default method of drawing the button in the disabled state. =item draw_caption CANVAS, X, Y Draws single line of text, stored in L property on CANVAS at X, Y coordinates. Performs underlining of eventual tilde-escaped character, and draws the text with dimmed colors if the button is disabled. If the button is focused, draws a dotted line around the text. =item caption_box [ CANVAS = self ] Calculates geometrical extensions of text string, stored in L property in pixels. Returns two integers, the width and the height of the string for the font selected on CANVAS. If CANVAS is undefined, the widget itself is used as a graphic device. =back =head1 Prima::Button A push button class, that extends Prima::AbstractButton functionality by allowing an image to be drawn together with the text. =head2 Properties =over =item autoHeight BOOLEAN If 1, the button height is automatically changed as text extensions change. Default value: 1 =item autoRepeat BOOLEAN If set, the button behaves like a keyboard button - after the first L event, a timeout is set, after which is expired and the button still pressed, L event is repeatedly called until the button is released. Useful for emulating the marginal scroll-bar buttons. Default value: 0 =item autoWidth BOOLEAN If 1, the button width is automatically changed as text extensions change. Default value: 1 =item borderWidth INTEGER Width of 3d-shade border around the button. Default value: 2 =item checkable BOOLEAN Selects if the button toggles L state when the user presses it. Default value: 0 =item checked BOOLEAN Selects whether the button is checked or not. Only actual when L property is set. See also L. Default value: 0 =item default BOOLEAN Defines if the button should react when the user presses the enter button. If set, the button is drawn with the black border, indicating that it executes the 'default' action. Useful for OK-buttons in dialogs. Default value: 0 =item defaultGlyph INTEGER Selects index of the default sub-image. Default value: 0 =item disabledGlyph INTEGER Selects index of the sub-image for the disabled button state. If C does not contain such sub-image, the C sub-image is drawn, and is dimmed over with L method. Default value: 1 =item flat BOOLEAN Selects special 'flat' mode, when a button is painted without a border when the mouse pointer is outside the button boundaries. This mode is useful for the toolbar buttons. See also L. Default value: 0 =item glyphs INTEGER If a button is to be drawn with the image, it can be passed in the L property. If, however, the button must be drawn with several different images, there are no several image-holding properties. Instead, the L object can be logically split vertically into several equal sub-images. This allows the button resource to contain all button states into one image file. The C property assigns how many such sub-images the image object contains. The sub-image indices can be assigned for rendition of the different states. These indices are selected by the following integer properties: L, L, L, L, L. Default value: 1 =item hiliteGlyph INTEGER Selects index of the sub-image for the state when the mouse pointer is over the button. This image is used only when L property is set. If C does not contain such sub-image, the C sub-image is drawn. Default value: 0 =item holdGlyph INTEGER Selects index of the sub-image for the state when the button is L. This image is used only when L property is set. If C does not contain such sub-image, the C sub-image is drawn. Default value: 3 =item image OBJECT If set, the image object is drawn next with the button text, over or left to it ( see L property ). If OBJECT contains several sub-images, then the corresponding sub-image is drawn for each button state. See L property. Default value: undef =item imageFile FILENAME Alternative to image selection by loading an image from the file. During the creation state, if set together with L property, is superseded by the latter. To allow easy multiframe image access, FILENAME string is checked if it contains a number after a colon in the string end. Such, C call would load the fourth frame in C file. =item imageScale SCALE Contains zoom factor for the L. Default value: 1 =item modalResult INTEGER Contains a custom integer value, preferably one of C constants. If a button with non-zero C is owned by a currently executing modal window, and is pressed, its C value is copied to the C property of the owner window, and the latter is closed. This scheme is helpful for the dialog design: $dialog-> insert( 'Prima::Button', modalResult => mb::OK, text => '~Ok', default => 1); $dialog-> insert( 'Prima::Button', modalResult => mb::Cancel, text => 'Cancel); return if $dialog-> execute != mb::OK. The toolkit defines the following constants for C use: mb::OK or mb::Ok mb::Cancel mb::Yes mb::No mb::Abort mb::Retry mb::Ignore mb::Help However, any other integer value can be safely used. Default value: 0 =item pressedGlyph INTEGER Selects index of the sub-image for the pressed state of the button. If C does not contain such sub-image, the C sub-image is drawn. =item transparent BOOLEAN See L. If set, the background is not painted. =item vertical BOOLEAN Determines the position of image next to the text string. If 1, the image is drawn above the text; left to the text if 0. In a special case when L is an empty string, image is centered. =back =head1 Prima::SpeedButton A convenience class, same as L but with default square shape and text property set to an empty string. =head1 Prima::Cluster An abstract class with common functionality of L and L. Reassigns default actions on tab and back-tab keys, so the sibling cluster widgets are not selected. Has C property set to 1, to prevent usage of background color from C palette. =head2 Properties =over =item auto BOOLEAN If set, the button is automatically checked when the button is in focus. This functionality allows arrow key walking by the radio buttons without pressing spacebar key. It is also has a drawback, that if a radio button gets focused without user intervention, or indirectly, it also gets checked, so that behavior might cause confusion. The said can be exemplified when an unchecked radio button in a notebook widget gets active by turning the notebook page. Although this property is present on the L, it is not used in there. =back =head2 Methods =over =item check Alias to C =item uncheck Alias to C =item toggle Reverts the C state of the button and returns the new state. =back =head1 Prima::Radio Represents a standard radio button, that can be either in checked, or in unchecked state. When checked, delivers L event to the owner ( if the latter provides one ). The button uses the standard toolkit images with C indices. If the images can not be loaded, the button is drawn with the graphic primitives. =head2 Events =over =item Check Called when a button is checked. =back =head1 Prima::CheckBox Represents a standard check box button, that can be either in checked, or in unchecked state. The button uses the standard toolkit images with C indices. If the images can not be loaded, the button is drawn with graphic primitives. =head1 Prima::GroupBox The class to be used as a container of radio and check-box buttons. It can, however, contain any other widgets. The widget draws a 3d-shaded box on its boundaries and a text string in its upper left corner. Uses C property to determine if it needs to paint its background. The class does not provide a method to calculate the extension of the inner rectangle. However, it can be safely assumed that all offsets except the upper are 5 pixels. The upper offset is dependent on a font, and constitutes the half of the font height. =head2 Events =over =item RadioClick BUTTON Called whenever one of children radio buttons is checked. BUTTON parameter contains the newly checked button. The default action of the class is that all checked buttons, except BUTTON, are unchecked. Since the flow type of C event is C, C method must be directly overloaded to disable this functionality. =back =head2 Properties =over =item index INTEGER Checks the child radio button with C. The indexing is based on the index in the widget list, returned by C method. =item value BITFIELD BITFIELD is an unsigned integer, where each bit corresponds to the C state of a child check-box button. The indexing is based on the index in the widget list, returned by C method. =back =head1 Prima::RadioGroup This class is obsolete and is same as C. =head1 Prima::CheckBoxGroup This class is obsolete and is same as C. =head1 BUGS The push button is not capable of drawing anything other than single line of text and single image. If an extended functionality is needed, instead of fully rewriting the painting procedure, it might be reasonable to overload C method of C, and perform custom output there. Tilde escaping in C is not realized, but is planned to. There currently is no way to avoid tilde underscoring. Radio buttons can get unexpectedly checked when used in notebooks. See L. C parameter is an integer, which size is architecture-dependent. Shift towards a vector is considered a good idea. =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, L, L, F, F. =cut Prima-1.28/Prima/themes/0000755000175100017510000000000011150770061012627 5ustar dkdkPrima-1.28/Prima/themes/tabset.pm0000644000175100017510000000036711150770061014455 0ustar dkdk# makes notebook tabset non-colored Prima::Themes::register( 'Prima::themes::tabset', 'tabset-gray', [ 'Prima::TabSet' => { colored => 0}]); Prima::Themes::register( 'Prima::themes::tabset', 'tabset-warp', [ 'Prima::TabSet' => { colored => 1}]); Prima-1.28/Prima/themes/color.pm0000644000175100017510000000367111150770061014312 0ustar dkdk# $Id: color.pm,v 1.2 2005/10/13 17:22:53 dk Exp $ # sample color styles use strict; use Prima qw(Themes); package Prima::Themes::color; # byte pairs: weak (0xFF00 mask) and strong ( 0x00FF) colors my %list = ( backColor => 0x80c0, light3DColor => 0x80e8, dark3DColor => 0x0080, disabledColor => 0x0040, disabledBackColor => 0x90cc, color => 0x0030, ); my %weak_selection = ( hiliteColor => 0x0030, hiliteBackColor => 0x60cc, ); my %strong_selection = ( hiliteBackColor => 0x0010, hiliteColor => 0x00f0, ); my %strong_classes = map { $_ => 1 } ( wc::Combo, wc::Edit, wc::ListBox, wc::InputLine, wc::Menu, wc::Popup ); my %transparent_classes = map { $_ => 1 } ( wc::CheckBox, wc::Radio, wc::Label, ); sub merger { my ( $object, $profile, $default, $mask) = @_; my $class = exists ( $profile->{widgetClass}) ? $profile->{widgetClass} : $default->{widgetClass}; my %class = (%list, exists($strong_classes{$class}) ? %strong_selection : %weak_selection); $class{hiliteBackColor} = $class{disabledBackColor} = $class{backColor} if $transparent_classes{$class}; my ( $r, $g, $b) = ( ( $mask >> 16) & 0xFF, ( $mask >> 8) & 0xFF, $mask & 0xFF, ); for ( keys %class) { my ( $weak_color, $strong_color) = (( $class{$_} & 0xFF00) >> 8, $class{$_} & 0xFF); $class{$_} = (( $r ? $strong_color : $weak_color) << 16) | (( $g ? $strong_color : $weak_color) << 8) | ( $b ? $strong_color : $weak_color); } Prima::Themes::merger( $object, $profile, $default, \%class); } Prima::Themes::register( 'Prima::themes::color', 'cyan', ['Prima::Widget' => 0x00FFFF], \&merger); Prima::Themes::register( 'Prima::themes::color', 'yellow', ['Prima::Widget' => 0xFFFF00], \&merger); Prima::Themes::register( 'Prima::themes::color', 'magenta', ['Prima::Widget' => 0xFF00FF], \&merger); Prima::Themes::register( 'Prima::themes::color', 'gray', ['Prima::Widget' => 0xFFFFFF], \&merger); Prima-1.28/Prima/themes/sysimage.pm0000644000175100017510000000160011150770061015003 0ustar dkdk# $Id: sysimage.pm,v 1.2 2005/10/13 17:22:53 dk Exp $ # changes sysimage package Prima::themes::sysimage; my %state; use Prima::StdBitmap; use Prima::Utils; sub install { my ( $theme, $install) = @_; if ( $install) { # install my $new = ( $theme eq 'sysimage-win32') ? 'Prima::sys::win32' : 'Prima'; $new = Prima::Utils::find_image( $new, 'sysimage.gif'); return 0 unless defined $new; $state{$theme} = [ $Prima::StdBitmap::sysimage, $new, ]; $Prima::StdBitmap::sysimage = $new; return 1; } else { # uninstall if ( $state{$theme}->[1] eq $Prima::StdBitmap::sysimage) { $Prima::StdBitmap::sysimage = $state{$theme}->[0]; } delete $state{$theme}; } } Prima::Themes::register( 'Prima::themes::sysimage', 'sysimage-win32', undef, undef, \&install); Prima::Themes::register( 'Prima::themes::sysimage', 'sysimage-standard', undef, undef, \&install); Prima-1.28/Prima/themes/round3d.pm0000644000175100017510000000437711150770061014556 0ustar dkdk# overrides rect3d calls for some classes use strict; use Prima qw(Themes); package Round3D; use vars qw(@ISA); @ISA=qw(Prima::Themes::Proxy); sub rect3d { my ( $self, $x, $y, $x1, $y1, $width, $lColor, $rColor, $backColor) = @_; my $canvas = $self-> {object}; if ( defined $backColor) { my $c = $canvas-> color; $canvas-> color( $backColor); $canvas-> bar( $x, $y, $x1, $y1); $canvas-> color( $c); } oval3d( $canvas, $x, $y, $x1, $y1, $width, $lColor, $rColor, 40); } sub oval3d { my ( $self, $x, $y, $x1, $y1, $width, $lColor, $rColor, $maxd) = @_; ( $x1, $x) = ( $x, $x1) if $x > $x1; ( $y1, $y) = ( $y, $y1) if $y > $y1; my $bias = int($width / 2); $x += $bias; $y += $bias; $x1 -= $bias; $y1 -= $bias; my ( $dx, $dy) = ( $x1 - $x, $y1 - $y); $dx = $maxd if $dx > $maxd; $dy = $maxd if $dy > $maxd; my $d = ( $dx < $dy ) ? $dx : $dy; my $r = int($d/2); # plots 3-d roundrect: # A' B' # /------\ lines: AC, AB - light, BD, CD - dark # |A B| arcs: A - light, B - l/d, C - l/d, D - dark # | | arcs cannot have diameter larger than $maxd # |C D| # \------/ # C' D' my @r = ( # coordinates of C and B, so A=r[0,3],B=r[2,3],C=r[0,1],D=[2,1] $x + $r, $y + $r, $x1 - $r, $y1 - $r, # coordinates of C' and B' $x, $y, $x1, $y1, ); my $c = $self-> color; my $w = $self-> lineWidth; $self-> lineWidth( $width) if $width != $w; $self-> color( $lColor) if $lColor != $c; # light color $self-> line( @r[0,7,2,7]) if $r[0] < $r[2]; $self-> line( @r[4,1,4,3]) if $r[1] < $r[3]; $self-> arc( @r[0,3], $d, $d, 90, 180); $self-> arc( @r[2,3], $d, $d, 45, 90); $self-> arc( @r[0,1], $d, $d, 180, 225); $self-> color( $rColor); # dark color $self-> line( @r[0,5,2,5]) if $r[0] < $r[2]; $self-> line( @r[6,1,6,3]) if $r[1] < $r[3]; $self-> arc( @r[2,1], $d, $d, 270, 360); $self-> arc( @r[2,3], $d, $d, 0, 45); $self-> arc( @r[0,1], $d, $d, 225, 270); # restore pen style $self-> color( $c) if $c != $rColor; $self-> lineWidth( $w) if $width != $w; } my %wrap_paint = ( onPaint => sub { $_[0]-> on_paint( Round3D-> new($_[1])); } ); Prima::Themes::register( 'Prima::themes::round3d', 'round3d', [ 'Prima::Button' => \%wrap_paint, 'Prima::ScrollBar' => \%wrap_paint, 'Prima::InputLine' => \%wrap_paint, ], ); Prima-1.28/Prima/Application.pm0000644000175100017510000005654211150770061014157 0ustar dkdk # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Anton Berezin # # $Id: Application.pm,v 1.31 2008/04/23 08:18:49 dk Exp $ package main; package Prima::Application; use strict; use Prima::Classes; use vars qw($uses); sub import { shift; my %profile = ( name => q(Prima), @_); $::application ||= Prima::Application-> create( %profile); $uses++; } 1; __END__ =pod =head1 NAME Prima::Application - root of widget objects hierarchy =head1 DESCRIPTION Prima::Application class serves as a hierarchy root for all objects with child-owner relationship. All toolkit objects, existing with non-null owner property, belong by their top-level parental relationship to Prima::Application object. There can be only one instance of Prima::Application class at a time. =head1 SYNOPSIS use Prima; use Prima::Application; or use Prima qw(Application); Prima::MainWindow-> create(); run Prima; =head1 USAGE Prima::Application class, and its only instance are treated specially throughout the toolkit. The object instance is contained in $::application scalar, defined in I module. The application instance must be created whenever widget and window, or event loop functionality is desired. Usually use Prima::Application; code is enough, but I<$::application> can also be assigned explicitly. The 'use' syntax has advantage as more resistant to eventual changes in the toolkit design. It can also be used in conjunction with custom parameters hash, alike the general create() syntax: use Prima::Application name => 'Test application', icon => $icon; In addition to this functionality Prima::Application is also a wrapper to a set of system functions, not directly related to object classes. This functionality is generally explained in L<"API">. =head2 Inherited functionality Prima::Application is a descendant of Prima::Widget, but it is designed so because their functional outliers are closest to each other. Prima::Application does not strictly conform ( in OO sense ) to any of the built-in classes. It has methods copied from both Prima::Widget and Prima::Window at one time, and the inherited Prima::Widget methods and properties function differently. For example, C<::origin>, a property from Prima::Widget, is also implemented in Prima::Application, but returns always (0,0), an expected but not much usable result. C<::size>, on the contrary, returns the extent of the screen in pixels. There are few properties, inherited from Prima::Widget, which return actual, but uninformative results, - C<::origin> is one of those, but same are C<::buffered>, C<::clipOwner>, C<::enabled>, C<::growMode>, C<::owner> and owner-inheritance properties, C<::selectable>, C<::shape>, C<::syncPaint>, C<::tabOrder>, C<::tabStop>, C<::transparent>, C<::visible>. To this group also belongs C<::modalHorizon>, Prima::Window class property, but defined for consistency and returning always 1. Other methods and properties, like C<::size>, that provide different functionality are described in L<"API">. =head2 Global functionality Prima::Application is a wrapper to functionality, that is not related to one or another class clearly. A notable example, paint mode, which is derived from Prima::Drawable class, allows painting on the screen, overwriting the graphic information created by the other programs. Although being subject to begin_paint()/end_paint() brackets, this functionality can not be attached to a class-shared API, an therefore is considered global. All such functionality is gathered in the Prima::Application class. These topics enumerated below, related to the global scope, but occupying more than one method or property - such functions described in L<"API">. =over =item Painting As stated above, Prima::Application provides interface to the on-screen painting. This mode is triggered by begin_paint()/end_paint() methods pair, and the other pair, begin_paint_info()/end_paint_info() triggers the information mode. This three-state paint functionality is more thoroughly described in L. =item Hint $::application hosts a special Prima::HintWidget class object, accessible via C, but with color and font functions aliased ( C<::hintColor>, C<::hintBackColor>, C<::hintFont> ). This widget serves as a hint label, floating over widgets if the mouse pointer hovers longer than C<::hintPause> milliseconds. Prima::Application internally manages all hint functionality. The hint widget itself, however, can be replaced before application object is created, using C<::hintClass> create-only property. =item Printer Result of L method points to an automatically created printer object, responsible for the system-driven printing. Depending on the operating system, it is either Prima::Printer, if the system provides GUI printing capabilities, or generic Prima::PS::Printer, the PostScript document interface. See L for details. =item Clipboard $::application hosts set of Prima::Clipboard objects, created automatically to reflect the system-provided clipboard IPC functionality. Their number depends on the system, - under X11 environment there is three clipboard objects, and only one under Win32 and OS/2. These are no methods to access these clipboard objects, except fetch() ( or, the indirect name calling ) - the clipboard objects are named after the system clipboard names, which are returned by Prima::Clipboard::get_standard_clipboards. The default clipboard is named I, and is accessible via my $clipboard = $::application-> Clipboard; code. See L for details. =item Help subsystem The toolkit has a built-in help viewer, that understands perl's native POD ( plain old documentation ) format. Whereas the viewer functionality itself is part of the toolkit, and resides in C module, any custom help viewing module can be assigned. Create-only C properties C<::helpClass> and C<::helpModule> can be used to set these options. C provides two methods for communicating with the help viewer window: C opens a selected topic in the help window, and C closes the window. =item System-dependent information A complex program will need eventually more information than the toolkit provides. Or, knowing the toolkit boundaries in some platforms, the program changes its behavior accordingly. Both these topics are facilitated by extra system information, returned by Prima::Application methods. C returns a system value for one of C constants, so the program can read the system-specific information. As well as C method, that returns the short description of the system, it is the portable call. To the contrary, C method is a wrapper to system-dependent functionality, called in non-portable way. This method is never used within the toolkit, and its usage is discouraged, primarily because its options do not serve the toolkit design, are subject to changes and cannot be relied upon. =back =head1 API =head2 Properties =over =item autoClose BOOLEAN If set to 1, issues C after the last top-level window is destroyed. Does not influence anything if set to 0. This feature is designed to help with general 'one main window' application layouts. Default value: 0 =item icon OBJECT Holds the icon object, associated with the application. If C, a system-provided default icon is assumed. Prima::Window object instances inherit the application icon by default. =item insertMode BOOLEAN A system boolean flag, showing whether text widgets through the system should insert ( 1 ) or overwrite ( 0 ) text on user input. Not all systems provide the global state of the flag. =item helpClass STRING Specifies a class of object, used as a help viewing package. The default value is Prima::HelpViewer. Run-time changes to the property do not affect the help subsystem until C call is made. =item helpModule STRING Specifies a perl module, loaded indirectly when a help viewing call is made via C. Used when C<::helpClass> property is overridden and the new class is contained in a third-party module. Run-time changes to the property do not affect the help subsystem until C call is made. =item hintClass STRING Create-only property. Specifies a class of widget, used as the hint label. Default value: Prima::HintWidget =item hintColor COLOR An alias to foreground color property for the hint label widget. =item hintBackColor COLOR An alias to background color property for the hint label widget. =item hintFont %FONT An alias to font property for the hint label widget. =item hintPause TIMEOUT Selects the timeout in milliseconds before the hint label is shown when the mouse pointer hovers over a widget. =item modalHorizon BOOLEAN A read-only property. Used as a landmark for the lowest-level modal horizon. Always returns 1. =item palette [ @PALETTE ] Used only within paint and information modes. Selects solid colors in a system palette, as many as possible. PALETTE is an array of integer triplets, where each is red, green, and blue component, with intensity range from 0 to 255. =item printerClass STRING Create-only property. Specifies a class of object, used as a printer. The default value is system-dependent, but is either C or C. =item printerModule STRING Create-only property. Specifies a perl module, loaded indirectly before a printer object of C<::printerClass> class is created. Used when C<::printerClass> property is overridden and the new class is contained in a third-party module. =item pointerVisible BOOLEAN Governs the system pointer visibility. If 0, hides the pointer so it is not visible in all system windows. Therefore this property usage must be considered with care. =item size WIDTH, HEIGHT A read-only property. Returns two integers, width and height of the screen. =item showHint BOOLEAN If 1, the toolkit is allowed to show the hint label over a widget. If 0, the display of the hint is forbidden. In addition to functionality of C<::showHint> property in Prima::Widget, Prima::Application::showHint is another layer of hint visibility control - if it is 0, all hint actions are disabled, disregarding C<::showHint> value in widgets. =item wantUnicodeInput BOOLEAN Selects if the system is allowed to generate key codes in unicode. Returns the effective state of the unicode input flag, which cannot be changed if perl or operating system do not support UTF8. If 1, C property may return UTF8 text from system clipboards is available. Default value: 0 =back =head2 Events =over =item PasteText $CLIPBOARD, $$TEXT_REF The notification queries C<$CLIPBOARD> for text content and stores in C<$$TEXT_REF>. Default action is that C<'Text'> format is queried if C is unset. Otherwise, C<'UTF8'> format is queried beforehand. The C mechanism is devised to ease defining text unicode/ascii conversion between clipboard and standard widgets, in a standard way. =back =head2 Methods =over =item add_startup_notification @CALLBACK CALLBACK is an array of anonymous subs, which is executed when Prima::Application object is created. If the application object is already created during the call, CALLBACKs called immediately. Useful for add-on packages initialization. =item begin_paint Enters the enabled ( active paint ) state, returns success flag. Once the object is in enabled state, painting and drawing methods can perform write operations on the whole screen. =item begin_paint_info Enters the information state, returns success flag. The object information state is same as enabled state ( see C), except that painting and drawing methods are not permitted to change the screen. =item close Issues a system termination call, resulting in calling C for all top-level windows. The call can be interrupted by these, and thus canceled. If not canceled, stops the application event loop. =item close_help Closes the help viewer window. =item end_paint Quits the enabled state and returns application object to the normal state. =item end_paint_info Quits the information state and returns application object to the normal state. =item font_encodings Returns array of encodings, represented by strings, that are recognized by the system and available for at least one font. Each system provides different sets of encoding strings; the font encodings are not portable. =item fonts NAME = '', ENCODING = '' Returns hash of font hashes ( see L ) describing fonts of NAME font family and of ENCODING. If NAME is '' or C, returns one fonts hash for each of the font families that match the ENCODING string. If ENCODING is '' or C, no encoding match is performed. If ENCODING is not valid ( not present in C result), it is treated as if it was '' or C. In the special case, when both NAME and ENCODING are '' or C, each font metric hash contains element C, that points to array of the font encodings, available for the fonts of NAME font family. =item get_active_window Returns object reference to a currently active window, if any, that belongs to the program. If no such window exists, C is returned. The exact definition of 'active window' is system-dependent, but it is generally believed that an active window is the one that has keyboard focus on one of its children widgets. =item get_caption_font Returns a title font, that the system uses to draw top-level window captions. The method can be called with a class string instead of an object instance. =item get_default_cursor_width Returns width of the system cursor in pixels. The method can be called with a class string instead of an object instance. =item get_default_font Returns the default system font. The method can be called with a class string instead of an object instance. =item get_default_scrollbar_metrics Returns dimensions of the system scrollbars - width of the standard vertical scrollbar and height of the standard horizon scrollbar. The method can be called with a class string instead of an object instance. =item get_default_window_borders BORDER_STYLE = bs::Sizeable Returns width and height of standard system window border decorations for one of C constants. The method can be called with a class string instead of an object instance. =item get_focused_widget Returns object reference to a currently focused widget, if any, that belongs to the program. If no such widget exists, C is returned. =item get_hint_widget Returns the hint label widget, attached automatically to Prima::Application object during startup. The widget is of C<::hintClass> class, Prima::HintWidget by default. =item get_image X_OFFSET, Y_OFFSET, WIDTH, HEIGHT Returns Prima::Image object with WIDTH and HEIGHT dimensions filled with graphic content of the screen, copied from X_OFFSET and Y_OFFSET coordinates. If WIDTH and HEIGHT extend beyond the screen dimensions, they are adjusted. If the offsets are outside screen boundaries, or WIDTH and HEIGHT are zero or negative, C is returned. =item get_indents Returns 4 integers that corresponds to extensions of eventual desktop decorations that the windowing system may present on the left, bottom, right, and top edges of the screen. For example, for win32 this reports the size of the part of the scraan that windows taskbar may occupies, if any. =item get_printer Returns the printer object, attached automatically to Prima::Application object. The object is of C<::printerClass> class. =item get_message_font Returns the font the system uses to draw the message text. The method can be called with a class string instead of an object instance. =item get_modal_window MODALITY_TYPE = mt::Exclusive, TOPMOST = 1 Returns the modal window, that resides on an end of a modality chain. MODALITY_TYPE selects the chain, and can be either C or C. TOPMOST is a boolean flag, selecting the lookup direction; if it is 1, the 'topmost' window is returned, if 0, the 'lowest' one ( in a simple case when window A is made modal (executed) after modal window B, the A window is the 'topmost' one ). If a chain is empty C is returned. In case when a chain consists of just one window, TOPMOST value is apparently irrelevant. =item get_scroll_rate Returns two integer values of two system-specific scrolling timeouts. The first is the initial timeout, that is applied when the user drags the mouse from a scrollable widget ( a text field, for example ), and the widget is about to scroll, but the actual scroll is performed after the timeout is expired. The second is the repetitive timeout, - if the dragging condition did not change, the scrolling performs automatically after this timeout. The timeout values are in milliseconds. =item get_system_info Returns a hash with information about the system. The hash result contains the following keys: =over =item apc One of C constants, reflecting the platform. Currently, the list of the supported platforms is: apc::Os2 apc::Win32 apc::Unix =item gui One of C constants, reflecting the graphic user interface used in the system: gui::Default gui::PM gui::Windows gui::XLib gui::GTK2 =item guiDescription Description of graphic user interface, returned as an arbitrary string. =item system An arbitrary string, representing the operating system software. =item release An arbitrary string, reflecting the OS version information. =item vendor The OS vendor string =item architecture The machine architecture string =back The method can be called with a class string instead of an object instance. =item get_system_value Returns the system integer value, associated with one of C constants. The constants are: sv::YMenu - height of menu bar in top-level windows sv::YTitleBar - height of title bar in top-level windows sv::XIcon - width and height of main icon dimensions, sv::YIcon acceptable by the system sv::XSmallIcon - width and height of alternate icon dimensions, sv::YSmallIcon acceptable by the system sv::XPointer - width and height of mouse pointer icon sv::YPointer acceptable by the system sv::XScrollbar - width of the default vertical scrollbar sv::YScrollbar - height of the default horizontal scrollbar ( see get_default_scrollbar_metrics() ) sv::XCursor - width of the system cursor ( see get_default_cursor_width() ) sv::AutoScrollFirst - the initial and the repetitive sv::AutoScrollNext scroll timeouts ( see get_scroll_rate() ) sv::InsertMode - the system insert mode ( see insertMode ) sv::XbsNone - widths and heights of the top-level window sv::YbsNone decorations, correspondingly, with borderStyle sv::XbsSizeable bs::None, bs::Sizeable, bs::Single, and sv::YbsSizeable bs::Dialog. sv::XbsSingle ( see get_default_window_borders() ) sv::YbsSingle sv::XbsDialog sv::YbsDialog sv::MousePresent - 1 if the mouse is present, 0 otherwise sv::MouseButtons - number of the mouse buttons sv::WheelPresent - 1 if the mouse wheel is present, 0 otherwise sv::SubmenuDelay - timeout ( in ms ) before a sub-menu shows on an implicit selection sv::FullDrag - 1 if the top-level windows are dragged dynamically, 0 - with marquee mode sv::DblClickDelay - mouse double-click timeout in milliseconds sv::ShapeExtension - 1 if Prima::Widget::shape functionality is supported, 0 otherwise sv::ColorPointer - 1 if system accepts color pointer icons. sv::CanUTF8_Input - 1 if system can generate key codes in unicode sv::CanUTF8_Output - 1 if system can output utf8 text The method can be called with a class string instead of an object instance. =item get_widget_from_handle HANDLE HANDLE is an integer value of a toolkit widget. It is usually passed to the program by other IPC means, so it returns the associated widget. If no widget is associated with HANDLE, C is returned. =item get_widget_from_point X_OFFSET, Y_OFFSET Returns the widget that occupies screen area under (X_OFFSET,Y_OFFSET) coordinates. If no toolkit widget are found, C is returned. =item go The main event loop. Called by run Prima; standard code. Returns when the program is about to terminate, or if the exception was signaled. In the latter case, the loop can be safely re-started. =item lock Effectively blocks the graphic output for all widgets. The output can be restored with C. =item open_help TOPIC Opens the help viewer window with TOPIC string in link POD format ( see L ) - the string is treated as "manpage/section", where 'manpage' is the file with POD content and 'section' is the topic inside the manpage. =item sync Synchronizes all pending requests where there are any. Is an effective C on X11, and is a no-op otherwise. =item sys_action CALL CALL is an arbitrary string of the system service name and the parameters to it. This functionality is non-portable, and its usage should be avoided. The system services provided are not documented and subject to change. The actual services can be looked in the toolkit source code under I tag. =item unlock Unblocks the graphic output for all widgets, previously locked with C. =item yield An event dispatcher, called from within the event loop. If the event loop can be schematized, then in while ( application not closed ) { yield } draft yield() is the only function, called repeatedly within the event loop. yield() cannot be used to organize event loops, but it can be employed to process stacked system events explicitly, to increase responsiveness of a program, for example, inside a long calculation cycle. The method can be called with a class string instead of an object instance; however, the $::application object must be initialized. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, L =cut Prima-1.28/Prima/DockManager.pm0000644000175100017510000012242411150770061014060 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: DockManager.pm,v 1.9 2005/10/13 17:22:50 dk Exp $ # # contains # DockManager # DockManager::LaunchPad # DockManager::Toolbar # DockManager::ToolbarDocker # DockManager::Panelbar # DockManager::S::SpeedButton; # use strict; use Prima; use Prima::Utils; use Prima::Docks; use Prima::Notebooks; use Prima::Lists; use Prima::StdBitmap; package Prima::DockManager::LaunchPad; use vars qw(@ISA); @ISA = qw(Prima::Notebook Prima::SimpleWidgetDocker); sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( fingerprint => 0x0000FFFF, dockup => undef, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); $self-> $_( $profile{$_}) for ( qw(fingerprint dockup)); return %profile; } # inner part of toolbar tandem package Prima::DockManager::ToolbarDocker; use vars qw(@ISA); @ISA = qw(Prima::SingleLinearWidgetDocker); sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( parentDocker => undef, instance => undef, x_sizeable => 0, y_sizeable => 0, ); @$def{keys %prf} = values %prf; return $def; } sub init { my ($self, %profile) = @_; %profile = $self-> SUPER::init( %profile); $self-> $_($profile{$_}) for qw( parentDocker instance); return %profile; } sub get_extent { my $self = $_[0]; my @ext = (0,0); for ($self-> docklings) { my @z = $_-> rect; for (0,1) { $ext[$_] = $z[$_+2] if $ext[$_] < $z[$_+2] } } return @ext; } sub update_size { my ( $self, @sz) = @_; my $o = $self-> parentDocker; return unless $o; @sz = $self-> size unless scalar @sz; my @r = $o-> client2frame( 0, 0, @sz); $o-> size( $r[2] - $r[0], $r[3] - $r[1]); $self-> size( @sz); if ( $o-> dock) { $o-> redock; } else { @r = $o-> externalDocker-> client2frame( 0,0, @sz); $o-> externalDocker-> size($r[2] - $r[0], $r[3] - $r[1]); $self-> rect( 0,0,@sz); # respect growMode } } # this part is responsible for changing toolbar's size when new tools are docked in sub dock { return $_[0]-> {dock} unless $#_; my $self = shift; my @sz = $self-> size; $self-> SUPER::dock(@_); my @sz1 = $self-> size; my $resize = 0; my @ext = $self-> get_extent; for ( 0, 1) { $resize = 1, $sz1[$_] = $ext[$_] if $sz1[$_] > $ext[$_]; } return if !$resize && ($sz[0] == $sz1[0] && $sz[1] == $sz1[1]); $self-> size( @sz1); $self-> update_size( @sz1); } sub rearrange { my $self = $_[0]; # fast version of rearrange, without real redocking my $v = $self-> vertical; my @ext = (0,0); my ( $xid, $yid) = ( $v ? 0 : 1, $v ? 1 : 0); my $a; for ( $self-> docklings) { $a = $_ unless $a; # my @sz = $_-> size; $_-> origin( $v ? ( 0, $ext[1]) : ( $ext[0], 0)); $ext[$xid] = $sz[$xid] if $ext[$xid] < $sz[$xid]; $ext[$yid] += $sz[$yid]; } if ( $a) { $self-> size( @ext); #innvoke dock-undock, just to be sure, but for only one widget $self-> redock_widget( $a); } } sub parentDocker { return $_[0]-> {parentDocker} unless $#_; $_[0]-> {parentDocker} = $_[1]; } sub instance { return $_[0]-> {instance} unless $#_; $_[0]-> {instance} = $_[1]; } sub on_dockerror { my ( $self, $urchin) = @_; $self-> redock_widget( $urchin); } sub on_undock { my $self = $_[0]; return if scalar(@{$self->{docklings}}); my $i = $self-> instance; $i-> post( sub { return if scalar(@{$self->{docklings}}); if ( $self-> parentDocker-> autoClose) { $self-> parentDocker-> destroy; } else { $i-> toolbar_visible( $self-> parentDocker, 0); $i-> notify(q(ToolbarChange)); } }); } package Prima::DockManager::Toolbar; use vars qw(@ISA); @ISA = qw(Prima::LinearDockerShuttle); sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( instance => undef, childDocker => undef, autoClose => 1, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); $self-> $_( $profile{$_}) for ( qw(instance childDocker autoClose)); return %profile; } sub autoClose { return $_[0]-> {autoClose} unless $#_; $_[0]-> {autoClose} = $_[1]; } sub childDocker { return $_[0]-> {childDocker} unless $#_; $_[0]-> {childDocker} = $_[1]; } sub instance { return $_[0]-> {instance} unless $#_; $_[0]-> {instance} = $_[1]; } sub on_getcaps { my ( $self, $docker, $prf) = @_; $self-> SUPER::on_getcaps( $docker, $prf); my @cd = $self-> {childDocker}-> size; my @i = @{$self-> {indents}}; my @sz = ($i[2] + $i[0] + $cd[0], $i[3] + $i[1] + $cd[1]); $prf-> {sizeMin} = [ @sz]; my $vs = $docker-> can('vertical') ? $docker-> vertical : 0; my $v = $self-> {vertical}; $prf-> {sizes} = ( $v == $vs) ? [[@sz]] : [[@sz[1,0]]]; } sub on_dock { my $self = $_[0]; my $nv = $self-> dock-> can('vertical') ? $self-> dock-> vertical : 0; return if $nv == $self-> {vertical}; $self-> vertical( $nv); my $c = $self-> {childDocker}; $c-> vertical( $nv); $c-> rect( $self-> frame2client( 0, 0, $self-> size)); $c-> rearrange; } package Prima::DockManager::Panelbar; use vars qw(@ISA); @ISA = qw(Prima::LinearDockerShuttle); sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( vertical => 1, instance => undef, externalDockerProfile => { borderStyle => bs::Sizeable }, x_sizeable => 1, y_sizeable => 1, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); $self-> $_( $profile{$_}) for ( qw(instance)); return %profile; } sub instance { return $_[0]-> {instance} unless $#_; $_[0]-> {instance} = $_[1]; } # flags for fingerprints - for different dockers and stages. package dmfp; use constant Tools => 0x0F000; # those who want tools, must set this use constant Toolbar => 0x10000; # those who want toolbars, must set this use constant LaunchPad => 0x20000; # tools that want to be disposable, set this package Prima::DockManager; use vars qw(@ISA); @ISA = qw(Prima::Component Prima::AbstractDocker::Interface); { my %RNT = ( %{Prima::Component->notification_types()}, CommandChange => nt::Notification, ToolbarChange => nt::Notification, PanelChange => nt::Notification, Command => nt::Command, ); sub notification_types { return \%RNT; } } sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( interactiveDrag => 0, commands => {}, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; $self-> {commands} = {}; $self-> {interactiveDrag} = 0; my %profile = $self-> SUPER::init( @_); $self-> {classes} = []; $self-> {hiddenToolbars} = []; $self-> {toolbars} = []; $self-> {panels} = []; $self-> $_( $profile{$_}) for ( qw( commands interactiveDrag)); return %profile; } sub interactiveDrag { return $_[0]-> {interactiveDrag} unless $#_; my ( $self, $id) = @_; return if $id == $self-> {interactiveDrag}; $self-> {interactiveDrag} = $id; if ( $id) { for ( $self-> toolbars) { $_-> enabled(1) for $_-> childDocker-> docklings; } } else { my $c = $self-> {commands}; for ( $self-> toolbars) { for ( $_-> childDocker-> docklings) { next if !defined $_->{CLSID} || !exists($c-> {$_->{CLSID}}) || $c-> {$_->{CLSID}}; $_-> enabled(0); } } } } sub toolbars { return @{$_[0]->{toolbars}}} sub panels { return @{$_[0]->{panels}}} sub fingerprint { return 0xFFFFFFFF } sub register_tool { my ( $self, $CLSID, $hash) = @_; $hash-> {tool} = 1; push @{$self-> {classes}}, $CLSID, $hash; } sub register_panel { my ( $self, $CLSID, $hash) = @_; $hash-> {tool} = 0; push @{$self-> {classes}}, $CLSID, $hash; } sub get_class { my ( $self, $CLSID) = @_; my $i; my $c = $self-> {classes}; my $x = scalar @$c; for ( $i = 0; $i < $x; $i+=2) { return $$c[$i+1] if $CLSID eq $$c[$i]; } } sub panel_by_id { my ( $self, $name) = @_; for ( @{$self-> {panels}}) { return $_ if $_-> {CLSID} eq $name; } } sub toolbar_by_name { my ( $self, $name) = @_; for ( @{$self-> {toolbars}}) { return $_ if $_-> name eq $name; } } sub post { my ( $self, $sub, @parms) = @_; $self-> post_message( 'sub', [ $sub, @parms]); } sub on_postmessage { my ( $self, $id, $val) = @_; return unless $id eq 'sub'; my $sub = shift @$val; $sub->( $self, @$val); } sub create_manager { my ( $self, $where, %profile) = @_; my @o = exists($profile{origin}) ? @{$profile{origin}} : (0,0); my @sz = exists($profile{size}) ? @{$profile{size}} : ($where-> size); my ( @items, %items); my @lclasses; my $i = 0; my $cls = $self-> {classes}; my $xcls = scalar @$cls; for ( $i = 0; $i < $xcls; $i += 2) { my ( $CLSID, $hash) = @$cls[$i, $i+1]; next unless $hash->{tool}; push ( @lclasses, $CLSID); $CLSID =~ m/^([^\:]+)(?:\:|$)/; next if !$1 || exists($items{$1}); $items{$1} = 1; push( @items, $1); } $i = 0; my $nb; my $lb = $where-> insert( ListBox => origin => [@o], size => [ int($sz[0] / 3), $sz[1]], name => 'GroupSelector', vScroll => 1, items => \@items, growMode=> gm::Client, focusedItem => 0, onSelectItem => sub { my ($self,$lst,$state) = @_; return unless $state; $nb-> pageIndex( $self-> focusedItem); }, exists($profile{listboxProfile}) ? %{$profile{listboxProfile}} : (), ); $nb = $where-> insert( 'Prima::DockManager::LaunchPad' => exists($profile{dockerProfile}) ? %{$profile{dockerProfile}} : (), origin => [ $o[0] + int($sz[0] / 3), 0], size => [ $sz[0] - int($sz[0] / 3), $sz[1]], name => 'PageFlipper', pageCount => scalar(@items), growMode => gm::GrowHiY|gm::GrowLoX, fingerprint => dmfp::LaunchPad, dockup => $self, ); $nb-> {dockingRoot} = $self; $i = 0; my %x = @$cls; my @szn = $nb-> size; for ( @items) { my $iid = $_; my @d = grep { m/^([^\:]+)(?:\:|$)/; my $j = $1 || ''; $j eq $iid; } @lclasses; my @org = (5,5); my $maxy = 0; my @ctrls; my $ix = 0; for ( @d) { my %acp = exists($x{$_}-> {profile}) ? %{$x{$_}-> {profile}} : (); my $ctrl = $nb-> insert_to_page( $i, $x{$_}->{class} => growMode => gm::GrowLoY, %acp, onMouseDown => \&Control_MouseDown_FirstStage, onKeyDown => \&Control_KeyDown, origin => [ @org], ); $ctrl-> {CLSID} = $_; $ctrl-> {DOCKMAN} = $self; push ( @ctrls, $ctrl); my @s = $ctrl-> size; if (( $s[0] + $org[0] > $szn[0] - 5) && ( $ix > 0)) { $ctrl-> origin( $org[0] = 5, $org[1] += $maxy + 3); $maxy = 0; } else { $org[0] += $s[0] + 1; $maxy = $s[1] if $maxy < $s[1]; } $ix++; } if ( $org[1] + $maxy < $szn[1] - 5) { my $d = $sz[1] - 5 - $org[1] - $maxy; for ( @ctrls) { my @o = $_-> origin; $_-> origin( $o[0], $o[1] + $d); } } $i++; } return $lb, $nb; } sub create_tool { my ( $self, $where, $CLSID, @rect) = @_; my $x = $self-> get_class( $CLSID); return unless $x; my %acp = exists($x-> {profile}) ? %{$x-> {profile}} : (); %acp = ( %acp, onMouseDown => \&Control_MouseDown, onKeyDown => \&Control_KeyDown, onDestroy => \&Control_Destroy, ); $acp{rect} = \@rect if 4 == scalar @rect; my $ctrl = $where-> insert( $x->{class} => %acp); $ctrl-> {CLSID} = $CLSID; $ctrl-> {DOCKMAN} = $self; $ctrl-> enabled(0) if !$self-> {interactiveDrag} && exists( $self-> {commands}->{$CLSID}) && !$self-> {commands}->{$CLSID}; return $ctrl; } sub create_toolbar { my ( $self, %profile) = @_; my $v = $profile{vertical} || 0; my $dock = $profile{dock}; my $auto = exists( $profile{autoClose}) ? $profile{autoClose} : ( exists($profile{name}) ? 1 : 0); my $name = $profile{name} || $self-> auto_toolbar_name; my $visible = exists($profile{visible}) ? $profile{visible} : 1; my @r = $profile{rect} ? @{$profile{rect}} : ( 0, 0, 10, 10); my $acd = $profile{dockerProfile} || {}; my $aci = $profile{toolbarProfile} || {}; my $x = Prima::DockManager::Toolbar-> create( dockingRoot => $self, name => $name, text => $name, visible => $visible, vertical => $v, instance => $self, autoClose => $auto, onEDSClose => \&Toolbar_EDSClose, %$acd, ); my @i = @{$x-> indents}; $x-> rect( $r[0] - $i[0], $r[1] - $i[1], $r[2] + $i[2], $r[3] + $i[3]); @r = $x-> frame2client( $x-> rect); my $xcl = $x-> insert( 'Prima::DockManager::ToolbarDocker' => %$aci, origin => [ @i[0,1]], size => [ $r[2] - $r[0], $r[3] - $r[1]], vertical => $v, growMode => gm::Client, fingerprint => dmfp::Toolbar, parentDocker => $x, name => $name, instance => $self, onDestroy => \&Toolbar_Destroy, ); $x-> client( $xcl); $x-> childDocker( $xcl); $self-> add_subdocker( $xcl); if ( $profile{dock}) { $x-> dock( $dock, $dock-> client_to_screen( $x-> rect)); } else { $x-> externalDocker-> rect( $x-> externalDocker-> client2frame( @r)); } push ( @{$self-> {toolbars}}, $x); $self-> toolbar_visible( $x, 0) unless $visible; $self-> notify(q(ToolbarChange)); return $x, $xcl; } sub create_panel { my ( $self, $CLSID, %profile) = @_; my $prf = $self-> get_class( $CLSID); return unless $prf; my %prf = ( dockingRoot => $self, x_sizeable => 1, y_sizeable => 1, instance => $self, ); $prf{text} = $prf-> {text} if exists $prf-> {text}; my $x = Prima::DockManager::Panelbar-> create( %prf, $prf-> {dockerProfile} ? %{$prf-> {dockerProfile}} : (), $profile{dockerProfile} ? %{$profile{dockerProfile}} : (), dock => undef, ); $x-> onEDSClose( \&Panel_EDSClose); $prf-> {text} = $x-> text unless exists $prf-> {text}; my @rrc = $x-> frame2client( 0, 0, $x-> size); my $xcl = $x-> insert( $prf->{class} => growMode => gm::Client, $prf-> {profile} ? %{$prf-> {profile}} : (), $profile{profile} ? %{$profile{profile}} : (), rect => [@rrc], ); $xcl-> add_notification( 'Destroy', \&Panelbar_Destroy, $x); $x-> client( $xcl); push( @{$self-> {panels}}, $x); $x-> {CLSID} = $CLSID; if ( $prf-> {dockerProfile}-> {dock} || $profile{dockerProfile}-> {dock}) { my $dock = $prf-> {dockerProfile}-> {dock} || $profile{dockerProfile}-> {dock}; $x-> dock( $dock, $dock-> client_to_screen( $x-> rect)); } $self-> notify(q(PanelChange)); return ( $x, $xcl); } sub auto_toolbar_name { my $name; my $self = $_[0]; my @ids; for ( @{$self->{toolbars}}) { my $x = $_-> name; next unless $x =~ m/^ToolBar(\d+)$/; $ids[$1] = 1; } my $i = 0; for ( @ids) { $i++, next unless $i; # skip ToolBar0 $name = $i, last unless $_; $i++; } $name = scalar(@ids) unless defined $name; $name++ unless $name; return "ToolBar$name"; } sub toolbar_menuitems { my ( $self, $sub) = @_; my @items; for ( @{$self->{toolbars}}) { my $vis = $_-> dock() ? $_-> visible : $_-> externalDocker-> visible; $vis = ( $vis ? '*' : '') . $_-> name; push ( @items, [ $vis => $_-> name => $sub ]); } return \@items; } sub panel_menuitems { my ( $self, $sub) = @_; my @items; my %h = map { $_->{CLSID} => 1} @{$self-> {panels}}; my $i; my $c = $self-> {classes}; for ( $i = 0; $i < @$c; $i += 2) { my ( $CLSID, $hash) = @$c[$i,$i+1]; next if $hash->{tool}; my $vis = ( $h{$CLSID} ? '*' : '') . $CLSID; push ( @items, [ $vis => $hash-> {text} => $sub ]); } return \@items; } sub toolbar_visible { my ( $self, $d, $visible) = @_; return unless $d; if ( $d-> dock) { return if $visible == $d-> visible; if ( $visible) { $d-> dock_back; } else { $d-> dock( undef); $d-> externalDocker-> visible( $visible); } } else { return if $visible == $d-> externalDocker-> visible; $d-> externalDocker-> visible( $visible); } } sub panel_visible { my ( $self, $panelbarCLSID, $visible) = @_; my $d = $self-> panel_by_id( $panelbarCLSID); my $hash = $self-> get_class( $panelbarCLSID); if ( $visible) { return if $d; my %pf; if ( $hash-> {lastUsedDock} && Prima::Object::alive($hash-> {lastUsedDock})) { $pf{dockerProfile}->{dock} = $hash-> {lastUsedDock}; } if ( $hash-> {lastUsedRect}) { $pf{dockerProfile}->{rect} = $hash-> {lastUsedRect}; } my ( $x, $xcl) = $self-> create_panel( $panelbarCLSID, %pf); $x-> bring_to_front; } else { return unless $d; $hash-> {lastUsedDock} = $d-> dock; $hash-> {lastUsedRect} = [$d-> dock ? $d-> rect : $d-> externalDocker-> rect], $d-> close; } } sub predefined_toolbars { my $self = shift; my %toolbars = map { $_-> name => $_ } @{$self-> {toolbars}}; my %c = @{$self-> {classes}}; my @o = ( 10, $::application-> height - 100); my @as = $::application-> size; for ( @_) { my $rec = $_; next if $toolbars{$_-> {name}}; my @org = (0,0); my $maxy = 0; my @ctrls; my @list = $rec->{list} ? @{$rec->{list}} : (); for ( @list) { my $ctrl = $self-> create_tool( $::application, $_); next unless $ctrl; $ctrl-> origin( @org); my @sz = $ctrl-> size; $org[0] += $sz[0]; $maxy = $sz[1] if $maxy < $sz[1]; push ( @ctrls, $ctrl); } my @oz = $rec->{origin} ? @{$rec->{origin}} : ( $rec->{dock} ? (0,0) : @o); my ( $x, $xcl) = $self-> create_toolbar( name => $_->{name}, rect => [ @oz, $oz[0]+$org[0], $oz[1]+$maxy], visible => 1, dock => $rec->{dock}, ); for ( @ctrls) { $_-> owner( $xcl); $xcl-> dock( $_); } $xcl-> rearrange; $o[0] += 25; $o[1] -= 25; } } sub predefined_panels { my ( $self, @rec) = @_; my $i; my %pan = map { $_-> {CLSID} => 1 } @{$self-> {panels}}; for ( $i = 0; $i < scalar @rec; $i += 2) { my ( $CLSID, $dock) = @rec[$i, $i+1]; next if $pan{$CLSID}; my ( $a, $b) = $self-> create_panel( $CLSID, dockerProfile => {dock => $dock}); } } sub activate { my $self = $_[0]; for ( @{$self->{panels}}, @{$self-> {toolbars}}) { next if $_-> dock; $_-> externalDocker-> bring_to_front if $_-> externalDocker; } } sub windowState { my ( $self, $ws) = @_; if ( $ws == ws::Minimized) { for ( @{$self->{panels}}, @{$self-> {toolbars}}) { next if $_-> dock; my $e = $_-> externalDocker; next unless $e; $e-> hide; push ( @{$self->{hiddenToolbars}}, $e); } } else { $_-> show for @{$self->{hiddenToolbars}}; @{$self->{hiddenToolbars}} = (); } } sub commands_enable { my ( $self, $enable) = ( shift, shift); my %cmds = map { $_ => 1 } @_; unless ( $self-> interactiveDrag) { for ( $self-> toolbars) { for ( $_-> childDocker-> docklings) { next if !defined $_->{CLSID} || !$cmds{$_->{CLSID}} || $enable == $self-> {commands}->{$_->{CLSID}}; $_-> enabled( $enable); } } } for ( keys %{$self->{commands}}) { next unless $cmds{$_}; $self-> {commands}-> {$_} = $enable; } $self-> notify(q(CommandChange)); } sub commands { return $_[0]-> {commands} unless $#_; my ( $self, $cmds) = @_; $self-> {commands} = $cmds; unless ( $self-> interactiveDrag) { for ( $self-> toolbars) { for ( $_-> childDocker-> docklings) { next if !defined $_->{CLSID} || !$cmds-> {$_->{CLSID}}; $_-> enabled( $cmds-> {$_-> {CLSID}}); } } } $self-> notify(q(CommandChange)); } # internals sub autodock { my ( $self, $ctrl) = @_; my $dock = $ctrl-> owner; $dock-> undock( $ctrl); my ( $x, $xcl) = $self-> create_toolbar( vertical => $dock-> can('vertical') ? $dock-> vertical : 0, dock => $dock, rect => [$ctrl-> rect], autoClose => 1, ); $ctrl-> owner( $xcl); $ctrl-> origin( 0,0); $xcl-> dock( $ctrl); return $x; } sub Control_KeyDown { return unless $_[0]-> {DOCKMAN}-> interactiveDrag; $_[0]-> clear_event; } sub Control_MouseDown_FirstStage { my ($self,$btn, $mod, $x,$y) = @_; return unless $btn == mb::Left; my $man = $self-> {DOCKMAN}; my $c = Prima::InternalDockerShuttle-> create( owner => $self-> owner, rect => [$self-> rect], dockingRoot => $man, fingerprint => dmfp::LaunchPad | dmfp::Toolbar | dmfp::Tools, # allow all docks backColor => cl::Yellow, onLanding => \&InternalDockerShuttle_Landing, name => 'FirstStage', onDock => sub { my $me = $_[0]; if ( $me-> owner-> isa(q(Prima::DockManager::LaunchPad))) { $man-> post( sub { $me-> destroy; }); return; } my $ctrl = $man-> create_tool( $me-> owner, $self-> {CLSID}, $me-> rect); return unless $ctrl; $me-> {dock} = undef; $me-> owner-> replace( $me, $ctrl); $man-> post( sub { $me-> destroy; }); $man-> autodock( $ctrl) unless $me-> owner-> isa(q(Prima::DockManager::ToolbarDocker)); }, onFailDock => sub { my ( $me, $ax, $ay) = @_; my ( $x, $xcl) = $man-> create_toolbar( rect => [$me-> rect], autoClose => 1); $xcl-> dock( $man-> create_tool( $xcl, $self-> {CLSID})); $x-> externalDocker-> origin( $ax, $ay); $man-> post( sub { $me-> destroy; }); }, ); $c-> externalDocker-> hide; $::application-> yield; $c-> drag( 1, [ $self-> client_to_screen(0,0,$self-> size)], $c-> screen_to_client( $self-> client_to_screen($x, $y))); $self-> clear_event; } sub Control_Destroy { $_[0]-> owner-> undock( $_[0]); } sub Control_MouseDown { my ( $self, $btn, $mod, $x, $y) = @_; my $man = $self-> {DOCKMAN}; return unless $man-> interactiveDrag; $self-> clear_event; return unless $btn == mb::Left; my $c; $c = Prima::InternalDockerShuttle-> create( owner => $self-> owner, rect => [$self-> rect], dockingRoot => $man, fingerprint => dmfp::LaunchPad | dmfp::Toolbar | dmfp::Tools, # allow all docks backColor => cl::White, onLanding => \&InternalDockerShuttle_Landing, name => 'SecondStage', onDock => sub { my $me = $_[0]; $me-> {dock} = undef; $me-> owner-> replace( $me, $self); $man-> post( sub { $me-> destroy; }); if ( $me-> owner-> isa(q(Prima::DockManager::LaunchPad))) { $man-> post( sub { $self-> destroy; }); return; } $man-> autodock( $self) unless $me-> owner-> isa(q(Prima::DockManager::ToolbarDocker)); }, onFailDock => sub { $self-> owner-> replace( $c, $self); $c-> {dock} = undef; $man-> post( sub { $c-> destroy; }); }, ); $c-> {dock} = $self-> owner; $self-> owner-> replace( $self, $c); $c-> externalDocker-> hide; $c-> hide; $::application-> yield; $c-> drag( 1, [ $self-> client_to_screen(0,0,$self-> size)], $c-> screen_to_client( $self-> client_to_screen($x, $y))); } sub Panelbar_Destroy { my $self = $_[0]; my $i = $self-> instance; return unless $i; @{$i-> {panels}} = grep { $_ != $self } @{$i->{panels}}; @{$i-> {hiddenToolbars}} = grep { $_ != $self } @{$i->{hiddenToolbars}}; $i-> notify(q(PanelChange)); } sub Toolbar_Destroy { my $self = $_[0]-> parentDocker; my $i = $self-> instance; return unless $i; @{$i-> {toolbars}} = grep { $_ != $self } @{$i->{toolbars}}; @{$i-> {hiddenToolbars}} = grep { $_ != $self } @{$i->{hiddenToolbars}}; $i-> notify(q(ToolbarChange)); } sub Toolbar_EDSClose { my $e = $_[0]-> externalDocker; $e-> hide; $_[0]-> clear_event; $_[0]-> instance-> notify(q(ToolbarChange)); } sub Panel_EDSClose { my $hash = $_[0]-> instance-> get_class($_[0]-> {CLSID}); return unless $hash; $hash-> {lastUsedDock} = undef; $hash-> {lastUsedRect} = [ $_[0]-> externalDocker-> rect ]; $_[0]-> instance-> notify(q(PanelChange)); } sub InternalDockerShuttle_Landing { my ( $self, $dm, @rc) = @_; return unless $self-> {drag}; # only for interactive my $wi = $::application-> get_widget_from_point($::application-> pointerPos); return if !$wi || $wi == $dm; unless ( $wi-> can('dock')) { $wi = $wi-> owner; return if $wi == $dm; } return unless $wi-> can('dock') && $wi-> isa('Prima::DockManager::ToolbarDocker'); $self-> clear_event; } package Prima::DockManager::S::SpeedButton; sub class { my ( $image, $action, %profile) = @_; $image =~ s/\:(\d+)$//; my $index = $1 || 0; my $i = Prima::Icon-> create; undef($i) unless $i-> load(Prima::Utils::find_image($image), index => $index); return $action, { class => 'Prima::SpeedButton', profile => { size => [ 24, 24], image => $i, borderWidth => 1, onClick => \&on_click, %profile, }, }, } sub on_click { $_[0]-> owner-> instance-> notify(q(Command), $_[0]-> {CLSID}); } 1; __DATA__ =pod =head1 NAME Prima::DockManager - advanced dockable widgets =head1 DESCRIPTION C contains classes that implement additional functionality within the dockable widgets paradigm. The module introduces two new dockable widget classes: C, a general purpose dockable container for variable-sized widgets; and C, a dockable container for fixed-size command widgets, mostly push buttons. The command widgets, nested in a toolbar, can also be docked. C class is an application-oriented class in a way that ( mostly ) the only instance of it is needed in the program. It is derived from C and therefore is never visualized. The class instance is stored in C property of all module classes to serve as a docking hierarchy root. Through the document, I term is referred to C class instance. The module by itself is not enough to make a docking-aware application work effectively. The reader is urged to look at F example code, which demonstrates the usage and capabilities of the module. =head1 Prima::DockManager::Toolbar A toolbar widget class. The toolbar has a dual nature; it can dock and accept docking widgets simultaneously. In the scope of C, the toolbar hosts command widget, mostly push buttons. The toolbar consists of two widgets. The external dockable widget is implemented in C, and the internal dock in C classes. =head2 Properties =over =item autoClose BOOLEAN Selects the behavior of a toolbar when all of its command widgets are undocked. If 1, the toolbar is automatically destroyed. If 0 it calls C. =item childDocker WIDGET Pointer to C instance. See also C. =item instance INSTANCE C instance, the docking hierarchy root. =back =head1 Prima::DockManager::ToolbarDocker Internal class, implements a dock widget for command widgets, while serves as a client in a dockable toolbar, which is a C descendant. When its size is changed due an eventual rearrange of its docked widgets, also resizes the toolbar. =head2 Properties =over =item instance INSTANCE C instance, the docking hierarchy root. =item parentDocker WIDGET Pointer to C instance. When in the docked state, C value is always equals to C. See also C. =back =head2 Methods =over =item get_extent Calculates the minimal rectangle that encloses all docked widgets and returns its extensions. =item update_size Called when size is changed to resizes the owner widget. If it is in the docked state, the size change might result in change of position or docking state. =back =head1 Prima::DockManager::Panelbar The class is derived from C, and is different only in that C property is introduced, and the external shuttle can be resized interactively. The class is to be used as a simple host to sizeable widgets. The user can dispose of the panel bar by clicking close button on the external shuttle. =head2 Properties =over =item instance INSTANCE C instance, the docking hierarchy root. =back =head1 Prima::DockManager A binder class, contains set of functions that groups toolbars, panels, and command widgets together under the docking hierarchy. The manager servers several purposes. First, it is a command state holder: the command widgets, mostly buttons, usually are in enabled or disabled state in different life stages of a program. The manager maintains the enabled/disabled state by assigning each command an unique scalar value ( farther and in the code referred as I ). The toolbars can be created with set of command widgets, referred via these CLSIDs. The same is valid for the panels - although they do not host command widgets, the widgets that they do host can also be created indirectly via CLSID identifier. In addition to CLSID, the commands can be grouped by sections. Both CLSID and group descriptor scalars are defined by the programmer. Second, C method presents a standard configuration widget, that allows rearranging of normally non-dockable command widgets, by presenting a full set of available commands to the user as icons. Dragging the icons to toolbars, dock widgets or merely outside the configuration widget automatically creates the corresponding command widget. The notable moment here is that the command widgets are not required to know anything about dragging and docking; any C descendant can be used as a command widget. Third, it helps maintaining the toolbars and panels visibility when the main window is hidden or restored. C method hides or shows the toolbars and panels effectively. Fourth, it serves as a docking hierarchy root. All docking sessions begin from C object, which although does not provide docking capabilities itself ( it is C descendant ), redirects the docking requests to the lower-level dock widgets. Fifth, it provides number of helper methods and notifications, and enforces use or C property by all dockable widgets. This property has default value of C<0xFFFF> ( defined in C ). The module contains the fingerprint C constants with value greater than this, so the toolbars and panels are not docked to a dock widget with the default configuration. The base constant set is: fdmp::Tools ( 0x0F000) - dock the command widgets fdmp::Toolbar ( 0x10000) - dock the toolbars fdmp::LaunchPad ( 0x20000) - allows widgets recycling All this functionality is demonstrated in F example. =head2 Properties =over =item commands HASH A hash of boolean values, with keys of CLSID scalars. If value is 1, the command is available. If 0, the command is disabled. Changes to this property are reflected in the visible command widgets, which are enabled or disabled immediately. Also, C notification is triggered. =item fingerprint INTEGER The property is read-only, and always returns C<0xFFFFFFFF>, to allow landing for all dockable widgets. In case when a finer granulation is needed, the default C values of toolbars and panels can be reset. =item interactiveDrag BOOLEAN If 1, the command widgets can be interactively dragged, created and destroyed. This property is usually operated together with C widget. If 0, the command widgets cannot be dragged. Default value: 0 =back =head2 Methods =over =item activate Brings to front all toolbars and panels. To be used inside a callback code of a main window, that has the toolbars and panels attached to: onActivate => sub { $dock_manager-> activate } =item auto_toolbar_name Returns an unique name for an automatically created toolbar, like C, C etc. =item commands_enable BOOLEAN, @CLSIDs Enabled or disables commands from CLSIDs array. The changes are reflected in the visible command widgets, which are enabled or disabled immediately. Also, C notification is triggered. =item create_manager OWNER, %PROFILE Inserts two widgets into OWNER with PROFILE parameters: a listbox with command section groups, displayed as items, that usually correspond to the predefined toolbar names, and a notebook that displays the command icons. The notebook pages are interactively selected by the listbox navigation. The icons, dragged from the notebook, behave as dockable widgets: they can be landed upon a toolbar, or any other dock widget, given it matches the C ( by default C). C constant allows the recycling; if a widget is dragged back onto the notebook, it is destroyed. Returns two widgets, the listbox and the notebook. PROFILE recognizes the following keys: =over =item origin X, Y Position where the widgets are to be inserted. Default value is 0,0. =item size X, Y Size of the widget insertion area. By default the widgets occupy all OWNER interior. =item listboxProfile PROFILE Custom parameters, passed to the listbox. =item dockerProfile PROFILE Custom parameteres, passed to the notebook. =back =item create_panel CLSID, %PROFILE Creates a dockable panel of a previously registered CLSID by C. PROFILE recognizes the following keys: =over =item profile HASH Hash of parameters, passed to C of the panel widget class. Before passing it is merged with the set of parameters, registered by C. The C hash takes the precedence. =item dockerProfile HASH Constains extra options, passed to C widget. Before the usage it is merged with the set of parameters, registered by C. NB: The C key here contains a reference to a desired dock widget. If C set to C, the panel is created in the non-docked state. =back Example: $dock_manager-> create_panel( $CLSID, dockerProfile => { dock => $main_window }}, profile => { backColor => cl::Green }); =item create_tool OWNER, CLSID, X1, Y1, X2, Y2 Inserts a command widget, previously registered with CLSID by C, into OWNER widget with X1 - Y2 coordinates. For automatic maintenance of enable/disable state of command widgets OWNER is expected to be a toolbar. If it is not, the maintenance must be performed separately, for example, by C event. =item create_toolbar %PROFILE Creates a new toolbar of C class. The following PROFILE options are recognized: =over =item autoClose BOOLEAN Sets C property of the toolbar. Default value is 1 if C options is set, 0 otherwise. =item dock DOCK Contain a reference to a desired DOCK widget. If C, the toolbar is created in the non-docked state. =item dockerProfile HASH Parameters passed to C as creation properties. NB: The C key here contains a reference to a desired dock widget. If C set to C, the panel is created in the non-docked state. =item rect X1, Y1, X2, Y2 Selects rectangle of the C instance in the dock widget ( if docked ) or the screen ( if non-docked ) coordinates. =item toolbarProfile HASH Parameters passed to C as creation properties. =item vertical BOOLEAN Sets C property of the toolbar. =item visible BOOLEAN Selects visibility state of the toolbar. =back =item get_class CLSID Returns class record hash, registered under CLSID, or C if the class is not registered. The hash format contains the following keys: =over =item class STRING Widget class =item profile HASH Creation parameters passed to C when the widget is created. =item tool BOOLEAN If 1, the class belongs to a control widget. If 0, the class represents a panel client widget. =item lastUsedDock DOCK Saved value of the last used dock widget =item lastUsedRect X1, Y1, X2, Y2 Saved coordinates of the widget =back =item panel_by_id CLSID Return reference to a panel widget represented by CLSID scalar, or C if none found. =item panel_menuitems CALLBACK A helper function; maps all panel names into a structure, ready to feed into C property ( see L ). The action member of the menu item record is set to CALLBACK scalar. =item panel_visible CLSID, BOOLEAN Sets the visibility of a panel, referred by CLSID scalar. If VISIBLE is 0, a panel is destroyed; if 1, new panel instance is created. =item panels Returns all visible panel widgets in an array. =item predefined_panels CLSID, DOCK, [ CLSID, DOCK, ... ] Accepts pairs of scalars, where each first item is a panel CLSID and second is the default dock widget. Checks for panel visibility, and creates the panels that are not visible. The method is useful in program startup, when some panels have to be visible from the beginning. =item predefined_toolbars @PROFILES Accepts array of hashes, where each array item describes a toolbar and a default set of command widgets. Checks for toolbar visibility, and creates the toolbars that are not visible. The method recognizes the following PROFILES options: =over =item dock DOCK The default dock widget. =item list ARRAY Array of CLSIDs corresponding to the command widgets to be inserted into the toolbar. =item name STRING Selects toolbar name. =item origin X, Y Selects the toolbar position relative to the dock ( if C is specified ) or to the screen ( if C is not specified ). =back The method is useful in program startup, when some panels have to be visible from the beginning. =item register_panel CLSID, PROFILE Registers a panel client class and set of parameters to be associated with CLSID scalar. PROFILE must contain the following keys: =over =item class STRING Client widget class =item text STRING String, displayed in the panel title bar =item dockerProfile HASH Hash of parameters, passed to C. =item profile Hash of parameters, passed to the client widget. =back =item register_tool CLSID, PROFILE Registers a control widget class and set of parameters to be associated with CLSID scalar. PROFILE must be set the following keys: =over =item class STRING Client widget class =item profile HASH Hash of parameters, passed to the control widget. =back =item toolbar_by_name NAME Returns a pointer to a toolbar of NAME, or C if none found. =item toolbar_menuitems CALLBACK A helper function; maps all toolbar names into a structure, ready to feed into C property ( see L ). The action member of the menu item record is set to CALLBACK scalar. =item toolbar_visible TOOLBAR, BOOLEAN Sets the visibility of a TOOLBAR. If VISIBLE is 0, the toolbar is hidden; if 1, it is shown. =item toolbars Returns all toolbar widgets in an array. =item windowState INTEGER Mimics interface of C, and maintains visibility of toolbars and panels. If the parameter is C, the toolbars and panels are hidden. On any other parameter these are shown. To be used inside a callback code of a main window, that has the toolbars and panels attached to: onWindowState => sub { $dock_manager-> windowState( $_[1] ) } =back =head2 Events =over =item Command CLSID A generic event, triggered by a command widget when the user activates it. It can also be called by other means. CLSID is the widget identifier. =item CommandChange Called when C property changes or C method is invoked. =item PanelChange Triggered when a panel is created or destroyed by the user. =item ToolbarChange Triggered when a toolbar is created, shown, hidden, or destroyed by the user. =back =head1 Prima::DockManager::S::SpeedButton The package simplifies creation of C command widgets. =head2 Methods =over =item class IMAGE, CLSID, %PROFILE Builds a hash with parameters, ready to feed C for registering a C class instance with PROFILE parameters. IMAGE is a path to a image file, loaded and stored in the registration hash. IMAGE provides an extended syntax for indicating a frame index, if the image file is multiframed: the frame index is appended to the path name with C<:> character prefix. CLSID scalar is not used; it is returned so the method result can directly be passed into C method. Returns two scalars: CLSID and the registration hash. Example: $dock_manager-> register_tool( Prima::DockManager::S::SpeedButton::class( "myicon.gif:2", q(CLSID::Logo), hint => 'Logo image' )); =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, F =cut Prima-1.28/Prima/KeySelector.pm0000644000175100017510000002524711150770061014143 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # $Id: KeySelector.pm,v 1.9 2005/10/13 17:22:50 dk Exp $ # # Contains: # Prima::KeySelector # Provides: # Control set for assigning and exporting keys package Prima::KeySelector; use strict; use Prima; use Prima::Buttons; use Prima::Label; use Prima::ComboBox; use vars qw(@ISA %vkeys); @ISA = qw(Prima::Widget); for ( keys %kb::) { next if $_ eq 'constant'; next if $_ eq 'AUTOLOAD'; next if $_ eq 'CharMask'; next if $_ eq 'CodeMask'; next if $_ eq 'ModMask'; $vkeys{$_} = &{$kb::{$_}}(); } sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, key => kb::NoKey, scaleChildren => 0, autoEnableChildren => 1, } } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); my @sz = $self-> size; my $fh = $self-> font-> height; $sz[1] -= $fh + 4; $self-> {keys} = $self-> insert( ComboBox => name => 'Keys', delegations => [qw(Change)], origin => [ 0, $sz[1]], size => [ $sz[0], $fh + 4], growMode => gm::GrowHiX, style => cs::DropDownList, items => [ sort keys %vkeys, 'A'..'Z', '0'..'9', '+', '-', '*'], ); $sz[1] -= $fh * 4 + 28; $self-> {mod} = $self-> insert( GroupBox => origin => [ 0, $sz[1]], size => [ $sz[0], $fh * 4 + 28], growMode => gm::GrowHiX, style => cs::DropDown, text => '', ); my @esz = $self-> {mod}-> size; $esz[1] -= $fh * 2 + 4; $self-> {modShift} = $self-> {mod}-> insert( CheckBox => name => 'Shift', delegations => [$self, qw(Click)], origin => [ 8, $esz[1]], size => [ $esz[0] - 16, $fh + 6], text => '~Shift', growMode => gm::GrowHiX, ); $esz[1] -= $fh + 8; $self-> {modCtrl} = $self-> {mod}-> insert( CheckBox => name => 'Ctrl', delegations => [$self, qw(Click)], origin => [ 8, $esz[1]], size => [ $esz[0] - 16, $fh + 6], text => '~Ctrl', growMode => gm::GrowHiX, ); $esz[1] -= $fh + 8; $self-> {modAlt} = $self-> {mod}-> insert( CheckBox => name => 'Alt', delegations => [$self, qw(Click)], origin => [ 8, $esz[1]], size => [ $esz[0] - 16, $fh + 6], text => '~Alt', growMode => gm::GrowHiX, ); $sz[1] -= $fh + 8; $self-> insert( Label => origin => [ 0, $sz[1]], size => [ $sz[0], $fh + 2], growMode => gm::GrowHiX, text => 'Press shortcut key:', ); $sz[1] -= $fh + 6; $self-> {keyhook} = $self-> insert( Widget => name => 'Hook', delegations => [qw(Paint KeyDown TranslateAccel )], origin => [ 0, $sz[1]], size => [ $sz[0], $fh + 2], growMode => gm::GrowHiX, selectable => 1, cursorPos => [ 4, 1], cursorSize => [ 1, $fh], cursorVisible => [ 1, $fh], tabStop => 1, ); $self-> key( $profile{key}); return %profile; } sub Keys_Change { $_[0]-> _gather; } sub Shift_Click { $_[0]-> _gather; } sub Ctrl_Click { $_[0]-> _gather; } sub Alt_Click { $_[0]-> _gather; } sub _gather { my $self = $_[0]; return if $self-> {blockChange}; my $mod = ( $self-> {modAlt}-> checked ? km::Alt : 0) | ( $self-> {modCtrl}-> checked ? km::Ctrl : 0) | ( $self-> {modShift}-> checked ? km::Shift : 0); my $tx = $self-> {keys}-> text; my $vk = exists $vkeys{$tx} ? $vkeys{$tx} : kb::NoKey; my $ck; if ( exists $vkeys{$tx}) { $ck = 0; } elsif (( $mod & km::Ctrl) && ( ord($tx) >= ord('A')) && ( ord($tx) <= ord('z'))) { $ck = ord( uc $tx) - ord('@'); } else { $ck = ord( $tx); } $self-> {key} = Prima::AbstractMenu-> translate_key( $ck, $vk, $mod); $self-> notify(q(Change)); } sub Hook_KeyDown { my ( $self, $hook, $code, $key, $mod) = @_; $self-> key( Prima::AbstractMenu-> translate_key( $code, $key, $mod)); } sub Hook_TranslateAccel { my ( $self, $hook, $code, $key, $mod) = @_; return unless $hook-> focused; $hook-> clear_event unless $key == kb::Tab || $key == kb::BackTab; } sub Hook_Paint { my ( $self, $hook, $canvas) = @_; $canvas-> rect3d( 0, 0, $canvas-> width - 1, $canvas-> height - 1, 1, $hook-> dark3DColor, $hook-> light3DColor, $hook-> backColor); } sub translate_codes { my ( $data, $useCTRL) = @_; my ( $code, $key, $mod); if ((( $data & 0xFF) >= ord('A')) && (( $data & 0xFF) <= ord('z'))) { $code = $data & 0xFF; $key = kb::NoKey; } elsif ((( $data & 0xFF) >= 1) && (( $data & 0xFF) <= 26)) { $code = $useCTRL ? ( $data & 0xFF) : ord( lc chr(ord( '@') + $data & 0xFF)); $key = kb::NoKey; $data |= km::Ctrl; } elsif ( $data & 0xFF) { $code = $data & 0xFF; $key = kb::NoKey; } else { $code = 0; $key = $data & kb::CodeMask; } $mod = $data & kb::ModMask; return $code, $key, $mod; } sub key { return $_[0]-> {key} unless $#_; my ( $self, $data) = @_; my ( $code, $key, $mod) = translate_codes( $data, 0); if ( $code) { $self-> {keys}-> text( chr($code)); } else { my $x = 'NoKey'; for ( keys %vkeys) { next if $_ eq 'constant'; $x = $_, last if $key == $vkeys{$_}; } $self-> {keys}-> text( $x); } $self-> {key} = $data; $self-> {blockChange} = 1; $self-> {modAlt}-> checked( $mod & km::Alt); $self-> {modCtrl}-> checked( $mod & km::Ctrl); $self-> {modShift}-> checked( $mod & km::Shift); delete $self-> {blockChange}; $self-> notify(q(Change)); } # static functions # exports binary value to a reasonable and perl-evaluable expression sub export { my $data = $_[0]; my ( $code, $key, $mod) = translate_codes( $data, 1); my $txt = ''; if ( $code) { if (( $code >= 1) && ($code <= 26)) { $code += ord('@'); $txt = '(ord(\''.uc chr($code).'\')-64)'; } else { $txt = 'ord(\''.lc chr($code).'\')'; } } else { my $x = 'NoKey'; for ( keys %vkeys) { next if $_ eq 'constant'; $x = $_, last if $vkeys{$_} == $key; } $txt = 'kb::'.$x; } $txt .= '|km::Alt' if $mod & km::Alt; $txt .= '|km::Ctrl' if $mod & km::Ctrl; $txt .= '|km::Shift' if $mod & km::Shift; return $txt; } # creates a key description, suitable for a menu accelerator text sub describe { my $data = $_[0]; my ( $code, $key, $mod) = translate_codes( $data, 0); my $txt = ''; my $lonekey; if ( $code) { $txt = uc chr $code; } elsif ( $key == kb::NoKey) { $lonekey = 1; } else { for ( keys %vkeys) { next if $_ eq 'constant'; $txt = $_, last if $vkeys{$_} == $key; } } $txt = 'Shift+' . $txt if $mod & km::Shift; $txt = 'Alt+' . $txt if $mod & km::Alt; $txt = 'Ctrl+' . $txt if $mod & km::Ctrl; $txt =~ s/\+$// if $lonekey; return $txt; } # exports binary value to AbstractMenu-> translate_shortcut input sub shortcut { my $data = $_[0]; my ( $code, $key, $mod) = translate_codes( $data, 0); my $txt = ''; if ( $code || (( $key >= kb::F1) && ( $key <= kb::F30))) { $txt = $code ? ( uc chr $code) : ( 'F' . (( $key - kb::F1) / ( kb::F2 - kb::F1) + 1)); $txt = '^' . $txt if $mod & km::Ctrl; $txt = '@' . $txt if $mod & km::Alt; $txt = '#' . $txt if $mod & km::Shift; } else { return export( $data); } return "'" . $txt . "'"; } 1; __DATA__ =pod =head1 NAME Prima::KeySelector - key combination widget and routines =head1 DESCRIPTION The module provides a standard widget for selecting a user-defined key combination. The widget class allows import, export, and modification of key combinations. The module provides a set of routines, useful for conversion of a key combination between representations. =head1 SYNOPSIS my $ks = Prima::KeySelector-> create( ); $ks-> key( km::Alt | ord('X')); print Prima::KeySelector::describe( $ks-> key ); =head1 API =head2 Properties =over =item key INTEGER Selects a key combination in integer format. The format is described in L, and is a combination of C key modifiers and either a C virtual key, or a character code value. The property allows almost, but not all possible combinations of key constants. Only C, C, and C modifiers are allowed. =back =head2 Methods All methods here can ( and must ) be called without the object syntax; - the first parameter must not be neither package nor widget. =over =item describe KEY Accepts KEY in integer format, and returns string description of the key combination in human readable format. Useful for supplying an accelerator text to a menu. print describe( km::Shift|km::Ctrl|km::F10); Ctrl+Shift+F10 =item export KEY Accepts KEY in integer format, and returns string with a perl-evaluable expression, which after evaluation resolves to the original KEY value. Useful for storing a key into text config files, where value must be both human readable and easily passed to a program. print export( km::Shift|km::Ctrl|km::F10); km::Shift|km::Ctrl|km::F10 =item shortcut KEY Converts KEY from integer format to a string, acceptable by C input methods. print shortcut( km::Ctrl|ord('X')); ^X =item translate_codes KEY, [ USE_CTRL = 0 ] Converts KEY in integer format to three integers in the format accepted by L event: code, key, and modifier. USE_CTRL is only relevant when KEY first byte ( C ) is between 1 and 26, what means that the key is a combination of an alpha key with the control key. If USE_CTRL is 1, code result is unaltered, and is in range 1 - 26. Otherwise, code result is converted to the character code ( 1 to ord('A'), 2 to ord('B') etc ). =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L. =cut Prima-1.28/Prima/IntUtils.pm0000644000175100017510000003555011150770061013463 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: IntUtils.pm,v 1.28 2008/04/09 19:06:17 dk Exp $ package Prima::IntUtils; use strict; use Prima::Const; package Prima::MouseScroller; my $scrollTimer; sub scroll_timer_active { return 0 unless defined $scrollTimer; return $scrollTimer-> {active}; } sub scroll_timer_semaphore { return 0 unless defined $scrollTimer; $#_ ? $scrollTimer-> {semaphore} = $_[1] : return $scrollTimer-> {semaphore}; } sub scroll_timer_stop { return unless defined $scrollTimer; $scrollTimer-> stop; $scrollTimer-> {active} = 0; $scrollTimer-> timeout( $scrollTimer-> {firstRate}); $scrollTimer-> {newRate} = $scrollTimer-> {nextRate}; } sub scroll_timer_start { my $self = $_[0]; $self-> scroll_timer_stop; unless ( defined $scrollTimer) { my @rates = $::application-> get_scroll_rate; $scrollTimer = Prima::Timer-> create( owner => $::application, timeout => $rates[0], name => q(ScrollTimer), onTick => sub { $_[0]-> {delegator}-> ScrollTimer_Tick( @_)}, onDestroy => sub { undef $scrollTimer }, ); @{$scrollTimer}{qw(firstRate nextRate newRate)} = (@rates,$rates[1]); } $scrollTimer-> {delegator} = $self; $scrollTimer-> {semaphore} = 1; $scrollTimer-> {active} = 1; $scrollTimer-> start; } sub ScrollTimer_Tick { my ( $self, $timer) = @_; if ( exists $scrollTimer-> {newRate}) { $timer-> timeout( $scrollTimer-> {newRate}); delete $scrollTimer-> {newRate}; } $scrollTimer-> {semaphore} = 1; $self-> notify(q(MouseMove), 0, $self-> pointerPos); $self-> scroll_timer_stop unless defined $self-> {mouseTransaction}; } package Prima::IntIndents; sub indents { return wantarray ? @{$_[0]-> {indents}} : [@{$_[0]-> {indents}}] unless $#_; my ( $self, @indents) = @_; @indents = @{$indents[0]} if ( scalar(@indents) == 1) && ( ref($indents[0]) eq 'ARRAY'); for ( @indents) { $_ = 0 if $_ < 0; } $self-> {indents} = \@indents; } sub get_active_area { my @r = ( scalar @_ > 2) ? @_[2,3] : $_[0]-> size; my $i = $_[0]-> {indents}; if ( !defined($_[1]) || $_[1] == 0) { # returns inclusive - exclusive return $$i[0], $$i[1], $r[0] - $$i[2], $r[1] - $$i[3]; } elsif ( $_[1] == 1) { # returns inclusive - inclusive return $$i[0], $$i[1], $r[0] - $$i[2] - 1, $r[1] - $$i[3] - 1; } else { # returns size return $r[0] - $$i[0] - $$i[2], $r[1] - $$i[1] - $$i[3]; } } package Prima::GroupScroller; use vars qw(@ISA); @ISA = qw(Prima::IntIndents); use Prima::ScrollBar; sub setup_indents { my ($self) = @_; $self-> {indents} = [ 0,0,0,0]; my $bw = $self-> {borderWidth}; $self-> {indents}-> [$_] += $bw for 0..3; $self-> {indents}-> [1] += $self-> {hScrollBar}-> height - 1 if $self-> {hScroll}; $self-> {indents}-> [2] += $self-> {vScrollBar}-> width - 1 if $self-> {vScroll}; } sub set_border_width { my ( $self, $bw) = @_; my @size = $self-> size; $bw = 0 if $bw < 0; $bw = 1 if $bw > $size[1] / 2; $bw = 1 if $bw > $size[0] / 2; return if $bw == $self-> {borderWidth}; my $obw = $self-> {borderWidth}; $self-> {borderWidth} = $bw; $self-> {hScrollBar}-> set( left => $bw - 1, bottom => $bw - 1, width => $size[0] - $bw * 2 + 2 - ( $self-> {vScroll} ? $self-> {vScrollBar}-> width - 2 : 0 ), ) if $self-> {hScroll}; $self-> {vScrollBar}-> set( top => $size[1] - $bw + 1, right => $size[0] - $bw + 1, bottom => $bw + ( $self-> {hScroll} ? $self-> {hScrollBar}-> height - 2 : 0 ), ) if $self-> {vScroll}; $self-> insert_bone if defined $self-> {bone}; $self-> setup_indents; $self-> reset_indents; } sub reset_indents {} sub insert_bone { my $self = $_[0]; my $bw = $self-> {borderWidth}; $self-> {bone}-> destroy if defined $self-> {bone}; $self-> {bone} = Prima::Widget-> new( owner => $self, name => q(Bone), pointerType => cr::Arrow, origin => [ $self-> width - $self-> {vScrollBar}-> width + 3 - $bw, $bw - 1], size => [ $self-> {vScrollBar}-> width-2, $self-> {hScrollBar}-> height-1], growMode => gm::GrowLoX, widgetClass => wc::ScrollBar, designScale => undef, onPaint => sub { my ( $self, $canvas, $owner, $w, $h) = ($_[0], $_[1], $_[0]-> owner, $_[0]-> size); $canvas-> color( $self-> backColor); $canvas-> bar( 0, 1, $w - 2, $h - 1); $canvas-> color( $owner-> light3DColor); $canvas-> line( 0, 0, $w - 1, 0); $canvas-> line( $w - 1, 0, $w - 1, $h - 1); }, ); } sub set_h_scroll { my ( $self, $hs) = @_; return if $hs == $self-> {hScroll}; my $bw = $self-> {borderWidth} || 0; if ( $self-> {hScroll} = $hs) { $self-> {hScrollBar} = Prima::ScrollBar-> new( owner => $self, name => q(HScroll), vertical => 0, origin => [ $bw-1, $bw-1], growMode => gm::GrowHiX, pointerType => cr::Arrow, width => $self-> width - 2 * $bw + 2 - ( $self-> {vScroll} ? $self-> {vScrollBar}-> width - 2 : 0), delegations => ['Change'], designScale => undef, ); $self-> setup_indents; if ( $self-> {vScroll}) { my $h = $self-> {hScrollBar}-> height; $self-> {vScrollBar}-> set( bottom => $self-> {vScrollBar}-> bottom + $h - 2, top => $self-> {vScrollBar}-> top, ); $self-> insert_bone; } } else { $self-> setup_indents; $self-> {hScrollBar}-> destroy; if ( $self-> {vScroll}) { $self-> {vScrollBar}-> set( bottom => $bw, height => $self-> height - $bw * 2, ); $self-> {bone}-> destroy; delete $self-> {bone}; } } $self-> reset_indents; } sub set_v_scroll { my ( $self, $vs) = @_; return if $vs == $self-> {vScroll}; my $bw = $self-> {borderWidth} || 0; my @size = $self-> size; if ( $self-> {vScroll} = $vs) { $self-> {vScrollBar} = Prima::ScrollBar-> new( owner => $self, name => q(VScroll), vertical => 1, left => $size[0] - $bw - $Prima::ScrollBar::stdMetrics[0] + 1, top => $size[1] - $bw + 1, bottom => $bw + ( $self-> {hScroll} ? $self-> {hScrollBar}-> height - 2 : 0), growMode => gm::GrowLoX | gm::GrowHiY, pointerType => cr::Arrow, delegations => ['Change'], designScale => undef, ); $self-> setup_indents; if ( $self-> {hScroll}) { $self-> {hScrollBar}-> width( $self-> {hScrollBar}-> width - $self-> {vScrollBar}-> width + 2, ); $self-> insert_bone; } } else { $self-> setup_indents; $self-> {vScrollBar}-> destroy; if ( $self-> {hScroll}) { $self-> {hScrollBar}-> width( $size[0] - 2 * $bw + 2); $self-> {bone}-> destroy; delete $self-> {bone}; } } $self-> reset_indents; } sub autoHScroll { return $_[0]-> {autoHScroll} unless $#_; my $v = ( $_[1] ? 1 : 0); return unless $v != $_[0]-> {autoHScroll}; $_[0]-> {autoHScroll} = $v; } sub autoVScroll { return $_[0]-> {autoVScroll} unless $#_; my $v = ( $_[1] ? 1 : 0); return unless $v != $_[0]-> {autoVScroll}; $_[0]-> {autoVScroll} = $v; } sub borderWidth {($#_)?($_[0]-> set_border_width( $_[1])):return $_[0]-> {borderWidth}} sub hScroll {($#_)?$_[0]-> set_h_scroll ($_[1]):return $_[0]-> {hScroll}} sub vScroll {($#_)?$_[0]-> set_v_scroll ($_[1]):return $_[0]-> {vScroll}} sub draw_border { my ( $self, $canvas, $backColor, @size) = @_; @size = $self-> size unless @size; $self-> rect_bevel( $canvas, 0, 0, $size[0]-1, $size[1]-1, width => $self-> {borderWidth}, panel => 1, fill => $backColor, ); } 1; __DATA__ =head1 NAME Prima::IntUtils - internal functions =head1 DESCRIPTION The module provides packages, containing common functionality for some standard classes. The packages are designed as a code containers, not as widget classes, and are to be used as secondary ascendants in the widget inheritance declaration. =head1 Prima::MouseScroller Implements routines for emulation of auto repeating mouse events. A code inside C callback can be implemented by the following scheme: if ( mouse_pointer_inside_the_scrollable_area) { $self-> scroll_timer_stop; } else { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore( 0); } The class uses a semaphore C<{mouseTransaction}>, which should be set to non-zero if a widget is in mouse capture state, and set to zero or C otherwise. The class starts an internal timer, which sets a semaphore and calls C notification when triggered. The timer is assigned the timeouts, returned by C ( see L ). =head2 Methods =over =item scroll_timer_active Returns a boolean value indicating if the internal timer is started. =item scroll_timer_semaphore [ VALUE ] A semaphore, set to 1 when the internal timer was triggered. It is advisable to check the semaphore state to discern a timer-generated event from the real mouse movement. If VALUE is specified, it is assigned to the semaphore. =item scroll_timer_start Starts the internal timer. =item scroll_timer_stop Stops the internal timer. =back =head1 Prima::IntIndents Provides the common functionality for the widgets that delegate part of their surface to the border elements. A list box can be of an example, where its scroll bars and 3-d borders are such elements. =head2 Properties =over =item indents ARRAY Contains four integers, specifying the breadth of decoration elements for each side. The first integer is width of the left element, the second - height of the lower element, the third - width of the right element, the fourth - height of the upper element. The property can accept and return the array either as a four scalars, or as an anonymous array of four scalars. =back =head2 Methods =over =item get_active_area [ TYPE = 0, WIDTH, HEIGHT ] Calculates and returns the extension of the area without the border elements, or the active area. The extension are related to the current size of a widget, however, can be overridden by specifying WIDTH and HEIGHT. TYPE is an integer, indicating the type of calculation: =over =item TYPE = 0 Returns four integers, defining the area in the inclusive-exclusive coordinates. =item TYPE = 1 Returns four integers, defining the area in the inclusive-inclusive coordinates. =item TYPE = 2 Returns two integers, the size of the area. =back =back =head1 Prima::GroupScroller The class is used for widgets that contain optional scroll bars, and provides means for their maintenance. The class is the descendant of L, and adjusts the L property when scrollbars are shown or hidden, or L is changed. The class does not provide range selection for the scrollbars; the descentant classes must implement that. The descendant classes must follow the guidelines: =over =item * A class must provide C, C, and C property keys in profile_default() . A class may provide C and C property keys in profile_default() . =item * A class' init() method must set C<{borderWidth}>, C<{hScroll}>, and C<{vScroll}> variables to 0 before the initialization, call C method, and then assign the properties from the object profile. If a class provides C and C properties, these must be set to 0 before the initialization. =item * If a class needs to overload one of C, C, C, C, and C properties, it is mandatory to call the inherited properties. =item * A class must implement the scroll bar notification callbacks: C and C. =item * A class must not use the reserved variable names, which are: {borderWidth} - internal borderWidth storage {hScroll} - internal hScroll value storage {vScroll} - internal vScroll value storage {hScrollBar} - pointer to the horizontal scroll bar {vScrollBar} - pointer to the vertical scroll bar {bone} - rectangular widget between the scrollbars {autoHScroll} - internal autoHScroll value storage {autoVScroll} - internal autoVScroll value storage The reserved method names: set_h_scroll set_v_scroll insert_bone setup_indents reset_indents borderWidth autoHScroll autoVScroll hScroll vScroll The reserved widget names: HScroll VScroll Bone =back =head2 Properties =over =item autoHScroll BOOLEAN Selects if the horizontal scrollbar is to be shown and hidden dynamically, depending on the widget layout. =item autoVScroll BOOLEAN Selects if the vertical scrollbar is to be shown and hidden dynamically, depending on the widget layout. =item borderWidth INTEGER Width of 3d-shade border around the widget. Recommended default value: 2 =item hScroll BOOLEAN Selects if the horizontal scrollbar is visible. If it is, C<{hScrollBar}> points to it. =item vScroll BOOLEAN Selects if the vertical scrollbar is visible. If it is, C<{vScrollBar}> points to it. =back =head2 Properties =over =item setup_indents The method is never called directly; it should be called whenever widget layout is changed so that indents are affected. The method is a request to recalculate indents, depending on the widget layout. The method is not reentrant; to receive this callback and update the widget layout, that in turn can result in more C calls, overload C . =item reset_indents Called after C is called and internal widget layout is updated, to give a chance to follow-up the layout changes. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, L, L, L, L. =cut Prima-1.28/Prima/ScrollWidget.pm0000644000175100017510000002775311150770061014320 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: ScrollWidget.pm,v 1.21 2008/04/09 20:14:27 dk Exp $ use strict; use Prima::Const; use Prima::Classes; use Prima::IntUtils; package Prima::ScrollWidget; use vars qw(@ISA); @ISA = qw( Prima::Widget Prima::GroupScroller); { my %RNT = ( %{Prima::Widget->notification_types()}, Scroll => nt::Default, ); sub notification_types { return \%RNT; } } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( autoHScroll => 1, autoVScroll => 1, borderWidth => 0, hScroll => 0, vScroll => 0, deltaX => 0, deltaY => 0, limitX => 0, limitY => 0, ); @$def{keys %prf} = values %prf; return $def; } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); $p-> {autoHScroll} = 0 if exists $p-> {hScroll}; $p-> {autoVScroll} = 0 if exists $p-> {vScroll}; } sub init { my $self = shift; for ( qw( autoHScroll autoVScroll scrollTransaction hScroll vScroll limitX limitY deltaX deltaY borderWidth winX winY)) { $self->{$_} = 0; } my %profile = $self-> SUPER::init(@_); $self-> setup_indents; for ( qw( autoHScroll autoVScroll hScroll vScroll borderWidth)) { $self->$_( $profile{ $_}); } $self-> limits( $profile{limitX}, $profile{limitY}); $self-> deltas( $profile{deltaX}, $profile{deltaY}); $self-> reset_scrolls; return %profile; } sub reset_scrolls { my $self = $_[0]; my ($x, $y) = $self-> get_active_area(2); my ($w, $h) = $self-> limits; my $reread; @{$self}{qw(winX winY)} = ($x, $y); if ( $self-> {autoHScroll} and $self->{autoVScroll} and ( $self-> {hScroll} or $self-> {vScroll}) ) { # avoid the special case when two scrollbars are unnecessary, but are present # since they obscure parts of the panel that would have been visible fully, # if not for the scrollbars my $dx = $self->{vScroll} ? $Prima::ScrollBar::stdMetrics[0] : 0; my $dy = $self->{hScroll} ? $Prima::ScrollBar::stdMetrics[1] : 0; if ( $x + $dx >= $w and $y + $dy >= $h) { $self-> hScroll(0) if $self->{hScroll}; $self-> vScroll(0) if $self->{vScroll}; @{$self}{qw(winX winY)} = $self-> get_active_area(2); $self-> set_deltas( $self->{deltaX}, $self->{deltaY}); return; } } if ( $self-> {autoHScroll}) { my $hs = ( $x < $w) ? 1 : 0; if ( $hs != $self-> {hScroll}) { $self-> hScroll( $hs); $reread = 1; } } if ( $self-> {autoVScroll}) { if ( $reread) { @{$self}{qw(winX winY)} = ($x, $y) = $self-> get_active_area(2); $reread = 0; } my $vs = ( $y < $h) ? 1 : 0; if ( $vs != $self-> {vScroll}) { $self-> vScroll( $vs); $reread = 1; } } if ( $reread) { @{$self}{qw(winX winY)} = ($x, $y) = $self-> get_active_area(2); } if ( $self-> {hScroll}) { $self-> {hScrollBar}-> set( max => $x < $w ? $w - $x : 0, whole => $w, partial => $x < $w ? $x : $w, ); } if ( $self-> {vScroll}) { $self-> {vScrollBar}-> set( max => $y < $h ? $h - $y : 0, whole => $h, partial => $y < $h ? $y : $h, ); } $self-> set_deltas( $self->{deltaX}, $self->{deltaY}); } sub set_limits { my ( $self, $w, $h) = @_; $w = 0 if $w < 0; $h = 0 if $h < 0; $w = int( $w); $h = int( $h); return if $w == $self-> {limitX} and $h == $self->{limitY}; $self-> {limitY} = $h; $self-> {limitX} = $w; $self-> reset_scrolls; } sub set_deltas { my ( $self, $w, $h) = @_; my ($odx,$ody) = ($self->{deltaX},$self->{deltaY}); $w = 0 if $w < 0; $h = 0 if $h < 0; $w = int( $w); $h = int( $h); my ($x, $y) = $self-> limits; my @sz = $self-> size; my ( $ww, $hh) = $self-> get_active_area( 2, @sz); $x -= $ww; $y -= $hh; $x = 0 if $x < 0; $y = 0 if $y < 0; $w = $x if $w > $x; $h = $y if $h > $y; return if $w == $odx && $h == $ody; $self-> {deltaY} = $h; $self-> {deltaX} = $w; $self-> notify('Scroll', $odx - $w, $h - $ody); $self-> {scrollTransaction} = 1; $self-> {hScrollBar}-> value( $w) if $self->{hScroll}; $self-> {vScrollBar}-> value( $h) if $self->{vScroll}; $self-> {scrollTransaction} = undef; } sub on_scroll { my ( $self, $dx, $dy) = @_; $self-> scroll( $dx, $dy, clipRect => [$self->get_active_area(0)]); } sub on_size { $_[0]-> reset_scrolls; } sub VScroll_Change { $_[0]-> deltaY( $_[1]-> value) unless $_[0]-> {scrollTransaction}; } sub HScroll_Change { $_[0]-> deltaX( $_[1]-> value) unless $_[0]-> {scrollTransaction}; } sub limitX {($#_)?$_[0]->set_limits($_[1],$_[0]->{limitY}):return $_[0]->{'limitX'}; } sub limitY {($#_)?$_[0]->set_limits($_[0]->{'limitX'},$_[1]):return $_[0]->{'limitY'}; } sub limits {($#_)?$_[0]->set_limits ($_[1], $_[2]):return ($_[0]->{'limitX'},$_[0]->{'limitY'});} sub deltaX {($#_)?$_[0]->set_deltas($_[1],$_[0]->{deltaY}):return $_[0]->{'deltaX'}; } sub deltaY {($#_)?$_[0]->set_deltas($_[0]->{'deltaX'},$_[1]):return $_[0]->{'deltaY'}; } sub deltas {($#_)?$_[0]->set_deltas ($_[1], $_[2]):return ($_[0]->{'deltaX'},$_[0]->{'deltaY'}); } package Prima::ScrollGroup; use vars qw(@ISA); @ISA = qw(Prima::ScrollWidget); sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( rigid => 1, clientSize => [100, 100], slaveClass => 'Prima::Widget', slaveProfile => {}, slaveDelegations => [], clientClass => 'Prima::ScrollGroup::Client', clientProfile => {}, clientDelegations => [], ); @$def{keys %prf} = values %prf; return $def; } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); if ( exists $p-> {clientSize}) { $p-> {rigid} = 0 unless exists $p-> {rigid}; $p-> {clientProfile}->{geometry} = gt::Default unless exists $p-> {clientProfile}->{geometry}; } } sub init { my ($self, %profile) = @_; %profile = $self-> SUPER::init(%profile); $self-> {$_} = 0 for qw(rigid); $self-> $_( $profile{$_}) for qw(rigid); $self-> {slave} = $profile{slaveClass}-> new( delegations => $profile{slaveDelegations}, %{$profile{slaveProfile}}, owner => $self, name => 'SlaveWindow', rect => [ $self-> get_active_area(0) ], growMode => gm::Client, ); $self-> {client_geomSize} = [0,0]; $self-> {client} = $profile{clientClass}-> new( delegations => [ $self, 'Size', $self, 'Move', @{$profile{clientDelegations}}], ( $profile{rigid} ? () : ( origin => [0,0], size => $profile{clientSize}) ), %{$profile{clientProfile}}, owner => $self-> {slave}, name => 'ClientWindow', designScale => undef, scaleChildren => $profile{scaleChildren}, ); $self-> {client}-> designScale( $self-> designScale); $self-> reset(1); return %profile; } sub reset_indents { $_[0]-> reset(1); } sub ClientWindow_Size { $_[0]-> reset; } sub ClientWindow_Move { $_[0]-> reset; } sub ClientWindow_geomSize { my ( $self, $client, $x, $y) = @_; $client-> sizeMin( $x, $y) if $self-> rigid; $self-> update_geom_size( $x, $y); } sub packPropagate { return shift-> SUPER::packPropagate unless $#_; my ( $self, $pack_propagate) = @_; $self-> SUPER::packPropagate( $pack_propagate); $self-> propagate_size if $pack_propagate; } sub propagate_size { my $self = $_[0]; $self-> update_geom_size( $self-> {client}-> geomSize) if $self-> {client}; } sub reset { my ( $self, $forced) = @_; return unless $self-> {client}; my @size = $self-> size; $self-> {slave}-> rect( $self-> get_active_area(0, @size)) if $forced; my @l = $self-> limits; my @s = $self-> {client}-> size; my @o = $self-> {client}-> origin; local $self-> {protect_scrolling} = 1; ( $l[0] == $s[0] and $l[1] == $s[1]) ? $self-> reset_scrolls : $self-> limits( $s[0], $s[1]); $self-> deltas( -$o[0], $o[1] - $self-> {slave}-> height + $s[1]); } sub children_extensions { my $self = $_[0]; my @ext = ( 0,0 ); for my $w ( $self-> {client}-> widgets) { my @r = $w-> rect; $ext[0] = $r[2] if $ext[0] < $r[2]; $ext[1] = $r[3] if $ext[1] < $r[3]; } return @ext; } sub update_geom_size { my ( $self, $x, $y) = @_; return unless $self-> packPropagate; my @i = $self-> indents; $self-> geomSize( $x + $i[0] + $i[2], $y + $i[1] + $i[3] ); } sub on_paint { my ( $self, $canvas) = @_; $self-> draw_border( $canvas, $self-> backColor, $self-> size ); } sub on_size { $_[0]-> reset(1); } sub on_scroll { my ( $self, $dx, $dy) = @_; return if $self-> {protect_scrolling}; local $self-> {protect_scrolling} = 1; my @o = $self-> {client}-> origin; $self-> {client}-> origin( $o[0] + $dx, $o[1] + $dy, ); } sub slave { $_[0]-> {slave} } sub client { $_[0]-> {client} } sub insert { shift-> {client}-> insert( @_ ) } sub rigid { return $_[0]-> {rigid} unless $#_; my ( $self, $rigid) = @_; return if $self-> {rigid} == $rigid; $self-> {rigid} = $rigid; $self-> reset if $rigid; } sub clientSize { return $_[0]-> {client}-> size unless $#_; shift-> {client}-> size(@_); } sub use_current_size { $_[0]-> {client}-> sizeMin( $_[0]-> children_extensions); } package Prima::ScrollGroup::Client; use vars qw(@ISA); @ISA = qw(Prima::Widget); sub profile_default { my $def = $_[0]-> SUPER::profile_default; my %prf = ( geometry => gt::Pack, packInfo => { expand => 1, fill => 'both'}, ); @$def{keys %prf} = values %prf; return $def; } sub geomSize { return $_[0]-> SUPER::geomSize unless $#_; my $self = shift; $self-> SUPER::geomSize( @_); $self-> owner-> owner-> ClientWindow_geomSize( $self, @_); } 1; __DATA__ =pod =head1 NAME Prima::ScrollWidget - scrollable generic document widget. =head1 DESCRIPTION C is a simple class that declares two pairs of properties, I and I for vertical and horizontal axes, which define a a virtual document. I is the document dimension, and I is the current offset. C is a descendant of C, and, as well as its ascendant, provides same user navigation by two scrollbars. The scrollbars' C and C properties are maintained if the document or widget extensions change. =head1 API =head2 Properties =over =item deltas X, Y Selects horizontal and vertical document offsets. =item deltaX INTEGER Selects horizontal document offset. =item deltaY INTEGER Selects vertical document offset. =item limits X, Y Selects horizontal and vertical document extensions. =item limitX INTEGER Selects horizontal document extension. =item limitY INTEGER Selects vertical document extension. =back =head2 Events =over =item Scroll DX, DY Called whenever the client area is to be scrolled. The default action calls C . =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, L, F. =cut Prima-1.28/Prima/sys/0000755000175100017510000000000011150770061012160 5ustar dkdkPrima-1.28/Prima/sys/win32/0000755000175100017510000000000011150770061013122 5ustar dkdkPrima-1.28/Prima/sys/win32/FileDialog.pm0000644000175100017510000001575711150770061015476 0ustar dkdk# # Copyright (c) 1997-2004 Dmitry Karasik # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: FileDialog.pm,v 1.4 2005/10/13 17:22:53 dk Exp $ use Prima; use strict; package Prima::sys::win32::FileDialog; use vars qw(@ISA); @ISA = qw(Prima::Component); return 1 if Prima::Application-> get_system_info->{apc} != apc::Win32; sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, defaultExt => '', fileName => '', filter => [[ 'All files' => '*.*']], filterIndex => 0, directory => '.', createPrompt => 0, multiSelect => 0, noReadOnly => 0, noTestFileCreate => 0, overwritePrompt => 1, pathMustExist => 1, fileMustExist => 1, showHelp => 0, openMode => 1, text => undef, } } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> {flags} = { HIDEREADONLY => 1, EXPLORER => 1, }; for ( qw( filterIndex openMode)) { $self->{$_}=$profile{$_} } for ( qw( defaultExt filter directory multiSelect createPrompt fileMustExist noReadOnly noTestFileCreate overwritePrompt pathMustExist showHelp )) { $self->$_($profile{$_}) } return %profile; } sub quoted_split { my @ret; $_ = $_[0]; s/(\\[^\\\s])/\\$1/g; study; { /\G\s+/gc && redo; /\G((?:[^\\\s]|\\.)+)\s*/gc && do { my $z = $1; $z =~ s/\\(.)/$1/g; push(@ret, $z); redo; }; /\G(\\)$/gc && do { push(@ret, $1); redo; }; } return @ret; } sub filter { if ( $#_) { my $self = $_[0]; my @filter = @{$_[1]}; @filter = [[ '' => '*']] unless scalar @filter; my @exts; my @mdts; for ( @filter) { push @exts, $$_[0]; push @mdts, $$_[1]; } $self-> {filterIndex} = scalar @exts - 1 if $self-> { filterIndex} >= scalar @exts; $self-> {filter} = \@filter; } else { return @{$_[0]-> {filter}}; } } sub filterIndex { if ( $#_) { $_[0]-> {filterIndex} = $_[1]; } else { return $_[0]-> {filterIndex}; } } sub directory { return $_[0]->{directory} unless $#_; $_[0]->{directory} = $_[1]; } sub createPrompt { return $_[0]->{flags}->{CREATEPROMPT} unless $#_; $_[0]->{flags}->{CREATEPROMPT} = $_[1]; } sub multiSelect { return $_[0]->{flags}->{ALLOWMULTISELECT} unless $#_; $_[0]->{flags}->{ALLOWMULTISELECT} = $_[1]; } sub noReadOnly { return $_[0]->{flags}->{NOREADONLYRETURN} unless $#_; $_[0]->{flags}->{NOREADONLYRETURN} = $_[1]; } sub noTestFileCreate { return $_[0]->{flags}->{NOTESTFILECREATE} unless $#_; $_[0]->{flags}->{NOTESTFILECREATE} = $_[1]; } sub overwritePrompt { return $_[0]->{flags}->{OVERWRITEPROMPT} unless $#_; $_[0]->{flags}->{OVERWRITEPROMPT} = $_[1]; } sub pathMustExist { return $_[0]->{flags}->{PATHMUSTEXIST} unless $#_; $_[0]->{flags}->{PATHMUSTEXIST} = $_[1]; } sub fileMustExist { return $_[0]->{flags}->{FILEMUSTEXIST} unless $#_; $_[0]->{flags}->{FILEMUSTEXIST} = $_[1]; } sub showHelp { return $_[0]->{flags}->{SHOWHELP} unless $#_; $_[0]->{flags}->{SHOWHELP} = $_[1]; } sub fileName { unless ( $#_) { return $_[0]->{fileName} unless $_[0]->multiSelect; my @s = quoted_split( $_[0]-> {fileName}); return $s[0] unless wantarray; return @s; } $_[0]->{fileName} = $_[1]; } sub defaultExt { return $_[0]->{defaultExt} unless $#_; $_[0]->{defaultExt} = $_[1]; } sub openMode { return $_[0]->{openMode} unless $#_; $_[0]->{openMode} = $_[1]; } sub text { return $_[0]->{text} unless $#_; $_[0]->{text} = $_[1]; } # dummies sub sorted { 1 } sub showDotFiles { 1 } # mere callbacks if someone wants these to inherit sub ok {} sub cancel {} sub execute { my $self = $_[0]; Prima::Application-> sys_action( 'win32.OpenFile.flags='. join(',', grep { $self->{flags}->{$_}} keys %{$self->{flags}})); Prima::Application-> sys_action( 'win32.OpenFile.filters=' . join("\0", map { "$$_[0] ($$_[1])\0$$_[1]" } @{$self->{filter}}) . "\0"); Prima::Application-> sys_action( 'win32.OpenFile.filterindex=' . ($self->{filterIndex}+1)); Prima::Application-> sys_action( 'win32.OpenFile.directory=' . $self->{directory}); Prima::Application-> sys_action( 'win32.OpenFile.defext=' . $self->{defaultExt}); Prima::Application-> sys_action( 'win32.OpenFile.title=' . (defined $self->{text} ? $self->{text} : 'NULL')); my $ret = Prima::Application-> sys_action( 'win32.OpenFile.'. ($self->{openMode}?'open':'save')); if ( !defined $ret) { $self-> cancel; return wantarray ? () : undef; } $self-> {directory} = Prima::Application-> sys_action( 'win32.OpenFile.directory'); $self-> {directory} =~ s/\\/\//g; $self-> {directory} =~ s/\s+$//; $self-> {directory} .= '/' unless $self-> {directory} =~ /\/$/; $self-> {fileName} = $ret; if ( $self-> multiSelect) { $self-> {fileName} = join( ' ', map { s/\\/\//g; $_ = $self->{directory} . $_ unless m/^\w\:/; # win32 absolute path, if any s/([\\\s])/\\$1/g; $_; } quoted_split($self-> {fileName})); } else { $self-> {fileName} =~ s/\\/\//g; } $self-> {filterIndex} = Prima::Application-> sys_action( 'win32.OpenFile.filterindex')-1; $self-> ok; return $self-> fileName; } package Prima::sys::win32::OpenDialog; use vars qw(@ISA); @ISA = qw(Prima::sys::win32::FileDialog); package Prima::sys::win32::SaveDialog; use vars qw(@ISA); @ISA = qw(Prima::sys::win32::FileDialog); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, openMode => 0, fileMustExist => 0, } } 1; __DATA__ =head1 NAME Prima::sys::win32::FileDialog - Windows file system dialogs. =head1 DESCRIPTION The module mimics Prima file dialog classes C and C, defined in L. The class names registered in the module are the same, but in C namespace. =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L =cut Prima-1.28/Prima/sys/win32/sysimage.gif0000644000175100017510000001420711150770061015436 0ustar dkdkGIF89a ÷  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~€€€‚‚‚ƒƒƒ„„„………†††‡‡‡ˆˆˆ‰‰‰ŠŠŠ‹‹‹ŒŒŒŽŽŽ‘‘‘’’’“““”””•••–––———˜˜˜™™™ššš›››œœœžžžŸŸŸ   ¡¡¡¢¢¢£££¤¤¤¥¥¥¦¦¦§§§¨¨¨©©©ªªª«««¬¬¬­­­®®®¯¯¯°°°±±±²²²³³³´´´µµµ¶¶¶···¸¸¸¹¹¹ººº»»»¼¼¼½½½¾¾¾¿¿¿ÀÀÀÁÁÁÂÂÂÃÃÃÄÄÄÅÅÅÆÆÆÇÇÇÈÈÈÉÉÉÊÊÊËËËÌÌÌÍÍÍÎÎÎÏÏÏÐÐÐÑÑÑÒÒÒÓÓÓÔÔÔÕÕÕÖÖÖ×××ØØØÙÙÙÚÚÚÛÛÛÜÜÜÝÝÝÞÞÞßßßàààáááâââãããäääåååæææçççèèèéééêêêëëëìììíííîîîïïïðððñññòòòóóóôôôõõõööö÷÷÷øøøùùùúúúûûûüüüýýýþþþÿÿÿ!ù2, ½ýýH° Áƒ LÈ°¡Ã‡#JœH±¢Å‹ý˜ñÏ9þúóÀ?!/’ôH’ãÊ—aŽü³å@’)+Žü‡r%Ç›ÿ~0‰&ÅA4èqâNš4ø§ñàÆœI V½9õßT¡QR:Õ(È[oÒdÉS)”`ßF=y2¬Ñ›'Å=û¶åªBOF%ˆ3¨M ¯¦¼kÕãΟQb…Ì“1eÀ— þͬu2eÏœC‹þ¹³¿€!ù2, ƒ„‚„üþüÄÂÄ,ÈI¥!ë=n`(zbøuX9d y®,ú±Zèrv ¿­¾ª$UN8Èc!ù2, ƒ„‚„üþüÄÂÄ-0ÈIå ëM.¨T‡£øUY`Ž’¦zØç¾ãvÒç,­mÅ“"‚pHì ŽÈ$2!ù2, ƒ„‚„üþüÄÂÄ#ÈI¥!ë=n`(zbÙa戦 Éžßë²sZ›×Û |ï÷!ù2, ƒ„‚„üþüÄÂÄ$0ÈIå ëM.¨T‡“ø‘‰¦Þª¢/ƒs%x®wCïÿ¾!ù2, ƒÀÀÀÿÿÿ€€€ÿÿ.H"ª˜³Ž=jÞ@l$ bZž"(ìȽ1‡†ð-«”ÎS©!P•0CâQ!ù2, ƒÿÿÿ€€€ÿÿ*pÈj˜³Š-jÞV°’Z¤©u¨Ê±àr- ¢’Ô‰KŠ‡ 1!ù2, ƒÀÀÀÿÿÿ€€€ÿÿ*H"ª˜³Ž=jÞ@l$ bZži°­ø¢q8×6E»&^J€ê‡ 1!ù2, ƒÿÿÿ€€€ÿÿ)pÈj˜³Š-jÞV°’Z¤y¢êí wîKÑ'IÕúÀ¨Þä÷ÃD!ù2, ƒÿÿ€€ÀÀÀ€€€ÿÿœ°ÈI«½8 HþضuhJâF å©¥ÜÚº¬²tmÇx>í·Y8’ù ¢ ‡Îå2ùt¥¤SgïÃR$᧋ínÇd),l²¤[5dS2ës<+?Wˆoq;lDM@y(D_†ŠŒ‘AŒJˆƒs‘eDU’›@„’–š=’¦A%§¢2-ª,[^²³²°g¶¸¹º¸»¾»!ù2, ƒÀÀÀÿÿÿÿ€€€ÿÿ¬°ÈI˸øÖÍ'B(X×] ¨ªä`RCºÎ£û4ì¬&Ç£ €á0+1§Žç[¥sû³E¹àÐÕ¥1w\ÌLcØD÷^ܪçܶý“Kï}uFwdU+z9…YFgƒ]aN…6’”3–‡[c%`W›7£¤V©—7©2–¡/0“!³µ¨"€»¿¸¾¿»“Âõ£‘Ç»´ËµÊ!ù2, ƒÀÀÀÿÿÿÿ€€€ÿÿµ°ÈI˸øÖÍ'B(X×] ¨ªä`RCºÎ£ût¾&> P¦âm|+`J ŠŒg(¨bÒPKÎ*àζØV(’¯`mÎ òÒÒH]ù¬_ä"zƒŸ6ûvq:T€}‡evj:lxRUz?‹4n_%ŒA‘!6›ˆ™šŸk¡&¨}X«7­®I³¢7³2¡¦/œ ·¿²OÅÉŠÉÊÌÍÅ­ÈÑžչ¿!ù2, ƒÿÿÿ€€€0ÈI%¸Ûœ7¿Þg d)!—vÁ§µ.ZÍ!ù2, ƒÿÿÿ€€€0ÈI%¸[,ò¾dáe hÚ}@ °.ìÙ\U!ù2, ƒÿÿÿÿ€€€€ÿÿ¯ÈIɸøÖÍ'`b]9ˆ(:”Õ•¾¡Æžp=šv¬­ÃÁÆ ØŒ*¡'hšHOB@¨kt¤´0¯"m*(¬ÁVô¸\ÓŠì¶{»˜³ïùÎÃíGs6{rstR€/o~ˆq}PXŽ i‘”^x‡–“1‰KYGu]›?/d¡¢¨¥C­I«C|@ª¦Š:¶·v.©‰Â,‰ÂÃĸÉÍÉË%β!ù2,ƒ€€€ÿÿÿÀÀÀS0ÈI«•#ˆÍ»ÿ@öd¨‘(g¦ìÊ¢.wIc¼€¢‡oºZÏ§Ú M°4üŒLä«c›R›‚Ù“‡|ê¾_®õ8—¯Ò± Ìn»ð¸|N—G!ù2,ƒüþüÄÂÄ„‚„RpÈI«•`ˆÍ»ÿA&diž¨ˆ®¬Ê¾¥ ¿2ùqkŒ)j(^Ì÷š„b‘5JÒ€Le:kQ«ËãM %é¸Ép8‹%—Mºsèª^·Oâ¸|Ž!ù2,ƒüþüÄÂÄ„‚„SÈI«•„Í»ÿBöd¨‘(g¦ìÊ¢î6ÌtMwq`ï3.rVPõ“ }'cj¸É1IO瑘ÔM›EëÙyŽ¢Yï\åí¸¯R6¸ßð¸“Àîö›IBC_ÐøÒá–‡`fBÑ(!ù2,$ƒ€€€ÿÿÿ€€€€ÿeÈI«½8Û¢ïèUà4_)D œ¯®l ÇÝ‚÷é6Nä }¥XI™ŽÂ‰H `RNÎ^t2 p¬WÙG{!ti5ô‰1wG;Œ“qÃya;ÞI!5|<.…[…ˆ !ù2,$ƒ€€€€€€ÿÿÿÿxPÈI«½8ë-€çÓ ×GD Xb%…«„Ú„ ×Âð“[§“#²`¿x …ÇÝRÄ^|;ÐzE&7PæÅûÍpÅlÃÐ0ꩬ8œ¼uKr•ŽÚÒ•SX{8n5\> SUPER::profile_default}, defaultExt => '', fileName => '', filter => [[ 'All files' => '*.*']], filterIndex => 0, directory => '.', createPrompt => 0, multiSelect => 0, noTestFileCreate => 0, overwritePrompt => 1, pathMustExist => 1, fileMustExist => 1, showHelp => 0, showDotFiles => 0, openMode => 1, text => undef, noReadOnly => 0, } } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); for ( qw( filterIndex openMode)) { $self->{$_}=$profile{$_} } for ( qw( filter directory multiSelect showDotFiles createPrompt fileMustExist noReadOnly noTestFileCreate overwritePrompt pathMustExist showHelp text )) { $self->$_($profile{$_}) } return %profile; } sub quoted_split { my @ret; $_ = $_[0]; s/(\\[^\\\s])/\\$1/g; study; { /\G\s+/gc && redo; /\G((?:[^\\\s]|\\.)+)\s*/gc && do { my $z = $1; $z =~ s/\\(.)/$1/g; push(@ret, $z); redo; }; /\G(\\)$/gc && do { push(@ret, $1); redo; }; } return @ret; } sub filter { if ( $#_) { my $self = $_[0]; my @filter = @{$_[1]}; @filter = [[ '' => '*']] unless scalar @filter; my @exts; my @mdts; for ( @filter) { push @exts, $$_[0]; push @mdts, $$_[1]; } $self-> {filterIndex} = scalar @exts - 1 if $self-> { filterIndex} >= scalar @exts; $self-> {filter} = \@filter; } else { return @{$_[0]-> {filter}}; } } sub filterIndex { if ( $#_) { $_[0]-> {filterIndex} = $_[1]; } else { return $_[0]-> {filterIndex}; } } sub directory { return $_[0]->{directory} unless $#_; my ( $self, $dir) = @_; if ( not defined($dir) or $dir eq '') { $dir = ''; } elsif ( $dir !~ /^\//) { # gtk doesn't like non-absolute paths $dir = Cwd::abs_path($dir); } $self-> {directory} = $dir; } sub multiSelect { return $_[0]->{multi_select} unless $#_; $_[0]->{multi_select} = $_[1] ? 1 : 0; } sub showDotFiles { return $_[0]->{show_hidden} unless $#_; $_[0]->{show_hidden} = $_[1]; } sub overwritePrompt { return $_[0]->{overwrite_prompt} unless $#_; $_[0]->{overwrite_prompt} = $_[1] ? 1 : 0; } sub fileName { unless ( $#_) { return $_[0]->{fileName} unless $_[0]->multiSelect; my @s = quoted_split( $_[0]-> {fileName}); return $s[0] unless wantarray; return @s; } $_[0]->{fileName} = $_[1]; } sub defaultExt { # unimplemented in GTK return $_[0]->{defaultExt} unless $#_; $_[0]->{defaultExt} = $_[1]; } sub openMode { return $_[0]->{openMode} unless $#_; $_[0]->{openMode} = $_[1]; } sub text { return $_[0]->{text} unless $#_; $_[0]->{text} = $_[1]; } sub pathMustExist { return $_[0]->{pathMustExist} unless $#_; $_[0]->{pathMustExist} = $_[1]; } sub fileMustExist { return $_[0]->{fileMustExist} unless $#_; $_[0]->{fileMustExist} = $_[1]; } sub noTestFileCreate { return $_[0]->{noTestFileCreate} unless $#_; $_[0]->{noTestFileCreate} = $_[1]; } sub createPrompt { return $_[0]->{createPrompt} unless $#_; $_[0]->{createPrompt} = $_[1]; } sub noReadOnly { return $_[0]->{noReadOnly} unless $#_; $_[0]->{noReadOnly} = $_[1]; } # dummies sub sorted { 1 } sub showHelp { 0 } # mere callbacks if someone wants these to inherit sub ok {} sub cancel {} sub execute { my $self = $_[0]; DIALOG: while ( 1) { Prima::Application-> sys_action( "gtk2.OpenFile.$_=". $self-> {$_}) for qw(multi_select overwrite_prompt show_hidden); Prima::Application-> sys_action( 'gtk2.OpenFile.filters=' . join("\0", map { "$$_[0] ($$_[1])\0$$_[1]" } @{$self->{filter}}) . "\0\0"); Prima::Application-> sys_action( 'gtk2.OpenFile.filterindex=' . ($self->{filterIndex})); Prima::Application-> sys_action( 'gtk2.OpenFile.directory=' . $self->{directory}); Prima::Application-> sys_action( 'gtk2.OpenFile.title=' . (defined $self->{text} ? $self->{text} : '')); my $ret = Prima::Application-> sys_action( 'gtk2.OpenFile.'. ($self->{openMode}?'open':'save')); if ( !defined $ret) { $self-> cancel; return wantarray ? () : undef; } $self-> {directory} = Prima::Application-> sys_action( 'gtk2.OpenFile.directory'); $self-> {directory} .= '/' unless $self-> {directory} =~ /\/$/; $self-> {fileName} = $ret; $self-> {filterIndex} = Prima::Application-> sys_action( 'gtk2.OpenFile.filterindex'); # emulate some flags now if ( $self-> {pathMustExist}) { unless ( -d $self-> {directory}) { message_box( $self-> text, "Directory $self->{directory} does not exist", mb::OK | mb::Error); next DIALOG; } } for my $file ( $self-> fileName) { if ( $self-> {fileMustExist}) { next if -f $file; message_box( $self-> text, "File $file does not exist", mb::OK | mb::Error); next DIALOG; } if ( $self-> {openMode}) { if ( $self-> {createPrompt}) { if ( Prima::MsgBox::message_box( $self-> text, "File $file does not exists. Create?", mb::OKCancel|mb::Information ) != mb::OK) { $self-> cancel; return wantarray ? () : undef; } } } else { if ( $self-> {noReadOnly} && !(-w $file)) { message_box( $self-> text, "File $file is read only", mb::OK | mb::Error ); next DIALOG; } if ( not $self-> {noTestFileCreate}) { if ( open FILE, ">>$file") { close FILE; } else { message_box( $self-> text, "Cannot create file $file: $!", mb::OK | mb::Error); next DIALOG; } } } } last; } $self-> ok; return $self-> fileName; } package Prima::sys::gtk2::OpenDialog; use vars qw(@ISA); @ISA = qw(Prima::sys::gtk2::FileDialog); package Prima::sys::gtk2::SaveDialog; use vars qw(@ISA); @ISA = qw(Prima::sys::gtk2::FileDialog); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, openMode => 0, fileMustExist => 0, } } 1; __DATA__ =head1 NAME Prima::sys::gtk2::FileDialog - GTK2 file system dialogs. =head1 DESCRIPTION The module mimics Prima file dialog classes C and C, defined in L. The class names registered in the module are the same, but in C namespace. =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L =cut Prima-1.28/Prima/HelpViewer.fm0000644000175100017510000000572411150770061013750 0ustar dkdk# VBForm version file=1.1 builder=0.1 # [preload] Prima::ComboBox sub { return ( 'LinkColor' => { class => 'Prima::ColorComboBox', module => 'Prima::ColorDialog', profile => { origin => [ 5, 57], name => 'LinkColor', owner => 'Form1', size => [ 56, 18], }}, 'Form1' => { class => 'Prima::Window', module => 'Prima::Classes', parent => 1, profile => { width => 402, name => 'Form1', text => 'Appearance settings', bottom => 303, originDontCare => 0, origin => [ 557, 303], height => 112, left => 557, sizeDontCare => 0, size => [ 402, 112], borderStyle => bs::Dialog, }}, 'CodeColor' => { class => 'Prima::ColorComboBox', module => 'Prima::ColorDialog', profile => { origin => [ 6, 12], name => 'CodeColor', owner => 'Form1', size => [ 56, 18], }}, 'Label1' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 5, 80], name => 'Label1', owner => 'Form1', size => [ 100, 20], text => '~Link color', focusLink => 'LinkColor', }}, 'Label2' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 5, 35], name => 'Label2', owner => 'Form1', size => [ 100, 20], text => '~Code color', focusLink => 'CodeColor', }}, 'OkButton' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 294, 57], name => 'OkButton', size => [ 96, 36], onClick => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> owner-> ok;','OkButton', 'onClick'), owner => 'Form1', default => 1, text => '~OK', }}, 'CancelButton' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 294, 12], name => 'CancelButton', size => [ 96, 36], onClick => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> owner-> cancel;','CancelButton', 'onClick'), owner => 'Form1', text => 'Cancel', }}, 'FixFont' => { class => 'Prima::ComboBox', module => 'Prima::ComboBox', profile => { origin => [ 112, 12], name => 'FixFont', style => cs::DropDown, size => [ 170, 19], owner => 'Form1', }}, 'Label3' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 112, 35], name => 'Label3', size => [ 170, 20], owner => 'Form1', text => '~Fixed font', focusLink => 'FixFont', }}, 'VarFont' => { class => 'Prima::ComboBox', module => 'Prima::ComboBox', profile => { origin => [ 112, 57], style => cs::DropDown, name => 'VarFont', owner => 'Form1', size => [ 170, 18], }}, 'Label4' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 112, 80], name => 'Label4', owner => 'Form1', size => [ 170, 21], text => '~Variable font', focusLink => 'VarFont', }}, ); } Prima-1.28/Prima/Sliders.pm0000644000175100017510000017552211150770061013321 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: Sliders.pm,v 1.42 2009/01/02 23:19:04 dk Exp $ # contains: # SpinButton # AltSpinButton # SpinEdit # Gauge # Slider # CircularSlider use strict; use Prima::Const; use Prima::Classes; use Prima::IntUtils; package Prima::AbstractSpinButton; use vars qw(@ISA); @ISA = qw(Prima::Widget Prima::MouseScroller); { my %RNT = ( %{Prima::Widget-> notification_types()}, Increment => nt::Default, TrackEnd => nt::Default, ); sub notification_types { return \%RNT; } } sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, ownerBackColor => 1, color => cl::Black, selectable => 0, tabStop => 0, widgetClass => wc::Button, } } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); $self-> { pressState} = 0; return %profile; } sub on_mouseclick { my $self = shift; $self-> clear_event; return unless pop; $self-> clear_event unless $self-> notify( "MouseDown", @_); } sub state {($#_)?$_[0]-> set_state ($_[1]):return $_[0]-> {pressState}} #sub on_trackend {} #sub on_increment { # my ( $self, $increment) = @_; #} package Prima::SpinButton; use vars qw(@ISA); @ISA = qw(Prima::AbstractSpinButton); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, width => 17, height => 24, } } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {mouseTransaction}; return if $btn != mb::Left; my $h = $self-> height; if ( $y >= $h * 0.6) { $self-> { mouseTransaction} = 1; } elsif ( $y < $h * 0.4) { $self-> { mouseTransaction} = 2; } else { $self-> { mouseTransaction} = 3; } $self-> { lastMouseOver} = 1; $self-> { startMouseY } = $y; $self-> state( $self-> { mouseTransaction}); $self-> capture(1); $self-> clear_event; $self-> {increment} = 0; if ( $self-> { mouseTransaction} != 3) { $self-> notify( 'Increment', $self-> { mouseTransaction} == 1 ? 1 : -1); $self-> scroll_timer_start; $self-> scroll_timer_semaphore(0); } else { $self-> {pointerSave} = $self-> pointer; $self-> pointer( cr::SizeWE); } } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return if $btn != mb::Left; return unless $self-> {mouseTransaction}; my $mt = $self-> {mouseTransaction}; my $inc = $mt != 2 ? 1 : -1; $self-> {mouseTransaction} = undef; $self-> {spaceTransaction} = undef; $self-> {lastMouseOver} = undef; $self-> capture(0); $self-> scroll_timer_stop; $self-> state( 0); $self-> pointer( $self-> {pointerSave}), $self-> {pointerSave} = undef if $mt == 3; $self-> {increment} = 0; $self-> notify( 'TrackEnd'); } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; unless ( $self-> {mouseTransaction}) { my $h = $self-> height; $self-> pointer((( $y >= $h * 0.6) || ( $y < $h * 0.4)) ? cr::Default : cr::SizeWE); return; } my @size = $self-> size; my $mouseOver = $x > 0 && $y > 0 && $x < $size[0] && $y < $size[1]; $self-> state( $self-> {pressState} ? 0 : $self-> {mouseTransaction}) if $self-> { lastMouseOver} != $mouseOver && $self-> {pressState} != 3; $self-> { lastMouseOver} = $mouseOver; if ( $self-> {pressState} == 3) { my $d = ( $self-> {startMouseY} - $y) / 3; # 2 is mouse sensitivity $self-> notify( 'Increment', int($self-> {increment}) - int($d)) if int( $self-> {increment}) != int( $d); $self-> {increment} = $d; } elsif ( $self-> {pressState} > 0) { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); $self-> notify( 'Increment', $self-> {mouseTransaction} == 1 ? 1 : -1); } else { $self-> scroll_timer_stop; } } sub on_paint { my ( $self, $canvas) = @_; my @clr = ( $self-> color, $self-> backColor); @clr = ( $self-> disabledColor, $self-> disabledBackColor) if ( !$self-> enabled); my @c3d = ( $self-> light3DColor, $self-> dark3DColor); my @size = $canvas-> size; my $p = $self-> {pressState}; $canvas-> rect3d( 0, 0, $size[0] - 1, $size[1] * 0.4 - 1, 2, (($p != 2) ? @c3d : reverse @c3d), $clr[1]); $canvas-> rect3d( 0, $size[1] * 0.4, $size[0] - 1, $size[1] * 0.6 - 1, 2, (($p != 3) ? @c3d : reverse @c3d), $clr[1]); $canvas-> rect3d( 0, $size[1] * 0.6, $size[0] - 1, $size[1] - 1, 2, (($p != 1) ? @c3d : reverse @c3d), $clr[1]); $canvas-> color( $clr[0]); my $p1 = ( $p == 1) ? 1 : 0; $canvas-> fillpoly([ $size[0] * 0.3 + $p1, $size[1] * 0.73 - $p1, $size[0] * 0.5 + $p1, $size[1] * 0.87 - $p1, $size[0] * 0.7 + $p1, $size[1] * 0.73 - $p1 ]); $p1 = ( $p == 2) ? 1 : 0; $canvas-> fillpoly([ $size[0] * 0.3 + $p1, $size[1] * 0.27 - $p1, $size[0] * 0.5 + $p1, $size[1] * 0.13 - $p1, $size[0] * 0.7 + $p1, $size[1] * 0.27 - $p1 ]); } sub set_state { my ( $self, $s) = @_; $s = 0 if $s > 3; return if $s == $self-> {pressState}; $self-> {pressState} = $s; $self-> repaint; } package Prima::AltSpinButton; use vars qw(@ISA); @ISA = qw(Prima::AbstractSpinButton); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, width => 18, height => 18, } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> {height} = $p-> {width} if !exists( $p-> {height}) && exists( $p-> {width}); $p-> {width} = $p-> {height} if exists( $p-> {height}) && !exists( $p-> {width}); $self-> SUPER::profile_check_in( $p, $default); } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {mouseTransaction}; return if $btn != mb::Left; $self-> { mouseTransaction} = (( $x * $self-> height / ( $self-> width || 1)) > $y) ? 2 : 1; $self-> { lastMouseOver} = 1; $self-> state( $self-> { mouseTransaction}); $self-> capture(1); $self-> clear_event; $self-> notify( 'Increment', $self-> { mouseTransaction} == 1 ? 1 : -1); $self-> scroll_timer_start; $self-> scroll_timer_semaphore(0); } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return if $btn != mb::Left; return unless $self-> {mouseTransaction}; $self-> {mouseTransaction} = undef; $self-> {spaceTransaction} = undef; $self-> {lastMouseOver} = undef; $self-> capture(0); $self-> scroll_timer_stop; $self-> state( 0); $self-> notify( 'TrackEnd'); } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; return unless $self-> {mouseTransaction}; my @size = $self-> size; my $mouseOver = $x > 0 && $y > 0 && $x < $size[0] && $y < $size[1]; $self-> state( $self-> {pressState} ? 0 : $self-> {mouseTransaction}) if $self-> { lastMouseOver} != $mouseOver; $self-> { lastMouseOver} = $mouseOver; if ( $self-> {pressState}) { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); $self-> notify( 'Increment', $self-> {mouseTransaction} == 1 ? 1 : -1); } else { $self-> scroll_timer_stop; } } sub on_paint { my ( $self, $canvas) = @_; my @clr = ( $self-> color, $self-> backColor); @clr = ( $self-> hiliteColor, $self-> hiliteBackColor) if $self-> { default}; @clr = ( $self-> disabledColor, $self-> disabledBackColor) if !$self-> enabled; my @c3d = ( $self-> light3DColor, $self-> dark3DColor); my @size = $canvas-> size; $canvas-> color( $clr[ 1]); $canvas-> bar( 0, 0, $size[0]-1, $size[1]-1); my $p = $self-> {pressState}; $canvas-> color( $p == 1 ? $c3d[1] : $c3d[ 0]); $canvas-> line( 0, 0, 0, $size[1] - 1); $canvas-> line( 1, 1, 1, $size[1] - 2); $canvas-> line( 2, $size[1] - 2, $size[0] - 3, $size[1] - 2); $canvas-> line( 1, $size[1] - 1, $size[0] - 2, $size[1] - 1); $canvas-> color( $p == 2 ? $c3d[0] : $c3d[ 1]); $canvas-> line( 1, 0, $size[0] - 1, 0); $canvas-> line( 2, 1, $size[0] - 1, 1); $canvas-> line( $size[0] - 2, 1, $size[0] - 2, $size[1] - 2); $canvas-> line( $size[0] - 1, 1, $size[0] - 1, $size[1] - 1); $canvas-> color( $p == 1 ? $c3d[ 0] : $c3d[ 1]); $canvas-> line( -1, 0, $size[0] - 2, $size[1] - 1); $canvas-> line( 0, 0, $size[0] - 1, $size[1] - 1); $canvas-> color( $p == 2 ? $c3d[ 1] : $c3d[ 0]); $canvas-> line( 1, 0, $size[0], $size[1] - 1); $canvas-> color( $clr[0]); my $p1 = ( $p == 1) ? 1 : 0; $canvas-> fillpoly([ $size[0] * 0.2 + $p1, $size[1] * 0.65 - $p1, $size[0] * 0.3 + $p1, $size[1] * 0.77 - $p1, $size[0] * 0.4 + $p1, $size[1] * 0.65 - $p1 ]); $p1 = ( $p == 2) ? 1 : 0; $canvas-> fillpoly([ $size[0] * 0.6 + $p1, $size[1] * 0.35 - $p1, $size[0] * 0.7 + $p1, $size[1] * 0.27 - $p1, $size[0] * 0.8 + $p1, $size[1] * 0.35 - $p1 ]); } sub set_state { my ( $self, $s) = @_; $s = 0 if $s > 2; return if $s == $self-> {pressState}; $self-> {pressState} = $s; $self-> repaint; } package Prima::SpinEdit; use vars qw(@ISA %editProps %spinDynas); use Prima::InputLine; @ISA = qw(Prima::Widget); %editProps = ( alignment => 1, autoScroll => 1, text => 1, charOffset => 1, maxLen => 1, insertMode => 1, firstChar => 1, selection => 1, selStart => 1, selEnd => 1, writeOnly => 1, copy => 1, cut => 1, 'delete' => 1, paste => 1, wordDelimiters => 1, readOnly => 1, passwordChar=> 1, focus => 1, select_all => 1, ); %spinDynas = ( onIncrement => 1, onTrackEnd => 1,); for ( keys %editProps) { eval < {edit}-> $_(\@_); } sub Prima::SpinEdit::DummyEdit::$_ { } GENPROC } sub profile_default { my $font = $_[ 0]-> get_default_font; my $fh = $font-> {height} + 2; return { %{Prima::InputLine-> profile_default}, %{$_[ 0]-> SUPER::profile_default}, autoEnableChildren => 1, ownerBackColor => 1, selectable => 0, scaleChildren => 0, min => 0, max => 100, step => 1, pageStep => 10, value => 0, circulate => 0, height => $fh < 20 ? 20 : $fh, editClass => 'Prima::InputLine', spinClass => 'Prima::AltSpinButton', editProfile => {}, spinProfile => {}, editDelegations=> [qw(KeyDown Change MouseWheel Enter Leave)], spinDelegations=> [qw(Increment)], } } sub init { my $self = shift; my %profile = @_; my $visible = $profile{visible}; $profile{visible} = 0; for (qw( min max step circulate pageStep)) {$self-> {$_} = 1;}; $self-> {edit} = bless [], q\Prima::SpinEdit::DummyEdit\; %profile = $self-> SUPER::init(%profile); my ( $w, $h) = ( $self-> size); $self-> {spin} = $self-> insert( $profile{spinClass} => ownerBackColor => 1, name => 'Spin', bottom => 1, right => $w - 1, height => $h - 1 * 2, growMode => gm::Right, delegations => $profile{spinDelegations}, (map { $_ => $profile{$_}} grep { exists $profile{$_} ? 1 : 0} keys %spinDynas), %{$profile{spinProfile}}, ); $self-> {edit} = $self-> insert( $profile{editClass} => name => 'InputLine', origin => [ 1, 1], size => [ $w - $self-> {spin}-> width - 1 * 2, $h - 1 * 2], growMode => gm::GrowHiX|gm::GrowHiY, selectable => 1, tabStop => 1, borderWidth => 0, current => 1, delegations => $profile{editDelegations}, (map { $_ => $profile{$_}} keys %editProps), %{$profile{editProfile}}, text => $profile{value}, ); for (qw( min max step value circulate pageStep)) {$self-> $_($profile{$_});}; $self-> visible( $visible); return %profile; } sub on_paint { my ( $self, $canvas) = @_; my @s = $canvas-> size; $canvas-> rect3d( 0, 0, $s[0]-1, $s[1]-1, 1, $self-> dark3DColor, $self-> light3DColor); } sub InputLine_MouseWheel { my ( $self, $edit, $mod, $x, $y, $z) = @_; $z = int($z/120); $z *= $self-> {pageStep} if $mod & km::Ctrl; my $value = $self-> value; $self-> value( $value + $z * $self-> {step}); $self-> value( $z > 0 ? $self-> min : $self-> max) if $self-> {circulate} && ( $self-> value == $value); $edit-> clear_event; } sub Spin_Increment { my ( $self, $spin, $increment) = @_; my $value = $self-> value; $self-> value( $value + $increment * $self-> {step}); $self-> value( $increment > 0 ? $self-> min : $self-> max) if $self-> {circulate} && ( $self-> value == $value); } sub InputLine_KeyDown { my ( $self, $edit, $code, $key, $mod) = @_; $edit-> clear_event, return if $key == kb::NoKey && !($mod & (km::Alt | km::Ctrl)) && chr($code) !~ /^[.\d+-]$/; if ( $key == kb::Up || $key == kb::Down || $key == kb::PgDn || $key == kb::PgUp) { my ($s,$pgs) = ( $self-> step, $self-> pageStep); my $z = ( $key == kb::Up) ? $s : (( $key == kb::Down) ? -$s : (( $key == kb::PgUp) ? $pgs : -$pgs)); if (( $mod & km::Ctrl) && ( $key == kb::PgDn || $key == kb::PgUp)) { $self-> value( $key == kb::PgDn ? $self-> min : $self-> max); } else { my $value = $self-> value; $self-> value( $value + $z); $self-> value( $z > 0 ? $self-> min : $self-> max) if $self-> {circulate} && ( $self-> value == $value); } $edit-> clear_event; return; } if ($key == kb::Enter) { my $value = $edit-> text; $self-> value( $value); $edit-> clear_event if $value ne $self-> value; return; } } sub InputLine_Change { my ( $self, $edit) = @_; $self-> notify(q(Change)); } sub InputLine_Enter { my ( $self, $edit) = @_; $self-> notify(q(Enter)); } sub InputLine_Leave { my ( $self, $edit) = @_; $self-> notify(q(Leave)); } sub set_bounds { my ( $self, $min, $max) = @_; $max = $min if $max < $min; ( $self-> { min}, $self-> { max}) = ( $min, $max); my $oldValue = $self-> value; $self-> value( $max) if $max < $self-> value; $self-> value( $min) if $min > $self-> value; } sub set_step { my ( $self, $step) = @_; $step = 0 if $step < 0; $self-> {step} = $step; } sub circulate { return $_[0]-> {circulate} unless $#_; $_[0]-> {circulate} = $_[1]; } sub pageStep { return $_[0]-> {pageStep} unless $#_; $_[0]-> {pageStep} = $_[1]; } sub min {($#_)?$_[0]-> set_bounds($_[1], $_[0]-> {'max'}) : return $_[0]-> {min};} sub max {($#_)?$_[0]-> set_bounds($_[0]-> {'min'}, $_[1]) : return $_[0]-> {max};} sub step {($#_)?$_[0]-> set_step ($_[1]):return $_[0]-> {step}} sub value { if ($#_) { my ( $self, $value) = @_; if ( $value =~ m/^\s*([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?\s*$/) { $value = $self-> {min} if $value < $self-> {min}; $value = $self-> {max} if $value > $self-> {max}; } else { $value = $self-> {min}; } return if $value eq $self-> {edit}-> text; $self-> {edit}-> text( $value); } else { my $self = $_[0]; my $value = $self-> {edit}-> text; if ( $value =~ m/^\s*([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?\s*$/) { $value = $self-> {min} if $value < $self-> {min}; $value = $self-> {max} if $value > $self-> {max}; } else { $value = $self-> {min}; } return $value; } } # gauge reliefs package gr; use constant Sink => -1; use constant Border => 0; use constant Raise => 1; package Prima::Gauge; use vars qw(@ISA); @ISA = qw(Prima::Widget); { my %RNT = ( %{Prima::Widget-> notification_types()}, Stringify => nt::Action, ); sub notification_types { return \%RNT; } } sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, indent => 1, relief => gr::Sink, ownerBackColor => 1, hiliteBackColor=> cl::Blue, hiliteColor => cl::White, min => 0, max => 100, value => 0, threshold => 0, vertical => 0, } } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); for (qw( relief value indent min max threshold vertical)) {$self-> {$_} = 0} $self-> {string} = ''; for (qw( vertical threshold min max relief indent value)) {$self-> $_($profile{$_}); } return %profile; } sub setup { $_[0]-> SUPER::setup; $_[0]-> value($_[0]-> {value}); } sub on_paint { my ($self,$canvas) = @_; my ($x, $y) = $canvas-> size; my $i = $self-> indent; my ($clComplete,$clBack,$clFore,$clHilite) = ($self-> hiliteBackColor, $self-> backColor, $self-> color, $self-> hiliteColor); my $v = $self-> {vertical}; my $complete = $v ? $y : $x; my $range = ($self-> {max} - $self-> {min}) || 1; $complete = int(($complete - $i*2) * $self-> {value} / $range + 0.5); my ( $l3, $d3) = ( $self-> light3DColor, $self-> dark3DColor); $canvas-> color( $clComplete); $canvas-> bar ( $v ? ($i, $i, $x-$i-1, $i+$complete) : ( $i, $i, $i + $complete, $y-$i-1)); $canvas-> color( $clBack); $canvas-> bar ( $v ? ($i, $i+$complete+1, $x-$i-1, $y-$i-1) : ( $i+$complete+1, $i, $x-$i-1, $y-$i-1)); # draw the border my $relief = $self-> relief; $canvas-> color(( $relief == gr::Sink) ? $d3 : (( $relief == gr::Border) ? cl::Black : $l3)); for ( my $j = 0; $j < $i; $j++) { $canvas-> line( $j, $j, $j, $y - $j - 1); $canvas-> line( $j, $y - $j - 1, $x - $j - 1, $y - $j - 1); } $canvas-> color(( $relief == gr::Sink) ? $l3 : (( $relief == gr::Border) ? cl::Black : $d3)); for ( my $j = 0; $j < $i; $j++) { $canvas-> line( $j + 1, $j, $x - $j - 1, $j); $canvas-> line( $x - $j - 1, $j, $x - $j - 1, $y - $j - 1); } # draw the text, if neccessary my $s = $self-> {string}; if ( $s ne '') { my ($fw, $fh) = ( $canvas-> get_text_width( $s), $canvas-> font-> height); my $xBeg = int(( $x - $fw) / 2 + 0.5); my $xEnd = $xBeg + $fw; my $yBeg = int(( $y - $fh) / 2 + 0.5); my $yEnd = $yBeg + $fh; my ( $zBeg, $zEnd) = $v ? ( $yBeg, $yEnd) : ( $xBeg, $xEnd); if ( $zBeg > $i + $complete) { $canvas-> color( $clFore); $canvas-> text_out( $s, $xBeg, $yBeg); } elsif ( $zEnd < $i + $complete + 1) { $canvas-> color( $clHilite); $canvas-> text_out( $s, $xBeg, $yBeg); } else { $canvas-> clipRect( $v ? ( 0, 0, $x, $i + $complete) : ( 0, 0, $i + $complete, $y) ); $canvas-> color( $clHilite); $canvas-> text_out( $s, $xBeg, $yBeg); $canvas-> clipRect( $v ? ( 0, $i + $complete + 1, $x, $y) : ( $i + $complete + 1, 0, $x, $y) ); $canvas-> color( $clFore); $canvas-> text_out( $s, $xBeg, $yBeg); } } } sub set_bounds { my ( $self, $min, $max) = @_; $max = $min if $max < $min; ( $self-> { min}, $self-> { max}) = ( $min, $max); my $oldValue = $self-> {value}; $self-> value( $max) if $self-> {value} > $max; $self-> value( $min) if $self-> {value} < $min; } sub value { return $_[0]-> {value} unless $#_; my $v = $_[1] < $_[0]-> {min} ? $_[0]-> {min} : ($_[1] > $_[0]-> {max} ? $_[0]-> {max} : $_[1]); $v -= $_[0]-> {min}; my $old = $_[0]-> {value}; if (abs($old - $v) >= $_[0]-> {threshold}) { my ($x, $y) = $_[0]-> size; my $i = $_[0]-> {indent}; my $range = ( $_[0]-> {max} - $_[0]-> {min}) || 1; my $x1 = $i + ($x - $i*2) * $old / $range; my $x2 = $i + ($x - $i*2) * $v / $range; ($x1, $x2) = ( $x2, $x1) if $x1 > $x2; my $s = $_[0]-> {string}; $_[0]-> {value} = $v; $_[0]-> notify(q(Stringify), $v, \$_[0]-> {string}); ( $_[0]-> {string} eq $s) ? $_[0]-> invalidate_rect( $x1, 0, $x2+1, $y) : $_[0]-> repaint; } } sub on_stringify { my ( $self, $value, $sref) = @_; $$sref = sprintf( "%2d%%", $value * 100.0 / (($_[0]-> {max} - $_[0]-> {min})||1)); $self-> clear_event; } sub indent {($#_)?($_[0]-> {indent} = $_[1],$_[0]-> repaint) :return $_[0]-> {indent};} sub relief {($#_)?($_[0]-> {relief} = $_[1],$_[0]-> repaint) :return $_[0]-> {relief};} sub vertical {($#_)?($_[0]-> {vertical} = $_[1],$_[0]-> repaint):return $_[0]-> {vertical};} sub min {($#_)?$_[0]-> set_bounds($_[1], $_[0]-> {'max'}) : return $_[0]-> {min};} sub max {($#_)?$_[0]-> set_bounds($_[0]-> {'min'}, $_[1]) : return $_[0]-> {max};} sub threshold {($#_)?($_[0]-> {threshold} = $_[1]):return $_[0]-> {threshold};} # slider standard schemes package ss; use constant Gauge => 0; use constant Axis => 1; use constant Thermometer => 2; use constant StdMinMax => 3; package Prima::AbstractSlider; use vars qw(@ISA); @ISA = qw(Prima::Widget); { my %RNT = ( %{Prima::Widget-> notification_types()}, Track => nt::Default, ); sub notification_types { return \%RNT; } } sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, autoTrack => 1, increment => 10, min => 0, max => 100, ownerBackColor => 1, readOnly => 0, scheme => undef, selectable => 1, snap => 0, step => 1, ticks => undef, value => 0, widgetClass => wc::Slider, } } sub init { my $self = shift; for ( qw( min max readOnly snap value autoTrack)) {$self-> {$_}=0} for ( qw( tickVal tickLen tickTxt )) { $self-> {$_} = [] }; my %profile = $self-> SUPER::init( @_); for ( qw( step min max increment readOnly ticks snap value autoTrack)) {$self-> $_($profile{$_});} $self-> scheme( $profile{scheme}) if defined $profile{scheme}; return %profile; } sub autoTrack { return $_[0]-> {autoTrack} unless $#_; $_[0]-> {autoTrack} = $_[1]; } sub on_mouseclick { my $self = shift; $self-> clear_event; return unless pop; $self-> clear_event unless $self-> notify( "MouseDown", @_); } sub on_mousewheel { my ( $self, $mod, $x, $y, $z) = @_; $self-> set_next_value( $self-> {step} * $z / 120); $self-> clear_event; } sub set_next_value { my ( $self, $dir) = @_; $dir *= -1 if $self-> {min} > $self-> {max}; if ( $self-> snap) { my $v = $self-> value; my $w = $v; return if ( $v + $dir > $self-> {min} and $v + $dir > $self-> {max}) or ( $v + $dir < $self-> {min} and $v + $dir < $self-> {max}); $self-> value( $v += $dir) while $self-> {value} == $w; } else { $self-> value( $self-> value + $dir); } } sub set_read_only { $_[0]-> {readOnly} = $_[1]; $_[0]-> repaint; $_[0]-> notify(q(MouseUp),0,0,0) if defined $_[0]-> {mouseTransaction}; } sub set_snap { $_[0]-> {snap} = $_[1]; $_[0]-> value( $_[0]-> value) if $_[1]; } sub set_step { my $i = $_[1]; $i = 1 if $i == 0; $_[0]-> {step} = $i; } sub get_ticks { my $self = $_[0]; my $i; my ( $tv, $tl, $tt) = ($self-> {tickVal}, $self-> {tickLen}, $self-> {tickTxt}); my @t; for ( $i = 0; $i < scalar @{$tv}; $i++) { push ( @t, { value => $$tv[$i], height => $$tl[$i], text => $$tt[$i] }); } return @t; } sub set_ticks { my $self = shift; return unless defined $_[0]; my @ticks = (@_ == 1 and ref($_[0]) eq q(ARRAY)) ? @{$_[0]} : @_; my @val; my @len; my @txt; for ( @ticks) { next unless exists $$_{value}; push( @val, $$_{value}); push( @len, exists($$_{height}) ? $$_{height} : 0); push( @txt, exists($$_{text}) ? $$_{text} : undef); } $self-> {tickVal} = \@val; $self-> {tickLen} = \@len; $self-> {tickTxt} = \@txt; $self-> {scheme} = undef; $self-> value( $self-> value); $self-> repaint; } sub set_bound { my ( $self, $val, $bound) = @_; $self-> {$bound} = $val; $self-> scheme($self-> {scheme}) if defined $self-> {scheme}; $self-> repaint; } sub set_scheme { my ( $self, $s) = @_; unless ( defined $s) { $self-> {scheme} = undef; return; } my ( $max, $min) = ( $self-> {max}, $self-> {min}); $self-> ticks([]), return if $max == $min; my @t; my $i; my $inc = $self-> {increment}; if ( $s == ss::Gauge) { for ( $i = $min; $i <= $max; $i += $inc) { push ( @t, { value => $i, height => 4, text => $i }); } } elsif ( $s == ss::Axis) { for ( $i = $min; $i <= $max; $i += $inc) { push ( @t, { value => $i, height => 6, text => $i }); if ( $i < $max) { for ( 1..4) { my $v = $i + $inc / 5 * $_; last if $v > $max; push ( @t, { value => $v, height => 3 }); push ( @t, { value => $v, height => 3 }); push ( @t, { value => $v, height => 3 }); push ( @t, { value => $v, height => 3 }); } } } } elsif ( $s == ss::StdMinMax) { push ( @t, { value => $min, height => 6, text => "Min" }); push ( @t, { value => $max, height => 6, text => "Max" }); } elsif ( $s == ss::Thermometer) { for ( $i = $min; $i <= $max; $i += $inc) { push ( @t, { value => $i, height => 6, text => $i }); if ( $i < $max) { my $j; for ( $j = 1; $j < 10; $j++) { my $v = $i + $inc / 10 * $j; last if $v > $max; push ( @t, { value => $v, height => $j == 5 ? 5 : 3 }); } } } } $self-> ticks( @t); $self-> {scheme} = $s; } sub increment { return $_[0]-> {increment} unless $#_; my ( $self, $increment) = @_; $self-> {increment} = $increment; if ( defined $self-> {scheme}) { $self-> scheme( $self-> {scheme}); $self-> repaint; } } sub readOnly {($#_)?$_[0]-> set_read_only ($_[1]):return $_[0]-> {readOnly};} sub ticks {($#_)?shift-> set_ticks (@_):return $_[0]-> get_ticks;} sub snap {($#_)?$_[0]-> set_snap ($_[1]):return $_[0]-> {snap};} sub step {($#_)?$_[0]-> set_step ($_[1]):return $_[0]-> {step};} sub scheme {($#_)?shift-> set_scheme (@_):return $_[0]-> {scheme}} sub value {($#_)?$_[0]-> {value} = $_[1] :return $_[0]-> {value};} sub min {($#_)?$_[0]-> set_bound($_[1],q(min)):return $_[0]-> {min};} sub max {($#_)?$_[0]-> set_bound($_[1],q(max)):return $_[0]-> {max};} # linear slider tick alignment package tka; use constant Normal => 0; use constant Alternative => 1; use constant Dual => 2; package Prima::Slider; use vars qw(@ISA); @ISA = qw(Prima::AbstractSlider); use constant DefButtonX => 12; sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, borderWidth => 0, ribbonStrip => 0, shaftBreadth => 6, tickAlign => tka::Normal, vertical => 0, } } sub init { my $self = shift; $self-> {$_} = 0 for qw( vertical tickAlign ribbonStrip shaftBreadth borderWidth); my %profile = $self-> SUPER::init( @_); $self-> $_($profile{$_}) for qw( vertical tickAlign ribbonStrip shaftBreadth borderWidth); return %profile; } sub on_paint { my ( $self, $canvas) = @_; my @clr = ( $self-> color, $self-> backColor); @clr = ( $self-> disabledColor, $self-> disabledBackColor) if ( !$self-> enabled); my @c3d = ( $self-> dark3DColor, $self-> light3DColor); my @cht = ( $self-> hiliteColor, $self-> hiliteBackColor); my @size = $canvas-> size; my ( $sb, $v, $range, $min, $tval, $tlen, $ttxt, $ta ) = ( $self-> {shaftBreadth}, $self-> {vertical}, abs($self-> {max} - $self-> {min}) || 1, $self-> {min}, $self-> {tickVal}, $self-> {tickLen}, $self-> {tickTxt}, $self-> {tickAlign} ); if ( $ta == tka::Normal) { $ta = 1; } elsif ( $ta == tka::Alternative) { $ta = 2; } else { $ta = 3; } unless ( $self-> transparent) { $canvas-> color( $clr[1]); $canvas-> bar(0,0,@size); } $sb = ( $v ? $size[0] : $size[1]) / 6 unless $sb; $sb = 2 unless $sb; if ( $v) { my $bh = $canvas-> font-> height; my $bw = ( $size[0] - $sb) / 2; return if $size[1] <= DefButtonX * ($self-> {readOnly} ? 1 : 0) + 2 * $bh + 2; $canvas-> translate((( $ta == 1) ? 1 : -1) * ( $bw - $sb - DefButtonX), 0) if $ta < 3; my $br = $size[1] - 2 * $bh - 2; $canvas-> rect3d( $bw, $bh, $bw + $sb - 1, $bh + $br - 1, 1, @c3d, $cht[1] ), return unless $range; my $val = $bh + 1 + abs( $self-> {value} - $min) * ( $br - 3) / $range; if ( $self-> {ribbonStrip}) { $canvas-> rect3d( $bw, $bh, $bw + $sb - 1, $bh + $br - 1, 1, @c3d); $canvas-> color( $cht[0]); $canvas-> bar( $bw + 1, $bh + 1, $bw + $sb - 2, $val); $canvas-> color( $cht[1]); $canvas-> bar( $bw + 1, $val + 1, $bw + $sb - 2, $bh + $br - 2); } else { $canvas-> rect3d( $bw, $bh, $bw + $sb - 1, $bh + $br - 1, 1, @c3d, $cht[1]); $canvas-> color( $clr[0]); $canvas-> line( $bw + 1, $val, $bw + $sb - 2, $val) if $self-> {readOnly}; } my $i; $canvas-> color( $clr[0]); for ( $i = 0; $i < scalar @{$tval}; $i++) { my $val = $bh + 1 + abs( $$tval[$i] - $min) * ( $br - 3) / $range; if ( $$tlen[ $i]) { $canvas-> line( $bw + $sb + 3, $val, $bw + $sb + $$tlen[ $i] + 3, $val ) if $ta & 2; $canvas-> line( $bw - 4, $val, $bw - 4 - $$tlen[ $i], $val ) if $ta & 1; } $canvas-> text_out( $$ttxt[ $i], ( $ta == 2) ? $bw + $sb + $$tlen[ $i] + 5 : $bw - $$tlen[ $i] - 5 - $canvas-> get_text_width( $$ttxt[ $i]), $val - $bh / 2 ) if defined $$ttxt[ $i]; } unless ( $self-> {readOnly}) { my @jp = ( $bw - 4, $val - DefButtonX / 2, $bw - 4, $val + DefButtonX / 2, $bw + $sb + 1, $val + DefButtonX / 2, $bw + $sb + 8, $val, $bw + $sb + 1, $val - DefButtonX / 2, ); $canvas-> color( $clr[1]); $canvas-> fillpoly( \@jp); $canvas-> color( $c3d[0]); $canvas-> polyline([@jp[6..9, 0, 1]]); $canvas-> line($bw - 3, $jp[7]+1, $jp[6]-1, $jp[7]+1); $canvas-> color( $c3d[1]); $canvas-> polyline([@jp[0..7]]); $canvas-> line($bw - 3, $jp[7]-1, $jp[6]-1, $jp[7]-1); } } else { my $bw = $canvas-> font-> width + $self-> {borderWidth}; my $bh = ( $size[1] - $sb) / 2; my $fh = $canvas-> font-> height; return if $size[0] <= DefButtonX * ($self-> {readOnly} ? 1 : 0) + 2 * $bw + 2; $canvas-> translate( 0, (( $ta == 1) ? -1 : 1) * ( $bh - $sb - DefButtonX)) if $ta < 3; my $br = $size[0] - 2 * $bw - 2; $canvas-> rect3d( $bw, $bh, $bw + $br - 1, $bh + $sb - 1, 1, @c3d, $cht[1]), return unless $range; my $val = $bw + 1 + abs( $self-> {value} - $min) * ( $br - 3) / $range; if ( $self-> {ribbonStrip}) { $canvas-> rect3d( $bw, $bh, $bw + $br - 1, $bh + $sb - 1, 1, @c3d); $canvas-> color( $cht[0]); $canvas-> bar( $bw+1, $bh+1, $val, $bh + $sb - 2); $canvas-> color( $cht[1]); $canvas-> bar( $val+1, $bh+1, $bw + $br - 2, $bh + $sb - 2); } else { $canvas-> rect3d( $bw, $bh, $bw + $br - 1, $bh + $sb - 1, 1, @c3d, $cht[1]); $canvas-> color( $clr[0]); $canvas-> line( $val, $bh+1, $val, $bh + $sb - 2) if $self-> {readOnly}; } my $i; $canvas-> color( $clr[0]); my @texts; for ( $i = 0; $i < scalar @{$tval}; $i++) { my $val = int( 1 + $bw + abs( $$tval[$i] - $min) * ( $br - 3) / $range + .5); if ( $$tlen[ $i]) { $canvas-> line( $val, $bh + $sb + 3, $val, $bh + $sb + $$tlen[ $i] + 3) if $ta & 1; $canvas-> line( $val, $bh - 4, $val, $bh - 4 - $$tlen[ $i]) if $ta & 2; } next unless defined $$ttxt[ $i]; my $tw = int( $canvas-> get_text_width( $$ttxt[ $i]) / 2 + .5); my $x = $val - $tw; next if $x >= $size[0] or $val + $tw < 0; push @texts, [ $$ttxt[$i], $val, $tw, ( $ta == 2) ? $bh - $$tlen[ $i] - 5 - $fh : $bh + $sb + $$tlen[ $i] + 5 ]; } if ( @texts) { # see that leftmost val fits if ( $texts[0]->[1] - $texts[0]->[2] < 0) { $texts[0]->[1] = $texts[0]->[2]; shift @texts if $texts[0]->[1] + $texts[0]->[2] > $size[0]; goto NO_LABELS unless @texts; } # see that rightmost text fits my ( $rightmost_val, $rightmost_label_width) = ( $texts[-1]->[1], $texts[-1]->[2]); $rightmost_val = $size[0] - 1 - $rightmost_label_width if $rightmost_val > $size[0] - 1 - $rightmost_label_width; if ( 1 < @texts and $rightmost_val < 0) { # skip it pop @texts; goto NO_LABELS unless @texts; } else { my $dx = $texts[-1]->[1] - $rightmost_val; $texts[-1]->[1] = $rightmost_val; # push the label next to it (but not the 1st one) $texts[-2]->[1] -= $dx if 2 < @texts; } # draw labels my $lastx = 0; for ( @texts) { my ( $text, $val, $width, $y) = @$_; my $x = $val - $width; next if $x < $lastx or $x < 0 or $val + $width >= $size[0]; $lastx = $val + $width; $canvas-> text_out( $text, $x, $y); } } NO_LABELS: unless ( $self-> {readOnly}) { my @jp = ( $val - DefButtonX / 2, $bh - 2, $val - DefButtonX / 2, $bh + $sb + 3, $val + DefButtonX / 2, $bh + $sb + 3, $val + DefButtonX / 2, $bh - 2, $val, $bh - 9, ); $canvas-> color( $clr[1]); $canvas-> fillpoly( \@jp); $canvas-> color( $c3d[0]); $canvas-> polyline([@jp[4..9]]); $canvas-> line($val-1,$jp[3]-1,$val-1,$jp[9]+1); $canvas-> color( $c3d[1]); $canvas-> polyline([@jp[8,9,0..5]]); $canvas-> line($val+1,$jp[3]-1,$val+1,$jp[9]+1); } } } sub pos2info { my ( $self, $x, $y) = @_; my @size = $self-> size; return if $self-> {max} == $self-> {min}; if ( $self-> {vertical}) { my $bh = $self-> font-> height; my $val = $bh + 1 + abs( $self-> {value} - $self-> {min}) * ( $size[1] - 2 * $bh - 5) / ( abs($self-> {max} - $self-> {min}) || 1); my $ret1 = $self-> {min} + ( $y - $bh - 1) * abs($self-> {max} - $self-> {min}) / (( $size[1] - 2 * $bh - 5) || 1); if ( $y < $val - DefButtonX / 2 or $y >= $val + DefButtonX / 2) { return 0, $ret1; } else { return 1, $ret1, $y - $val; } } else { my $bw = $self-> font-> width + $self->{borderWidth}; my $val = $bw + 1 + abs( $self-> {value} - $self-> {min}) * ( $size[0] - 2 * $bw - 5) / (abs($self-> {max} - $self-> {min}) || 1); my $ret1 = $self-> {min} + ( $x - $bw - 1) * abs($self-> {max} - $self-> {min}) / (( $size[0] - 2 * $bw - 5) || 1); if ( $x < $val - DefButtonX / 2 or $x >= $val + DefButtonX / 2) { return 0, $ret1; } else { return 1, $ret1, $x - $val; } } } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {readOnly}; return if $self-> {mouseTransaction}; return if $btn != mb::Left; my ($info, $pos, $ap) = $self-> pos2info( $x, $y); return unless defined $info; if ( $info == 0) { $self-> value( $pos); return; } $self-> {aperture} = $ap; $self-> {mouseTransaction} = 1; $self-> capture(1); $self-> clear_event; } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return if $btn != mb::Left; return unless $self-> {mouseTransaction}; $self-> {mouseTransaction} = undef; $self-> capture(0); $self-> notify( 'Change') unless $self-> {autoTrack}; } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; return unless $self-> {mouseTransaction}; $self-> {vertical} ? $y : $x -= $self-> {aperture}; my ( $info, $pos) = $self-> pos2info( $x, $y); return unless defined $info; my $ov = $self-> {value}; $self-> {suppressNotify} = 1 unless $self-> {autoTrack}; $self-> value( $pos); $self-> {suppressNotify} = 0; $self-> notify(q(Track)) if !$self-> {autoTrack} && $ov != $self-> {value}; } sub on_keydown { my ( $self, $code, $key, $mod) = @_; return if $self-> {readOnly}; if ( $key == kb::Home || $key == kb::PgUp) { $self-> value( $self-> {vertical} ? $self-> {max} : $self-> {min}); $self-> clear_event; return; } if ( $key == kb::End || $key == kb::PgDn) { $self-> value( $self-> {vertical} ? $self-> {min} : $self-> {max}); $self-> clear_event; return; } if ( $key == kb::Left || $key == kb::Right || $key == kb::Up || $key == kb::Down) { my $s = $self-> {step}; $self-> clear_event; $self-> set_next_value(( $key == kb::Left || $key == kb::Down) ? -$s : $s); } } sub set_vertical { $_[0]-> {vertical} = $_[1]; $_[0]-> repaint; } sub set_tick_align { my ( $self, $ta) = @_; $ta = tka::Normal if $ta != tka::Alternative and $ta != tka::Dual; return if $ta == $self-> {tickAlign}; $self-> {tickAlign} = $ta; $self-> repaint; } sub set_ribbon_strip { $_[0]-> {ribbonStrip} = $_[1]; $_[0]-> repaint; } sub set_shaft_breadth { my ( $self, $sb) = @_; $sb = 0 if $sb < 0; return if $sb == $self-> {shaftBreadth}; $self-> {shaftBreadth} = $sb; $self-> repaint; } sub set_bound { my ( $self, $val, $bound) = @_; $self-> {$bound} = $val; $self-> scheme($self-> {scheme}) if defined $self-> {scheme}; $self-> repaint; } sub value { if ($#_) { my ( $self, $value) = @_; my ( $min, $max) = ( $self-> {min}, $self-> {max}); my $old = $self-> {value}; if ( $self-> {snap}) { my ( $minDist, $thatVal, $i) = ( abs( $min - $max)); my $tval = $self-> {tickVal}; for ( $i = 0; $i < scalar @{$tval}; $i++) { my $j = $$tval[ $i]; $minDist = abs(($thatVal = $j) - $value) if abs( $j - $value) < $minDist; } $value = $thatVal if defined $thatVal; } elsif ( $self-> {step} != 0 ) { $value = int ( $value / $self-> {step} ) * $self-> {step}; } $value = $min if $value < $min; $value = $max if $value > $max; return if $old == $value; $self-> {value} = $value; my @size = $self-> size; my $sb = $self-> {shaftBreadth}; if ( $self-> {vertical}) { $sb = $size[0] / 6 unless $sb; $sb = 2 unless $sb; my $bh = $self-> font-> height; my $bw = ( $size[0] - $sb) / 2; my $v1 = $bh + 1 + abs( $self-> {value} - $self-> {min}) * ( $size[1] - 2 * $bh - 5) / (abs($self-> {max} - $self-> {min})||1); my $v2 = $bh + 1 + abs( $old - $self-> {min}) * ( $size[1] - 2 * $bh - 5) / (abs($self-> {max} - $self-> {min})||1); ( $v2, $v1) = ( $v1, $v2) if $v1 > $v2; $v1 -= DefButtonX / 2; $v2 += DefButtonX / 2 + 1; my $xd = 0; $xd = (( $self-> {tickAlign} == tka::Normal) ? 1 : -1) * ( $bw - $sb - DefButtonX) if $self-> {tickAlign} != tka::Dual; $self-> invalidate_rect( $bw - 4 + $xd, $v1, $bw + $sb + 9 + $xd, $v2); } else { $sb = $size[1] / 6 unless $sb; $sb = 2 unless $sb; my $bw = $self-> font-> width + $self-> {borderWidth}; my $bh = ( $size[1] - $sb) / 2; my $v1 = $bw + 1 + abs( $self-> {value} - $self-> {min}) * ( $size[0] - 2 * $bw - 5) / (abs($self-> {max} - $self-> {min})||1); my $v2 = $bw + 1 + abs( $old - $self-> {min}) * ( $size[0] - 2 * $bw - 5) / (abs($self-> {max} - $self-> {min})||1); ( $v2, $v1) = ( $v1, $v2) if $v1 > $v2; $v1 -= DefButtonX / 2; $v2 += DefButtonX / 2 + 1; my $yd = 0; $yd = (( $self-> {tickAlign} == tka::Normal) ? -1 : 1) * ( $bh - $sb - DefButtonX) if $self-> {tickAlign} != tka::Dual; $self-> invalidate_rect( $v1, $bh - 9 + $yd, $v2, $bh + $sb + 4 + $yd); } $self-> notify(q(Change)) unless $self-> {suppressNotify}; } else { return $_[0]-> {value}; } } sub vertical {($#_)?$_[0]-> set_vertical ($_[1]):return $_[0]-> {vertical};} sub tickAlign {($#_)?$_[0]-> set_tick_align ($_[1]):return $_[0]-> {tickAlign};} sub ribbonStrip {($#_)?$_[0]-> set_ribbon_strip($_[1]):return $_[0]-> {ribbonStrip};} sub shaftBreadth{($#_)?$_[0]-> set_shaft_breadth($_[1]):return $_[0]-> {shaftBreadth};} sub borderWidth { return $_[0]-> {borderWidth} unless $#_; my ( $self, $bw) = @_; $bw = 0 if $bw < 0; $self-> {borderWidth} = $bw; $self-> repaint; } package Prima::CircularSlider; use vars qw(@ISA); @ISA = qw(Prima::AbstractSlider Prima::MouseScroller); { my %RNT = ( %{Prima::AbstractSlider-> notification_types()}, Stringify => nt::Action, ); sub notification_types { return \%RNT; } } use constant DefButtonX => 10; sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, buttons => 1, stdPointer => 0, } } sub init { my $self = shift; for ( qw( buttons pressState circX circY br butt1X butt1Y butt2X)) {$self-> {$_}=0} $self-> {string} = ''; my %profile = $self-> SUPER::init( @_); for ( qw( buttons stdPointer)) {$self-> $_($profile{$_});} $self-> reset; return %profile; } sub setup { $_[0]-> SUPER::setup; $_[0]-> notify(q(Stringify), $_[0]-> {value}, \$_[0]-> {string}); $_[0]-> repaint; } sub text { return $_[0]-> SUPER::text unless $#_; $_[0]-> SUPER::text( $_[1]); $_[0]-> repaint; } sub reset { my $self = $_[0]; my @size = $self-> size; my $fh = $self-> font-> height; my $br = $size[0] > ( $size[1] - $fh) ? ( $size[1] - $fh) : $size[0]; $self-> {br} = $br; $self-> {circX} = $size[0]/2; $self-> {circY} = ($size[1] + $fh) / 2; $self-> {butt1X} = $size[0] / 2 - $br * 0.4 - DefButtonX / 2; $self-> {butt1Y} = ( $size[1] + $fh) / 2 - $br * 0.4; $self-> {butt2X} = $size[0] / 2 + $br * 0.4 - DefButtonX / 2; $self-> {circAlive} = $br > DefButtonX * 5; } sub offset2pt { my ( $self, $width, $height, $value, $radius) = @_; my $a = 225 * 3.14159 / 180 - ( 270 * 3.14159 / 180) * ( $value - $self-> {min}) / (abs( $self-> {min} - $self-> {max})||1); return $width + $radius * cos($a), $height + $radius * sin($a); } sub offset2data { my ( $self, $value) = @_; my $a = 225 * 3.14159 / 180 - ( 270 * 3.14159 / 180) * abs( $value - $self-> {min})/ (abs( $self-> {min} - $self-> {max})||1); return cos($a), sin($a); } sub on_paint { my ( $self, $canvas) = @_; my @clr = ( $self-> color, $self-> backColor); @clr = ( $self-> disabledColor, $self-> disabledBackColor) if ( !$self-> enabled); my @c3d = ( $self-> dark3DColor, $self-> light3DColor); my @cht = ( $self-> hiliteColor, $self-> hiliteBackColor); my @size = $canvas-> size; my ( $range, $min, $tval, $tlen, $ttxt) = ( abs($self-> {max} - $self-> {min}), $self-> {min}, $self-> {tickVal}, $self-> {tickLen}, $self-> {tickTxt} ); if ( defined $self-> {singlePaint}) { my @clip1 = @{$self-> {expectedClip}}; my @clip2 = $self-> clipRect; my $i; for ( $i = 0; $i < 4; $i++) { $self-> {singlePaint} = undef, last if $clip1[$i] != $clip2[$i]; } } $canvas-> color( $clr[1]); $canvas-> bar( 0, 0, @size) if !$self-> transparent && !defined $self-> {singlePaint}; my $fh = $canvas-> font-> height; my $br = $self-> {br}; my $rad = $br * 0.3; my @cpt = ( $self-> {circX}, $self-> {circY}, $rad*2+1, $rad*2+1); if ( $self-> {circAlive}) { if ( defined $self-> {singlePaint}) { $canvas-> fill_ellipse( @cpt[0..1], $rad*2-5, $rad*2-5); $canvas-> color( $clr[0]); } else { $canvas-> color( $c3d[1]); $canvas-> lineWidth(2); $canvas-> arc( @cpt[0..1], $cpt[2]-2, $cpt[3]-2, 65, 235); $canvas-> color( $c3d[0]); $canvas-> arc( @cpt[0..1], $cpt[2]-2, $cpt[3]-2, 255, 405); $canvas-> lineWidth(0); $canvas-> color( $clr[0]); $canvas-> ellipse( @cpt); } if ( $self-> {stdPointer}) { my $dev = $range * 0.03; my @j = ( $self-> offset2pt( @cpt[0,1], $self-> {value}, $rad * 0.8), $self-> offset2pt( @cpt[0,1], $self-> {value} + $dev, $rad * 0.6), $self-> offset2pt( @cpt[0,1], $self-> {value} - $dev, $rad * 0.6), ); $self-> fillpoly( \@j); } else { my @cxt = ( $self-> offset2pt( @cpt[0,1], $self-> {value}, $rad - 10), 4, 4); $canvas-> lineWidth(2); $canvas-> color( $c3d[0]); $canvas-> arc( @cxt[0..1], 3, 3, 65, 235); $canvas-> color( $c3d[1]); $canvas-> arc( @cxt[0..1], 3, 3, 255, 405); $canvas-> lineWidth(0); $canvas-> color( $clr[0]); } my $i; unless ( defined $self-> {singlePaint}) { for ( $i = 0; $i < scalar @{$tval}; $i++) { my $r = $rad + 3 + $$tlen[ $i]; my ( $cos, $sin) = $self-> offset2data( $$tval[$i]); $canvas-> line( $self-> offset2pt( @cpt[0,1], $$tval[$i], $rad + 3), $cpt[0] + $r * $cos, $cpt[1] + $r * $sin ) if $$tlen[ $i]; $r += 3; if ( defined $$ttxt[ $i]) { my $y = $cpt[1] + $r * $sin - $fh / 2 * ( 1 - $sin); my $x = $cpt[0] + $r * $cos - ( 1 - $cos) * $canvas-> get_text_width( $$ttxt[ $i]) / 2; $canvas-> text_out( $$ttxt[ $i], $x, $y); } } } } else { $canvas-> bar( 0, 0, @size); $canvas-> color( $clr[0]); } my $ttw = $canvas-> get_text_width( $self-> {string}); $canvas-> text_out( $self-> {string}, ( $size[0] - $ttw) / 2, $size[1] / 2 - $fh / 3) if $ttw < $rad || !$self-> {circAlive}; return if defined $self-> {singlePaint}; $ttw = $canvas-> get_text_width( $self-> text); $canvas-> text_out( $self-> text, ( $size[0] - $ttw) / 2, 2); if ( $self-> {buttons}) { my $s = $self-> {pressState}; my @cbd = reverse @c3d; my $at = 0; $at = 1, @cbd = reverse @cbd if $s & 1; $canvas-> rect3d( $self-> { butt1X}, $self-> { butt1Y}, $self-> { butt1X} + DefButtonX, $self-> { butt1Y} + DefButtonX, 1, @cbd, $clr[1] ); $canvas-> line( $self-> { butt1X} + 2 + $at, $self-> { butt1Y} + DefButtonX / 2 - $at, $self-> { butt1X} - 2 + + DefButtonX + $at, $self-> {butt1Y} + DefButtonX / 2 - $at ); @cbd = reverse @c3d; $at = 0; $at = 1, @cbd = reverse @cbd if $s & 2; $canvas-> rect3d( $self-> { butt2X}, $self-> { butt1Y}, $self-> { butt2X} + DefButtonX, $self-> { butt1Y} + DefButtonX, 1, @cbd, $clr[1] ); $canvas-> line( $self-> { butt2X} + 2 + $at, $self-> { butt1Y} + DefButtonX / 2 - $at, $self-> { butt2X} - 2 + + DefButtonX + $at, $self-> {butt1Y} + DefButtonX / 2 - $at ); $canvas-> line( $self-> { butt2X} + DefButtonX / 2 + $at, $self-> { butt1Y} + 2 - $at, $self-> { butt2X} + DefButtonX / 2 + $at, $self-> { butt1Y} - 2 - $at + DefButtonX ); } $canvas-> rect_focus( ( $size[0] - $ttw) / 2 - 1, 1, ( $size[0] + $ttw) / 2 + 1, $fh + 2 ) if $self-> focused && ( length( $self-> text) > 0); } sub on_keydown { my ( $self, $code, $key, $mod) = @_; return if $self-> {readOnly}; if ( $key == kb::Home || $key == kb::PgUp) { $self-> value( $self-> {min}); $self-> clear_event; return; } if ( $key == kb::End || $key == kb::PgDn) { $self-> value( $self-> {max}); $self-> clear_event; return; } if ( $key == kb::Left || $key == kb::Right || $key == kb::Up || $key == kb::Down) { my $s = $self-> {step}; $self-> clear_event; $self-> set_next_value(( $key == kb::Left || $key == kb::Down) ? -$s : $s); } } sub xy2val { my ( $self, $x, $y) = @_; $x -= $self-> {circX}; $y -= $self-> {circY}; my $a = atan2( $y, $x); my $pi = atan2( 0, -1); $a += $pi / 2; $a += $pi * 2 if $a < 0; $a = $self-> {min} + abs( $self-> {max} - $self-> {min}) * ( $pi * 1.75 - $a) * 2 / ( 3 * $pi); my $s = $self-> {step}; $a = int( $a) if int( $s) - $s == 0; my $inCircle = ( abs($x) < $self-> {br} * 0.3 + 3 and abs($y) < $self-> {br} * 0.3 + 3); return $a, $inCircle; } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {readOnly}; return if $self-> {mouseTransaction}; return if $btn != mb::Left; my @butt = ( $self-> {butt1X}, $self-> {butt1Y}, $self-> {butt2X}, $self-> {butt1X} + DefButtonX, $self-> {butt1Y} + DefButtonX, $self-> {butt2X} + DefButtonX ); if ( $self-> {buttons} and $y >= $butt[1] and $y < $butt[4]) { if ( $x >= $butt[0] and $x < $butt[3]) { $self-> {pressState} = 1; $self-> invalidate_rect( @butt[0..1], $butt[3] + 1, $butt[4] + 1); } if ( $x >= $butt[2] and $x < $butt[5]) { $self-> {pressState} = 2; $self-> invalidate_rect( $butt[2], $butt[1], $butt[5] + 1, $butt[4] + 1); } if ( $self-> {pressState} > 0) { $self-> {mouseTransaction} = $self-> {pressState}; $self-> update_view; $self-> capture(1); $self-> scroll_timer_start; $self-> scroll_timer_semaphore(0); $self-> value( $self-> value + $self-> step * (($self-> {pressState} == 1) ? -1 : 1)); return; } } my ( $val, $inCircle) = $self-> xy2val( $x, $y); return unless $inCircle; $self-> {mouseTransaction} = 3; $self-> value( $val); $self-> capture(1); $self-> clear_event; } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return if $btn != mb::Left; return unless $self-> {mouseTransaction}; my @butt = ( $self-> {butt1X}, $self-> {butt1Y}, $self-> {butt2X}, $self-> {butt1X} + DefButtonX, $self-> {butt1Y} + DefButtonX, $self-> {butt2X} + DefButtonX ); $self-> scroll_timer_stop; $self-> {pressState} = 0; if ( $self-> {mouseTransaction} == 1) { $self-> invalidate_rect( @butt[0..1], $butt[3] + 1, $butt[4] + 1); $self-> update_view; } if ( $self-> {mouseTransaction} == 2) { $self-> invalidate_rect( $butt[2], $butt[1], $butt[5] + 1, $butt[4] + 1); $self-> update_view; } my $mt = $self-> {mouseTransaction}; $self-> {mouseTransaction} = undef; $self-> capture(0); $self-> notify( 'Change') if $mt == 3 && !$self-> {autoTrack}; } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; return unless $self-> {mouseTransaction}; if ( $self-> {mouseTransaction} == 3) { my $ov = $self-> {value}; $self-> {suppressNotify} = 1 unless $self-> {autoTrack}; $self-> value( $self-> xy2val( $x, $y)); $self-> {suppressNotify} = 0; $self-> notify(q(Track)) if !$self-> {autoTrack} && $ov != $self-> {value}; } elsif ( $self-> {pressState} > 0) { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); $self-> value( $self-> value + $self-> step * (( $self-> {mouseTransaction} == 1) ? -1 : 1)); } else { $self-> scroll_timer_stop; } } sub on_mouseclick { my $self = shift; $self-> clear_event; return unless pop; $self-> clear_event unless $self-> notify( "MouseDown", @_); } sub on_size { $_[0]-> reset; } sub on_fontchanged { $_[0]-> reset; } sub on_enter { $_[0]-> repaint; } sub on_leave { $_[0]-> repaint; } sub on_stringify { my ( $self, $value, $sref) = @_; $$sref = $value; $self-> clear_event; } sub set_buttons { $_[0]-> {buttons} = $_[1]; $_[0]-> repaint; } sub set_std_pointer { $_[0]-> {stdPointer} = $_[1]; $_[0]-> repaint; } sub stdPointer {($#_)?$_[0]-> set_std_pointer ($_[1]):return $_[0]-> {stdPointer};} sub buttons {($#_)?$_[0]-> set_buttons ($_[1]):return $_[0]-> {buttons};} sub value { return $_[0]-> {value} unless $#_; my ( $self, $value) = @_; my ( $min, $max) = ( $self-> {min}, $self-> {max}); my $old = $self-> {value}; $value = $min if $value < $min; $value = $max if $value > $max; if ( $self-> {snap}) { my ( $minDist, $thatVal, $i) = ( abs( $min - $max)); my $tval = $self-> {tickVal}; for ( $i = 0; $i < scalar @{$tval}; $i++) { my $j = $$tval[ $i]; $minDist = abs(($thatVal = $j) - $value) if abs( $j - $value) < $minDist; } $value = $thatVal if defined $thatVal; } elsif ( $self-> {step} != 0 ) { $value = int ( $value / $self-> {step} ) * $self-> {step}; } return if $old == $value; $self-> {value} = $value; $self-> notify(q(Stringify), $value, \$self-> {string}); $self-> {singlePaint} = 1; my @clip = ( int( $self-> {circX} - $self-> {br} * 0.3), int( $self-> {circY} - $self-> {br} * 0.3), int( $self-> {circX} + $self-> {br} * 0.3), int( $self-> {circY} + $self-> {br} * 0.3), ); $self-> {expectedClip} = \@clip; $self-> invalidate_rect( @clip[0..1], $clip[2]+1, $clip[3]+1); $self-> update_view; $self-> {singlePaint} = undef; $self-> notify(q(Change)) unless $self-> {suppressNotify}; } 1; __DATA__ =pod =head1 NAME Prima::Sliders - sliding bars, spin buttons and input lines, dial widget etc. =head1 DESCRIPTION The module is a set of widget classes, with one common property; - all of these provide input and / or output of an integer value. This property unites the following set of class hierarchies: Prima::AbstractSpinButton Prima::SpinButton Prima::AltSpinButton Prima::SpinEdit Prima::Gauge Prima::AbstractSlider Prima::Slider Prima::CircularSlider =head1 Prima::AbstractSpinButton Provides a generic interface to spin-button class functionality, which includes range definition properties and events. Neither C, nor its descendants store the integer value. These provide a mere possibility for the user to send incrementing or decrementing commands. The class is not usable directly. =head2 Properties =over =item state INTEGER Internal state, reflects widget modal state, for example, is set to non-zero when the user performs a mouse drag action. The exact meaning of C is defined in the descendant classes. =back =head2 Events =over =item Increment DELTA Called when the user presses a part of a widget that is responsible for incrementing or decrementing commands. DELTA is an integer value, indicating how the associated value must be modified. =item TrackEnd Called when the user finished the mouse transaction. =back =head1 Prima::SpinButton A rectangular spin button, consists of three parts, divided horizontally. The upper and the lower parts are push-buttons associated with singular increment and decrement commands. The middle part, when dragged by mouse, fires C events with delta value, based on a vertical position of the mouse pointer. =head1 Prima::AltSpinButton A rectangular spin button, consists of two push-buttons, associated with singular increment and decrement command. Comparing to C, the class is less functional but has more stylish look. =head1 Prima::SpinEdit The class is a numerical input line, paired with a spin button. The input line value can be change three ways - either as a direct traditional keyboard input, or as spin button actions, or as mouse wheel response. The class provides value storage and range selection properties. =head2 Properties =over =item circulate BOOLEAN Selects the value modification rule when the increment or decrement action hits the range. If 1, the value is changed to the opposite limit value ( for example, if value is 100 in range 2-100, and the user clicks on 'increment' button, the value is changed to 2 ). If 0, the value does not change. Default value: 0 =item editClass STRING Assigns an input line class. Create-only property. Default value: C =item editDelegations ARRAY Assigns the input line list of delegated notifications. Create-only property. =item editProfile HASH Assigns hash of properties, passed to the input line during the creation. Create-only property. =item max INTEGER Sets the upper limit for C. Default value: 100. =item min INTEGER Sets the lower limit for C. Default value: 0 =item pageStep INTEGER Determines the multiplication factor for incrementing/decrementing actions of the mouse wheel. Default value: 10 =item spinClass STRING Assigns a spin-button class. Create-only property. Default value: C =item spinProfile ARRAY Assigns the spin-button list of delegated notifications. Create-only property. =item spinDelegations HASH Assigns hash of properties, passed to the spin-button during the creation. Create-only property. =item step INTEGER Determines the multiplication factor for incrementing/decrementing actions of the spin-button. Default value: 1 =item value INTEGER Selects integer value in range from C to C, reflected in the input line. Default value: 0. =back =head2 Methods =over =item set_bounds MIN, MAX Simultaneously sets both C and C values. =back =head2 Events =over =item Change Called when C is changed. =back =head1 Prima::Gauge An output-only widget class, displays a progress bar and an eventual percentage string. Useful as a progress indicator. =head2 Properties =over =item indent INTEGER Selects width of a border around the widget. Default value: 1 =item max INTEGER Sets the upper limit for C. Default value: 100. =item min INTEGER Sets the lower limit for C. Default value: 0 =item relief INTEGER Selects the style of a border around the widget. Can be one of the following C constants: gr::Sink - 3d sunken look gr::Border - uniform black border gr::Raise - 3d risen look Default value: C. =item threshold INTEGER Selects the threshold value used to determine if the changes to C are reflected immediately or deferred until the value is changed more significantly. When 0, all calls to C result in an immediate repaint request. Default value: 0 =item value INTEGER Selects integer value between C and C, reflected in the progress bar and eventual text. Default value: 0. =item vertical BOOLEAN If 1, the widget is drawn vertically, and the progress bar moves from bottom to top. If 0, the widget is drawn horizontally, and the progress bar moves from left to right. Default value: 0 =back =head2 Methods =over =item set_bounds MIN, MAX Simultaneously sets both C and C values. =back =head2 Events =over =item Stringify VALUE, REF Converts integer VALUE into a string format and puts into REF scalar reference. Default stringifying conversion is identical to C one. =back =head1 Prima::AbstractSlider The class provides basic functionality of a sliding bar, equipped with tick marks. Tick marks are supposed to be drawn alongside the main sliding axis or circle and provide visual feedback for the user. The class is not usable directly. =head2 Properties =over =item autoTrack BOOLEAN A boolean flag, selects the way notifications execute when the user mouse-drags the sliding bar. If 1, C notification is executed as soon as C is changed. If 0, C is deferred until the user finished the mouse drag; instead, C notification is executed when the bar is moved. This property can be used when the action, called on C performs very slow, so the eventual fast mouse interactions would not thrash down the program. Default value: 1 =item increment INTEGER A step range value, used in C for marking the key ticks. See L for details. Default value: 10 =item max INTEGER Sets the upper limit for C. Default value: 100. =item min INTEGER Sets the lower limit for C. Default value: 0 =item readOnly BOOLEAN If 1, the use cannot change the value by moving the bar or otherwise. Default value: 0 =item ticks ARRAY Selects the tick marks representation along the sliding axis or circle. ARRAY consists of hashes, each for one tick. The hash must contain at least C key, with integer value. The two additional keys, C and C, select the height of a tick mark in pixels and the text drawn near the mark, correspondingly. If ARRAY is C, no ticks are drawn. =item scheme INTEGER C is a property, that creates a set of tick marks using one of the predefined scale designs, selected by C constants. Each constant produces different scale; some make use of C integer property, which selects a step by which the additional text marks are drawn. As an example, C design with default C, C, and C values would look like that: 0 10 20 100 | | | | |||||||||||||||....||| The module defines the following constants: ss::Axis - 5 minor ticks per increment ss::Gauge - 1 tick per increment ss::StdMinMax - 2 ticks at the ends of the bar ss::Thermometer - 10 minor ticks per increment, longer text ticks When C property is set, C is reset to C. =item snap BOOLEAN If 1, C cannot accept values that are not on the tick scale. When set such a value, it is rounded to the closest tick mark. If 0, C can accept any integer value in range from C to C. Default value: 0 =item step INTEGER Integer delta for singular increment / decrement commands and a threshold for C when C value is 0. Default value: 1 =item value INTEGER Selects integer value between C and C and the corresponding sliding bar position. Default value: 0. =back =head2 Events =over =item Change Called when C value is changed, with one exception: if the user moves the sliding bar while C is 0, C notification is called instead. =item Track Called when the user moves the sliding bar while C value is 0; this notification is a substitute to C. =back =head1 Prima::Slider Presents a linear sliding bar, movable along a linear shaft. =head2 Properties =over =item borderWidth INTEGER In horizontal mode, sets extra margin space between the slider line and the widget boundaries. Can be used for fine tuning of displaying text labels from , where the default spacing (0) or spacing procedure (drop overlapping labels) is not enough. =item ribbonStrip BOOLEAN If 1, the parts of shaft are painted with different colors, to increase visual feedback. If 0, the shaft is painted with single default background color. Default value: 0 =item shaftBreadth INTEGER Breadth of the shaft in pixels. Default value: 6 =item tickAlign INTEGER One of C constants, that correspond to the situation of tick marks: tka::Normal - ticks are drawn on the left or on the top of the shaft tka::Alternative - ticks are drawn on the right or at the bottom of the shaft tka::Dual - ticks are drawn both ways The ticks orientation ( left or top, right or bottom ) is dependant on C property value. Default value: C =item vertical BOOLEAN If 1, the widget is drawn vertically, and the slider moves from bottom to top. If 0, the widget is drawn horizontally, and the slider moves from left to right. Default value: 0 =back =head2 Methods =over =item pos2info X, Y Translates integer coordinates pair ( X, Y ) into the value corresponding to the scale, and returns three scalars: =over =item info INTEGER If C, the user-driven positioning is not possible ( C equals to C ). If 1, the point is located on the slider. If 0, the point is outside the slider. =item value INTEGER If C is 0 or 1, contains the corresponding C. =item aperture INTEGER Offset in pixels along the shaft axis. =back =back =head1 Prima::CircularSlider Presents a slider widget with the dial and two increment / decrement buttons. The tick marks are drawn around the perimeter of the dial; current value is displayed in the center of the dial. =head2 Properties =over =item buttons BOOLEAN If 1, the increment / decrement buttons are shown at the bottom of the dial, and the user can change the value either by the dial or by the buttons. If 0, the buttons are not shown. Default values: 0 =item stdPointer BOOLEAN Determines the style of a value indicator ( pointer ) on the dial. If 1, it is drawn as a black triangular mark. If 0, it is drawn as a small circular knob. Default value: 0 =back =head2 Methods =over =item offset2data VALUE Converts integer value in range from C to C into the corresponding angle, and return two real values: cosine and sine of the angle. =item offset2pt X, Y, VALUE, RADIUS Converts integer value in range from C to C into the point coordinates, with the RADIUS and dial center coordinates X and Y. Return the calculated point coordinates as two integers in (X,Y) format. =item xy2val X, Y Converts widget coordinates X and Y into value in range from C to C, and return two scalars: the value and the boolean flag, which is set to 1 if the (X,Y) point is inside the dial circle, and 0 otherwise. =back =head2 Events =over =item Stringify VALUE, REF Converts integer VALUE into a string format and puts into REF scalar reference. The resulting string is displayed in the center of the dial. Default conversion routine simply copies VALUE to REF as is. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE, Anton Berezin Etobez@tobez.orgE. =head1 SEE ALSO L, F =cut Prima-1.28/Prima/images/0000755000175100017510000000000011150770061012607 5ustar dkdkPrima-1.28/Prima/images/VB/0000755000175100017510000000000011150770061013116 5ustar dkdkPrima-1.28/Prima/TextView.pm0000644000175100017510000016211511150770061013465 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by: # Dmitry Karasik # # $Id: TextView.pm,v 1.25 2008/04/09 20:14:27 dk Exp $ use strict; use Prima; use Prima::IntUtils; use Prima::ScrollBar; package tb; use vars qw(@oplen); @oplen = ( 4, 2, 3, 4, 3, 2, 4); # lengths of tb::OP_XXX constants ( see below ) + 1 # basic opcodes use constant OP_TEXT => 0; # (3) text offset, text length, text width use constant OP_COLOR => 1; # (1) 0xRRGGBB or COLOR_INDEX | palette_index use constant OP_FONT => 2; # (2) op_font_mode, font info use constant OP_TRANSPOSE => 3; # (3) move current point to delta X, delta Y use constant OP_CODE => 4; # (2) code pointer and parameters # formatting opcodes use constant OP_WRAP => 5; # (1) on / off use constant OP_MARK => 6; # (3) id, x, y # OP_TEXT use constant T_OFS => 1; use constant T_LEN => 2; use constant T_WID => 3; # OP_FONT use constant F_MODE => 1; use constant F_DATA => 2; # OP_COLOR use constant COLOR_INDEX => 0x01000000; # index in colormap() array use constant BACKCOLOR_FLAG => 0x02000000; # OP_COLOR flag for backColor use constant BACKCOLOR_DEFAULT => BACKCOLOR_FLAG|COLOR_INDEX|1; use constant COLOR_MASK => 0xFCFFFFFF; # OP_TRANSPOSE - indices use constant X_X => 1; use constant X_Y => 2; use constant X_FLAGS => 3; # OP_TRANSPOSE - X_FLAGS constants use constant X_DIMENSION_PIXEL => 0; use constant X_TRANSPOSE => 0; use constant X_EXTEND => 1; # formatting flags use constant X_DIMENSION_FONT_HEIGHT => 2; # multiply by font height use constant X_DIMENSION_POINT => 4; # multiply by resolution / 72 # block header indices use constant BLK_FLAGS => 0; use constant BLK_WIDTH => 1; use constant BLK_HEIGHT => 2; use constant BLK_X => 3; use constant BLK_Y => 4; use constant BLK_APERTURE_X => 5; use constant BLK_APERTURE_Y => 6; use constant BLK_TEXT_OFFSET => 7; use constant BLK_DATA_START => 8; use constant BLK_FONT_ID => BLK_DATA_START; use constant BLK_FONT_SIZE => 9; use constant BLK_FONT_STYLE => 10; use constant BLK_COLOR => 11; use constant BLK_DATA_END => 12; use constant BLK_BACKCOLOR => BLK_DATA_END; use constant BLK_START => BLK_DATA_END + 1; # OP_FONT again use constant F_ID => BLK_FONT_ID; use constant F_SIZE => BLK_FONT_SIZE; use constant F_STYLE => BLK_FONT_STYLE; use constant F_HEIGHT=> 1000000; # BLK_FLAGS constants use constant T_SIZE => 0x1; use constant T_WRAPABLE => 0x2; # realize_state mode use constant REALIZE_FONTS => 0x1; use constant REALIZE_COLORS => 0x2; use constant REALIZE_ALL => 0x3; use constant YMAX => 1000; sub block_create { my $ret = [ ( 0 ) x BLK_START ]; $$ret[ BLK_FLAGS ] |= T_SIZE; push @$ret, @_; return $ret; } sub block_count { my $block = $_[0]; my $ret = 0; my ( $i, $lim) = ( BLK_START, scalar @$block); $i += $oplen[$$block[$i]], $ret++ while $i < $lim; return $ret; } # creates a new opcode for custom use sub opcode { my $len = $_[0] || 0; $len = 0 if $len < 0; push @oplen, $len + 1; return scalar(@oplen) - 1; } sub text { return OP_TEXT, $_[0], $_[1], $_[2] || 0 } sub color { return OP_COLOR, $_[0] } sub backColor { return OP_COLOR, $_[0] | BACKCOLOR_FLAG} sub colorIndex { return OP_COLOR, $_[0] | COLOR_INDEX } sub backColorIndex { return OP_COLOR, $_[0] | COLOR_INDEX | BACKCOLOR_FLAG} sub fontId { return OP_FONT, F_ID, $_[0] } sub fontSize { return OP_FONT, F_SIZE, $_[0] } sub fontHeight { return OP_FONT, F_SIZE, $_[0] + F_HEIGHT } sub fontStyle { return OP_FONT, F_STYLE, $_[0] } sub moveto { return OP_TRANSPOSE, $_[0], $_[1], $_[2] || 0 } sub extend { return OP_TRANSPOSE, $_[0], $_[1], ($_[2] || 0) | X_EXTEND } sub code { return OP_CODE, $_[0], $_[1] } sub wrap { return OP_WRAP, $_[0] } sub mark { return OP_MARK, $_[0], 0, 0 } package Prima::TextView::EventContent; sub on_mousedown {} sub on_mousemove {} sub on_mouseup {} package Prima::TextView; use vars qw(@ISA); @ISA = qw(Prima::Widget Prima::MouseScroller Prima::GroupScroller); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( autoHScroll => 1, autoVScroll => 0, borderWidth => 2, colorMap => [ $def-> {color}, $def-> {backColor} ], fontPalette => [ { name => $def-> {font}-> {name}, encoding => '', pitch => fp::Default, }], hScroll => 1, offset => 0, paneWidth => 0, paneHeight => 0, paneSize => [0,0], resolution => [ $::application-> resolution ], topLine => 0, scaleChildren => 0, selectable => 1, textOutBaseline => 1, textRef => '', vScroll => 1, widgetClass => wc::Edit, pointer => cr::Text, ); @$def{keys %prf} = values %prf; return $def; } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); if ( exists( $p-> { paneSize})) { $p-> { paneWidth} = $p-> { paneSize}-> [ 0]; $p-> { paneHeight} = $p-> { paneSize}-> [ 1]; } $p-> { text} = '' if exists( $p-> { textRef}); $p-> {autoHScroll} = 0 if exists $p-> {hScroll}; $p-> {autoVScroll} = 0 if exists $p-> {vScroll}; } sub init { my $self = shift; for ( qw( topLine scrollTransaction hScroll vScroll offset paneWidth paneHeight borderWidth autoVScroll autoHScroll)) { $self-> {$_} = 0; } my %profile = $self-> SUPER::init(@_); $self-> {paneSize} = [0,0]; $self-> {colorMap} = []; $self-> {fontPalette} = []; $self-> {blocks} = []; $self-> {resolution} = []; $self-> {defaultFontSize} = $self-> font-> size; $self-> {selection} = [ -1, -1, -1, -1]; $self-> {selectionPaintMode} = 0; $self-> {ymap} = []; $self-> setup_indents; $self-> resolution( @{$profile{resolution}}); for ( qw( autoHScroll autoVScroll colorMap fontPalette hScroll vScroll borderWidth paneWidth paneHeight offset topLine textRef)) { $self-> $_( $profile{ $_}); } return %profile; } sub reset_scrolls { my $self = shift; my @sz = $self-> get_active_area( 2, @_); if ( $self-> {scrollTransaction} != 1) { if ( $self-> {autoVScroll}) { my $vs = ($self-> {paneHeight} > $sz[1]) ? 1 : 0; if ( $vs != $self-> {vScroll}) { $self-> vScroll( $vs); @sz = $self-> get_active_area( 2, @_); } } $self-> {vScrollBar}-> set( max => $self-> {paneHeight} - $sz[1], pageStep => int($sz[1] * 0.9), step => $self-> font-> height, whole => $self-> {paneHeight}, partial => $sz[1], value => $self-> {topLine}, ) if $self-> {vScroll}; } if ( $self-> {scrollTransaction} != 2) { if ( $self-> {autoHScroll}) { my $hs = ($self-> {paneWidth} > $sz[0]) ? 1 : 0; if ( $hs != $self-> {hScroll}) { $self-> hScroll( $hs); @sz = $self-> get_active_area( 2, @_); } } $self-> {hScrollBar}-> set( max => $self-> {paneWidth} - $sz[0], whole => $self-> {paneWidth}, value => $self-> {offset}, partial => $sz[0], pageStep => int($sz[0] * 0.75), ) if $self-> {hScroll}; } } sub on_size { my ( $self, $oldx, $oldy, $x, $y) = @_; $self-> reset_scrolls( $x, $y); } sub on_fontchanged { my $f = $_[0]-> font; $_[0]-> {defaultFontSize} = $f-> size; $_[0]-> {fontPalette}-> [0]-> {name} = $f-> name; } sub set { my ( $self, %set) = @_; if ( exists $set{paneSize}) { $self-> paneSize( @{$set{paneSize}}); delete $set{paneSize}; } $self-> SUPER::set( %set); } sub text { unless ($#_) { my $hugeScalarRef = $_[0]-> textRef; return $$hugeScalarRef; } else { my $s = $_[1]; $_[0]-> textRef( \$s); } } sub textRef { return $_[0]-> {text} unless $#_; $_[0]-> {text} = $_[1] if $_[1]; } sub paneWidth { return $_[0]-> {paneWidth} unless $#_; my ( $self, $pw) = @_; $pw = 0 if $pw < 0; return if $pw == $self-> {paneWidth}; $self-> {paneWidth} = $pw; $self-> reset_scrolls; $self-> repaint; } sub paneHeight { return $_[0]-> {paneHeight} unless $#_; my ( $self, $ph) = @_; $ph = 0 if $ph < 0; return if $ph == $self-> {paneHeight}; $self-> {paneHeight} = $ph; $self-> reset_scrolls; $self-> repaint; } sub paneSize { return $_[0]-> {paneWidth}, $_[0]-> {paneHeight} if $#_ < 2; my ( $self, $pw, $ph) = @_; $ph = 0 if $ph < 0; $pw = 0 if $pw < 0; return if $ph == $self-> {paneHeight} && $pw == $self-> {paneWidth}; $self-> {paneWidth} = $pw; $self-> {paneHeight} = $ph; $self-> reset_scrolls; $self-> repaint; } sub offset { return $_[0]-> {offset} unless $#_; my ( $self, $offset) = @_; $offset = int($offset); my @sz = $self-> size; my @aa = $self-> get_active_area(2, @sz); my $pw = $self-> {paneWidth}; $offset = $pw - $aa[0] if $offset > $pw - $aa[0]; $offset = 0 if $offset < 0; return if $self-> {offset} == $offset; my $dt = $offset - $self-> {offset}; $self-> {offset} = $offset; if ( $self-> {hScroll} && $self-> {scrollTransaction} != 2) { $self-> {scrollTransaction} = 2; $self-> {hScrollBar}-> value( $offset); $self-> {scrollTransaction} = 0; } $self-> scroll( -$dt, 0, clipRect => [ $self-> get_active_area(0, @sz)]); } sub resolution { return @{$_[0]->{resolution}} unless $#_; my ( $self, $x, $y) = @_; die "Invalid resolution\n" if $x <= 0 or $y <= 0; @{$self-> {resolution}} = ( $x, $y); } sub topLine { return $_[0]-> {topLine} unless $#_; my ( $self, $top) = @_; $top = int($top); my @sz = $self-> size; my @aa = $self-> get_active_area(2, @sz); my $ph = $self-> {paneHeight}; $top = $ph - $aa[1] if $top > $ph - $aa[1]; $top = 0 if $top < 0; return if $self-> {topLine} == $top; my $dt = $top - $self-> {topLine}; $self-> {topLine} = $top; if ( $self-> {vScroll} && $self-> {scrollTransaction} != 1) { $self-> {scrollTransaction} = 1; $self-> {vScrollBar}-> value( $top); $self-> {scrollTransaction} = 0; } $self-> scroll( 0, $dt, clipRect => [ $self-> get_active_area(0, @sz)]); } sub VScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction}; $self-> {scrollTransaction} = 1; $self-> topLine( $scr-> value); $self-> {scrollTransaction} = 0; } sub HScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction}; $self-> {scrollTransaction} = 2; $self-> offset( $scr-> value); $self-> {scrollTransaction} = 0; } sub colorMap { return [ @{$_[0]-> {colorMap}}] unless $#_; my ( $self, $cm) = @_; $self-> {colorMap} = [@$cm]; $self-> {colorMap}-> [1] = $self-> backColor if scalar @$cm < 2; $self-> {colorMap}-> [0] = $self-> color if scalar @$cm < 1; $self-> repaint; } sub fontPalette { return [ @{$_[0]-> {fontPalette}}] unless $#_; my ( $self, $fm) = @_; $self-> {fontPalette} = [@$fm]; $self-> {fontPalette}-> [0] = { name => $self-> font-> name, encoding => '', pitch => fp::Default, } if scalar @$fm < 1; $self-> repaint; } sub create_state { my $self = $_[0]; my $g = tb::block_create(); $$g[ tb::BLK_FONT_SIZE] = $self-> {defaultFontSize}; $$g[ tb::BLK_COLOR] = tb::COLOR_INDEX; $$g[ tb::BLK_BACKCOLOR] = tb::BACKCOLOR_DEFAULT; return $g; } sub realize_state { my ( $self, $canvas, $state, $mode) = @_; if ( $mode & tb::REALIZE_FONTS) { my %f = %{$self-> {fontPalette}-> [ $$state[ tb::BLK_FONT_ID]]}; if ( $$state[ tb::BLK_FONT_SIZE] > tb::F_HEIGHT) { $f{height} = $$state[ tb::BLK_FONT_SIZE] - tb::F_HEIGHT; } else { $f{size} = $$state[ tb::BLK_FONT_SIZE]; } $f{style} = $$state[ tb::BLK_FONT_STYLE]; $canvas-> set_font( \%f); } return unless $mode & tb::REALIZE_COLORS; if ( $self-> {selectionPaintMode}) { $self-> selection_state( $canvas); } else { $canvas-> set( color => (( $$state[ tb::BLK_COLOR] & tb::COLOR_INDEX) ? ( $self-> {colorMap}-> [$$state[ tb::BLK_COLOR] & tb::COLOR_MASK]) : ( $$state[ tb::BLK_COLOR] & tb::COLOR_MASK)), backColor => (( $$state[ tb::BLK_BACKCOLOR] & tb::COLOR_INDEX) ? ( $self-> {colorMap}-> [$$state[ tb::BLK_BACKCOLOR] & tb::COLOR_MASK]) : ( $$state[ tb::BLK_BACKCOLOR] & tb::COLOR_MASK)), textOpaque => (( $$state[ tb::BLK_BACKCOLOR] == tb::BACKCOLOR_DEFAULT) ? 0 : 1), ); } } sub recalc_ymap { my ( $self, $from) = @_; $self-> {ymap} = [] unless $from; # ok if $from == 0 my $ymap = $self-> {ymap}; my ( $i, $lim) = ( defined($from) ? $from : 0, scalar(@{$self-> {blocks}})); my $b = $self-> {blocks}; for ( ; $i < $lim; $i++) { $_ = $$b[$i]; my $y1 = $$_[ tb::BLK_Y]; my $y2 = $$_[ tb::BLK_HEIGHT] + $y1; for ( int( $y1 / tb::YMAX) .. int ( $y2 / tb::YMAX)) { push @{$ymap-> [$_]}, $i; } } } sub block_wrap { my ( $self, $canvas, $b, $state, $width) = @_; $width = 0 if $width < 0; my ( $i, $lim) = ( tb::BLK_START, scalar @$b); my $cmd; my ( $o, $t) = ( $$b[ tb::BLK_TEXT_OFFSET], $self-> {text}); my ( $x, $y) = (0, 0); my $f_taint; my $wrapmode = 1; my $stsave = $state; $state = [ @$state ]; my ( $haswrapinfo, @wrapret); my ( @ret, $z); my $lastTextOffset = $$b[ tb::BLK_TEXT_OFFSET]; my $has_text; my $newblock = sub { push @ret, $z = tb::block_create(); @$z[ tb::BLK_DATA_START .. tb::BLK_DATA_END ] = @$state[ tb::BLK_DATA_START .. tb::BLK_DATA_END]; $$z[ tb::BLK_X] = $$b[ tb::BLK_X]; $$z[ tb::BLK_FLAGS] &= ~ tb::T_SIZE; $$z[ tb::BLK_TEXT_OFFSET] = $$b [ tb::BLK_TEXT_OFFSET]; $x = 0; undef $has_text; }; my $retrace = sub { $haswrapinfo = 0; splice( @{$ret[-1]}, $wrapret[0]); @$state = @{$wrapret[1]}; $newblock-> (); $i = $wrapret[2]; }; $newblock-> (); $$z[tb::BLK_TEXT_OFFSET] = $$b[tb::BLK_TEXT_OFFSET]; my %state_hash; # print "start - $$b[tb::BLK_TEXT_OFFSET] \n"; # first state - wrap the block # print "new wrap for $width\n"; for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]]) { $cmd = $$b[$i]; if ( $cmd == tb::OP_TEXT) { # print "OP_TEXT @$b[$i+1..$i+3], x = $x\n"; unless ( $f_taint) { $self-> realize_state( $canvas, $state, tb::REALIZE_FONTS); $f_taint = $canvas-> get_font; my $state_key = join('.', @$state[tb::BLK_FONT_ID .. tb::BLK_FONT_STYLE] ); $state_hash{$state_key} = $f_taint unless $state_hash{$state_key}; } my $ofs = $$b[ $i + 1]; my $tlen = $$b[ $i + 2]; $lastTextOffset = $ofs + $tlen unless $wrapmode; REWRAP: my $tw = $canvas-> get_text_width( substr( $$t, $o + $ofs, $tlen), 1); my $apx = $f_taint-> {width}; # print "$x+$apx: new text $tw :|",substr( $$t, $o + $ofs, $tlen),"|\n"; if ( $x + $tw + $apx <= $width) { push @$z, tb::OP_TEXT, $ofs, $tlen, $tw; $x += $tw; $has_text = 1; # print "copied as is, advanced to $x, width $tw, $ofs\n"; } elsif ( $wrapmode) { next if $tlen <= 0; my $str = substr( $$t, $o + $ofs, $tlen); my $leadingSpaces = ''; if ( $str =~ /^(\s+)/) { $leadingSpaces = $1; $str =~ s/^\s+//; } my $l = $canvas-> text_wrap( $str, $width - $apx - $x, tw::ReturnFirstLineLength | tw::WordBreak | tw::BreakSingle); # print "repo $l bytes wrapped in $width - $apx - $x\n"; if ( $l > 0) { if ( $has_text) { push @$z, tb::OP_TEXT, $ofs, $l + length $leadingSpaces, $tw = $canvas-> get_text_width( $leadingSpaces . substr( $str, 0, $l), 1 ); } else { push @$z, tb::OP_TEXT, $ofs + length $leadingSpaces, $l, $tw = $canvas-> get_text_width( substr( $str, 0, $l), 1 ); $has_text = 1; } # print "$x + advance $$z[-1]/$tw|", $leadingSpaces , "+", substr( $str, 0, $l), "|\n"; $str = substr( $str, $l); $l += length $leadingSpaces; $newblock-> (); $ofs += $l; $tlen -= $l; # print "tx shift $l, str=|$str|, x=$x\n"; if ( $str =~ /^(\s+)/) { $ofs += length $1; $tlen -= length $1; $x += $canvas-> get_text_width( $1, 1); $str =~ s/^\s+//; } goto REWRAP if length $str; } else { # does not fit into $width # print "new block: x = $x |$str|\n"; my $ox = $x; $newblock-> (); $ofs += length $leadingSpaces; $tlen -= length $leadingSpaces; if ( length $str) { # well, it cannot be fit into width, # but may be some words can be stripped? goto REWRAP if $ox > 0; if ( $str =~ m/^(\S+)(\s*)/) { $tw = $canvas-> get_text_width( $1, 1); push @$z, tb::OP_TEXT, $ofs, length $1, $tw; $has_text = 1; $x += $tw; $ofs += length($1) + length($2); $tlen -= length($1) + length($2); goto REWRAP; } } push @$z, tb::OP_TEXT, $ofs, length($str), $x += $canvas-> get_text_width( $str, 1); $has_text = 1; } } elsif ( $haswrapinfo) { # unwrappable, and cannot be fit - retrace $retrace-> (); # print "retrace\n"; next; } else { # unwrappable, cannot be fit, no wrap info! - whole new block # print "new empty block - |", substr( $$t,$o + $ofs, $tlen), "|\n"; push @$z, tb::OP_TEXT, $ofs, $tlen, $tw; $newblock-> (); } } elsif ( $cmd == tb::OP_WRAP) { if ( $wrapmode == 1 && $$b[ $i + 1] == 0) { @wrapret = ( scalar @$z, [ @$state ], $i); $haswrapinfo = 1; # print "wrap start record x = $x\n"; } $wrapmode = $$b[ $i + 1]; # print "wrap: $wrapmode\n"; } elsif ( $cmd == tb::OP_FONT) { if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) { $$state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2]; } else { $$state[ $$b[$i + 1]] = $$b[$i + 2]; } $f_taint = undef; push @$z, @$b[ $i .. ( $i + $tb::oplen[ $cmd] - 1)]; } elsif ( $cmd == tb::OP_COLOR) { $$state[ tb::BLK_COLOR + (($$b[ $i + 1] & tb::BACKCOLOR_FLAG) ? 1 : 0)] = $$b[$i + 1]; push @$z, @$b[ $i .. ( $i + $tb::oplen[ $cmd] - 1)]; } elsif ( $cmd == tb::OP_TRANSPOSE) { my @r = @$b[ $i .. $i + 3]; if ( $$b[ $i + tb::X_FLAGS] & tb::X_DIMENSION_FONT_HEIGHT) { unless ( $f_taint) { $self-> realize_state( $canvas, $state, tb::REALIZE_FONTS); $f_taint = $canvas-> get_font; my $state_key = join('.', @$state[tb::BLK_FONT_ID .. tb::BLK_FONT_STYLE] ); $state_hash{$state_key} = $f_taint unless $state_hash{$state_key}; } $r[ tb::X_X] *= $f_taint-> {height}; $r[ tb::X_Y] *= $f_taint-> {height}; $r[ tb::X_FLAGS] &= ~ tb::X_DIMENSION_FONT_HEIGHT; } if ( $$b[ $i + tb::X_FLAGS] & tb::X_DIMENSION_POINT) { $r[ tb::X_X] *= $self-> {resolution}-> [0] / 72; $r[ tb::X_Y] *= $self-> {resolution}-> [1] / 72; $r[ tb::X_FLAGS] &= ~tb::X_DIMENSION_POINT; } # print "advance block $x $r[tb::X_X]\n"; if ( $x + $r[tb::X_X] >= $width) { if ( $wrapmode) { $newblock-> (); } elsif ( $haswrapinfo) { $retrace-> (); next; } } else { $x += $r[ tb::X_X]; } push @$z, @r; } else { push @$z, @$b[ $i .. ( $i + $tb::oplen[ $cmd] - 1)]; } } # remove eventual empty trailing blocks pop @ret while scalar ( @ret) && ( tb::BLK_START == scalar @{$ret[-1]}); # second stage - position the blocks $state = $stsave; $f_taint = undef; my $start; if ( !defined $$b[ tb::BLK_Y]) { # auto position the block if the creator didn't care $start = $$state[ tb::BLK_Y] + $$state[ tb::BLK_HEIGHT]; } else { $start = $$b[ tb::BLK_Y]; } $lastTextOffset = $$b[ tb::BLK_TEXT_OFFSET]; my $lastBlockOffset = $lastTextOffset; for ( @ret) { $b = $_; $$b[ tb::BLK_Y] = $start; ( $x, $y, $i, $lim) = ( 0, 0, tb::BLK_START, scalar @$b); for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]]) { $cmd = $$b[$i]; if ( $cmd == tb::OP_TEXT) { $f_taint = $state_hash{ join('.', @$state[tb::BLK_FONT_ID .. tb::BLK_FONT_STYLE] ) }; $x += $$b[ $i + 3]; $$b[ tb::BLK_WIDTH] = $x if $$b[ tb::BLK_WIDTH ] < $x; $$b[ tb::BLK_APERTURE_Y] = $f_taint-> {descent} - $y if $$b[ tb::BLK_APERTURE_Y] < $f_taint-> {descent} - $y; $$b[ tb::BLK_APERTURE_X] = $f_taint-> {width} - $x if $$b[ tb::BLK_APERTURE_X] < $f_taint-> {width} - $x; my $newY = $y + $f_taint-> {ascent} + $f_taint-> {externalLeading}; $$b[ tb::BLK_HEIGHT] = $newY if $$b[ tb::BLK_HEIGHT] < $newY; # print "OP_TEXT patch $$b[$i+1] => "; $lastTextOffset = $$b[ tb::BLK_TEXT_OFFSET] + $$b[ $i + 1] + $$b[ $i + 2]; $$b[ $i + 1] -= $lastBlockOffset - $$b[ tb::BLK_TEXT_OFFSET]; # print "$$b[$i+1]\n"; } elsif ( $cmd == tb::OP_FONT) { if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) { $$state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2]; } else { $$state[ $$b[$i + 1]] = $$b[$i + 2]; } } elsif ( $cmd == tb::OP_TRANSPOSE) { my ( $newX, $newY) = ( $x + $$b[ $i + tb::X_X], $y + $$b[ $i + tb::X_Y]); $$b[ tb::BLK_WIDTH] = $newX if $$b[ tb::BLK_WIDTH ] < $newX; $$b[ tb::BLK_HEIGHT] = $newY if $$b[ tb::BLK_HEIGHT] < $newY; $$b[ tb::BLK_APERTURE_X] = -$newX if $newX < 0 && $$b[ tb::BLK_APERTURE_X] > -$newX; $$b[ tb::BLK_APERTURE_Y] = -$newY if $newY < 0 && $$b[ tb::BLK_APERTURE_Y] > -$newY; unless ( $$b[ $i + tb::X_FLAGS] & tb::X_EXTEND) { ( $x, $y) = ( $newX, $newY); } } elsif ( $cmd == tb::OP_MARK) { $$b[ $i + 2] = $x; $$b[ $i + 3] = $y; } } $$b[ tb::BLK_TEXT_OFFSET] = $lastBlockOffset; # print "block offset: $lastBlockOffset\n"; $$b[ tb::BLK_HEIGHT] += $$b[ tb::BLK_APERTURE_Y]; $$b[ tb::BLK_WIDTH] += $$b[ tb::BLK_APERTURE_X]; $start += $$b[ tb::BLK_HEIGHT]; $lastBlockOffset = $lastTextOffset; } if ( $ret[-1]) { $b = $ret[-1]; $$state[$_] = $$b[$_] for tb::BLK_X, tb::BLK_Y, tb::BLK_HEIGHT, tb::BLK_WIDTH; } return @ret; } sub selection_state { my ( $self, $canvas) = @_; $canvas-> color( $self-> hiliteColor); $canvas-> backColor( $self-> hiliteBackColor); $canvas-> textOpaque(0); } sub on_paint { my ( $self, $canvas) = @_; my @size = $canvas-> size; unless ( $self-> enabled) { $self-> color( $self-> disabledColor); $self-> backColor( $self-> disabledBackColor); } my ( $t, $offset, @aa) = ( $self-> { topLine}, $self-> { offset}, $self-> get_active_area(1,@size)); my @clipRect = $canvas-> clipRect; $self-> draw_border( $canvas, $self-> backColor, @size); my $bx = $self-> {blocks}; my $lim = scalar @$bx; return unless $lim; my @cy = ( $aa[3] - $clipRect[3], $aa[3] - $clipRect[1]); $cy[0] = 0 if $cy[0] < 0; $cy[1] = $aa[3] - $aa[1] if $cy[1] > $aa[3] - $aa[1]; $cy[$_] += $t for 0,1; $self-> clipRect( $self-> get_active_area( 1, @size)); @clipRect = $self-> clipRect; my $i = 0; my $b; my ( $sx1, $sy1, $sx2, $sy2) = @{$self-> {selection}}; for ( int( $cy[0] / tb::YMAX) .. int( $cy[1] / tb::YMAX)) { next unless $self-> {ymap}-> [$_]; for ( @{$self-> {ymap}-> [$_]}) { my $j = $_; $b = $$bx[$j]; my ( $x, $y) = ( $aa[0] - $offset + $$b[ tb::BLK_X], $aa[3] + $t - $$b[ tb::BLK_Y] - $$b[ tb::BLK_HEIGHT] ); next if $x + $$b[ tb::BLK_WIDTH] < $clipRect[0] || $x > $clipRect[2] || $y + $$b[ tb::BLK_HEIGHT] < $clipRect[1] || $y > $clipRect[3] || $$b[ tb::BLK_WIDTH] == 0 || $$b[ tb::BLK_HEIGHT] == 0; if ( $j == $sy1 || $j == $sy2) { # complex selection case my @cr = @clipRect; my $x1 = $x + $self-> text2xoffset(( $j == $sy1) ? $sx1 : $sx2, $j); my $eq = ( $j == $sy1 ) && ( $j == $sy2 ); $self-> {selectionPaintMode} = ( $eq || $j == $sy1 ) ? 0 : 1; if ( $cr[0] <= $x1 ) { # left upper part $cr[2] = $x1 - 1 if $cr[2] > $x1 - 1; $cr[2] = $aa[2] if $cr[2] > $aa[2]; $cr[2] = $aa[0] if $cr[2] < $aa[0]; if ( $cr[0] <= $cr[2]) { $self-> selection_state( $canvas) if $self-> {selectionPaintMode}; $self-> clipRect( @cr); $self-> block_draw( $canvas, $b, $x, $y); } @cr = @clipRect; } $self-> {selectionPaintMode} = (( $eq || $j == $sy1 ) ? 1 : 0); if ( $cr[2] >= $x1) { # right part $cr[0] = $x1 if $cr[0] < $x1; $cr[0] = $aa[0] if $cr[0] < $aa[0]; $cr[0] = $aa[2] if $cr[0] > $aa[2]; my $x2 = $x + $self-> text2xoffset( $sx2, $j); if ( $eq) { # selection is one block - center part if ( $cr[0] <= $x2) { my $cr2 = $cr[2]; $cr[2] = $x2 - 1 if $cr[2] > $x2 - 1; $cr[2] = $aa[0] if $cr[2] < $aa[0]; $cr[2] = $aa[2] if $cr[2] > $aa[2]; if ( $cr[0] <= $cr[2]) { $self-> selection_state( $canvas) if $self-> {selectionPaintMode}; $self-> clipRect( @cr); $self-> block_draw( $canvas, $b, $x, $y); } @cr = @clipRect; } $cr[0] = $x2 if $cr[0] < $x2; $cr[0] = $aa[0] if $cr[0] < $aa[0]; $cr[0] = $aa[2] if $cr[0] > $aa[2]; } $self-> {selectionPaintMode} = ( $eq || $j == $sy2 ) ? 0 : 1; if ( $cr[0] <= $cr[2]) { $self-> selection_state( $canvas) if $self-> {selectionPaintMode}; $self-> clipRect( @cr); $self-> block_draw( $canvas, $b, $x, $y); } } $self-> {selectionPaintMode} = 0; $self-> clipRect( @clipRect); } elsif ( $j > $sy1 && $j < $sy2) { # simple selection case $self-> {selectionPaintMode} = 1; $self-> selection_state( $canvas); $self-> block_draw( $canvas, $b, $x, $y); $self-> {selectionPaintMode} = 0; } else { $self-> block_draw( $canvas, $b, $x, $y); } } } $self-> {selectionPaintMode} = 0; } sub block_draw { my ( $self, $canvas, $b, $x, $y) = @_; my ( $i, $lim) = ( tb::BLK_START, scalar @$b); my $ret = 1; my $cmd; my ( $t, $o) = ( $self-> {text}, $$b[ tb::BLK_TEXT_OFFSET]); my @state = @$b[ 0 .. tb::BLK_DATA_END ]; my ( $f_taint, $c_taint); $canvas-> clear( $x, $y, $x + $$b[ tb::BLK_WIDTH] - 1, $y + $$b[ tb::BLK_HEIGHT] - 1) if $self-> {selectionPaintMode}; $x += $$b[ tb::BLK_APERTURE_X]; $y += $$b[ tb::BLK_APERTURE_Y]; for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]] ) { $cmd = $$b[$i]; if ( $cmd == tb::OP_TEXT) { if ( $$b[$i + 2] > 0) { unless ( $f_taint) { $self-> realize_state( $canvas, \@state, tb::REALIZE_FONTS); $f_taint = $canvas-> get_font; } unless ( $c_taint) { $self-> realize_state( $canvas, \@state, tb::REALIZE_COLORS); $c_taint = 1; } $ret = $canvas-> text_out( substr( $$t, $o + $$b[$i + 1], $$b[$i + 2]), $x, $y); } $x += $$b[ $i + 3]; } elsif ( $cmd == tb::OP_FONT) { if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) { $state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2]; } else { $state[ $$b[$i + 1]] = $$b[$i + 2]; } $f_taint = undef; } elsif (( $cmd == tb::OP_TRANSPOSE) && !($$b[ $i + tb::X_FLAGS] & tb::X_EXTEND)) { $x += $$b[ $i + tb::X_X]; $y += $$b[ $i + tb::X_Y]; } elsif ( $cmd == tb::OP_CODE) { unless ( $f_taint) { $self-> realize_state( $canvas, \@state, tb::REALIZE_FONTS); $f_taint = $canvas-> get_font; } unless ( $c_taint) { $self-> realize_state( $canvas, \@state, tb::REALIZE_COLORS); $c_taint = 1; } $$b[ $i + 1]-> ( $self, $canvas, $b, \@state, $x, $y, $$b[ $i + 2]); } elsif ( $cmd == tb::OP_COLOR) { $state[ tb::BLK_COLOR + (($$b[ $i + 1] & tb::BACKCOLOR_FLAG) ? 1 : 0)] = $$b[$i + 1]; $c_taint = undef; } } return $ret; } sub xy2info { my ( $self, $x, $y) = @_; my $bx = $self-> {blocks}; my ( $pw, $ph) = $self-> paneSize; $x = 0 if $x < 0; $x = $pw if $x > $pw; return (0,0) if $y < 0 || !scalar(@$bx) ; $x = $pw, $y = $ph if $y > $ph; my ( $b, $bid); my $xhint = 0; # find if there's a block that has $y in its inferior my $ymapix = int( $y / tb::YMAX); if ( $self-> {ymap}-> [ $ymapix]) { my ( $minxdist, $bdist, $bdistid) = ( $self-> {paneWidth} * 2, undef, undef); for ( @{$self-> {ymap}-> [ $ymapix]}) { my $z = $$bx[$_]; if ( $y >= $$z[ tb::BLK_Y] && $y < $$z[ tb::BLK_Y] + $$z[ tb::BLK_HEIGHT]) { if ( $x >= $$z[ tb::BLK_X] && $x < $$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH] ) { $b = $z; $bid = $_; last; } elsif ( abs($$z[ tb::BLK_X] - $x) < $minxdist || abs($$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH] - $x) < $minxdist ) { $minxdist = ( abs( $$z[ tb::BLK_X] - $x) < $minxdist) ? abs( $$z[ tb::BLK_X] - $x) : abs( $$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH] - $x); $bdist = $z; $bdistid = $_; } } } if ( !$b && $bdist) { $b = $bdist; $bid = $bdistid; $xhint = (( $$b[ tb::BLK_X] > $x) ? -1 : 1); } } # if still no block found, find the closest block down unless ( $b) { my $minydist = $self-> {paneHeight} * 2; my $ymax = scalar @{$self-> {ymap}}; while ( $ymapix < $ymax) { if ( $self-> {ymap}-> [ $ymapix]) { for ( @{$self-> {ymap}-> [ $ymapix]}) { my $z = $$bx[$_]; if ( $minydist > $$z[ tb::BLK_Y] - $y && $$z[ tb::BLK_Y] >= $y ) { $minydist = $$z[ tb::BLK_Y] - $y; $b = $z; $bid = $_; } } } last if $b; $ymapix++; } $ymapix = int( $y / tb::YMAX); $xhint = -1; } # if still no block found, assume EOT unless ( $b) { $b = $$bx[-1]; $bid = scalar @{$bx} - 1; $xhint = 1; } if ( $xhint < 0) { # start of line return ( 0, $bid); } elsif ( $xhint > 0) { # end of line if ( $bid < ( scalar @{$bx} - 1)) { return ( $$bx[ $bid + 1]-> [ tb::BLK_TEXT_OFFSET] - $$b[ tb::BLK_TEXT_OFFSET], $bid ); } else { return ( length( ${$self-> {text}}) - $$b[ tb::BLK_TEXT_OFFSET], $bid); } } # find text offset my $bofs = $$b[ tb::BLK_TEXT_OFFSET]; my ( $ofs, $unofs) = (0,0); my $pm = $self-> get_paint_state; $self-> begin_paint_info unless $pm; my $savefont = $self-> get_font; my @state = @$b[ 0 .. tb::BLK_DATA_END ]; my $f_taint; my ( $i, $lim) = ( tb::BLK_START, scalar @$b); my $px = $$b[ tb::BLK_X]; for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]] ) { my $cmd = $$b[$i]; if ( $cmd == tb::OP_TEXT) { my $npx = $px + $$b[$i+3]; if ( $px > $x) { $ofs = $$b[ $i + 1]; undef $unofs; last; } elsif ( $px <= $x && $npx > $x) { unless ( $f_taint) { $self-> realize_state( $self, \@state, tb::REALIZE_FONTS); $f_taint = $self-> get_font; } $ofs = $$b[ $i + 1] + $self-> text_wrap( substr( ${$self-> {text}}, $bofs + $$b[ $i + 1], $$b[ $i + 2] ), $x - $px, tw::ReturnFirstLineLength | tw::BreakSingle ); undef $unofs; last; } $unofs = $$b[ $i + 1] + $$b[ $i + 2]; $px = $npx; } elsif (( $cmd == tb::OP_TRANSPOSE) && !($$b[ $i + tb::X_FLAGS] & tb::X_EXTEND)) { $px += $$b[ $i + tb::X_X]; } elsif ( $cmd == tb::OP_FONT) { if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) { $state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2]; } else { $state[ $$b[$i + 1]] = $$b[$i + 2]; } $f_taint = undef; } } $pm ? $self-> set_font( $savefont) : $self-> end_paint_info; return defined( $unofs) ? $unofs : $ofs, $bid; } sub screen2point { my ( $self, $x, $y, @size) = @_; @size = $self-> size unless @size; my @aa = $self-> get_active_area( 0, @size); $x -= $aa[0]; $y = $aa[3] - $y; $y += $self-> {topLine}; $x += $self-> {offset}; return $x, $y; } sub text2xoffset { my ( $self, $x, $bid) = @_; my $b = $self-> {blocks}-> [$bid]; return 0 unless $b; return 0 if $x <= 0; # XXX my $pm = $self-> get_paint_state; $self-> begin_paint_info unless $pm; my $savefont = $self-> get_font; my @state = @$b[ 0 .. tb::BLK_DATA_END ]; my $f_taint; my ( $i, $lim) = ( tb::BLK_START, scalar @$b); my $px = $$b[tb::BLK_APERTURE_X]; my $bofs = $$b[tb::BLK_TEXT_OFFSET]; for ( ; $i < $lim; $i += $tb::oplen[ $$b[ $i]] ) { my $cmd = $$b[$i]; if ( $cmd == tb::OP_TEXT) { if ( $x >= $$b[$i+1]) { if ( $x < $$b[$i+1] + $$b[$i+2]) { unless ( $f_taint) { $self-> realize_state( $self, \@state, tb::REALIZE_FONTS ); $f_taint = $self-> get_font; } $px += $self-> get_text_width( substr( ${$self-> {text}}, $bofs + $$b[$i+1], $x - $$b[$i+1] ) ); last; } elsif ( $x == $$b[$i+1] + $$b[$i+2]) { $px += $$b[$i+3]; last; } } $px += $$b[$i+3]; } elsif (( $cmd == tb::OP_TRANSPOSE) && !($$b[ $i + tb::X_FLAGS] & tb::X_EXTEND)) { $px += $$b[ $i + tb::X_X]; } elsif ( $cmd == tb::OP_FONT) { if ( $$b[$i + 1] == tb::F_SIZE && $$b[$i + 2] < tb::F_HEIGHT ) { $state[ $$b[$i + 1]] = $self-> {defaultFontSize} + $$b[$i + 2]; } else { $state[ $$b[$i + 1]] = $$b[$i + 2]; } $f_taint = undef; } } $pm ? $self-> set_font( $savefont) : $self-> end_paint_info; return $px; } sub info2text_offset { my ( $self, $ofs, $blk) = @_; if ( $blk >= 0 && $ofs >= 0) { return $self-> {blocks}-> [$blk]-> [tb::BLK_TEXT_OFFSET] + $ofs; } else { return length ${$self-> {text}}; } } sub text_offset2info { my ( $self, $ofs) = @_; my $blk = $self-> text_offset2block( $ofs); return undef unless defined $blk; return $ofs - $self-> {blocks}-> [$blk]-> [ tb::BLK_TEXT_OFFSET], $blk; } sub info2xy { my ( $self, $ofs, $blk) = @_; $blk = $self-> {blocks}-> [$blk]; return undef unless defined $blk; return @$blk[ tb::BLK_X, tb::BLK_Y]; } sub text_offset2block { my ( $self, $ofs) = @_; my $bx = $self-> {blocks}; my $end = length ${$self-> {text}}; my $ret = 0; return undef if $ofs < 0 || $ofs >= $end; my ( $l, $r) = ( 0, scalar @$bx); while ( 1) { my $i = int(( $l + $r) / 2); last if $i == $ret; $ret = $i; my ( $b1, $b2) = ( $$bx[$i], $$bx[$i+1]); last if $ofs == $$b1[ tb::BLK_TEXT_OFFSET]; if ( $ofs > $$b1[ tb::BLK_TEXT_OFFSET]) { if ( $b2) { last if $ofs < $$b2[ tb::BLK_TEXT_OFFSET]; $l = $i; } else { last; } } else { $r = $i; } } return $ret; } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {mouseTransaction}; my @size = $self-> size; my @aa = $self-> get_active_area( 0, @size); return if $x < $aa[0] || $x >= $aa[2] || $y < $aa[1] || $y >= $aa[3]; ( $x, $y) = $self-> screen2point( $x, $y, @size); for my $obj ( @{$self-> {contents}}) { unless ( $obj-> on_mousedown( $self, $btn, $mod, $x, $y)) { $self-> clear_event; return; } } return if $btn != mb::Left; my ( $text_offset, $bid) = $self-> xy2info( $x, $y); $self-> {mouseTransaction} = 1; $self-> {mouseAnchor} = [ $text_offset, $bid ]; $self-> selection( -1, -1, -1, -1); $self-> capture(1); $self-> clear_event; } sub on_mouseclick { my ( $self, $btn, $mod, $x, $y, $dbl) = @_; return unless $dbl; return if $self-> {mouseTransaction}; return if $btn != mb::Left; my @size = $self-> size; my @aa = $self-> get_active_area( 0, @size); if ( $x < $aa[0] || $x >= $aa[2] || $y < $aa[1] || $y >= $aa[3]) { if ( $self-> has_selection) { $self-> selection( -1, -1, -1, -1); my $cp = $::application-> bring('Primary'); $cp-> text( '') if $cp; } return; } ( $x, $y) = $self-> screen2point( $x, $y, @size); my ( $text_offset, $bid) = $self-> xy2info( $x, $y); my $ln = ( $bid + 1 == scalar @{$self-> {blocks}}) ? length ${$self-> {text}} : $self-> {blocks}-> [$bid+1]-> [tb::BLK_TEXT_OFFSET]; $self-> selection( 0, $bid, $ln - $self-> {blocks}-> [$bid]-> [tb::BLK_TEXT_OFFSET], $bid); $self-> clear_event; my $cp = $::application-> bring('Primary'); $cp-> text( $self-> get_selected_text) if $cp; } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; unless ( $self-> {mouseTransaction}) { ( $x, $y) = $self-> screen2point( $x, $y); for my $obj ( @{$self-> {contents}}) { unless ( $obj-> on_mouseup( $self, $btn, $mod, $x, $y)) { $self-> clear_event; return; } } return; } return if $btn != mb::Left; $self-> capture(0); $self-> {mouseTransaction} = undef; $self-> clear_event; my $cp = $::application-> bring('Primary'); $cp-> text( $self-> get_selected_text) if $cp; } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; unless ( $self-> {mouseTransaction}) { ( $x, $y) = $self-> screen2point( $x, $y); for my $obj ( @{$self-> {contents}}) { unless ( $obj-> on_mousemove( $self, $mod, $x, $y)) { $self-> clear_event; return; } } return; } my @size = $self-> size; my @aa = $self-> get_active_area( 0, @size); if ( $x < $aa[0] || $x >= $aa[2] || $y < $aa[1] || $y >= $aa[3]) { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); } else { $self-> scroll_timer_stop; } my ( $nx, $ny) = $self-> screen2point( $x, $y, @size); my ( $text_offset, $bid) = $self-> xy2info( $nx, $ny); $self-> selection( @{$self-> {mouseAnchor}}, $text_offset, $bid); if ( $x < $aa[0] || $x >= $aa[2]) { my $px = $self-> {paneWidth} / 8; $px = 5 if $px < 5; $px *= -1 if $x < $aa[0]; $self-> offset( $self-> {offset} + $px); } if ( $y < $aa[1] || $y >= $aa[3]) { my $py = $self-> font-> height; $py = 5 if $py < 5; $py *= -1 if $y >= $aa[3]; $self-> topLine( $self-> {topLine} + $py); } } sub on_mousewheel { my ( $self, $mod, $x, $y, $z) = @_; $z = int( $z/120) * 3; $z *= $self-> font-> height + $self-> font-> externalLeading unless $mod & km::Ctrl; my $newTop = $self-> {topLine} - $z; $self-> topLine( $newTop > $self-> {paneHeight} ? $self-> {paneHeight} : $newTop); $self-> clear_event; } sub on_keydown { my ( $self, $code, $key, $mod, $repeat) = @_; $mod &= km::Alt|km::Ctrl|km::Shift; return if $mod & km::Alt; if ( grep { $key == $_ } ( kb::Up, kb::Down, kb::Left, kb::Right, kb::Space, kb::PgDn, kb::PgUp, kb::Home, kb::End )) { my ( $dx, $dy) = (0,0); if ( $key == kb::Up || $key == kb::Down) { $dy = $self-> font-> height; $dy = 5 if $dy < 5; $dy *= $repeat; $dy = -$dy if $key == kb::Up; } elsif ( $key == kb::Left || $key == kb::Right) { $dx = $self-> {paneWidth} / 8; $dx = 5 if $dx < 5; $dx *= $repeat; $dx = -$dx if $key == kb::Left; } elsif ( $key == kb::PgUp || $key == kb::PgDn || $key == kb::Space) { my @aa = $self-> get_active_area(0); $dy = ( $aa[3] - $aa[1]) * 0.9; $dy = 5 if $dy < 5; $dy *= $repeat; $dy = -$dy if $key == kb::PgUp; } $dx += $self-> {offset}; $dy += $self-> {topLine}; if ( $key == kb::Home) { $dy = 0; } elsif ( $key == kb::End) { $dy = $self-> {paneHeight}; } $self-> offset( $dx); $self-> topLine( $dy); $self-> clear_event; } if (((( $key == kb::Insert) && ( $mod & km::Ctrl)) || chr($code & 0xff) eq "\cC") && $self-> has_selection) { $self-> copy; $self-> clear_event; } } sub has_selection { return ( grep { $_ != -1 } @{$_[0]-> {selection}} ) ? 1 : 0; } sub selection { return @{$_[0]-> {selection}} unless $#_; my ( $self, $sx1, $sy1, $sx2, $sy2) = @_; $sy1 = 0 if $sy1 < 0; $sy2 = 0 if $sy2 < 0; my $lim = scalar @{$self-> {blocks}} - 1; $sy1 = $lim if $sy1 > $lim; $sy2 = $lim if $sy2 > $lim; my $empty = ! $self-> has_selection; my ( $osx1, $osy1, $osx2, $osy2) = @{$self-> {selection}}; my ( $x1, $y1, $x2, $y2) = (0,0,0,0); unless ( grep { $_ != -1 } $sx1, $sy1, $sx2, $sy2 ) { # new empty selection EMPTY: return if $empty; $y1 = $osy1; $y2 = $osy2; if ( $y1 == $y2) { $x1 = $osx1; $x2 = $osx2; } } else { ( $sy1, $sy2, $sx1, $sx2) = ( $sy2, $sy1, $sx2, $sx1) if $sy2 < $sy1; ( $sx1, $sx2) = ( $sx2, $sx1) if $sy2 == $sy1 && $sx2 < $sx1; ( $sx1, $sx2, $sy1, $sy2) = ( -1, -1, -1, -1), goto EMPTY if $sy1 == $sy2 && $sx1 == $sx2; if ( $empty) { $y1 = $sy1; $y2 = $sy2; if ( $y1 == $y2) { $x1 = $sx1; $x2 = $sx2; } } else { if ( $sy1 == $osy1 && $sx1 == $osx1) { return if $sy2 == $osy2 && $sx2 == $osx2; $y1 = $sy2; $y2 = $osy2; if ( $sy2 == $osy2) { $x1 = $sx2; $x2 = $osx2; } } elsif ( $sy2 == $osy2 && $sx2 == $osx2) { $y1 = $sy1; $y2 = $osy1; if ( $sy1 == $osy1) { $x1 = $sx1; $x2 = $osx1; } } else { $y1 = ( $sy1 < $osy1) ? $sy1 : $osy1; $y2 = ( $sy2 > $osy2) ? $sy2 : $osy2; if ( $sy1 == $sy2 && $osy1 == $osy2 && $sy2 == $osy1) { $x1 = ( $sx1 < $osx1) ? $sx1 : $osx1; $x2 = ( $sx2 > $osx2) ? $sx2 : $osx2; } } ( $y1, $y2, $x1, $x2) = ( $y2, $y1, $x2, $x1) if $y2 < $y1; } } my $bx = $self-> {blocks}; my @clipRect; my @size = $self-> size; my @aa = $self-> get_active_area( 0, @size); if ( $y2 != $y1) { my $b = $$bx[ $y1]; my @a = ( $$b[ tb::BLK_X], $$b[tb::BLK_Y], $$b[ tb::BLK_X], $$b[ tb::BLK_Y]); for ( $y1 .. $y2) { my $z = $$bx[ $_]; my @b = ( $$z[ tb::BLK_X], $$z[tb::BLK_Y], $$z[ tb::BLK_X] + $$z[ tb::BLK_WIDTH], $$z[ tb::BLK_Y] + $$z[ tb::BLK_HEIGHT]); for ( 0, 1) { $a[$_] = $b[$_] if $a[$_] > $b[$_] } for ( 2, 3) { $a[$_] = $b[$_] if $a[$_] < $b[$_] } } $clipRect[0] = $aa[0] - $self-> {offset} + $a[0]; $clipRect[1] = $aa[3] + $self-> {topLine} - $a[1] - 1; $clipRect[2] = $aa[0] - $self-> {offset} + $a[2]; $clipRect[3] = $aa[3] + $self-> {topLine} - $a[3] - 1; } else { my $b = $$bx[ $y1]; ( $x2, $x1) = ( $x1, $x2) if $x1 > $x2; $clipRect[0] = $aa[0] - $self-> {offset} + $$b[ tb::BLK_X] + $self-> text2xoffset( $x1, $y1); $clipRect[1] = $aa[3] - $$b[ tb::BLK_Y] - $$b[ tb::BLK_HEIGHT] + $self-> {topLine} - 1; $clipRect[2] = $aa[0] - $self-> {offset} + $$b[ tb::BLK_X] + $self-> text2xoffset( $x2, $y1); $clipRect[3] = $aa[3] - $$b[ tb::BLK_Y] + $self-> {topLine} - 1; } for ( 0, 1) { @clipRect[$_,$_+2] = @clipRect[$_+2,$_] if $clipRect[$_] > $clipRect[$_+2]; $clipRect[$_] = $aa[$_] if $clipRect[$_] < $aa[$_]; $clipRect[$_+2] = $aa[$_+2] if $clipRect[$_+2] > $aa[$_+2]; } $self-> {selection} = [ $sx1, $sy1, $sx2, $sy2 ]; my @cpr = $self-> get_invalid_rect; if ( $cpr[0] != $cpr[2] || $cpr[1] != $cpr[3]) { for ( 0,1) { $clipRect[$_] = $cpr[$_] if $clipRect[$_] > $cpr[$_]; $clipRect[$_+2] = $cpr[$_+2] if $clipRect[$_+2] < $cpr[$_+2]; } } $self-> invalidate_rect( @clipRect); } sub get_selected_text { my $self = $_[0]; return unless $self-> has_selection; my ( $sx1, $sy1, $sx2, $sy2) = $self-> selection; my ( $a1, $a2) = ( $self-> {blocks}-> [$sy1]-> [tb::BLK_TEXT_OFFSET] + $sx1, $self-> {blocks}-> [$sy2]-> [tb::BLK_TEXT_OFFSET] + $sx2, ); return substr( ${$self-> {text}}, $a1, $a2 - $a1); } sub copy { my $self = $_[0]; my $text = $self-> get_selected_text; $::application-> Clipboard-> store( 'Text', $text) if defined $text; } sub clear_all { my $self = $_[0]; $self-> selection(-1,-1,-1,-1); $self-> {blocks} = []; $self-> paneSize( 0, 0); $self-> text(''); } package Prima::TextView::EventRectangles; sub new { my $class = shift; my %profile = @_; my $self = {}; bless( $self, $class); $self-> {$_} = $profile{$_} ? $profile{$_} : [] for qw( rectangles references); return $self; } sub contains { my ( $self, $x, $y) = @_; my $rec = 0; for ( @{$self-> {rectangles}}) { return $rec if $x >= $$_[0] && $y >= $$_[1] && $x < $$_[2] && $y < $$_[3]; $rec++; } return -1; } sub rectangles { return $_[0]-> {rectangles} unless $#_; $_[0]-> {rectangles} = $_[1]; } sub references { return $_[0]-> {references} unless $#_; $_[0]-> {references} = $_[1]; } 1; __END__ =pod =head1 NAME Prima::TextView - rich text browser widget =head1 DESCRIPTION Prima::TextView accepts blocks of formatted text, and provides basic functionality - scrolling and user selection. The text strings are stored as one large text chunk, available by the C<::text> and C<::textRef> properties. A block of a formatted text is an array with fixed-length header and the following instructions. A special package C provides the block constants and simple functions for text block access. =head2 Capabilities Prima::TextView is mainly the text block functions and helpers. It provides function for wrapping text block, calculating block dimensions, drawing and converting coordinates from (X,Y) to a block position. Prima::TextView is centered around the text functionality, and although any custom graphic of arbitrary complexity can be embedded in a text block, the internal coordinate system is used ( TEXT_OFFSET, BLOCK ), where TEXT_OFFSET is a text offset from the beginning of a block and BLOCK is an index of a block. The functionality does not imply any text layout - this is up to the class descendants, they must provide they own layout policy. The only policy Prima::TextView requires is that blocks' BLK_TEXT_OFFSET field must be strictly increasing, and the block text chunks must not overlap. The text gaps are allowed though. A text block basic drawing function includes change of color, backColor and font, and the painting of text strings. Other types of graphics can be achieved by supplying custom code. =head2 Block header A block's fixed header consists of C integer scalars, each of those is accessible via the corresponding C constant. The constants are separated into two logical groups: BLK_FLAGS BLK_WIDTH BLK_HEIGHT BLK_X BLK_Y BLK_APERTURE_X BLK_APERTURE_Y BLK_TEXT_OFFSET and BLK_FONT_ID BLK_FONT_SIZE BLK_FONT_STYLE BLK_COLOR BLK_BACKCOLOR The second group is enclosed in C - C range, like the whole header is contained in 0 - C range. This is done for the backward compatibility, if the future development changes the length of the header. The first group fields define the text block dimension, aperture position and text offset ( remember, the text is stored as one big chunk ). The second defines the initial color and font settings. Prima::TextView needs all fields of every block to be initialized before displaying. L method can be used for automated assigning of these fields. =head2 Block parameters The scalars, beginning from C, represent the commands to the renderer. These commands have their own parameters, that follow the command. The length of a command is located in C<@oplen> array, and must not be changed. The basic command set includes C, C, C, C, and C. The additional codes are C and C, not used in drawing but are special commands to L. =over =item OP_TEXT - TEXT_OFFSET, TEXT_LENGTH, TEXT_WIDTH C commands to draw a string, from offset C, with a length TEXT_LENGTH. The third parameter TEXT_WIDTH contains the width of the text in pixels. Such the two-part offset scheme is made for simplification or an imaginary code, that would alter ( insert to, or delete part of ) the big text chunk; the updating procedure would not need to traverse all commands, but just the block headers. Relative to: C. =item OP_COLOR - COLOR C sets foreground or background color. To set the background, COLOR must be or-ed with C value. In addition to the two toolkit supported color values ( RRGGBB and system color index ), COLOR can also be or-ed with C flags, in such case it is an index in C<::colormap> property array. Relative to: C, C. =item OP_FONT - KEY, VALUE As the font is a complex property, that itself includes font name, size, direction, etc keys, C KEY represents one of the three parameters - C, C, C. All three have different VALUE meaning. Relative to: C, C, C. =over =item F_STYLE Contains a combination of C constants, such as C, C etc. Default value: 0 =item F_SIZE Contains the relative font size. The size is relative to the current widget's font size. As such, 0 is a default value, and -2 is the widget's default font decreased by 2 points. Prima::TextView provides no range checking ( but the toolkit does ), so while it is o.k. to set the negative C values larger than the default font size, one must be vary when relying on the combined font size value . If C value is added to a C constant, then it is treated as a font height in pixels rather than font size in points. The macros for these opcodes are named respectively C and C, while the opcode is the same. =item F_ID All other font properties are collected under an 'ID'. ID is a index in the C<::fontPalette> property array, which contains font hashes with the other font keys initialized - name, encoding, and pitch. These three are minimal required set, and the other font keys can be also selected. =back =item OP_TRANSPOSE X, Y, FLAGS Contains a mark for an empty space. The space is extended to the relative coordinates (X,Y), so the block extension algorithms take this opcode in the account. If FLAGS does not contain C, then in addition to the block expansion, current coordinate is also moved to (X,Y). In this regard, C<(OP_TRANSPOSE,0,0,0)> and C<(OP_TRANSPOSE,0,0,X_EXTEND)> are identical and are empty operators. There are formatting-only flags,in effect with L function. C indicates that (X,Y) values must be multiplied to the current font height. Another flag C does the same but multiplies by current value of L property divided by 72 ( basically, treats X and Y not as pixel but point values). C can be used for customized graphics, in conjunction with C to assign a space, so the rendering algorithms do not need to be re-written every time the new graphic is invented. As an example, see how L deals with the images. =item OP_CODE - SUB, PARAMETER Contains a custom code pointer SUB with a parameter PARAMETER, passed when a block is about to be drawn. SUB is called with the following format: ( $widget, $canvas, $text_block, $font_and_color_state, $x, $y, $parameter); $font_and_color_state ( or $state, through the code ) contains the state of font and color commands in effect, and is changed as the rendering algorithm advances through a block. The format of the state is the same as of text block, so one may notice that for readability F_ID, F_SIZE, F_STYLE constants are paired to BLK_FONT_ID, BLK_FONT_SIZE and BLK_FONT_STYLE. The SUB code is executed only when the block is about to draw. =item OP_WRAP ON_OFF C is only in effect in L method. ON_OFF is a boolean flag, selecting if the wrapping is turned on or off. L does not support stacking for the wrap commands, so the C<(OP_WRAP,1,OP_WRAP,1,OP_WRAP,0)> has same effect as C<(OP_WRAP,0)>. If ON_OFF is 1, wrapping is disabled - all following commands treated an non-wrapable until C<(OP_WRAP,0)> is met. =item OP_MARK PARAMETER, X, Y C is only in effect in L method and is a user command. L only sets (!) X and Y to the current coordinates when the command is met. Thus, C can be used for arbitrary reasons, easy marking the geometrical positions that undergo the block wrapping. =back As can be noticed, these opcodes are far not enough for the full-weight rich text viewer. However, the new opcodes can be created using C, that accepts the opcode length and returns the new opcode value. =head2 Rendering methods =over =item block_wrap C is the function, that is used to wrap a block into a given width. It returns one or more text blocks with fully assigned headers. The returned blocks are located one below another, providing an illusion that the text itself is wrapped. It does not only traverses the opcodes and sees if the command fit or not in the given width; it also splits the text strings if these do not fit. By default the wrapping can occur either on a command boundary or by the spaces or tab characters in the text strings. The unsolicited wrapping can be prevented by using C command brackets. The commands inside these brackets are not wrapped; C commands are removed from the output blocks. In general, C copies all commands and their parameters as is, ( as it is supposed to do ), but some commands are treated especially: - C's third parameter, C, is disregarded, and is recalculated for every C met. - If C's third parameter, C contains C flag, the command coordinates X and Y are multiplied to the current font height and the flag is cleared in the output block. - C's second and third parameters assigned to the current (X,Y) coordinates. - C removed from the output. =item block_draw CANVAS, BLOCK, X, Y The C draws BLOCK onto CANVAS in screen coordinates (X,Y). It can not only be used for drawing inside begin_paint/end_paint brackets; CANVAS can be an arbitrary C descendant. =back =head2 Coordinate system methods Prima::TextView employs two its own coordinate systems: (X,Y)-document and (TEXT_OFFSET,BLOCK)-block. The document coordinate system is isometric and measured in pixels. Its origin is located into the imaginary point of the beginning of the document ( not of the first block! ), in the upper-left point. X increases to the right, Y increases downwards. The block header values BLK_X and BLK_Y are in document coordinates, and the widget's pane extents ( regulated by C<::paneSize>, C<::paneWidth> and C<::paneHeight> properties ) are also in document coordinates. The block coordinate system in an-isometric - its second axis, BLOCK, is an index of a text block in the widget's blocks storage, C<$self-E{blocks}>, and its first axis, TEXT_OFFSET is a text offset from the beginning of the block. Below described different coordinate system converters =over =item screen2point X, Y Accepts (X,Y) in the screen coordinates ( O is a lower left widget corner ), returns (X,Y) in document coordinates ( O is upper left corner of a document ). =item xy2info X, Y Accepts (X,Y) is document coordinates, returns (TEXT_OFFSET,BLOCK) coordinates, where TEXT_OFFSET is text offset from the beginning of a block ( not related to the big text chunk ) , and BLOCK is an index of a block. =item info2xy TEXT_OFFSET, BLOCK Accepts (TEXT_OFFSET,BLOCK) coordinates, and returns (X,Y) in document coordinates of a block. =item text2xoffset TEXT_OFFSET, BLOCK Returns X coordinate where TEXT_OFFSET begins in a BLOCK index. =item info2text_offset Accepts (TEXT_OFFSET,BLOCK) coordinates and returns the text offset with regard to the big text chunk. =item text_offset2info TEXT_OFFSET Accepts big text offset and returns (TEXT_OFFSET,BLOCK) coordinates =item text_offset2block TEXT_OFFSET Accepts big text offset and returns BLOCK coordinate. =back =head2 Text selection The text selection is performed automatically when the user selects the region with a mouse. The selection is stored in (TEXT_OFFSET,BLOCK) coordinate pair, and is accessible via the C<::selection> property. If its value is assigned to (-1,-1,-1,-1) this indicates that there is no selection. For convenience the C method is introduced. Also, C returns the text within the selection (or undef with no selection ), and C copies automatically the selected text into the clipboard. The latter action is bound to C key combination. =head2 Event rectangles Partly as an option for future development, partly as a hack a concept of 'event rectangles' was introduced. Currently, C<{contents}> private variable points to an array of objects, equipped with C, C, and C methods. These are called within the widget's mouse events, so the overloaded classes can define the interactive content without overloading the actual mouse events ( which is although easy but is dependent on Prima::TextView own mouse reactions ). As an example L uses the event rectangles to catch the mouse events over the document links. Theoretically, every 'content' is to be bound with a separate logical layer; when the concept was designed, a html-browser was in mind, so such layers can be thought as ( in the html world ) links, image maps, layers, external widgets. Currently, C class is provided for such usage. Its property C<::rectangles> contains an array of rectangles, and the C method returns an integer value, whether the passed coordinates are inside one of its rectangles or not; in the first case it is the rectangle index. =cut Prima-1.28/Prima/ExtLists.pm0000644000175100017510000001421711150770061013464 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: ExtLists.pm,v 1.23 2005/10/15 14:02:52 dk Exp $ # contains: # CheckList use strict; use Prima::Const; use Prima::Classes; use Prima::Lists; use Prima::StdBitmap; package Prima::CheckList; use vars qw(@ISA); @ISA = qw(Prima::ListBox); my @images = ( Prima::StdBitmap::image(sbmp::CheckBoxUnchecked), Prima::StdBitmap::image(sbmp::CheckBoxChecked), ); my @imgSize = (0,0); @imgSize = $images[0]-> size if $images[0]; sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( vector => '', ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; $self-> {vector} = 0; my %profile = $self-> SUPER::init(@_); $self-> {fontHeight} = $self-> font-> height; $self-> recalc_icons; $self-> vector( $profile{vector}); return %profile; } sub on_measureitem { my ( $self, $index, $sref) = @_; $$sref = $self-> get_text_width( $self-> {items}-> [$index]) + $imgSize[0] + 4; } sub recalc_icons { return unless $imgSize[0]; my $self = $_[0]; my $hei = $self-> font-> height + 2; $hei = $imgSize[1] + 2 if $hei < $imgSize[1] + 2; $self-> itemHeight( $hei); } sub on_fontchanged { my $self = shift; $self-> recalc_icons; $self-> {fontHeight} = $self-> font-> height; $self-> SUPER::on_fontchanged(@_); } sub draw_items { shift-> std_draw_text_items( @_); } sub draw_text_items { my ( $self, $canvas, $first, $last, $step, $x, $y, $textShift, $clipRect) = @_; my ( $i, $j); for ( $i = $first, $j = 1; $i <= $last; $i += $step, $j++) { next if $self-> {widths}-> [$i] + $self-> {offset} + $x + 1 < $clipRect-> [0]; $canvas-> text_out( $self-> {items}-> [$i], $x + 2 + $imgSize[0], $y + $textShift - $j * $self-> {itemHeight} + 1); $canvas-> put_image( $x + 1, $y + int(( $self-> {itemHeight} - $imgSize[1]) / 2) - $j * $self-> {itemHeight} + 1, $images[ vec($self-> {vector}, $i, 1)], ); } } sub on_mouseclick { my ( $self, $btn, $mod, $x, $y, $dbl) = @_; $self-> SUPER::on_mouseclick( $btn, $mod, $x, $y); return if $btn != mb::Left; my $foc = $self-> focusedItem; return if $foc < 0; my $f = vec( $self-> {vector}, $foc, 1) ? 0 : 1; vec( $self-> {vector}, $foc, 1) = $f; $self-> notify(q(Change), $foc, $f); $self-> invalidate_rect( $self-> item2rect( $foc)); } sub on_click { my $self = $_[0]; my $foc = $self-> focusedItem; return if $foc < 0; my $f = vec( $self-> {vector}, $foc, 1) ? 0 : 1; vec( $self-> {vector}, $foc, 1) = $f; $self-> notify(q(Change), $foc, $f); $self-> invalidate_rect( $self-> item2rect( $foc)); } sub vector { my $self = $_[0]; return $self-> {vector} unless $#_; $self-> {vector} = $_[1]; $self-> repaint; } sub clear_all_buttons { my $self = $_[0]; my $c = int($self-> {count} / 32) + (($self-> {count} % 32) ? 1 : 0); vec( $self-> {vector}, $c, 32) = 0 while $c--; $self-> notify(q(Change), -1, 1); $self-> repaint; }; sub set_all_buttons { my $self = $_[0]; my $c = int($self-> {count} / 32) + (($self-> {count} % 32) ? 1 : 0); vec( $self-> {vector}, $c, 32) = 0xffffffff while $c--; $self-> notify(q(Change), -1, 0); $self-> repaint; }; sub button { my ( $self, $index, $state) = @_; return 0 if $index < 0 || $index >= $self-> {count}; my $current = vec( $self-> {vector}, $index, 1); return $current unless defined $state; $state = ( $state < 0) ? !$current : ( $state ? 1 : 0); return $current if $current == $state; vec( $self-> {vector}, $index, 1) = $state; $self-> notify(q(Change), $index, $state); $self-> redraw_items( $index); return $state; } #sub on_change #{ # my ( $self, $index, $state) = @_; #} 1; __DATA__ =pod =head1 NAME Prima::ExtLists - extended functionality for list boxes =head1 SYNOPSIS use Prima::ExtLists; my $vec = ''; vec( $vec, 0, 8) = 0x55; Prima::CheckList-> new( items => [1..10], vector => $vec, ); =head1 DESCRIPTION The module is intended to be a collection of list boxes with particular enhancements. Currently the only package is contained is C class. =head1 Prima::CheckList Provides a list box, where each item is equipped with a check box. The check box state can interactively be toggled by the enter key; also the list box reacts differently by click and double click. =head2 Properties =over =item button INDEX, STATE Runtime only. Sets INDEXth button STATE to 0 or 1. If STATE is -1, the button state is toggled. Returns the new state of the button. =item vector VEC VEC is a vector scalar, where each bit corresponds to the check state of each list box item. See also: L. =back =head2 Methods =over =item clear_all_buttons Sets all buttons to state 0 =item set_all_buttons Sets all buttons to state 1 =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, F =cut Prima-1.28/Prima/Calendar.pm0000644000175100017510000003657311150770061013427 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: Calendar.pm,v 1.16 2007/05/24 13:57:28 dk Exp $ use strict; use Prima; use Prima::Classes; use Prima::Label; use Prima::ComboBox; use Prima::Sliders; package Prima::Calendar; use vars qw(@ISA @non_locale_months @days_in_months $OB_format); @ISA = qw(Prima::Widget); my $posix_state; my @non_locale_months = qw( January February March April May June July August September October November December); @days_in_months = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); sub profile_default { my @date = (localtime(time))[3,4,5]; return { %{$_[ 0]-> SUPER::profile_default}, scaleChildren => 0, date => \@date, useLocale => 1, day => $date[0], month => $date[1], year => $date[2], firstDayOfWeek => 0, } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> {date} = $default-> {date} unless exists $p-> {date}; $p-> {date}-> [0] = $p-> {day} if exists $p-> {day}; $p-> {date}-> [1] = $p-> {month} if exists $p-> {month}; $p-> {date}-> [2] = $p-> {year} if exists $p-> {year}; $self-> SUPER::profile_check_in( $p, $default); } sub init { my $self = shift; $self-> {$_} = 0 for qw( day month year useLocale firstDayOfWeek); $self-> {date} = [0,0,0]; my %profile = $self-> SUPER::init(@_); $self-> {useLocale} = can_use_locale() if $profile{useLocale}; my $fh = $self-> font-> height; my ( $w, $h) = $self-> size; $self-> reset_days; $self-> insert( ComboBox => origin => [ 5, $h - $fh * 2 - 10 ], size => [ $w - 115, $fh + 4], name => 'Month', items => $self-> make_months, style => cs::DropDownList, growMode => gm::GrowHiX | gm::GrowLoY, delegations => [ 'Change' ], ); $self-> insert( Label => origin => [ 5, $h - $fh - 4], size => [ $w - 115, $fh + 2], text => '~Month', focusLink => $self-> Month, growMode => gm::GrowHiX | gm::GrowLoY, ); $self-> insert( SpinEdit => origin => [ $w - 105, $h - $fh * 2 - 10 ], size => [ 100, $fh + 4], name => 'Year', min => 1900, max => 2099, growMode => gm::GrowLoX | gm::GrowLoY, delegations => [ 'Change' ], ); $self-> insert( Label => origin => [ $w - 105, $h - $fh - 4], size => [ 100, $fh + 2], text => '~Year', focusLink => $self-> Year, growMode => gm::GrowLoX | gm::GrowLoY, ); $self-> insert( Widget => origin => [ 5, 5 ], size => [ $w - 10, $h - $fh * 3 - 22 ], name => 'Day', selectable => 1, current => 1, delegations => [ qw( Paint MouseDown MouseMove MouseUp MouseWheel KeyDown Size FontChanged Enter Leave )], growMode => gm::Client, ); $self-> insert( Label => origin => [ 5, $h - $fh * 3 - 15], size => [ $w - 10, $fh + 2], text => '~Day', focusLink => $self-> Day, growMode => gm::GrowHiX | gm::GrowLoY, ); $self-> $_($profile{$_}) for qw( date useLocale firstDayOfWeek); } sub can_use_locale { return $posix_state if defined $posix_state; undef $@; eval "use POSIX q(strftime);"; return $posix_state = 1 unless $@; return $posix_state = 0; } sub month2str { return $non_locale_months[$_[1]] unless $_[0]-> {useLocale}; return POSIX::strftime ( "%B", 0, 0, 0, 1, $_[1], 0 ); } sub make_months { return \@non_locale_months unless $_[0]-> {useLocale}; unless ( defined $OB_format) { # %OB is a BSD extension for locale-specific date string # for use without date $OB_format = ( POSIX::strftime ( "%OB", 0, 0, 0, 1, 0, 0 ) eq POSIX::strftime ( "%OB", 0, 0, 0, 1, 1, 0 ) ) ? '%B' : '%OB'; } return [ map { POSIX::strftime ( $OB_format, 0, 0, 0, 1, $_, 0 ) } 0 .. 11 ]; } sub day_of_week { my ( $self, $day, $month, $year, $useFirstDayOfWeek) = @_; $month++; $year += 1900; $useFirstDayOfWeek = 1 unless defined $useFirstDayOfWeek; if ( $month < 3) { $month += 10; $year--; } else { $month -= 2; } my $century = int($year / 100); $year %= 100; my $dow = ( int(( 26 * $month - 2) / 10) + $day + $year + int($year / 4) + int($century / 4) - ( 2 * $century) - (( $useFirstDayOfWeek ? 1 : 0) * $self-> {firstDayOfWeek}) + 7) % 7; return ($dow < 0) ? $dow + 7 : $dow; } sub reset_days { my $self = $_[0]; my $dow = $self-> {firstDayOfWeek}; $self-> {days} = $self-> {useLocale} ? [ map { strftime("%a", 0, 0, 0, 1, 0, 0, $_) } 0 .. 6 ] : [ qw( Sun Mon Tue Wed Thu Fri Sat ) ]; push @{$self-> {days}}, splice( @{$self-> {days}}, 0, $dow) if $dow; } sub useLocale { return $_[0]-> {useLocale} unless $#_; my ( $self, $useLocale) = @_; $useLocale = can_use_locale if $useLocale; $self-> {useLocale} = $useLocale; $self-> Month-> items( $self-> make_months); $self-> Month-> text( $self-> Month-> List-> get_item_text( $self-> Month-> focusedItem)); $self-> reset_days; my $day = $self-> Day; $self-> day_reset( $day, $day-> size); $day-> repaint; } sub Day_Paint { my ( $owner, $self, $canvas) = @_; my @sz = $self-> size; $canvas-> set( color => $self-> disabledColor, backColor => $self-> disabledBackColor) unless $self-> enabled; $canvas-> rect3d( 0, 0, $sz[0]-1, $sz[1]-1, 2, $self-> dark3DColor, $self-> light3DColor, $self-> backColor); my @zs = ( $self-> {X}, $self-> {Y}, $self-> {CX1}, $self-> {CY}); my $i; my $c = $canvas-> color; my $b = $canvas-> backColor; $canvas-> color( int((($b & 0xff0000)>>16)*0.8)<<16 | int((($b & 0xff00)>>8)*0.8)<<8 | int((($b & 0xff))*0.8)); $canvas-> bar( 2, $sz[1] - $zs[1] - 3, $sz[0] - 3, $sz[1] - 3); $canvas-> color($c); $canvas-> clipRect( 2, 2, $sz[0] - 3, $sz[1] - 3); for ( $i = 0; $i < 7; $i++) { $canvas-> text_out( $owner-> {days}-> [$i], $i * $zs[0] + $self-> {CX3}, $sz[1]-$zs[1]+$zs[3], ); } my ( $d, $m, $y) = @{$owner-> {date}}; my $dow = $owner-> day_of_week( 1, $m, $y); my $v = $days_in_months[ $m] + (((( $y % 4) == 0) && ( $m == 1)) ? 1 : 0); $y = $sz[1] - $zs[1] * 2 + $zs[3] - 3; $d--; for ( $i = 0; $i < $v; $i++) { if ( $d == $i) { $canvas-> color( cl::Hilite); $canvas-> bar( $dow * $zs[0] + 2, $y - $zs[3], ( 1 + $dow) * $zs[0] - 1, $y - $zs[3] + $zs[1] - 1 ); $canvas-> color( cl::HiliteText); $canvas-> text_out( $i + 1, $dow * $zs[0] + $zs[2], $y); $canvas-> rect_focus( $dow * $zs[0] + 2, $y - $zs[3], ( 1 + $dow) * $zs[0] - 1, $y - $zs[3] + $zs[1] - 1 ) if $self-> focused; $canvas-> color( $c); } else { $canvas-> text_out( $i + 1, $dow * $zs[0] + $zs[2], $y); } $zs[2] = $self-> {CX2} if $i == 8; next unless $dow++ == 6; $y -= $zs[1]; $dow = 0; } } sub Day_KeyDown { my ( $owner, $self, $code, $key, $mod, $repeat) = @_; return unless grep { $key == $_ } ( kb::Left, kb::Right, kb::Down, kb::Up, kb::PgUp, kb::PgDn ); my ( $d, $m, $y) = @{$owner-> {date}}; $d-- if $key == kb::Left; $d++ if $key == kb::Right; $d+=7 if $key == kb::Down; $d-=7 if $key == kb::Up; if ( $key == kb::PgDn) { ( $m == 11) ? ($y++, $m = 0) : $m++; } if ( $key == kb::PgUp) { ( $m == 0) ? ($y--, $m = 11) : $m--; } $self-> clear_event; $owner-> date( $d, $m, $y); } sub Day_MouseDown { my ( $owner, $self, $btn, $mod, $x, $y) = @_; return unless $btn == mb::Left; my ( $day, $month, $year) = @{$owner-> {date}}; my @zs = ( $self-> {X}, $self-> {Y}); my $v = $days_in_months[ $month] + (((( $year % 4) == 0) && ( $month == 1)) ? 1 : 0); my @sz = $self-> size; $day = (int(($sz[1] - $y - 2) / $zs[1]) - 1) * 7 + int(($x - 2) / $zs[0]) - $owner-> day_of_week( 1, $month, $year) + 1; $self-> clear_event; $self-> {mouseTransaction} = 1; return if $day <= 0 || $day > $v; $owner-> date( $day, $month, $year); } sub Day_MouseMove { my ( $owner, $self, $mod, $x, $y) = @_; return unless $self-> {mouseTransaction}; my ( $day, $month, $year) = @{$owner-> {date}}; my @zs = ( $self-> {X}, $self-> {Y}); my $v = $days_in_months[ $month] + (((( $year % 4) == 0) && ( $month == 1)) ? 1 : 0); my @sz = $self-> size; $day = (int(($sz[1] - $y - 2) / $zs[1]) - 1) * 7 + int(($x - 2) / $zs[0]) - $owner-> day_of_week( 1, $month, $year) + 1; $self-> clear_event; return if $day <= 0 || $day > $v; $owner-> date( $day, $month, $year); } sub Day_MouseUp { my ( $owner, $self, $btn, $mod, $x, $y) = @_; return unless $btn == mb::Left && $self-> {mouseTransaction}; delete $self-> {mouseTransaction}; $self-> clear_event; } sub Day_MouseWheel { my ( $self, $widget, $mod, $x, $y, $z) = @_; my ( $day, $month, $year) = @{$self-> {date}}; if ( $z > 0) { if ( --$day < 1) { if ( --$month < 0) { return if --$year < 0; $month = 11; } $day = $days_in_months[$month]; } } elsif ( ++$day > $days_in_months[$month]) { if ( ++$month > 11) { return if ++$year > 199; $month = 0; } $day = 1; } $self-> date( $day, $month, $year); $widget-> clear_event; } sub day_reset { my ( $owner, $self, $x, $y) = @_; $self-> {X} = int(( $x - 4) / 7 ); $self-> {Y} = int(( $y - 4) / 7 ); $self-> begin_paint_info; my ($x1,$x2,$x3) = ( $self-> get_text_width('8'), $self-> get_text_width('28'), $self-> get_text_width( $owner-> {days}-> [0]) ); $y = $self-> font-> height; $self-> end_paint_info; $self-> {X} = $x2 if $self-> {X} < $x2; $self-> {X} = $x3 if $self-> {X} < $x3; $self-> {Y} = $y if $self-> {Y} < $y; $self-> {CX1} = int(( $self-> {X} - $x1 ) / 2) + 4; $self-> {CX2} = int(( $self-> {X} - $x2 ) / 2) + 4; $self-> {CX3} = int(( $self-> {X} - $x3 ) / 2) + 4; $self-> {CY} = int(( $self-> {Y} - $y ) / 2); } sub Day_Size { my ( $owner, $self, $ox, $oy, $x, $y) = @_; $owner-> day_reset( $self, $x, $y); } sub Day_FontChanged { $_[0]-> day_reset( $_[1], $_[1]-> size); } sub Day_Enter { $_[1]-> repaint } sub Day_Leave { $_[1]-> repaint } sub Month_Change { my ( $owner, $self) = @_; $owner-> month( $self-> focusedItem); } sub Year_Change { my ( $owner, $self) = @_; $owner-> year( $self-> value - 1900); } sub date { return @{$_[0]-> {date}} unless $#_; my $self = shift; my ($day, $month, $year) = $#_ ? @_ : @{$_[0]} ; $month = 11 if $month > 11; $month = 0 if $month < 0; $year = 0 if $year < 0; $year = 199 if $year > 199; $day = 1 if $day < 1; my $v = $days_in_months[ $month] + (((( $year % 4) == 0) && ( $month == 1)) ? 1 : 0); $day = $v if $day > $v; my @od = @{$self-> {date}}; return if $day == $od[0] && $month == $od[1] && $year == $od[2]; $self-> {date} = [ $day, $month, $year ]; $self-> Year-> value( $year + 1900); $self-> Month-> focusedItem( $month); $day = $self-> Day; $day-> invalidate_rect( 2, 2, $day-> width - 3, $day-> height - $day-> {Y} - 3); $self-> notify(q(Change)); } sub day { return $_[0]-> {date}-> [0] unless $#_; return if $_[0]-> {date}-> [0] == $_[1]; $_[0]-> date( $_[1], $_[0]-> {date}-> [1],$_[0]-> {date}-> [2]); } sub month { return $_[0]-> {date}-> [1] unless $#_; return if $_[0]-> {date}-> [1] == $_[1]; $_[0]-> date( $_[0]-> {date}-> [0],$_[1],$_[0]-> {date}-> [2]); } sub year { return $_[0]-> {date}-> [2] unless $#_; return if $_[0]-> {date}-> [2] == $_[1]; $_[0]-> date( $_[0]-> {date}-> [0],$_[0]-> {date}-> [1],$_[1]); } sub date_as_string { my $self = shift; my ( $d, $m, $y) = ( @_ ? ( $#_ ? @_ : @{$_[0]}) : @{ $self-> {date}}); $y += 1900; return $self-> month2str( $m) . " $d, $y"; } sub date_from_time { $_[0]-> date( @_[4,5,6]); } sub firstDayOfWeek { return $_[0]-> {firstDayOfWeek} unless $#_; my ( $self, $dow) = @_; $dow %= 7; return if $dow == $self-> {firstDayOfWeek}; $self-> {firstDayOfWeek} = $dow; $self-> reset_days; $self-> Day-> repaint; } 1; __DATA__ =pod =head1 NAME Prima::Calendar - standard calendar widget =head1 SYNOPSIS use Prima::Calendar; my $cal = Prima::Calendar-> create( useLocale => 1, onChange => sub { print $_[0]-> date_as_string, "\n"; }, ); $cal-> date_from_time( localtime ); $cal-> month( 5); =head1 DESCRIPTION Provides interactive selection of date between 1900 and 2099 years. The main property, L, is a three-integer array, day, month, and year, in the format of perl localtime ( see L ) - day can be in range from 1 to 31,month from 0 to 11, year from 0 to 199. =head1 API =head2 Events =over =item Change Called when the L property is changed. =back =head2 Properties =over =item date DAY, MONTH, YEAR Accepts three integers in format of C. DAY can be from 1 to 31, MONTH from 0 to 11, YEAR from 0 to 199. Default value: today's date. =item day INTEGER Selects the day in month. =item firstDayOfWeek INTEGER Selects the first day of week, an integer between 0 and 6, where 0 is Sunday is the first day, 1 is Monday etc. Default value: 0 =item month Selects the month. =item useLocale BOOLEAN If 1, the locale-specific names of months and days of week are used. These are read by calling C. If invocation of POSIX module fails, the property is automatically assigned to 0. If 0, the English names of months and days of week are used. Default value: 1 See also: L =item year Selects the year. =back =head2 Methods =over =item can_use_locale Returns boolean value, whether the locale information can be retrieved by calling C. =item month2str MONTH Returns MONTH name according to L value. =item make_months Returns array of 12 month names according to L value. =item day_of_week DAY, MONTH, YEAR, [ USE_FIRST_DAY_OF_WEEK = 1 ] Returns integer value, from 0 to 6, of the day of week on DAY, MONTH, YEAR date. If boolean USE_FIRST_DAY_OF_WEEK is set, the value of C property is taken into the account, so 0 is a Sunday shifted forward by C days. The switch from Julian to Gregorian calendar is ignored. =item date_as_string [ DAY, MONTH, YEAR ] Returns string representation of date on DAY, MONTH, YEAR according to L property value. =item date_from_time SEC, MIN, HOUR, M_DAY, MONTH, YEAR, ... Copies L from C or C result. This helper method allows the following syntax: $calendar-> date_from_time( localtime( time)); =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, L, L, F. =cut Prima-1.28/Prima/FileDialog.pm0000644000175100017510000013605311150770061013707 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by: # Anton Berezin # Dmitry Karasik # Modifications by: # David Scott # # $Id: FileDialog.pm,v 1.37 2008/10/29 19:40:52 dk Exp $ use strict; use Prima::Classes; use Prima::Buttons; use Prima::Lists; use Prima::Label; use Prima::InputLine; use Prima::ComboBox; use Prima::MsgBox; package Prima::DirectoryListBox; use vars qw(@ISA @images); @ISA = qw(Prima::ListViewer); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, path => '.', openedGlyphs => 1, closedGlyphs => 1, openedIcon => undef, closedIcon => undef, indent => 12, multiSelect => 0, showDotDirs => 1, } } sub init { unless (@images) { my $i = 0; for ( sbmp::SFolderOpened, sbmp::SFolderClosed) { $images[ $i++] = Prima::StdBitmap::icon($_); } } my $self = shift; my %profile = $self-> SUPER::init(@_); for ( qw( maxWidth oneSpaceWidth)) { $self-> {$_} = 0} for ( qw( files filesStat items)) { $self-> {$_} = []; } for ( qw( openedIcon closedIcon openedGlyphs closedGlyphs indent showDotDirs)) { $self-> {$_} = $profile{$_}} $self-> {openedIcon} = $images[0] unless $self-> {openedIcon}; $self-> {closedIcon} = $images[1] unless $self-> {closedIcon}; $self-> {fontHeight} = $self-> font-> height; $self-> recalc_icons; $self-> path( $profile{path}); return %profile; } use constant ROOT => 0; use constant ROOT_ONLY => 1; use constant LEAF => 2; use constant LAST_LEAF => 3; use constant NODE => 4; use constant LAST_NODE => 5; sub on_stringify { my ( $self, $index, $sref) = @_; $$sref = $self-> {items}-> [$index]-> {text}; } sub on_measureitem { my ( $self, $index, $sref) = @_; my $item = $self-> {items}-> [$index]; $$sref = $self-> get_text_width( $item-> {text}) + $self-> {oneSpaceWidth} + ( $self-> {opened} ? ( $self-> {openedIcon} ? $self-> {openedIcon}-> width : 0): ( $self-> {closedIcon} ? $self-> {closedIcon}-> width : 0) ) + 4 + $self-> {indent} * $item-> {indent}; } sub on_fontchanged { my $self = shift; $self-> recalc_icons; $self-> {fontHeight} = $self-> font-> height; $self-> SUPER::on_fontchanged(@_); } sub on_click { my $self = $_[0]; my $items = $self-> {items}; my $foc = $self-> focusedItem; return if $foc < 0; my $newP = ''; my $ind = $items-> [$foc]-> {indent}; for ( @{$items} ) { $newP .= $_-> {text}."/" if $_-> {indent} < $ind; } $newP .= $items-> [$foc]-> {text}; $newP .= '/' unless $newP =~ m/[\/\\]$/; $_[0]-> path( $newP); } sub on_drawitem { my ($self, $canvas, $index, $left, $bottom, $right, $top, $hilite, $focusedItem) = @_; my $item = $self-> {items}-> [$index]; my $text = $item-> {text}; $text =~ s[^\s*][]; # my $clrSave = $self-> color; # my $backColor = $hilite ? $self-> hiliteBackColor : $self-> backColor; # my $color = $hilite ? $self-> hiliteColor : $clrSave; # $canvas-> color( $backColor); # $canvas-> bar( $left, $bottom, $right, $top); my ( $c, $bc); if ( $hilite) { $c = $self-> color; $bc = $self-> backColor; $canvas-> color($self-> hiliteColor); $canvas-> backColor($self-> hiliteBackColor); } $canvas-> clear( $left, $bottom, $right, $top); my $type = $item-> {type}; # $canvas-> color($color); my ($x, $y, $x2); my $indent = $self-> {indent} * $item-> {indent}; my $prevIndent = $indent - $self-> {indent}; my ( $icon, $glyphs) = ( $item-> {opened} ? $self-> {openedIcon} : $self-> {closedIcon}, $item-> {opened} ? $self-> {openedGlyphs} : $self-> {closedGlyphs}, ); my ( $iconWidth, $iconHeight) = $icon ? ( $icon-> width/$glyphs, $icon-> height) : ( 0, 0); if ( $type == ROOT || $type == NODE) { $x = $left + 2 + $indent + $iconWidth / 2; $x = int( $x); $y = ($top + $bottom) / 2; $canvas-> line( $x, $bottom, $x, $y); } if ( $type != ROOT && $type != ROOT_ONLY) { $x = $left + 2 + $prevIndent + $iconWidth / 2; $x = int( $x); $x2 = $left + 2 + $indent + $iconWidth / 2; $x2 = int( $x2); $y = ($top + $bottom) / 2; $canvas-> line( $x, $y, $x2, $y); $canvas-> line( $x, $y, $x, $top); $canvas-> line( $x, $y, $x, $bottom) if $type == LEAF; } $canvas-> put_image_indirect ( $icon, $left + 2 + $indent, int(($top + $bottom - $iconHeight) / 2+0.5), 0, 0, $iconWidth, $iconHeight, $iconWidth, $iconHeight, rop::CopyPut); $canvas-> text_out( $text, $left + 2 + $indent + $self-> {oneSpaceWidth} + $iconWidth, int($top + $bottom - $self-> {fontHeight}) / 2+0.5); $canvas-> rect_focus( $left + $self-> {offset}, $bottom, $right, $top) if $focusedItem; if ( $hilite) { $canvas-> color($c); $canvas-> backColor($bc); } # $canvas-> color($clrSave); } sub recalc_icons { my $self = $_[0]; my $hei = $self-> font-> height + 2; my ( $o, $c) = ( $self-> {openedIcon} ? $self-> {openedIcon}-> height : 0, $self-> {closedIcon} ? $self-> {closedIcon}-> height : 0 ); $hei = $o if $hei < $o; $hei = $c if $hei < $c; $self-> itemHeight( $hei); } sub recalc_items { my ($self, $items) = ($_[0], $_[0]-> {items}); $self-> begin_paint_info; $self-> {oneSpaceWidth} = $self-> get_text_width(' '); my $maxWidth = 0; my @widths = ( $self-> {openedIcon} ? ( $self-> {openedIcon}-> width / $self-> {openedGlyphs}) : 0, $self-> {closedIcon} ? ( $self-> {closedIcon}-> width / $self-> {closedGlyphs}) : 0, ); for ( @$items) { my $width = $self-> get_text_width( $_-> {text}) + $self-> {oneSpaceWidth} + ( $_-> {opened} ? $widths[0] : $widths[1]) + 4 + $self-> {indent} * $_-> {indent}; $maxWidth = $width if $maxWidth < $width; } $self-> end_paint_info; $self-> {maxWidth} = $maxWidth; } sub new_directory { my $self = shift; my $p = $self-> path; my @fs = Prima::Utils::getdir( $p); unless ( scalar @fs) { $self-> path('.'), return unless $p =~ tr{/\\}{} > 1; $self-> {path} =~ s{[/\\][^/\\]+[/\\]?$}{/}; $self-> path('.'), return if $p eq $self-> {path}; $self-> path($self-> {path}); return; } my $oldPointer = $::application-> pointer; $::application-> pointer( cr::Wait); my $i; my @fs1; my @fs2; for ( $i = 0; $i < scalar @fs; $i += 2) { next if !$self-> {showDotDirs} && $fs[$i] =~ /^\./; push( @fs1, $fs[ $i]); if ( $fs[ $i + 1] eq 'lnk') { if ( -f $p.$fs[$i]) { $fs[ $i + 1] = 'reg'; } elsif ( -d _) { $fs[ $i + 1] = 'dir'; } } push( @fs2, $fs[ $i + 1]); } $self-> {files} = \@fs1; $self-> {filesStat} = \@fs2; my @d = sort grep { $_ ne '.' && $_ ne '..' } $self-> files( 'dir'); my $ind = 0; my @ups = split /[\/\\]/, $p; my @lb; my $wasRoot = 0; $ups[0] = '/' if $p =~ /^\//; for ( @ups) { push @lb, { text => $_, opened => 1, type => $wasRoot ? NODE : ROOT, indent => $ind++, }; $wasRoot = 1; } $lb[-1]-> {type} = LAST_LEAF unless scalar @d; $lb[-1]-> {type} = ROOT_ONLY if $#ups == 0 && scalar @d == 0; my $foc = $#ups; for (@d) { push @lb, { text => $_, opened => 0, type => LEAF, indent => $ind, }; } $lb[-1]-> {type} = LAST_LEAF if scalar @d; $self-> items([@lb]); $self-> focusedItem( $foc); $self-> notify( q(Change)); $::application-> pointer( $oldPointer); } sub safe_abs_path { my $p = $_[0]; my $warn; local $SIG{__WARN__} = sub { $warn = "@_"; }; $p = eval { Cwd::abs_path($p) }; $@ .= $warn if defined $warn; return $p; } sub path { return $_[0]-> {path} unless $#_; my $p = $_[1]; $p =~ s{^([^\\\/]*[\\\/][^\\\/]*)[\\\/]$}{$1}; $p .= '/' unless $p =~ m/[\/\\]$/; $p =~ s/^\/\//\//; # cygwin barfs on // paths unless( scalar( stat $p)) { $p = ""; } else { $p = safe_abs_path($p); $p = "." if $@ || !defined $p; $p = "" unless -d $p; $p .= '/' unless $p =~ m/[\/\\]$/; } $_[0]-> {path} = $p; return if defined $_[0]-> {recursivePathCall} && $_[0]-> {recursivePathCall} > 2; $_[0]-> {recursivePathCall}++; $_[0]-> new_directory; $_[0]-> {recursivePathCall}--; } sub files { my ( $fn, $fs) = ( $_[0]-> {files}, $_[0]-> {filesStat}); return wantarray ? @$fn : $fn unless ($#_); my @f; for ( my $i = 0; $i < scalar @$fn; $i++) { push ( @f, $$fn[$i]) if $$fs[$i] eq $_[1]; } return wantarray ? @f : \@f; } sub openedIcon { return $_[0]-> {openedIcon} unless $#_; $_[0]-> {openedIcon} = $_[1]; $_[0]-> recalc_icons; $_[0]-> calibrate; } sub closedIcon { return $_[0]-> {closedIcon} unless $#_; $_[0]-> {closedIcon} = $_[1]; $_[0]-> recalc_icons; $_[0]-> calibrate; } sub openedGlyphs { return $_[0]-> {openedGlyphs} unless $#_; $_[1] = 1 if $_[1] < 1; $_[0]-> {openedGlyphs} = $_[1]; $_[0]-> recalc_icons; $_[0]-> calibrate; } sub closedGlyphs { return $_[0]-> {closedGlyphs} unless $#_; $_[1] = 1 if $_[1] < 1; $_[0]-> {closedGlyphs} = $_[1]; $_[0]-> recalc_icons; $_[0]-> calibrate; } sub indent { return $_[0]-> {indent} unless $#_; $_[1] = 0 if $_[1] < 0; return if $_[0]-> {indent} == $_[1]; $_[0]-> calibrate; } sub showDotDirs { return $_[0]-> {showDotDirs} unless $#_; my ( $self, $show) = @_; $show = ( $show ? 1 : 0); return if $show == $self-> {showDotDirs}; $self-> {showDotDirs} = $show; $self-> new_directory; } package Prima::DriveComboBox::InputLine; use vars qw(@ISA); @ISA = qw(Prima::Widget); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, ownerBackColor => 1, selectable => 1, selectingButtons => 0, } } sub text { return $_[0]-> SUPER::text unless $#_; my ($self,$cap) = @_; $self-> SUPER::text( $cap); $self-> notify(q(Change)); $self-> repaint; } sub borderWidth { return 1} sub selection { return 0, 0; } sub on_paint { my ( $self, $canvas, $combo, $W, $H, $focused) = ($_[0],$_[1],$_[0]-> owner,$_[1]-> size,$_[0]-> focused || $_[0]-> owner-> listVisible); my $back = $focused ? $self-> hiliteBackColor : $self-> backColor; my $fore = $focused ? $self-> hiliteColor : $self-> color; $canvas-> rect3d( 0, 0, $W-1, $H-1, 1, $self-> dark3DColor, $self-> light3DColor, $back); my $icon = $combo-> {icons}[$combo-> focusedItem]; my $adj = 3; if ( $icon) { my ($h, $w) = ($icon-> height, $icon-> width); $canvas-> put_image( 3, ($H - $h)/2, $icon); $adj += $w + 3; } $canvas-> color( $fore); $canvas-> text_out( $self-> text, $adj, ($H - $canvas-> font-> height) / 2); } sub on_mousedown { # this code ( instead of listVisible(!listVisible)) is formed so because # ::InputLine is selectable, and unwilling focus() could easily hide # listBox automatically. Manual focus is also supported by # selectingButtons == 0. my $self = $_[0]; my $lv = $self-> owner-> listVisible; $self-> owner-> listVisible(!$lv); $self-> focus if $lv; $self-> clear_event; } sub on_enter { $_[0]-> repaint; } sub on_leave { $_[0]-> repaint; } sub on_mouseclick { $_[0]-> clear_event; return unless $_[5]; shift-> notify(q(MouseDown), @_); } package Prima::DriveComboBox; use vars qw(@ISA @images); @ISA = qw(Prima::ComboBox); sub profile_default { my %sup = %{$_[ 0]-> SUPER::profile_default}; return { %sup, style => cs::DropDownList, height => $sup{ editHeight}, firstDrive => 'A:', drive => 'C:', editClass => 'Prima::DriveComboBox::InputLine', listClass => 'Prima::ListViewer', editProfile => {}, }; } { my $i = 0; for ( sbmp::DriveFloppy, sbmp::DriveHDD, sbmp::DriveNetwork, sbmp::DriveCDROM, sbmp::DriveMemory, sbmp::DriveUnknown ) { $images[ $i++] = Prima::StdBitmap::icon($_); } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> { style} = cs::DropDownList; $self-> SUPER::profile_check_in( $p, $default); } sub init { my $self = shift; my %profile = @_; $self-> {driveTransaction} = 0; $self-> {firstDrive} = $profile{firstDrive}; $self-> {drives} = [split ' ', Prima::Utils::query_drives_map( $profile{firstDrive})]; $self-> {icons} = []; my $maxhei = $profile{itemHeight}; for ( @{$self-> {drives}}) { my $dt = Prima::Utils::query_drive_type($_) - dt::Floppy; $dt = -1 if $dt < 0; my $ic = $images[ $dt]; push( @{$self-> {icons}}, $ic); $maxhei = $ic-> height if $ic && $ic-> height > $maxhei; } $profile{text} = $profile{drive}; $profile{items} = [@{$self-> {drives}}]; push (@{$profile{editDelegations}}, 'KeyDown'); push (@{$profile{listDelegations}}, qw(DrawItem FontChanged MeasureItem Stringify)); %profile = $self-> SUPER::init(%profile); $self-> {drive} = $self-> text; $self-> {list}-> itemHeight( $maxhei); $self-> drive( $self-> {drive}); return %profile; } sub on_change { my $self = shift; return unless scalar @{$self-> {drives}}; $self-> {driveTransaction} = 1; $self-> drive( $self-> {drives}-> [$self-> List-> focusedItem]); $self-> {driveTransaction} = undef; } sub drive { return $_[0]-> {drive} unless $#_; return if $_[0]-> {drive} eq $_[1]; if ( $_[0]-> {driveTransaction}) { $_[0]-> {drive} = $_[1]; return; } $_[0]-> {driveTransaction} = 1; $_[0]-> text( $_[1]); my $d = $_[0]-> {drive}; $_[0]-> {drive} = $_[0]-> text; $_[0]-> notify( q(Change)) if $d ne $_[0]-> text; $_[0]-> {driveTransaction} = 0; } sub InputLine_KeyDown { my ( $combo, $self, $code, $key) = @_; $combo-> listVisible(1), $self-> clear_event if $key == kb::Down; return if $key != kb::NoKey; $code = uc chr($code) .':'; ($_[0]-> text( $code), $_[0]-> notify( q(Change))) if (scalar grep { $code eq $_ } @{$combo-> {drives}}) && ($code ne $_[0]-> text); $self-> clear_event; } sub List_DrawItem { my ($combo, $me, $canvas, $index, $left, $bottom, $right, $top, $hilite, $focused) = @_; my ( $c, $bc); if ( $hilite) { $c = $me-> color; $bc = $me-> backColor; $me-> color( $me-> hiliteColor); $me-> backColor( $me-> hiliteBackColor); } $canvas-> clear( $left, $bottom, $right, $top); my $text = ${$combo-> {drives}}[$index]; my $icon = ${$combo-> {icons}}[$index]; my $font = $canvas-> font; my $x = $left + 2; my ($h, $w); if ( $icon) { ($h, $w) = ($icon-> height, $icon-> width); $canvas-> put_image( $x, ($top + $bottom - $h) / 2, $icon); $x += $w + 4; } ($h,$w) = ($font-> height, $canvas-> get_text_width( $text)); $canvas-> text_out( $text, $x, ($top + $bottom - $h) / 2); if ( $hilite) { $canvas-> color( $c); $canvas-> backColor( $bc); } } sub List_FontChanged { my ( $combo, $self) = @_; return unless $self-> {autoHeight}; my $maxHei = $self-> font-> height; for ( @{$combo-> {icons}}) { next unless defined $_; $maxHei = $_-> height if $maxHei < $_-> height; } $self-> itemHeight( $maxHei); $self-> autoHeight(1); } sub List_MeasureItem { my ( $combo, $self, $index, $sref) = @_; my $iw = ( $combo-> {icons}-> [$index] ? $combo-> {icons}-> [$index]-> width : 0); $$sref = $self-> get_text_width($combo-> {drives}[$index]) + $iw; $self-> clear_event; } sub List_Stringify { my ( $combo, $self, $index, $sref) = @_; $$sref = $combo-> {drives}[$index]; $self-> clear_event; } sub set_style { $_[0]-> raise_ro('set_style')} package Prima::FileDialog; use Prima::MsgBox; use Cwd; use vars qw( @ISA); @ISA = qw( Prima::Dialog); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, width => 635, height => 410, sizeMin => [380, 280], centered => 1, visible => 0, borderStyle => bs::Sizeable, defaultExt => '', fileName => '', filter => [[ 'All files' => '*']], filterIndex => 0, directory => '.', designScale => [ 8, 20], createPrompt => 0, multiSelect => 0, noReadOnly => 0, noTestFileCreate => 0, overwritePrompt => 1, pathMustExist => 1, fileMustExist => 1, showHelp => 0, sorted => 1, showDotFiles => 0, openMode => 1, system => 0, } } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); unless ( $p-> {sizeMin}) { $p-> {sizeMin}-> [0] = $default-> {sizeMin}-> [0] * $p-> {width} / $default-> {width}; $p-> {sizeMin}-> [1] = $default-> {sizeMin}-> [1] * $p-> {height} / $default-> {height}; } } my $unix = ($^O =~ /cygwin/) || (Prima::Application-> get_system_info-> {apc} == apc::Unix); my $win32 = (Prima::Application-> get_system_info-> {apc} == apc::Win32); my $gtk2 = (Prima::Utils::get_gui == gui::GTK2); sub create { my ( $class, %params) = @_; if ( $params{system} && ( $win32 || $gtk2)) { my $sys = $win32 ? 'win32' : 'gtk2'; if ( $class =~ /^Prima::(Open|Save|File)Dialog$/) { undef $@; eval "use Prima::sys::${sys}::FileDialog"; die $@ if $@; $class =~ s/(Prima)/$1::sys::$sys/; return $class-> create(%params); } } return $class-> SUPER::create(%params); } sub canonize_mask { my $self = shift; my @ary = split ';', $self-> { mask}; for (@ary) { s{^.*[:/\\]([^:\\/]*)$}{$1}; s{([^\w*?])}{\\$1}g; s{\*}{.*}g; s{\?}{.?}g; } $self-> { mask} = "^(${\(join( '|', @ary))})\$"; } sub canon_path { my $p = shift; return Prima::DirectoryListBox::safe_abs_path($p) if -d $p; my $dir = $p; my $fn; if ($dir =~ s{[/\\]([^\\/]+)$}{}) { $fn = $1; } else { $fn = $p; $dir = '.'; } unless ( scalar(stat($dir . (( !$unix && $dir =~ /:$/) ? '/' : '')))) { $dir = ""; } else { $dir = Prima::DirectoryListBox::safe_abs_path($dir); $dir = "." if $@; $dir = "" unless -d $dir; $dir =~ s/(\\|\/)$//; } return "$dir/$fn"; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); my $drives = length( Prima::Utils::query_drives_map); $self-> {hasDrives} = $drives; for ( qw( defaultExt filter directory filterIndex showDotFiles createPrompt fileMustExist noReadOnly noTestFileCreate overwritePrompt pathMustExist showHelp openMode sorted )) { $self-> {$_} = $profile{$_} } @{$self-> {filter}} = [[ '' => '*']] unless scalar @{$self-> {filter}}; my @exts; my @mdts; for ( @{$self-> {filter}}) { push @exts, $$_[0]; push @mdts, $$_[1]; } $self-> { filterIndex} = scalar @exts - 1 if $self-> { filterIndex} >= scalar @exts; $self-> { mask} = $mdts[ $self-> { filterIndex}]; $self-> { mask} = $profile{fileName} if $profile{fileName} =~ /[*?]/; $self-> canonize_mask; $self-> insert( InputLine => name => 'Name', origin => [ 14, 343], size => [ 245, 25], text => $profile{fileName}, maxLen => 32768, delegations => [qw(KeyDown)], growMode => gm::GrowLoY, ); $self-> insert( Label=> origin => [ 14 , 375], size => [ 245, 25], focusLink => $self-> Name, text => '~Filename', growMode => gm::GrowLoY, name => 'NameLabel', ); $self-> insert( ListBox => name => 'Files', origin => [ 14, 85 ], size => [ 245, 243], multiSelect => $profile{ multiSelect}, delegations => [qw(KeyDown SelectItem Click)], growMode => gm::GrowHiY, ); $self-> insert( ComboBox => name => 'Ext', origin => [ 14 , 25], size => [ 245, 25], style => cs::DropDownList, items => [ @exts], text => $exts[ $self-> { filterIndex}], delegations => [qw(Change)], ); $self-> insert( Label=> origin => [ 14, 55], size => [ 245, 25], focusLink => $self-> Ext, text => '~Extensions', name => 'ExtensionsLabel', ); $self-> insert( Label => name => 'Directory', origin => [ 275, 343], size => [ 235, 25], autoWidth => 0, text => $profile{ directory}, delegations => [qw(FontChanged)], growMode => gm::GrowLoY, ); $self-> insert( DirectoryListBox => name => 'Dir', origin => [ 275, $drives ? 85 : 25], size => [ 235, $drives ? 243 : 303], path => $self-> { directory}, delegations=> [qw(Change)], showDotDirs=> $self-> {showDotFiles}, growMode => gm::GrowHiY, ); $self-> insert( DriveComboBox => origin => [ 275, 25], size => [ 235, 25], name => 'Drive', drive => $self-> Dir-> path, delegations=> [qw(Change)], ) if $drives; $self-> insert( Label=> origin => [ 275, 375], size => [ 235, 25], text => 'Di~rectory', focusLink => $self-> Dir, growMode => gm::GrowLoY, name => 'DirectoryLabel', ); $self-> insert( Label => origin => [ 275, 55], size => [ 235, 25], text => '~Drives', focusLink => $self-> Drive, name => 'DriveLabel', ) if $drives; my $button = $self-> insert( Button=> origin => [ 524, 350], size => [ 96, 36], text => $self-> {openMode} ? '~Open' : '~Save', name => 'Open', default => 1, delegations => [qw(Click)], growMode => gm::GrowLoX | gm::GrowLoY, ); $self-> {right_margin} = $self-> width - $button-> left; $self-> insert( Button=> origin => [ 524, 294], name => 'Cancel', text => 'Cancel', size => [ 96, 36], modalResult => mb::Cancel, growMode => gm::GrowLoX | gm::GrowLoY, ); $self-> insert( Button=> origin => [ 524, 224], name => 'Help', text => '~Help', size => [ 96, 36], growMode => gm::GrowLoX | gm::GrowLoY, ) if $self-> {showHelp}; $self-> Name-> current(1); $self-> Name-> select_all; $self-> {curpaths} = {}; if ( $drives) { for ( @{$self-> Drive-> items}) { $self-> {curpaths}-> {lc $_} = $_} $self-> {curpaths}-> {lc $self-> Drive-> drive} = $self-> Dir-> path; $self-> Drive-> {lastDrive} = $self-> Drive-> drive; } return %profile; } sub on_create { my $self = $_[0]; $self-> Dir_Change( $self-> Dir); } sub on_size { my ( $self, $ox, $oy, $x, $y) = @_; my ( $w, $dx, @left, @right); $dx = $self-> Files-> left; $x -= $self-> {right_margin}; $w = ( $x - 3 * $dx ) / 2; $_-> width( $w) for grep { defined } map { $self-> bring($_) } qw(Files Name NameLabel Ext ExtensionsLabel CompletionList); $x = 2 * $dx + $w; $_-> set( left => $x, width => $w) for grep { defined } map { $self-> bring($_) } qw(Directory DirectoryLabel Dir Drive DriveLabel); } sub on_show { my $self = $_[0]; $self-> Dir_Change( $self-> Dir); } sub on_endmodal { $_[0]-> hide_completions; } sub execute { return ($_[0]-> SUPER::execute != mb::Cancel) ? $_[0]-> fileName : ( wantarray ? () : undef); } sub hide_completions { if ( $_[0]-> {completionList}) { $_[0]-> {completionList}-> destroy; delete $_[0]-> {completionList}; } } sub Name_KeyDown { my ( $dlg, $self, $code, $key, $mod) = @_; if (($key == kb::Tab) && !($mod & km::Ctrl)) { $self-> clear_event; my $f = $self-> text; substr( $f, $self-> selStart) = '' if $self-> selStart == $self-> charOffset && $self-> selEnd == length $f; $f =~ s/^\s*//; $f =~ s/\\\s/ /g; $f =~ s/^~/$ENV{HOME}/ if $f =~ m/^~/ && defined $ENV{HOME}; my $relative; $f = $dlg-> Dir-> path . $f, $relative = 1 if ($unix && $f !~ /^\//) || (!$unix && $f !~ /^([a-z]\:|\/)/i); $f =~ s/\\/\//g; my $path = $f; my $rel_path = $relative ? substr($path, length($dlg-> Dir-> path)) : $path; $path =~ s/(^|\/)[^\/]*$/$1/; $rel_path =~ s/(^|\/)[^\/]*$/$1/; my $residue = substr( $f, length $path); if ( -d $path) { my $i; my @fs = Prima::Utils::getdir( $path); my @completions; my $mask = $dlg-> {mask}; for ( $i = 0; $i < scalar @fs; $i += 2) { next if !$dlg-> {showDotFiles} && $fs[$i] =~ /^\./; next if substr( $fs[$i], 0, length $residue) ne $residue; $fs[ $i + 1] = 'dir' if $fs[ $i + 1] eq 'lnk' && -d $path.$fs[$i]; next if $fs[ $i + 1] ne 'dir' && $fs[$i] !~ /$mask/i; push @completions, $fs[$i] . (( $fs[ $i + 1] eq 'dir') ? '/' : ''); } s/\s/\\ /g for @completions; if ( 1 == scalar @completions) { $self-> text( $rel_path . $completions[0]); $i = length( $rel_path) + length( $residue ); $self-> selection( $i, length($rel_path) + length($completions[0])); $self-> charOffset( $i); } elsif ( 1 < scalar @completions) { unless ( $dlg-> {completionList}) { $dlg-> {completionList} = Prima::ListBox-> create( owner => $dlg, width => $self-> width, bottom => $dlg-> Files-> bottom, top => $self-> bottom - 1, left => $self-> left, designScale => undef, name => 'CompletionList', delegations => [qw(SelectItem KeyDown Click)], growMode => gm::GrowHiY, ); $dlg-> {completionMatch} = ''; $dlg-> {completionListIndex} = 0; } if ( $dlg-> {completionMatch} eq $rel_path && defined $completions[$dlg-> {completionListIndex}] && defined $dlg-> {completionList}-> get_items($dlg-> {completionListIndex}) && $dlg-> {completionList}-> get_items($dlg-> {completionListIndex}) eq $completions[$dlg-> {completionListIndex}] ) { $dlg-> {completionList}-> focusedItem($dlg-> {completionListIndex}); $f = $rel_path . $completions[$dlg-> {completionListIndex}]; $self-> text( $f); $i = length( $rel_path) + length( $residue); $self-> selection( $i , length $f); $self-> charOffset( $i); $dlg-> {completionListIndex} = 0 if ++$dlg-> {completionListIndex} >= @completions; } else { $dlg-> {completionListIndex} = 0; } $dlg-> {completionList}-> items( \@completions); $dlg-> {completionList}-> bring_to_front; } elsif ($dlg-> {completionList}) { $dlg-> {completionList}-> items([]); $dlg-> {completionListIndex} = 0; } $dlg-> {completionMatch} = $rel_path; $dlg-> {completionPath} = $path; } } elsif ( $key == kb::Esc && $dlg-> {completionList}) { $dlg-> {completionList}-> destroy; delete $dlg-> {completionList}; $self-> clear_event; my $f = $self-> text; if ( $self-> selStart == $self-> charOffset && $self-> selEnd == length $f) { substr( $f, $self-> selStart) = ''; $self-> text( $f); } } } sub CompletionList_Click { my ( $self, $lst) = @_; $self-> Name_text( $self-> {completionMatch} . $lst-> get_items($lst-> focusedItem)); $self-> hide_completions; $self-> Name-> select; } sub CompletionList_SelectItem { my ( $self, $lst) = @_; my $text = $lst-> get_items($lst-> focusedItem); $self-> Name_text( $self-> {completionMatch} . $text); if ( $self-> {completionPath} eq $self-> Dir-> path) { # simulate Files walk my $f = $self-> Files; my $c = $f-> count; for ( my $i = 0; $i < $c; $i++) { next unless $f-> get_item_text($i) eq $text; $f-> focusedItem( $i); last; } } } sub CompletionList_KeyDown { my ( $dlg, $self, $code, $key, $mod) = @_; if ( $key == kb::Esc) { $self-> clear_event; $dlg-> hide_completions; $dlg-> Name-> select; } elsif ( $key == kb::Enter) { $dlg-> Name_text( $dlg-> {completionMatch} . $self-> get_items($self-> focusedItem)); $self-> clear_event; $dlg-> hide_completions; $dlg-> Name-> select; } } sub Files_KeyDown { my ( $dlg, $self, $code, $key, $mod) = @_; if ( $code == ord("\cR")) { $dlg-> Dir-> path( $dlg-> Dir-> path); $self-> clear_event; } } sub Directory_FontChanged { my ( $self, $dc) = @_; my ( $w, $path) = ( $dc-> width, $self-> Dir-> path); if ( $w < $dc-> get_text_width( $path)) { $path =~ s{(./)}{$1...}; while ( $w < $dc-> get_text_width( $path)) { $path =~ s{(./\.\.\.).}{$1}}; } $dc-> text( $path); } sub Dir_Change { my ( $self, $dir) = @_; my $mask = $self-> {mask}; my @a = grep { /$mask/i; } $dir-> files( 'reg'); @a = grep { !/^\./ } @a unless $self-> {showDotFiles}; @a = sort {uc($a) cmp uc($b)} @a if $self-> {sorted}; $self-> Files-> items([@a]); $self-> Directory_FontChanged( $self-> Directory); } sub Drive_Change { my ( $self, $drive) = @_; my $newDisk = $drive-> text . "/"; until (-d $newDisk) { last if Prima::MsgBox::message_box( $self-> text, "Drive $newDisk is not ready!", mb::Cancel | mb::Retry | mb::Warning) != mb::Retry; } unless (-d $newDisk) { $drive-> drive($drive-> {lastDrive}); $drive-> clear_event; return; } my $path = $self-> Dir-> path; my $drv = lc substr($path,0,2); $self-> {curpaths}-> {$drv} = $path; $self-> Dir-> path( $self-> {curpaths}-> {lc $drive-> text}); if ( lc $drive-> text ne lc substr($self-> Dir-> path,0,2)) { $drive-> drive( $self-> Dir-> path); } $drive-> {lastDrive} = $drive-> drive; } sub Ext_Change { my ( $self, $ext) = @_; my %cont; for ( @{$self-> {filter}}) { $cont{$$_[0]} = $$_[1]; }; $self-> {mask} = $cont{ $ext-> text}; $self-> canonize_mask; $self-> Dir_Change( $self-> Dir); $self-> {filterIndex} = $ext-> List-> focusedItem; } sub Files_SelectItem { my ( $self, $lst) = @_; my @items = $lst-> get_items($lst-> selectedItems); $self-> Name_text( scalar(@items) ? @items : ''); } sub Files_Click { my $self = shift; $self-> Files_SelectItem( @_); $self-> Open_Click( $self-> Open); } sub quoted_split { my @ret; $_ = $_[0]; s/(\\[^\\\s])/\\$1/g; study; { /\G\s+/gc && redo; /\G((?:[^\\\s]|\\.)+)\s*/gc && do { my $z = $1; $z =~ s/\\(.)/$1/g; push(@ret, $z); redo; }; /\G(\\)$/gc && do { push(@ret, $1); redo; }; } return @ret; } sub Name_text { my $text = ''; my $self; for ( @_) { $self = $_, next unless defined $self; my $x = $_; $x =~ s/(\s|\\)/\\$1/g; $text .= $x; $text .= ' '; } chop $text; $self-> Name-> text( $text); } sub Open_Click { my $self = shift; $self-> hide_completions; $_ = $self-> Name-> text; my @files; if ( $self-> multiSelect) { @files = quoted_split( $_); } else { s/\\([\\\s])/$1/g; @files = ($_); } return unless scalar @files; @files = ($files[ 0]) if ( !$self-> multiSelect and scalar @files > 1); (@files = grep {/[*?]/} @files), @files = ($files[ 0]) if /[*?]/; my %uniq; @files = grep { !$uniq{$_}++ } @files; # validating names for ( @files) { s{\\}{/}g; s/^~/$ENV{HOME}/ if m/^~/ && defined $ENV{HOME}; if ( $unix) { $_ = $self-> directory . $_ unless m{^/}; } else { $_ = $self-> directory . $_ unless m{^/|[A-Za-z]:}; $_ .= '/' if !$unix && m/^[A-Za-z]:$/; } my $pwd = cwd; chdir $self-> directory; $_ = canon_path($_); chdir $pwd; } # testing for indirect directory/mask use if ( scalar @files == 1) { # have single directory if ( -d $files[ 0]) { my %cont; for ( @{$self-> {filter}}) { $cont{$$_[0]} = $$_[1]}; $self-> directory( $files[ 0]); $self-> Name-> text(''); $self-> Name-> focus; return; } my ( $dirTo, $fileTo) = ( $files[ 0] =~ m{^(.*[:/\\])([^:\\/]*)$}); $dirTo or $dirTo = ''; $fileTo = $files[ 0] unless $fileTo || $dirTo; # $fileTo =~ s/^\s*(.*)\s*$/$1/; # $dirTo =~ s/^\s*(.*)\s*$/$1/; # have directory with mask if ( $fileTo =~ /[*?]/) { my @masked = grep { /[*?]/ } map { m{([^/\\]*)$} ? $1 : $_ } grep { /[*?]/ } @files; $self-> Name_text( @masked); $self-> {mask} = join( ';', @masked); $self-> canonize_mask; $self-> directory( $dirTo); $self-> Name-> focus; return; } if ( $dirTo =~ /[*?]/) { Prima::MsgBox::message_box( $self-> text, "Invalid path name " . $self-> Name-> text, mb::OK | mb::Error ); $self-> Name-> select_all; $self-> Name-> focus; return; } } if (( 1 == scalar(@files)) && !($files[0] =~ m/\./)) { # check if can authomatically add an extension for ( split(';', $self-> {filter}-> [$self-> {filterIndex}]-> [1])) { next unless m/^[\*\.]*([^;\.\*]+)/; my $f = $files[0] . '.' . $1; $files[0] = $f, last if !$self-> {openMode} || -f $f; } } # possible commands recognized, treating names as files for ( @files) { $_ .= $self-> {defaultExt} if $self-> {openMode} && !m{\.[^/]*$}; if ( -f $_) { if ( !$self-> {openMode} && $self-> {noReadOnly} && !(-w $_)) { Prima::MsgBox::message_box( $self-> text, "File $_ is read only", mb::OK | mb::Error ); $self-> Name-> select_all; $self-> Name-> focus; return; } return if !$self-> {openMode} && $self-> {overwritePrompt} && ( Prima::MsgBox::message_box( $self-> text, "File $_ already exists. Overwrite?", mb::OKCancel|mb::Warning) != mb::OK); } else { my ( $dirTo, $fileTo) = ( m{^(.*[:/\\])([^:\\/]*)$}); $dirTo = '.', $fileTo = $_ unless defined $dirTo; if ( $self-> {openMode} && $self-> {createPrompt}) { return if ( Prima::MsgBox::message_box( $self-> text, "File $_ does not exists. Create?", mb::OKCancel|mb::Information ) != mb::OK); if ( open FILE, ">$_") { close FILE; } else { Prima::MsgBox::message_box( $self-> text, "Cannot create file $_: $!", mb::OK | mb::Error ); $self-> Name-> select_all; $self-> Name-> focus; return; } } if ( $self-> {pathMustExist} and !( -d $dirTo)) { Prima::MsgBox::message_box( $self-> text, "Directory $dirTo does not exist", mb::OK | mb::Error); $self-> Name-> select_all; $self-> Name-> focus; return; } if ( $self-> {fileMustExist} and !( -f $_)) { Prima::MsgBox::message_box( $self-> text, "File $_ does not exist", mb::OK | mb::Error); $self-> Name-> select_all; $self-> Name-> focus; return; } } if ( !$self-> {openMode} && !$self-> {noTestFileCreate}) { if ( open FILE, ">>$_") { close FILE; } else { Prima::MsgBox::message_box( $self-> text, "Cannot create file $_: $!", mb::OK | mb::Error); $self-> Name-> select_all; $self-> Name-> focus; return; } } }; # flags & files processed, ending process $self-> Name_text( @files); $self-> ok; } sub filter { if ( $#_) { my $self = $_[0]; my @filter = @{$_[1]}; @filter = [[ '' => '*']] unless scalar @filter; my @exts; my @mdts; for ( @filter) { push @exts, $$_[0]; push @mdts, $$_[1]; } $self-> { filterIndex} = scalar @exts - 1 if $self-> { filterIndex} >= scalar @exts; $self-> {filter} = \@filter; $self-> { mask} = $mdts[ $self-> { filterIndex}]; $self-> { mask} = '*' unless defined $self-> { mask}; $self-> canonize_mask; $self-> Ext-> items( \@exts); $self-> Ext-> text( $exts[$self-> { filterIndex}]); } else { return @{$_[0]-> {filter}}; } } sub filterIndex { if ( $#_) { return if $_[1] == $_[0]-> Ext-> focusedItem; $_[0]-> Ext-> focusedItem( $_[1]); $_[0]-> Ext-> notify(q(Change)); } else { return $_[0]-> {filterIndex}; } } sub directory { return $_[0]-> Dir-> path unless $#_; $_[0]-> Dir-> path($_[1]); $_[0]-> Drive-> text( $_[0]-> Dir-> path) if $_[0]-> {hasDrives}; } sub fileName { $_[0]-> Name_text($_[1]), return if ($#_); my @s = quoted_split( $_[0]-> Name-> text); return $s[0] unless wantarray; return @s; } sub sorted { return $_[0]-> {sorted} unless $#_; return if $_[0]-> {sorted} == $_[1]; $_[0]-> {sorted} = $_[1]; $_[0]-> Dir_Change( $_[0]-> Dir); } sub reread { $_[0]-> Dir_Change( $_[0]-> Dir); } sub showDotFiles { return $_[0]-> {showDotFiles} unless $#_; my ( $self, $show) = @_; $show = ( $show ? 1 : 0); return if $show == $self-> {showDotFiles}; $self-> {showDotFiles} = $show; $self-> Dir-> showDotDirs($show); $self-> reread; } sub multiSelect { ($#_)? $_[0]-> Files-> multiSelect($_[1]) : return $_[0]-> Files-> multiSelect }; sub createPrompt { ($#_)? $_[0]-> {createPrompt} = ($_[1]) : return $_[0]-> {createPrompt} }; sub noReadOnly { ($#_)? $_[0]-> {noReadOnly} = ($_[1]) : return $_[0]-> {noReadOnly} }; sub noTestFileCreate { ($#_)? $_[0]-> {noTestFileCreate} = ($_[1]) : return $_[0]-> {noTestFileCreate} }; sub overwritePrompt { ($#_)? $_[0]-> {overwritePrompt} = ($_[1]) : return $_[0]-> {overwritePrompt} }; sub pathMustExist { ($#_)? $_[0]-> {pathMustExist} = ($_[1]) : return $_[0]-> {pathMustExist} }; sub fileMustExist { ($#_)? $_[0]-> {fileMustExist} = ($_[1]) : return $_[0]-> {fileMustExist} }; sub defaultExt { ($#_)? $_[0]-> {defaultExt} = ($_[1]) : return $_[0]-> {defaultExt} }; sub showHelp { ($#_)? shift-> raise_ro('showHelp') : return $_[0]-> {showHelp} }; sub openMode { $_[0]-> {openMode} } package Prima::OpenDialog; use vars qw( @ISA); @ISA = qw( Prima::FileDialog); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, text => 'Open file', openMode => 1, } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> { openMode} = 1; $self-> SUPER::profile_check_in( $p, $default); } package Prima::SaveDialog; use vars qw( @ISA); @ISA = qw( Prima::FileDialog); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, text => 'Save file', openMode => 0, fileMustExist => 0, } } sub profile_check_in { my ( $self, $p, $default) = @_; $p-> { openMode} = 0; $self-> SUPER::profile_check_in( $p, $default); } package Prima::ChDirDialog; use vars qw(@ISA); @ISA = qw(Prima::Dialog); sub profile_default { return { %{$_[ 0]-> SUPER::profile_default}, width => 500, height => 236, centered => 1, visible => 0, text => 'Change directory', directory => '', designScale => [7, 16], showHelp => 0, showDotDirs => 0, borderStyle => bs::Sizeable, } } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); my $j; my $drives = length( Prima::Utils::query_drives_map); $self-> {hasDrives} = $drives; for ( qw( showHelp directory showDotDirs)) { $self-> {$_} = $profile{$_} } $self-> insert( DirectoryListBox => origin => [ 10, 40], width => 480, growMode => gm::Client, height => 160, name => 'Dir', current => 1, path => $self-> { directory}, delegations => [qw(KeyDown)], showDotDirs => $self-> {showDotDirs}, ); $self-> insert( Label => name => 'Directory', origin => [ 10, 202], growMode => gm::GrowLoY, autoWidth => 1, autoHeight => 1, text => '~Directory', focusLink => $self-> Dir, ); $self-> insert( DriveComboBox => origin => [ 10, 10], width => 150, name => 'Drive', drive => $self-> Dir-> path, delegations => [qw(Change)], ) if $drives; $self-> insert( Button => origin => [ 200, 3], size => [ 80, 30], text => '~OK', name => 'OK', default => 1, delegations => [qw(Click)], ); $self-> insert( Button=> origin => [ 300, 3], name => 'Cancel', text => 'Cancel', size => [ 80, 30], modalResult => mb::Cancel, ); $self-> insert( Button=> origin => [ 400, 3], name => 'Help', text => '~Help', size => [ 80, 30], ) if $self-> {showHelp}; $self-> {curpaths} = {}; if ( $drives) { for ( @{$self-> Drive-> items}) { $self-> {curpaths}-> {lc $_} = $_} $self-> {curpaths}-> {lc $self-> Drive-> drive} = $self-> Dir-> path; $self-> Drive-> {lastDrive} = $self-> Drive-> drive; } return %profile; } sub Dir_KeyDown { my ( $dlg, $self, $code, $key, $mod) = @_; if ( $code == ord("\cR")) { $dlg-> Dir-> path( $dlg-> Dir-> path); $self-> clear_event; } } sub Drive_Change { my ( $self, $drive) = @_; my $newDisk = $drive-> text . "/"; until (-d $newDisk) { last if Prima::MsgBox::message_box( $self-> text, "Drive $newDisk is not ready!", mb::Cancel | mb::Retry | mb::Warning ) != mb::Retry; } unless (-d $newDisk) { $drive-> drive($drive-> {lastDrive}); $drive-> clear_event; return; } my $path = $self-> Dir-> path; my $drv = lc substr($path,0,2); $self-> {curpaths}-> {$drv} = $path; $self-> Dir-> path( $self-> {curpaths}-> {lc $drive-> text}); if ( lc $drive-> text ne lc substr($self-> Dir-> path,0,2)) { $drive-> drive( $self-> Dir-> path); } $drive-> {lastDrive} = $drive-> drive; } sub OK_Click { my $self = $_[0]; $self-> ok; } sub directory { return $_[0]-> Dir-> path unless $#_; $_[0]-> Dir-> path($_[1]); $_[0]-> Drive-> text( $_[0]-> Dir-> path) if $_[0]-> {hasDrives}; } sub showHelp { ($#_)? shift-> raise_ro('showHelp') : return $_[0]-> {showHelp} }; sub showDotDirs { return $_[0]-> {showDotDirs} unless $#_; my ( $self, $show) = @_; $show = ( $show ? 1 : 0); return if $show == $self-> {showDotDirs}; $self-> {showDotDirs} = $show; $self-> Dir-> showDotDirs($show); } 1; __DATA__ =head1 NAME Prima::FileDialog - File system related widgets and dialogs. =head1 SYNOPSIS # open a file use Prima qw(Application); use Prima::StdDlg; my $open = Prima::OpenDialog-> new( filter => [ ['Perl modules' => '*.pm'], ['All' => '*'] ] ); print $open-> fileName, " is to be opened\n" if $open-> execute; # save a file my $save = Prima::SaveDialog-> new( fileName => $open-> fileName, ); print $save-> fileName, " is to be saved\n" if $save-> execute; # open several files $open-> multiSelect(1); print $open-> fileName, " are to be opened\n" if $open-> execute; =head1 DESCRIPTION The module contains widgets for file and drive selection, and also standard open file, save file, and change directory dialogs. =head1 Prima::DirectoryListBox A directory listing list box. Shows the list of subdirectories and upper directories, hierarchy-mapped, with the folder images and outlines. =head2 Properties =over =item closedGlyphs INTEGER Number of horizontal equal-width images, contained in L property. Default value: 1 =item closedIcon ICON Provides an icon representation for the directories, contained in the current directory. =item indent INTEGER A positive integer number of pixels, used for offset of the hierarchy outline. Default value: 12 =item openedGlyphs INTEGER Number of horizontal equal-width images, contained in L property. Default value: 1 =item openedIcon OBJECT Provides an icon representation for the directories, contained in the directories above the current directory. =item path STRING Runtime-only property. Selects a file system path. =item showDotDirs BOOLEAN Selects if the directories with the first dot character are shown the view. The treatment of the dot-prefixed names as hidden is traditional to unix, and is of doubtful use under win32 and os2. Default value: 1 =back =head2 Methods =over =item files [ FILE_TYPE ] If FILE_TYPE value is not specified, the list of all files in the current directory is returned. If FILE_TYPE is given, only the files of the types are returned. The FILE_TYPE is a string, one of those returned by C ( see L. =back =head1 Prima::DriveComboBox Provides drive selection combo-box for non-unix systems. =head2 Properties =over =item firstDrive DRIVE_LETTER Create-only property. Default value: 'A:' DRIVE_LETTER can be set to other value to start the drive enumeration from. Some OSes can probe eventual diskette drives inside the drive enumeration routines, so it might be reasonable to set DRIVE_LETTER to C string for responsiveness increase. =item drive DRIVE_LETTER Selects the drive letter. Default value: 'C:' =back =head1 Prima::FileDialog Provides a standard file dialog, allowing to navigate by the file system and select one or many files. The class can operate in two modes - 'open' and 'save'; these modes are set by L and L. Some properties behave differently depending on the mode, which is stored in L property. =head2 Properties =over =item createPrompt BOOLEAN If 1, and a file selected is nonexistent, asks the user if the file is to be created. Only actual when L is 1. Default value: 0 =item defaultExt STRING Selects the file extension, appended to the file name typed by the user, if the extension is not given. Default value: '' =item directory STRING Selects the currently selected directory. =item fileMustExist BOOLEAN If 1, ensures that the file typed by the user exists before closing the dialog. Default value: 1 =item fileName STRING, ... For single-file selection, assigns the selected file name, For multiple-file selection, on get-call returns list of the selected files; on set-call, accepts a single string, where the file names are separated by the space character. The eventual space characters must be quoted. =item filter ARRAY Contains array of arrays of string pairs, where each pair describes a file type. The first scalar in the pair is the description of the type; the second is a file mask. Default value: [[ 'All files' => '*']] =item filterIndex INTEGER Selects the index in L array of the currently selected file type. =item multiSelect BOOLEAN Selects whether the user can select several ( 1 ) or one ( 0 ) file. See also: L. =item noReadOnly BOOLEAN If 1, fails to open a file when it is read-only. Default value: 0 Only actual when L is 0. =item noTestFileCreate BOOLEAN If 0, tests if a file selected can be created. Default value: 0 Only actual when L is 0. =item overwritePrompt BOOLEAN If 1, asks the user if the file selected is to be overwrittten. Default value: 1 Only actual when L is 0. =item openMode BOOLEAN Create-only property. Selects whether the dialog operates in 'open' ( 1 ) mode or 'save' ( 0 ) mode. =item pathMustExist BOOLEAN If 1, ensures that the path, types by the user, exists before closing the dialog. Default value: 1 =item showDotFiles BOOLEAN Selects if the directories with the first dot character are shown the files view. Default value: 0 =item showHelp BOOLEAN Create-only property. If 1, 'Help' button is inserted in the dialog. Default value: 1 =item sorted BOOLEAN Selects whether the file list appears sorted by name ( 1 ) or not ( 0 ). Default value : 1 =item system BOOLEAN Create-only property. If set to 1, C returns instance of C system-specific file dialog, if available for the I platform. C knows only how to map C, C, and C classes onto the system-specific file dialog classes; the inherited classes are not affected. =back =head2 Methods =over =item reread Re-reads the currently selected directory. =back =head1 Prima::OpenDialog Descendant of L, tuned for open-dialog functionality. =head1 Prima::SaveDialog Descendant of L, tuned for save-dialog functionality. =head1 Prima::ChDirDialog Provides standard dialog with interactive directory selection. =head2 Properties =over =item directory STRING Selects the directory =item showDotDirs Selects if the directories with the first dot character are shown the view. Default value: 0 =item showHelp Create-only property. If 1, 'Help' button is inserted in the dialog. Default value: 1 =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, F, F. =cut Prima-1.28/Prima/EventHook.pm0000644000175100017510000001525511150770061013612 0ustar dkdk# $Id: EventHook.pm,v 1.6 2006/10/09 22:15:09 dk Exp $ # # Copyright (c) 1997-2004 Dmitry Karasik # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: EventHook.pm,v 1.6 2006/10/09 22:15:09 dk Exp $ use strict; package Prima::EventHook; use vars qw($hook $auto_hook %hooks %groups); $auto_hook = 1; %groups = ( keyboard => [qw(KeyDown KeyUp TranslateAccel)], mouse => [qw(MouseDown MouseUp MouseMove MouseClick MouseEnter MouseLeave MouseWheel)], geometry => [qw(Size Move ZOrderChanged)], objects => [qw(ChangeOwner ChildEnter ChildLeave Create Destroy)], focus => [qw(Leave Enter)], visibility => [qw(Hide Show)], ability => [qw(Enable Disable)], menu => [qw(Menu Popup)], ); sub install { my ( $sub, %rules) = @_; my @params; if ( defined($rules{param})) { @params = ( ref($rules{param}) eq 'ARRAY') ? @{$rules{param}} : $rules{param}; } my @names; if ( defined($rules{event})) { @names = ( ref($rules{event}) eq 'ARRAY') ? @{$rules{event}} : $rules{event}; } else { @names = ('*'); } @names = map { exists($groups{$_}) ? @{$groups{$_}} : $_} @names; my @objects; if ( defined($rules{object})) { @objects = ( ref($rules{object}) eq 'ARRAY') ? @{$rules{object}} : $rules{object}; } else { @objects = (undef); } for (@names) { $hooks{$_} = [] unless $hooks{$_}; my $array = $hooks{$_}; for ( @objects) { push @$array, [$sub, $_, $rules{children}, @params]; } } Prima::Component-> event_hook( $hook = \&hook_proc) if $auto_hook && !$hook; } sub deinstall { my $sub = $_[0]; my $total = 0; for ( keys %hooks) { @{$hooks{$_}} = grep { $$_[0] != $sub } @{$hooks{$_}}; $total += @{$hooks{$_}}; } Prima::Component-> event_hook( $hook = undef) if !$total && $hook && $auto_hook; } sub hook_proc { my ( $object, $event, @params) = @_; for ( '*', $event) { next unless exists $hooks{$_}; for ( @{$hooks{$_}}) { my ( $sub, $sub_object, $sub_children, @sub_params) = @$_; next if defined $sub_object && ( ( $sub_children && $sub_object-> is_owner( $object) == 0) || ( !$sub_children && $sub_object != $object) ); return 0 unless $sub-> ( @sub_params, $object, $event, @params); } } return 1; } 1; __DATA__ =pod =head1 NAME Prima::EventHook - event filtering =head1 SYNOPSIS use Prima::EventHook; sub hook { my ( $my_param, $object, $event, @params) = @_; ... print "Object $object received event $event\n"; ... return 1; } Prima::EventHook::install( \&hook, param => $my_param, object => $my_window, event => [qw(Size Move Destroy)], children => 1 ); Prima::EventHook::deinstall(\&hook); =head1 DESCRIPTION Prima dispatches events by calling notifications registered on one or more objects interested in the events. Also, one event hook can be installed that would receive all events occurred on all objects. C provides multiplex access to the core event hook and introduces set of dispatching rules so the user hook subs receive only a defined subset of events. The filtering criteria are event names and object hierarchy. =head1 API =head2 install SUB, %RULES Installs SUB into hook list using hash of RULES. The SUB is called with variable list of parameters, formed so first passed parameters from C<'param'> key ( see below ), then event source object, then event name, and finally parameters to the event. SUB must return an integer, either 0 or 1, to block or pass the event, respectively. If 1 is returned, other hook subs are called; if 0 is returned, the event is efficiently blocked and no hooks are further called. Rules can contain the following keys: =over =item event Event is either a string, an array of strings, or C value. In the latter case it is equal to C<'*'> string, which selects all events to be passed in the SUB. A string is either name of an event, or one of pre-defined event groups, declared in C<%groups> package hash. The group names are: ability focus geometry keyboard menu mouse objects visibility These contain respective events. See source for detailed description. In case C<'event'> key is an array of strings, each of the strings is also name of either an event or a group. In this case, if C<'*'> string or event duplicate names are present in the list, SUB is called several times which is obviously inefficient. =item object A Prima object, or an array of Prima objects, or undef; the latter case matches all objects. If an object is defined, the SUB is called if event source is same as the object. =item children If 1, SUB is called using same rules as described in C<'object'>, but also if the event source is a child of the object. Thus, selecting C as a filter object and setting C<'children'> to 0 is almost the same as selecting C<$::application>, which is the root of Prima object hierarchy, as filter object with C<'children'> set to 1. Setting together object to C and children to 1 is inefficient. =item param A scalar or array of scalars passed as first parameters to SUB whenever it is called. =back =head2 deinstall SUB Removes the hook sub for the hook list. =head1 NOTES C by default automatically starts and stops Prima event hook mechanism when appropriate. If it is not desired, for example for your own event hook management, set C<$auto_hook> to 0. =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L =cut Prima-1.28/Prima/PS/0000755000175100017510000000000011150770061011664 5ustar dkdkPrima-1.28/Prima/PS/fonts/0000755000175100017510000000000011150770061013015 5ustar dkdkPrima-1.28/Prima/PS/fonts/Palatino-Bold0000644000175100017510000001513211150770061015367 0ustar dkdk('Palatino-Bold' => { name => 'Palatino-Bold', family => 'Palatino', height => 1201, weigth => fw::Bold, style => fs::Bold, pitch => fp::Variable, vector => 1, ascent => 935, descent => 266, maximalWidth => 1153, width => 1153, internalLeading => 215, externalLeading => 70, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 73.29, yDeviceRes => 73.29, size => 1000, encoding => 'Latin1', chardata => { space => [32,150,0,150], exclam => [33,75,187,70], quotedbl => [34,26,429,26], numbersign => [35,4,590,4], dollar => [36,33,533,33], percent => [37,73,921,73], ampersand => [38,62,913,24], quoteright => [39,34,264,34], parenleft => [40,78,288,33], parenright => [41,33,288,78], asterisk => [42,52,426,54], plus => [43,61,605,61], comma => [44,-7,279,27], hyphen => [45,19,361,19], period => [46,56,187,56], slash => [47,-10,377,-10], zero => [48,39,522,38], one => [49,42,504,54], two => [50,30,536,33], three => [51,26,523,50], four => [52,14,553,32], five => [53,50,516,33], six => [54,44,518,37], seven => [55,55,536,8], eight => [56,40,520,39], nine => [57,37,518,44], colon => [58,56,187,56], semicolon => [59,-7,279,27], less => [60,58,611,57], equal => [61,61,605,61], greater => [62,58,611,57], question => [63,51,441,39], at => [64,50,795,51], A => [65,28,880,25], B => [66,46,686,67], C => [67,52,781,32], D => [68,42,901,56], E => [69,46,646,40], F => [70,33,613,20], G => [71,56,875,68], H => [72,43,912,44], I => [73,46,373,46], J => [74,-13,433,46], K => [75,46,869,18], L => [76,46,646,40], M => [77,38,1124,38], N => [78,42,916,42], O => [79,56,888,55], P => [80,46,666,20], Q => [81,56,888,55], R => [82,46,803,16], S => [83,68,602,62], T => [84,20,760,20], U => [85,31,881,21], V => [86,24,892,18], W => [87,20,1166,14], X => [88,20,760,20], Y => [89,18,774,8], Z => [90,28,724,48], bracketleft => [91,87,261,50], backslash => [92,86,554,86], bracketright => [93,50,261,87], asciicircum => [94,62,602,62], underscore => [95,0,600,0], quoteleft => [96,34,264,34], a => [97,48,526,26], b => [98,12,655,66], c => [99,44,452,36], d => [100,50,642,40], e => [101,50,503,46], f => [102,40,416,9], g => [103,31,611,25], h => [104,28,676,28], i => [105,40,317,42], j => [106,3,285,110], k => [107,25,691,16], l => [108,28,326,44], m => [109,28,1008,30], n => [110,28,676,28], o => [111,48,572,46], p => [112,34,646,52], q => [113,62,644,26], r => [114,36,431,0], s => [115,46,439,46], t => [116,26,362,10], u => [117,30,670,33], v => [118,13,641,13], w => [119,15,969,15], x => [120,24,556,20], y => [121,12,643,12], z => [122,19,538,43], braceleft => [123,6,339,26], bar => [124,312,103,312], braceright => [125,26,339,6], asciitilde => [126,61,605,61], exclamdown => [161,70,187,75], cent => [162,87,452,60], sterling => [163,-2,604,-1], fraction => [164,-182,566,-183], yen => [165,20,559,20], florin => [166,13,575,12], section => [167,36,529,34], currency => [168,38,523,38], quotesingle => [169,54,163,55], quotedblleft => [170,40,518,40], guillemotleft => [171,43,512,44], guilsinglleft => [172,98,270,98], guilsinglright => [173,98,270,98], fi => [174,12,702,19], fl => [175,20,691,21], endash => [177,0,600,0], dagger => [178,34,532,33], daggerdbl => [179,38,523,38], periodcentered => [180,56,187,56], paragraph => [182,22,696,50], bullet => [183,157,413,157], quotesinglbase => [184,67,264,68], quotedblbase => [185,40,518,40], quotedblright => [186,40,518,40], guillemotright => [187,44,512,43], ellipsis => [188,106,987,106], perthousand => [189,39,1139,21], questiondown => [191,39,441,51], grave => [193,21,285,92], acute => [194,93,285,20], circumflex => [195,-2,404,-2], tilde => [196,-19,438,-19], macron => [197,1,397,1], breve => [198,18,363,18], dotaccent => [199,120,160,118], dieresis => [200,-9,419,-9], ring => [202,80,240,79], cedilla => [203,87,272,39], hungarumlaut => [205,-67,535,-68], ogonek => [206,72,257,70], caron => [207,-2,404,-2], emdash => [208,0,1201,0], AE => [225,14,1131,55], ordfeminine => [227,92,341,92], Lslash => [232,19,673,40], Oslash => [233,38,931,30], OE => [234,51,1131,18], ordmasculine => [235,106,372,106], ae => [241,55,822,56], dotlessi => [245,40,317,42], lslash => [248,-4,405,-1], oslash => [249,27,613,26], oe => [250,57,901,40], germandbls => [251,36,642,55], Yacute => [-1,18,774,8], Ucircumflex => [-1,31,881,21], Ugrave => [-1,31,881,21], Zcaron => [-1,28,724,48], Ydieresis => [-1,18,774,8], threesuperior => [-1,10,323,26], Uacute => [-1,31,881,21], twosuperior => [-1,14,330,15], Udieresis => [-1,31,881,21], middot => [-1,56,187,56], onesuperior => [-1,21,311,27], aacute => [-1,48,526,26], agrave => [-1,48,526,26], acircumflex => [-1,48,526,26], Scaron => [-1,68,602,62], Otilde => [-1,56,888,55], sfthyphen => [-1,19,361,19], atilde => [-1,48,526,26], aring => [-1,48,526,26], adieresis => [-1,48,526,26], Ograve => [-1,56,888,55], Ocircumflex => [-1,56,888,55], Odieresis => [-1,56,888,55], Ntilde => [-1,42,916,42], edieresis => [-1,50,503,46], eacute => [-1,50,503,46], egrave => [-1,50,503,46], Icircumflex => [-1,31,404,31], ecircumflex => [-1,50,503,46], Igrave => [-1,46,373,46], Iacute => [-1,46,373,46], Idieresis => [-1,24,419,24], degree => [-1,60,360,60], Ecircumflex => [-1,46,646,40], minus => [-1,61,605,61], multiply => [-1,86,554,86], divide => [-1,61,605,61], Egrave => [-1,46,646,40], trademark => [-1,45,1108,44], Oacute => [-1,56,888,55], thorn => [-1,20,655,57], eth => [-1,48,572,46], Eacute => [-1,46,646,40], ccedilla => [-1,44,452,36], idieresis => [-1,-9,419,-9], iacute => [-1,40,338,20], igrave => [-1,21,336,42], plusminus => [-1,61,605,61], onehalf => [-1,10,883,6], onequarter => [-1,22,859,18], threequarters => [-1,18,864,18], icircumflex => [-1,-2,404,-2], Edieresis => [-1,46,646,40], ntilde => [-1,28,676,28], Aring => [-1,28,880,25], odieresis => [-1,48,572,46], oacute => [-1,48,572,46], ograve => [-1,48,572,46], ocircumflex => [-1,48,572,46], otilde => [-1,48,572,46], scaron => [-1,46,439,46], udieresis => [-1,30,670,33], uacute => [-1,30,670,33], ugrave => [-1,30,670,33], ucircumflex => [-1,30,670,33], yacute => [-1,12,643,12], zcaron => [-1,19,538,43], ydieresis => [-1,12,643,12], copyright => [-1,31,833,32], registered => [-1,31,833,32], Atilde => [-1,28,880,25], nbspace => [-1,150,0,150], Ccedilla => [-1,52,781,32], Acircumflex => [-1,28,880,25], Agrave => [-1,28,880,25], logicalnot => [-1,61,605,61], Aacute => [-1,28,880,25], Eth => [-1,12,931,56], brokenbar => [-1,312,103,312], Thorn => [-1,46,642,44], Adieresis => [-1,28,880,25], mu => [-1,30,670,33], '.notdef' => [-1,150,0,150], }} ); Prima-1.28/Prima/PS/fonts/Courier-Oblique0000644000175100017510000001547011150770061015755 0ustar dkdk('Courier-Oblique' => { name => 'Courier-Oblique', family => 'Courier', height => 1027, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 811, descent => 216, maximalWidth => 772, width => 772, internalLeading => 207, externalLeading => 68, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 88.13, yDeviceRes => 88.13, size => 1000, encoding => 'Latin1', chardata => { space => [32,327,0,288], exclam => [33,252,222,140], quotedbl => [34,260,336,18], numbersign => [35,140,464,11], dollar => [36,134,463,18], percent => [37,140,466,9], ampersand => [38,135,405,74], quoteright => [39,212,268,135], parenleft => [40,344,254,17], parenright => [41,127,254,234], asterisk => [42,216,385,14], plus => [43,134,469,12], comma => [44,112,268,235], hyphen => [45,134,469,12], period => [46,241,155,219], slash => [47,101,540,-25], zero => [48,160,426,29], one => [49,120,385,110], two => [50,86,501,28], three => [51,112,481,21], four => [52,144,414,56], five => [53,116,483,16], six => [54,188,459,-31], seven => [55,220,401,-6], eight => [56,146,444,24], nine => [57,145,459,11], colon => [58,241,220,154], semicolon => [59,117,320,178], less => [60,134,509,-27], equal => [61,97,544,-25], greater => [62,94,509,12], question => [63,237,359,19], at => [64,142,433,40], A => [65,13,598,4], B => [66,48,558,9], C => [67,112,539,-35], D => [68,48,559,8], E => [69,48,587,-19], F => [70,48,609,-41], G => [71,110,542,-36], H => [72,58,604,-47], I => [73,120,499,-3], J => [74,102,615,-101], K => [75,48,631,-63], L => [76,68,531,15], M => [77,15,703,-102], N => [78,47,649,-80], O => [79,104,527,-16], P => [80,48,554,13], Q => [81,104,527,-16], R => [82,48,561,6], S => [83,98,519,-2], T => [84,156,509,-49], U => [85,139,554,-78], V => [86,127,598,-109], W => [87,125,589,-98], X => [88,45,634,-63], Y => [89,157,525,-66], Z => [90,105,500,10], bracketleft => [91,260,324,30], backslash => [92,256,230,129], bracketright => [93,135,324,156], asciicircum => [94,197,385,33], underscore => [95,-62,641,36], quoteleft => [96,398,160,57], a => [97,95,465,55], b => [98,26,580,9], c => [99,125,486,4], d => [100,104,542,-30], e => [101,106,478,30], f => [102,111,568,-64], g => [103,107,556,-48], h => [104,56,514,45], i => [105,98,428,89], j => [106,115,446,54], k => [107,68,524,22], l => [108,98,428,89], m => [109,15,603,-3], n => [110,58,502,55], o => [111,113,478,23], p => [112,-13,622,7], q => [113,107,578,-69], r => [114,90,545,-19], s => [115,110,462,43], t => [116,130,401,84], u => [117,130,453,31], v => [118,117,555,-56], w => [119,117,555,-56], x => [120,56,571,-11], y => [121,22,628,-34], z => [122,118,460,37], braceleft => [123,254,287,73], bar => [124,263,192,160], braceright => [125,179,287,148], asciitilde => [126,148,441,25], exclamdown => [161,227,222,165], cent => [162,179,398,37], sterling => [163,92,463,60], fraction => [164,86,576,-46], yen => [165,165,517,-66], florin => [166,75,584,-44], section => [167,93,547,-24], currency => [168,130,482,3], quotesingle => [169,353,151,110], quotedblleft => [170,226,374,14], guillemotleft => [171,110,531,-26], guilsinglleft => [172,110,296,208], guilsinglright => [173,305,295,15], fi => [174,14,617,-15], fl => [175,14,613,-11], endash => [177,134,469,12], dagger => [178,213,362,40], daggerdbl => [179,158,417,40], periodcentered => [180,292,155,168], paragraph => [182,156,509,-49], bullet => [183,259,201,155], quotesinglbase => [184,112,268,235], quotedblbase => [185,74,477,63], quotedblright => [186,174,477,-35], guillemotright => [187,68,531,15], ellipsis => [188,58,512,45], perthousand => [189,93,520,2], questiondown => [191,107,359,148], grave => [193,293,146,175], acute => [194,398,194,23], circumflex => [195,270,298,47], tilde => [196,264,329,21], macron => [197,280,298,36], breve => [198,288,299,27], dotaccent => [199,377,103,134], dieresis => [200,264,330,20], ring => [202,334,195,86], cedilla => [203,185,179,250], hungarumlaut => [205,270,321,24], ogonek => [206,264,154,197], caron => [207,293,298,23], emdash => [208,61,615,-60], AE => [225,14,694,-92], ordfeminine => [227,235,289,91], Lslash => [232,67,534,14], Oslash => [233,34,668,-87], OE => [234,63,644,-92], ordmasculine => [235,249,308,58], ae => [241,36,610,-30], dotlessi => [245,98,428,89], lslash => [248,98,439,78], oslash => [249,48,605,-37], oe => [250,51,595,-30], germandbls => [251,48,505,62], Yacute => [-1,157,525,-66], Ucircumflex => [-1,139,554,-78], Ugrave => [-1,139,554,-78], Zcaron => [-1,105,515,-5], Ydieresis => [-1,157,525,-66], threesuperior => [-1,251,278,86], Uacute => [-1,139,554,-78], twosuperior => [-1,236,291,88], Udieresis => [-1,139,554,-78], middot => [-1,292,155,168], onesuperior => [-1,255,225,134], aacute => [-1,95,465,55], agrave => [-1,95,465,55], acircumflex => [-1,95,465,55], Scaron => [-1,98,536,-18], Otilde => [-1,105,528,-18], sfthyphen => [-1,134,469,12], atilde => [-1,95,489,30], aring => [-1,95,465,55], adieresis => [-1,95,489,30], Ograve => [-1,104,527,-16], Ocircumflex => [-1,104,527,-16], Odieresis => [-1,104,527,-16], Ntilde => [-1,47,649,-80], edieresis => [-1,106,493,15], eacute => [-1,106,478,30], egrave => [-1,106,478,30], Icircumflex => [-1,120,499,-3], ecircumflex => [-1,106,478,30], Igrave => [-1,120,499,-3], Iacute => [-1,120,499,-3], Idieresis => [-1,120,507,-11], degree => [-1,263,303,48], Ecircumflex => [-1,48,587,-19], minus => [-1,134,469,12], multiply => [-1,146,445,23], divide => [-1,134,469,12], Egrave => [-1,48,587,-19], trademark => [-1,92,636,-112], Oacute => [-1,104,527,-16], thorn => [-1,-13,622,7], eth => [-1,113,483,18], Eacute => [-1,48,587,-19], ccedilla => [-1,125,486,4], idieresis => [-1,98,483,33], iacute => [-1,98,450,66], igrave => [-1,98,428,89], plusminus => [-1,78,535,3], onehalf => [-1,84,559,-27], onequarter => [-1,75,559,-19], threequarters => [-1,71,563,-19], icircumflex => [-1,97,452,65], Edieresis => [-1,48,587,-19], ntilde => [-1,58,526,30], Aring => [-1,13,598,4], odieresis => [-1,113,481,20], oacute => [-1,113,478,23], ograve => [-1,113,478,23], ocircumflex => [-1,113,478,23], otilde => [-1,113,487,14], scaron => [-1,109,489,16], udieresis => [-1,130,457,28], uacute => [-1,130,453,31], ugrave => [-1,130,453,31], ucircumflex => [-1,130,453,31], yacute => [-1,22,628,-34], zcaron => [-1,118,473,24], ydieresis => [-1,22,628,-34], copyright => [-1,58,622,-64], registered => [-1,58,622,-64], Atilde => [-1,13,598,4], nbspace => [-1,327,0,288], Ccedilla => [-1,112,539,-35], Acircumflex => [-1,13,598,4], Agrave => [-1,13,598,4], logicalnot => [-1,164,473,-21], Aacute => [-1,13,598,4], Eth => [-1,48,559,8], brokenbar => [-1,263,192,160], Thorn => [-1,48,533,34], Adieresis => [-1,13,598,4], mu => [-1,88,496,31], '.notdef' => [-1,327,0,288], }} ); Prima-1.28/Prima/PS/fonts/Palatino-Roman0000644000175100017510000001512511150770061015565 0ustar dkdk('Palatino-Roman' => { name => 'Palatino-Roman', family => 'Palatino', height => 1226, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 943, descent => 283, maximalWidth => 1188, width => 1188, internalLeading => 217, externalLeading => 71, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 71.62, yDeviceRes => 71.62, size => 1000, encoding => 'Latin1', chardata => { space => [32,153,0,153], exclam => [33,99,142,99], quotedbl => [34,63,327,63], numbersign => [35,4,601,6], dollar => [36,36,540,35], percent => [37,47,935,46], ampersand => [38,52,870,30], quoteright => [39,55,230,55], parenleft => [40,73,295,39], parenright => [41,39,295,73], asterisk => [42,39,400,36], plus => [43,62,617,62], comma => [44,19,247,39], hyphen => [45,20,361,25], period => [46,82,142,82], slash => [47,106,529,106], zero => [48,35,534,42], one => [49,73,438,100], two => [50,19,554,39], three => [51,18,548,46], four => [52,2,576,34], five => [53,15,546,50], six => [54,39,534,39], seven => [55,53,555,3], eight => [56,36,532,44], nine => [57,24,535,52], colon => [58,80,142,83], semicolon => [59,19,247,39], less => [60,69,614,58], equal => [61,62,617,62], greater => [62,58,614,69], question => [63,52,431,60], at => [64,29,858,28], A => [65,18,908,26], B => [66,31,674,42], C => [67,26,794,47], D => [68,26,893,28], E => [69,26,674,47], F => [70,26,630,24], G => [71,26,865,42], H => [72,26,966,26], I => [73,26,359,26], J => [74,-18,399,26], K => [75,26,854,8], L => [76,26,691,30], M => [77,19,1115,24], N => [78,20,975,22], O => [79,26,909,26], P => [80,26,684,29], Q => [81,26,909,26], R => [82,26,793,-1], S => [83,29,587,26], T => [84,22,707,22], U => [85,14,915,23], V => [86,9,855,19], W => [87,9,1196,19], X => [88,17,777,23], Y => [89,11,790,15], Z => [90,18,763,35], bracketleft => [91,96,256,55], backslash => [92,99,528,115], bracketright => [93,55,256,96], asciicircum => [94,62,616,63], underscore => [95,0,613,0], quoteleft => [96,55,230,55], a => [97,39,538,35], b => [98,-18,641,55], c => [99,31,474,38], d => [100,42,666,39], e => [101,31,517,38], f => [102,28,389,-9], g => [103,39,627,14], h => [104,7,693,12], i => [105,25,306,24], j => [106,-49,253,82], k => [107,25,647,8], l => [108,25,306,24], m => [109,19,1045,17], n => [110,7,693,12], o => [111,39,590,39], p => [112,9,669,57], q => [113,42,643,0], r => [114,25,432,25], s => [115,36,442,40], t => [116,26,364,8], u => [117,22,690,26], v => [118,7,653,31], w => [119,7,983,31], x => [120,24,583,24], y => [121,14,652,14], z => [122,19,551,41], braceleft => [123,71,283,53], bar => [124,337,68,337], braceright => [125,53,283,71], asciitilde => [126,62,617,62], exclamdown => [161,99,142,99], cent => [162,74,474,63], sterling => [163,14,571,26], fraction => [164,-203,616,-208], yen => [165,6,601,4], florin => [166,0,579,33], section => [167,31,538,42], currency => [168,36,539,36], quotesingle => [169,74,105,74], quotedblleft => [170,62,487,62], guillemotleft => [171,61,490,61], guilsinglleft => [172,80,243,80], guilsinglright => [173,80,243,80], fi => [174,28,691,22], fl => [175,28,695,22], endash => [177,0,613,0], dagger => [178,41,529,41], daggerdbl => [179,41,529,41], periodcentered => [180,82,142,82], paragraph => [182,47,674,47], bullet => [183,160,421,160], quotesinglbase => [184,26,230,83], quotedblbase => [185,62,487,62], quotedblright => [186,62,487,62], guillemotright => [187,61,490,61], ellipsis => [188,133,958,133], perthousand => [189,150,1100,150], questiondown => [191,52,431,60], grave => [193,38,274,95], acute => [194,95,274,38], circumflex => [195,13,382,12], tilde => [196,2,404,1], macron => [197,13,382,12], breve => [198,31,345,30], dotaccent => [199,91,122,91], dieresis => [200,20,366,20], ring => [202,82,245,80], cedilla => [203,117,255,35], hungarumlaut => [205,3,458,3], ogonek => [206,83,217,83], caron => [207,13,382,12], emdash => [208,0,1226,0], AE => [225,-12,1125,44], ordfeminine => [227,29,350,28], Lslash => [232,7,711,30], Oslash => [233,36,940,44], OE => [234,26,1152,44], ordmasculine => [235,12,383,12], ae => [241,36,860,31], dotlessi => [245,25,306,19], lslash => [248,-17,392,-18], oslash => [249,19,630,31], oe => [250,39,941,33], germandbls => [251,28,608,45], Yacute => [-1,11,790,15], Ucircumflex => [-1,14,915,23], Ugrave => [-1,14,915,23], Zcaron => [-1,18,763,35], Ydieresis => [-1,11,790,15], threesuperior => [-1,6,338,23], Uacute => [-1,14,915,23], twosuperior => [-1,7,340,19], Udieresis => [-1,14,915,23], middot => [-1,82,142,82], onesuperior => [-1,39,272,56], aacute => [-1,39,538,35], agrave => [-1,39,538,35], acircumflex => [-1,39,538,35], Scaron => [-1,29,587,26], Otilde => [-1,26,909,26], sfthyphen => [-1,20,361,25], atilde => [-1,39,538,35], aring => [-1,39,538,35], adieresis => [-1,39,538,35], Ograve => [-1,26,909,26], Ocircumflex => [-1,26,909,26], Odieresis => [-1,26,909,26], Ntilde => [-1,20,975,22], edieresis => [-1,31,517,38], eacute => [-1,31,517,38], egrave => [-1,31,517,38], Icircumflex => [-1,15,382,14], ecircumflex => [-1,31,517,38], Igrave => [-1,26,359,26], Iacute => [-1,26,359,26], Idieresis => [-1,23,366,23], degree => [-1,61,367,61], Ecircumflex => [-1,26,674,47], minus => [-1,62,617,62], multiply => [-1,101,539,101], divide => [-1,62,617,62], Egrave => [-1,26,674,47], trademark => [-1,49,1102,49], Oacute => [-1,26,909,26], thorn => [-1,-2,669,69], eth => [-1,39,578,51], Eacute => [-1,26,674,47], ccedilla => [-1,31,474,38], idieresis => [-1,-7,366,-7], iacute => [-1,25,316,9], igrave => [-1,9,322,19], plusminus => [-1,62,617,62], onehalf => [-1,18,882,18], onequarter => [-1,36,854,28], threequarters => [-1,18,882,18], icircumflex => [-1,-14,382,-15], Edieresis => [-1,26,674,47], ntilde => [-1,7,693,12], Aring => [-1,18,908,26], odieresis => [-1,39,590,39], oacute => [-1,39,590,39], ograve => [-1,39,590,39], ocircumflex => [-1,39,590,39], otilde => [-1,39,590,39], scaron => [-1,36,442,40], udieresis => [-1,22,690,26], uacute => [-1,22,690,26], ugrave => [-1,22,690,26], ucircumflex => [-1,22,690,26], yacute => [-1,14,652,14], zcaron => [-1,19,551,41], ydieresis => [-1,14,652,14], copyright => [-1,13,888,13], registered => [-1,13,888,13], Atilde => [-1,18,908,26], nbspace => [-1,153,0,153], Ccedilla => [-1,26,794,47], Acircumflex => [-1,18,908,26], Agrave => [-1,18,908,26], logicalnot => [-1,62,613,67], Aacute => [-1,18,908,26], Eth => [-1,17,903,28], brokenbar => [-1,337,68,337], Thorn => [-1,39,664,36], Adieresis => [-1,18,908,26], mu => [-1,22,690,26], '.notdef' => [-1,153,0,153], }} ); Prima-1.28/Prima/PS/fonts/Bookman-LightItalic0000644000175100017510000001556211150770061016532 0ustar dkdk('Bookman-LightItalic' => { name => 'Bookman-LightItalic', family => 'Bookman', height => 1099, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 878, descent => 221, maximalWidth => 1498, width => 1498, internalLeading => 163, externalLeading => 53, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 77.21, yDeviceRes => 77.21, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,329], exclam => [33,113,262,-24], quotedbl => [34,117,324,-46], numbersign => [35,117,539,24], dollar => [36,85,594,1], percent => [37,61,829,-12], ampersand => [38,71,860,-30], quoteright => [39,162,153,-8], parenleft => [40,105,315,-113], parenright => [41,-8,315,1], asterisk => [42,152,402,-71], plus => [43,100,553,5], comma => [44,96,152,80], hyphen => [45,85,283,-17], period => [46,105,148,75], slash => [47,114,503,41], zero => [48,94,615,-28], one => [49,169,380,131], two => [50,72,626,-17], three => [51,60,623,-2], four => [52,75,620,-15], five => [53,76,597,6], six => [54,97,624,-40], seven => [55,157,581,-57], eight => [56,67,652,-38], nine => [57,84,628,-31], colon => [58,105,215,8], semicolon => [59,96,224,8], less => [60,86,559,13], equal => [61,100,553,5], greater => [62,102,559,-2], question => [63,125,538,-70], at => [64,112,769,-24], A => [65,-27,818,-21], B => [66,23,796,-28], C => [67,96,723,-28], D => [68,23,836,-46], E => [69,23,785,-61], F => [70,23,793,-135], G => [71,96,796,-58], H => [72,23,952,-96], I => [73,23,429,-101], J => [74,-2,734,-116], K => [75,23,860,-92], L => [76,23,697,-83], M => [77,19,1030,-105], N => [78,19,884,-113], O => [79,96,781,-42], P => [80,23,725,-89], Q => [81,67,825,-35], R => [82,23,785,-39], S => [83,67,667,-30], T => [84,54,741,-137], U => [85,129,795,-134], V => [86,95,800,-148], W => [87,95,1107,-148], X => [88,-27,923,-126], Y => [89,95,793,-163], Z => [90,8,755,-126], bracketleft => [91,61,324,-100], backslash => [92,92,503,63], bracketright => [93,16,323,-53], asciicircum => [94,106,551,1], underscore => [95,0,549,0], quoteleft => [96,209,152,-54], a => [97,78,675,-72], b => [98,96,585,-23], c => [99,71,502,-46], d => [100,71,692,-60], e => [101,71,560,-38], f => [102,-175,787,-238], g => [103,4,634,-23], h => [104,96,660,-75], i => [105,96,289,-78], j => [106,-219,558,-30], k => [107,96,625,-62], l => [108,109,265,-68], m => [109,96,949,-79], n => [110,96,642,-58], o => [111,71,557,-35], p => [112,-26,707,-21], q => [113,71,570,-26], r => [114,96,431,-89], s => [115,71,529,-7], t => [116,96,354,-78], u => [117,96,657,-72], v => [118,96,520,-24], w => [119,96,884,-14], x => [120,9,678,-94], y => [121,65,603,-9], z => [122,41,574,-45], braceleft => [123,137,345,-86], bar => [124,323,85,250], braceright => [125,16,346,54], asciitilde => [126,100,553,5], exclamdown => [161,80,250,20], cent => [162,162,492,26], sterling => [163,4,767,-90], fraction => [164,-250,605,-332], yen => [165,78,729,-126], florin => [166,-28,789,-79], section => [167,41,659,-19], currency => [168,109,554,16], quotesingle => [169,108,162,-51], quotedblleft => [170,209,331,-58], guillemotleft => [171,76,267,-14], guilsinglleft => [172,82,146,-30], guilsinglright => [173,76,146,-25], fi => [174,-174,953,-75], fl => [175,-174,958,-58], endash => [177,36,580,-67], dagger => [178,211,415,54], daggerdbl => [179,158,463,59], periodcentered => [180,150,148,30], paragraph => [182,123,665,-107], bullet => [183,109,378,17], quotesinglbase => [184,95,152,103], quotedblbase => [185,95,332,98], quotedblright => [186,162,332,-12], guillemotright => [187,65,267,-3], ellipsis => [188,108,880,109], perthousand => [189,61,1256,-20], questiondown => [191,19,538,35], grave => [193,200,214,-40], acute => [194,195,214,-58], circumflex => [195,193,332,-42], tilde => [196,197,338,-52], macron => [197,195,336,-48], breve => [198,209,339,-65], dotaccent => [199,185,132,-32], dieresis => [200,203,309,-51], ring => [202,195,171,-37], cedilla => [203,49,214,87], hungarumlaut => [205,183,258,-68], ogonek => [206,56,146,83], caron => [207,195,332,-45], emdash => [208,36,1129,-67], AE => [225,-49,1444,-53], ordfeminine => [227,103,460,-80], Lslash => [232,23,697,-83], Oslash => [233,96,781,-42], OE => [234,96,1262,-62], ordmasculine => [235,103,396,-60], ae => [241,78,930,-41], dotlessi => [245,96,289,-78], lslash => [248,54,382,-63], oslash => [249,71,556,-34], oe => [250,71,970,-52], germandbls => [251,-132,850,-36], Yacute => [-1,95,793,-163], Ucircumflex => [-1,129,795,-134], Ugrave => [-1,129,795,-134], Zcaron => [-1,8,755,-126], Ydieresis => [-1,95,793,-163], threesuperior => [-1,76,405,-73], Uacute => [-1,129,795,-134], twosuperior => [-1,74,407,-73], Udieresis => [-1,129,795,-134], middot => [-1,150,148,30], onesuperior => [-1,125,247,36], aacute => [-1,78,675,-72], agrave => [-1,78,675,-72], acircumflex => [-1,78,675,-72], Scaron => [-1,67,667,-30], Otilde => [-1,96,781,-42], sfthyphen => [-1,85,283,-17], atilde => [-1,78,675,-72], aring => [-1,78,675,-72], adieresis => [-1,78,675,-72], Ograve => [-1,96,781,-42], Ocircumflex => [-1,96,781,-42], Odieresis => [-1,96,781,-42], Ntilde => [-1,19,884,-113], edieresis => [-1,71,560,-38], eacute => [-1,71,560,-38], egrave => [-1,71,560,-38], Icircumflex => [-1,23,437,-108], ecircumflex => [-1,71,560,-38], Igrave => [-1,23,429,-101], Iacute => [-1,23,429,-101], Idieresis => [-1,23,435,-106], degree => [-1,131,329,-21], Ecircumflex => [-1,23,785,-61], minus => [-1,100,553,5], multiply => [-1,100,553,5], divide => [-1,100,553,5], Egrave => [-1,23,785,-61], trademark => [-1,75,984,16], Oacute => [-1,96,781,-42], thorn => [-1,-26,707,-21], eth => [-1,71,634,-112], Eacute => [-1,23,785,-61], ccedilla => [-1,71,502,-46], idieresis => [-1,96,317,-106], iacute => [-1,96,289,-78], igrave => [-1,96,289,-78], plusminus => [-1,100,553,5], onehalf => [-1,100,916,5], onequarter => [-1,100,903,18], threequarters => [-1,108,894,18], icircumflex => [-1,83,332,-108], Edieresis => [-1,23,785,-61], ntilde => [-1,96,642,-58], Aring => [-1,-27,818,-21], odieresis => [-1,71,557,-35], oacute => [-1,71,557,-35], ograve => [-1,71,557,-35], ocircumflex => [-1,71,557,-35], otilde => [-1,71,557,-35], scaron => [-1,71,529,-7], udieresis => [-1,96,657,-72], uacute => [-1,96,657,-72], ugrave => [-1,96,657,-72], ucircumflex => [-1,96,657,-72], yacute => [-1,65,603,-9], zcaron => [-1,41,574,-45], ydieresis => [-1,65,603,-9], copyright => [-1,92,769,-48], registered => [-1,92,769,-48], Atilde => [-1,-27,818,-21], nbspace => [-1,0,0,329], Ccedilla => [-1,96,723,-28], Acircumflex => [-1,-27,818,-21], Agrave => [-1,-27,818,-21], logicalnot => [-1,100,553,5], Aacute => [-1,-27,818,-21], Eth => [-1,23,836,-46], brokenbar => [-1,323,85,250], Thorn => [-1,23,697,-61], Adieresis => [-1,-27,818,-21], mu => [-1,58,695,-72], '.notdef' => [-1,0,0,329], }} ); Prima-1.28/Prima/PS/fonts/Helvetica-BoldOblique0000644000175100017510000001573111150770061017052 0ustar dkdk('Helvetica-BoldOblique' => { name => 'Helvetica-BoldOblique', family => 'Helvetica', height => 1186, weigth => fw::Bold, style => fs::Bold|fs::Italic, pitch => fp::Variable, vector => 1, ascent => 953, descent => 233, maximalWidth => 1285, width => 1285, internalLeading => 224, externalLeading => 73, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 75.12, yDeviceRes => 75.12, size => 1000, encoding => 'Latin1', chardata => { space => [32,290,0,39], exclam => [33,132,361,-99], quotedbl => [34,209,476,-124], numbersign => [35,39,743,-123], dollar => [36,69,674,-85], percent => [37,152,917,-16], ampersand => [38,105,748,2], quoteright => [39,195,226,-92], parenleft => [40,99,443,-148], parenright => [41,-24,447,-27], asterisk => [42,171,394,-105], plus => [43,103,603,-14], comma => [44,32,258,39], hyphen => [45,83,356,-45], period => [46,75,214,39], slash => [47,-1,507,-176], zero => [48,96,632,-68], one => [49,203,423,32], two => [50,35,709,-85], three => [51,79,647,-67], four => [52,67,642,-50], five => [53,69,690,-100], six => [54,100,640,-81], seven => [55,155,649,-145], eight => [56,71,664,-75], nine => [57,80,643,-65], colon => [58,134,309,-48], semicolon => [59,90,353,-48], less => [60,91,655,-54], equal => [61,72,665,-45], greater => [62,45,655,-8], question => [63,199,597,-72], at => [64,86,1137,-67], A => [65,30,802,22], B => [66,97,806,-47], C => [67,126,813,-84], D => [68,91,829,-64], E => [69,93,810,-112], F => [70,87,791,-154], G => [71,126,844,-48], H => [72,80,882,-106], I => [73,74,361,-106], J => [74,69,690,-100], K => [75,87,912,-143], L => [76,94,623,5], M => [77,78,1025,-116], N => [78,80,887,-111], O => [79,125,856,-59], P => [80,90,795,-94], Q => [81,129,856,-62], R => [82,94,836,-74], S => [83,90,769,-68], T => [84,168,724,-168], U => [85,141,818,-103], V => [86,212,738,-160], W => [87,199,1089,-169], X => [88,26,925,-160], Y => [89,215,738,-163], Z => [90,35,833,-144], bracketleft => [91,27,521,-154], backslash => [92,163,174,-8], bracketright => [93,-29,521,-97], asciicircum => [94,141,546,4], underscore => [95,-77,729,7], quoteleft => [96,198,225,-93], a => [97,59,626,-26], b => [98,69,689,-34], c => [99,91,616,-48], d => [100,93,736,-105], e => [101,75,625,-41], f => [102,106,443,-155], g => [103,30,747,-53], h => [104,79,666,-21], i => [105,79,349,-99], j => [106,-50,483,-103], k => [107,69,702,-112], l => [108,79,349,-99], m => [109,71,1009,-26], n => [110,74,671,-21], o => [111,97,654,-27], p => [112,13,742,-30], q => [113,85,696,-56], r => [114,74,502,-116], s => [115,71,627,-39], t => [116,119,371,-96], u => [117,104,673,-53], v => [118,152,619,-112], w => [119,142,902,-122], x => [120,18,749,-109], y => [121,43,730,-115], z => [122,24,657,-88], braceleft => [123,99,460,-98], bar => [124,67,329,-65], braceright => [125,34,462,-35], asciitilde => [126,115,574,3], exclamdown => [161,30,361,2], cent => [162,93,615,-49], sterling => [163,58,687,-86], fraction => [164,-209,789,-381], yen => [165,126,705,-173], florin => [166,-24,843,-158], section => [167,66,640,-47], currency => [168,78,685,-104], quotesingle => [169,209,196,-124], quotedblleft => [170,202,494,-104], guillemotleft => [171,160,517,-17], guilsinglleft => [172,151,264,-21], guilsinglright => [173,113,264,16], fi => [174,100,732,-109], fl => [175,104,727,-106], endash => [177,41,698,-80], dagger => [178,129,613,-83], daggerdbl => [179,41,697,-79], periodcentered => [180,169,150,9], paragraph => [182,143,667,-151], bullet => [183,131,300,-16], quotesinglbase => [184,43,226,59], quotedblbase => [185,43,504,45], quotedblright => [186,205,500,-112], guillemotright => [187,122,509,27], ellipsis => [188,109,1004,72], perthousand => [189,85,1125,-24], questiondown => [191,61,597,65], grave => [193,207,194,-7], acute => [194,292,270,-168], circumflex => [195,160,377,-142], tilde => [196,138,454,-198], macron => [197,177,375,-158], breve => [198,222,316,-144], dotaccent => [199,285,161,-52], dieresis => [200,174,381,-161], ring => [202,253,218,-77], cedilla => [203,-15,335,74], hungarumlaut => [205,97,493,-195], ogonek => [206,27,266,100], caron => [207,198,377,-180], emdash => [208,43,1225,-83], AE => [225,1,1308,-123], ordfeminine => [227,113,421,-96], Lslash => [232,64,676,-15], Oslash => [233,40,1034,-151], OE => [234,106,1206,-126], ordmasculine => [235,109,449,-125], ae => [241,64,1035,-45], dotlessi => [245,79,302,-52], lslash => [248,59,381,-111], oslash => [249,14,826,-116], oe => [250,84,1085,-49], germandbls => [251,79,696,-50], Yacute => [-1,215,738,-163], Ucircumflex => [-1,141,818,-103], Ugrave => [-1,141,818,-103], Zcaron => [-1,35,833,-144], Ydieresis => [-1,215,738,-163], threesuperior => [-1,174,406,-54], Uacute => [-1,141,818,-103], twosuperior => [-1,147,444,-65], Udieresis => [-1,141,818,-103], middot => [-1,169,150,9], onesuperior => [-1,249,270,7], aacute => [-1,59,636,-36], agrave => [-1,59,626,-26], acircumflex => [-1,59,626,-26], Scaron => [-1,90,769,-68], Otilde => [-1,125,856,-59], sfthyphen => [-1,83,356,-45], atilde => [-1,59,666,-66], aring => [-1,59,626,-26], adieresis => [-1,59,629,-29], Ograve => [-1,125,856,-59], Ocircumflex => [-1,125,856,-59], Odieresis => [-1,125,856,-59], Ntilde => [-1,80,887,-111], edieresis => [-1,75,625,-41], eacute => [-1,75,625,-41], egrave => [-1,75,625,-41], Icircumflex => [-1,74,479,-224], ecircumflex => [-1,75,625,-41], Igrave => [-1,74,361,-106], Iacute => [-1,74,505,-250], Idieresis => [-1,74,498,-243], degree => [-1,284,359,74], Ecircumflex => [-1,93,810,-112], minus => [-1,91,627,-26], multiply => [-1,120,569,2], divide => [-1,91,627,-26], Egrave => [-1,93,810,-112], trademark => [-1,252,1036,-103], Oacute => [-1,125,856,-59], thorn => [-1,13,742,-30], eth => [-1,98,652,-26], Eacute => [-1,93,810,-112], ccedilla => [-1,91,616,-48], idieresis => [-1,79,444,-194], iacute => [-1,79,451,-201], igrave => [-1,79,302,-52], plusminus => [-1,59,687,-54], onehalf => [-1,249,996,5], onequarter => [-1,249,974,27], threequarters => [-1,174,1049,27], icircumflex => [-1,79,425,-175], Edieresis => [-1,93,810,-112], ntilde => [-1,74,691,-41], Aring => [-1,30,802,22], odieresis => [-1,97,654,-27], oacute => [-1,97,654,-27], ograve => [-1,97,654,-27], ocircumflex => [-1,97,654,-27], otilde => [-1,97,660,-33], scaron => [-1,71,636,-48], udieresis => [-1,104,673,-53], uacute => [-1,104,673,-53], ugrave => [-1,104,673,-53], ucircumflex => [-1,104,673,-53], yacute => [-1,43,730,-115], zcaron => [-1,24,657,-88], ydieresis => [-1,43,730,-115], copyright => [-1,64,928,-118], registered => [-1,65,927,-118], Atilde => [-1,30,845,-20], nbspace => [-1,290,0,39], Ccedilla => [-1,126,813,-84], Acircumflex => [-1,30,802,22], Agrave => [-1,30,802,22], logicalnot => [-1,122,627,-56], Aacute => [-1,30,815,9], Eth => [-1,86,833,-64], brokenbar => [-1,67,329,-65], Thorn => [-1,90,764,-64], Adieresis => [-1,30,808,16], mu => [-1,13,763,-52], '.notdef' => [-1,290,0,39], }} ); Prima-1.28/Prima/PS/fonts/Courier0000644000175100017510000001530311150770061014352 0ustar dkdk('Courier' => { name => 'Courier', family => 'Courier', height => 1027, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 811, descent => 216, maximalWidth => 625, width => 625, internalLeading => 207, externalLeading => 68, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 88.13, yDeviceRes => 88.13, size => 1000, encoding => 'Latin1', chardata => { space => [32,302,0,313], exclam => [33,246,123,246], quotedbl => [34,149,316,149], numbersign => [35,94,427,94], dollar => [36,116,384,116], percent => [37,89,437,89], ampersand => [38,107,383,125], quoteright => [39,138,210,267], parenleft => [40,301,168,145], parenright => [41,150,168,296], asterisk => [42,116,384,116], plus => [43,73,468,73], comma => [44,138,210,267], hyphen => [45,73,468,73], period => [46,232,151,232], slash => [47,116,384,116], zero => [48,116,384,116], one => [49,116,384,116], two => [50,86,404,125], three => [51,98,413,103], four => [52,107,383,125], five => [53,98,413,103], six => [54,139,384,92], seven => [55,107,383,125], eight => [56,116,384,116], nine => [57,139,384,92], colon => [58,232,151,232], semicolon => [59,142,216,256], less => [60,73,462,80], equal => [61,52,511,52], greater => [62,80,462,73], question => [63,137,362,116], at => [64,107,383,125], A => [65,9,597,9], B => [66,44,511,60], C => [67,64,483,67], D => [68,44,489,82], E => [69,44,489,82], F => [70,44,489,82], G => [71,64,512,39], H => [72,54,511,50], I => [73,116,384,116], J => [74,86,512,17], K => [75,44,543,28], L => [76,64,490,60], M => [77,11,597,7], N => [78,22,554,39], O => [79,52,511,52], P => [80,44,468,103], Q => [81,52,511,52], R => [82,44,560,11], S => [83,94,427,94], T => [84,73,468,73], U => [85,41,534,41], V => [86,9,597,9], W => [87,20,575,20], X => [88,41,534,41], Y => [89,52,511,52], Z => [90,105,404,105], bracketleft => [91,287,169,159], backslash => [92,116,384,116], bracketright => [93,159,169,287], asciicircum => [94,116,384,116], underscore => [95,-12,640,-12], quoteleft => [96,267,210,138], a => [97,73,481,60], b => [98,22,533,60], c => [99,86,463,66], d => [100,64,534,17], e => [101,64,469,82], f => [102,107,447,60], g => [103,64,512,39], h => [104,44,521,50], i => [105,94,427,94], j => [106,150,319,145], k => [107,64,490,60], l => [108,94,427,94], m => [109,11,597,7], n => [110,54,501,60], o => [111,73,468,73], p => [112,22,533,60], q => [113,64,534,17], r => [114,86,469,60], s => [115,105,404,105], t => [116,44,468,103], u => [117,44,511,60], v => [118,30,554,30], w => [119,30,554,30], x => [120,52,511,52], y => [121,52,511,52], z => [122,118,384,113], braceleft => [123,202,211,202], bar => [124,287,41,287], braceright => [125,202,211,202], asciitilde => [126,94,427,94], exclamdown => [161,246,123,246], cent => [162,116,365,134], sterling => [163,64,469,82], fraction => [164,51,512,52], yen => [165,52,511,52], florin => [166,89,442,84], section => [167,67,480,67], currency => [168,105,404,105], quotesingle => [169,242,131,242], quotedblleft => [170,95,425,95], guillemotleft => [171,64,490,60], guilsinglleft => [172,64,255,295], guilsinglright => [173,300,254,60], fi => [174,10,590,15], fl => [175,10,592,13], endash => [177,73,468,73], dagger => [178,127,361,127], daggerdbl => [179,127,361,127], periodcentered => [180,232,151,232], paragraph => [182,81,458,77], bullet => [183,207,201,207], quotesinglbase => [184,138,210,267], quotedblbase => [185,95,425,95], quotedblright => [186,95,425,95], guillemotright => [187,64,490,60], ellipsis => [188,52,511,52], perthousand => [189,34,544,36], questiondown => [191,116,362,137], grave => [193,159,169,287], acute => [194,287,169,159], circumflex => [195,159,297,159], tilde => [196,148,318,148], macron => [197,159,297,159], breve => [198,159,297,159], dotaccent => [199,256,102,256], dieresis => [200,143,329,142], ring => [202,212,191,212], cedilla => [203,215,171,229], hungarumlaut => [205,159,297,159], ogonek => [206,287,157,171], caron => [207,159,297,159], emdash => [208,1,614,1], AE => [225,10,595,10], ordfeminine => [227,159,299,157], Lslash => [232,44,511,60], Oslash => [233,41,534,41], OE => [234,10,595,10], ordmasculine => [235,158,301,156], ae => [241,12,581,22], dotlessi => [245,94,427,94], lslash => [248,94,427,94], oslash => [249,54,503,58], oe => [250,12,581,22], germandbls => [251,44,468,103], Yacute => [-1,52,511,52], Ucircumflex => [-1,41,534,41], Ugrave => [-1,41,534,41], Zcaron => [-1,105,404,105], Ydieresis => [-1,52,511,52], threesuperior => [-1,185,241,188], Uacute => [-1,41,534,41], twosuperior => [-1,179,236,200], Udieresis => [-1,41,534,41], middot => [-1,232,151,232], onesuperior => [-1,196,224,195], aacute => [-1,73,481,60], agrave => [-1,73,481,60], acircumflex => [-1,73,481,60], Scaron => [-1,94,427,94], Otilde => [-1,52,511,52], sfthyphen => [-1,73,468,73], atilde => [-1,73,481,60], aring => [-1,73,481,60], adieresis => [-1,73,481,60], Ograve => [-1,52,511,52], Ocircumflex => [-1,52,511,52], Odieresis => [-1,52,511,52], Ntilde => [-1,22,554,39], edieresis => [-1,64,469,82], eacute => [-1,64,469,82], egrave => [-1,64,469,82], Icircumflex => [-1,116,384,116], ecircumflex => [-1,64,469,82], Igrave => [-1,116,384,116], Iacute => [-1,116,384,116], Idieresis => [-1,116,384,116], degree => [-1,159,297,159], Ecircumflex => [-1,44,489,82], minus => [-1,73,468,73], multiply => [-1,121,373,121], divide => [-1,73,468,73], Egrave => [-1,44,489,82], trademark => [-1,4,610,2], Oacute => [-1,52,511,52], thorn => [-1,22,533,60], eth => [-1,73,468,73], Eacute => [-1,44,489,82], ccedilla => [-1,86,463,66], idieresis => [-1,94,427,94], iacute => [-1,94,427,94], igrave => [-1,94,427,94], plusminus => [-1,73,468,73], onehalf => [-1,23,564,27], onequarter => [-1,16,579,20], threequarters => [-1,6,589,20], icircumflex => [-1,94,427,94], Edieresis => [-1,44,489,82], ntilde => [-1,54,501,60], Aring => [-1,9,597,9], odieresis => [-1,73,468,73], oacute => [-1,73,468,73], ograve => [-1,73,468,73], ocircumflex => [-1,73,468,73], otilde => [-1,73,468,73], scaron => [-1,105,404,105], udieresis => [-1,44,511,60], uacute => [-1,44,511,60], ugrave => [-1,44,511,60], ucircumflex => [-1,44,511,60], yacute => [-1,52,511,52], zcaron => [-1,118,384,113], ydieresis => [-1,52,511,52], copyright => [-1,3,609,4], registered => [-1,3,609,4], Atilde => [-1,9,597,9], nbspace => [-1,302,0,313], Ccedilla => [-1,64,483,67], Acircumflex => [-1,9,597,9], Agrave => [-1,9,597,9], logicalnot => [-1,73,468,73], Aacute => [-1,9,597,9], Eth => [-1,0,534,82], brokenbar => [-1,287,41,287], Thorn => [-1,44,468,103], Adieresis => [-1,9,597,9], mu => [-1,44,511,60], '.notdef' => [-1,302,0,313], }} ); Prima-1.28/Prima/PS/fonts/ZapfDingbats0000644000175100017510000001260411150770061015317 0ustar dkdk('ZapfDingbats' => { name => 'ZapfDingbats', family => 'ZapfDingbats', height => 962, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 819, descent => 143, maximalWidth => 983, width => 983, internalLeading => 128, externalLeading => 42, firstChar => 32, lastChar => 234, defaultChar => 32, xDeviceRes => 86.65, yDeviceRes => 86.65, size => 1000, encoding => 'Specific', chardata => { space => [32,0,0,267], a1 => [33,33,869,33], a2 => [34,33,858,32], a202 => [35,33,869,33], a3 => [36,33,875,33], a4 => [37,32,626,32], a5 => [38,33,692,32], a119 => [39,33,692,33], a118 => [40,33,698,28], a117 => [41,33,596,33], a11 => [42,33,856,33], a12 => [43,33,835,33], a13 => [44,27,468,31], a14 => [45,32,756,33], a15 => [46,33,809,33], a16 => [47,33,831,32], a105 => [48,33,809,33], a17 => [49,33,840,34], a18 => [50,33,868,34], a19 => [51,32,660,32], a20 => [52,34,745,33], a21 => [53,33,665,33], a22 => [54,33,665,32], a23 => [55,0,550,0], a24 => [56,34,582,33], a25 => [57,33,666,33], a26 => [58,33,664,32], a27 => [59,33,663,32], a28 => [60,33,658,32], a6 => [61,33,408,32], a7 => [62,33,463,33], a8 => [63,33,450,32], a9 => [64,33,487,33], a10 => [65,33,598,33], a29 => [66,33,688,33], a30 => [67,33,689,34], a31 => [68,33,690,33], a32 => [69,33,693,32], a33 => [70,33,696,32], a34 => [71,33,696,33], a35 => [72,33,718,32], a36 => [73,33,723,34], a37 => [74,33,691,33], a38 => [75,33,742,32], a39 => [76,33,725,32], a40 => [77,33,734,33], a41 => [78,33,718,32], a42 => [79,33,732,33], a43 => [80,33,820,33], a44 => [81,33,649,32], a45 => [82,33,628,33], a46 => [83,33,653,33], a47 => [84,32,694,32], a48 => [85,33,695,32], a49 => [86,33,602,32], a50 => [87,33,679,33], a51 => [88,33,672,32], a52 => [89,33,694,33], a53 => [90,33,663,32], a54 => [91,33,612,33], a55 => [92,33,612,34], a56 => [93,33,588,33], a57 => [94,33,607,33], a58 => [95,33,727,33], a59 => [96,33,716,33], a60 => [97,33,691,33], a61 => [98,33,691,33], a62 => [99,32,614,32], a63 => [100,34,591,34], a64 => [101,33,602,33], a65 => [102,33,596,32], a66 => [103,32,689,33], a67 => [104,33,689,33], a68 => [105,33,618,33], a69 => [106,33,693,33], a70 => [107,34,687,32], a71 => [108,33,694,32], a72 => [109,33,772,33], a73 => [110,33,664,33], a74 => [111,33,665,33], a203 => [112,33,665,33], a75 => [113,33,663,32], a204 => [114,33,663,32], a76 => [115,33,791,32], a77 => [116,33,791,32], a78 => [117,33,691,32], a79 => [118,33,686,33], a81 => [119,33,354,33], a82 => [120,33,66,32], a83 => [121,33,199,33], a84 => [122,33,331,33], a97 => [123,33,309,33], a98 => [124,32,310,33], a99 => [125,33,575,33], a100 => [126,34,575,32], a101 => [161,33,636,33], a102 => [162,53,415,53], a103 => [163,32,455,34], a104 => [164,33,808,33], a106 => [165,33,575,32], a107 => [166,33,664,32], a108 => [167,0,729,1], a112 => [168,33,679,33], a111 => [169,32,506,33], a110 => [170,33,600,33], a109 => [171,32,535,33], a120 => [172,33,691,32], a121 => [173,33,691,32], a122 => [174,33,691,32], a123 => [175,33,691,32], a124 => [176,33,691,32], a125 => [177,33,691,32], a126 => [178,33,691,32], a127 => [179,33,691,32], a128 => [180,33,691,32], a129 => [181,33,691,32], a130 => [182,33,691,32], a131 => [183,33,691,32], a132 => [184,33,691,32], a133 => [185,33,691,32], a134 => [186,33,691,32], a135 => [187,33,691,32], a136 => [188,33,691,32], a137 => [189,33,691,32], a138 => [190,33,691,32], a139 => [191,33,691,32], a140 => [192,33,691,32], a141 => [193,33,691,32], a142 => [194,33,691,32], a143 => [195,33,691,32], a144 => [196,33,691,32], a145 => [197,33,691,32], a146 => [198,33,691,32], a147 => [199,33,691,32], a148 => [200,33,691,32], a149 => [201,33,691,32], a150 => [202,33,691,32], a151 => [203,33,691,32], a152 => [204,33,691,32], a153 => [205,33,691,32], a154 => [206,33,691,32], a155 => [207,33,691,32], a156 => [208,33,691,32], a157 => [209,33,691,32], a158 => [210,33,691,32], a159 => [211,33,691,32], a160 => [212,33,793,32], a161 => [213,33,738,33], a163 => [214,32,911,33], a164 => [215,33,372,34], a196 => [216,33,637,48], a165 => [217,33,822,32], a192 => [218,33,637,48], a166 => [219,33,816,32], a167 => [220,33,824,33], a168 => [221,33,823,35], a169 => [222,33,825,33], a170 => [223,33,734,33], a171 => [224,33,772,33], a172 => [225,33,727,35], a173 => [226,33,821,33], a162 => [227,33,821,33], a174 => [228,33,814,33], a175 => [229,33,828,32], a176 => [230,33,828,33], a177 => [231,33,379,32], a178 => [232,33,782,33], a179 => [233,33,737,32], a193 => [234,33,737,32], a180 => [235,33,766,33], a199 => [236,33,766,33], a181 => [237,33,602,33], a200 => [238,33,602,33], a182 => [239,33,774,32], a201 => [241,33,774,32], a183 => [242,33,663,33], a184 => [243,33,842,33], a197 => [244,32,675,33], a185 => [245,33,764,33], a194 => [246,32,675,33], a198 => [247,32,787,33], a186 => [248,33,862,33], a195 => [249,32,787,33], a187 => [250,33,732,33], a188 => [251,34,771,33], a189 => [252,33,823,34], a190 => [253,33,861,37], a191 => [254,32,817,32], a95 => [-1,33,253,33], a88 => [-1,33,157,33], a87 => [-1,33,157,33], a86 => [-1,33,327,33], a206 => [-1,33,327,33], a85 => [-1,33,423,32], a96 => [-1,33,253,33], a91 => [-1,33,199,32], a94 => [-1,33,238,32], a93 => [-1,33,238,32], a90 => [-1,33,307,33], a89 => [-1,33,308,32], a92 => [-1,33,199,32], a205 => [-1,33,423,32], '.notdef' => [-1,0,0,267], }} ); Prima-1.28/Prima/PS/fonts/NewCenturySchlbk-BoldItalic0000644000175100017510000001542411150770061020204 0ustar dkdk('NewCenturySchlbk-BoldItalic' => { name => 'NewCenturySchlbk-BoldItalic', family => 'NewCenturySchlbk', height => 1220, weigth => fw::Bold, style => fs::Bold|fs::Italic, pitch => fp::Variable, vector => 1, ascent => 998, descent => 222, maximalWidth => 1322, width => 1322, internalLeading => 262, externalLeading => 86, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 75.43, yDeviceRes => 75.43, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,350], exclam => [33,3,406,-3], quotedbl => [34,122,496,-130], numbersign => [35,50,600,50], dollar => [36,3,678,18], percent => [37,62,957,64], ampersand => [38,37,966,80], quoteright => [39,85,281,-51], parenleft => [40,86,464,-54], parenright => [41,-85,461,120], asterisk => [42,39,536,34], plus => [43,50,614,74], comma => [44,-58,278,130], hyphen => [45,12,319,74], period => [46,14,212,123], slash => [47,-30,409,-40], zero => [48,25,649,25], one => [49,30,566,103], two => [50,-54,711,43], three => [51,-6,662,43], four => [52,-15,679,36], five => [53,0,699,1], six => [54,36,662,1], seven => [55,78,645,-23], eight => [56,0,672,28], nine => [57,1,662,36], colon => [58,-2,315,36], semicolon => [59,-47,361,36], less => [60,17,620,101], equal => [61,50,614,74], greater => [62,46,620,71], question => [63,96,455,35], at => [64,26,854,30], A => [65,-91,965,30], B => [66,-59,938,47], C => [67,42,883,0], D => [68,-59,1030,45], E => [69,-50,938,15], F => [70,-50,935,-26], G => [71,41,936,15], H => [72,-50,1161,-50], I => [73,-50,642,-51], J => [74,-10,886,-62], K => [75,-50,1065,-65], L => [76,-48,866,41], M => [77,-29,1234,-53], N => [78,-69,1182,-73], O => [79,43,928,43], P => [80,-46,938,12], Q => [81,42,928,45], R => [82,-50,966,54], S => [83,1,811,23], T => [84,53,875,-48], U => [85,107,984,-75], V => [86,39,939,-74], W => [87,48,1163,-61], X => [88,-87,1077,-85], Y => [89,18,929,-89], Z => [90,-35,907,-13], bracketleft => [91,-37,564,-30], backslash => [92,98,566,74], bracketright => [93,-59,564,-8], asciicircum => [94,63,612,63], underscore => [95,0,610,0], quoteleft => [96,47,281,-13], a => [97,18,769,25], b => [98,34,645,65], c => [99,3,590,61], d => [100,0,808,4], e => [101,-2,585,50], f => [102,-58,729,-196], g => [103,-80,814,10], h => [104,0,777,58], i => [105,34,384,56], j => [106,-207,672,-13], k => [107,-6,718,78], l => [108,31,419,23], m => [109,10,1111,29], n => [110,3,779,52], o => [111,12,646,41], p => [112,-143,863,70], q => [113,0,716,52], r => [114,3,635,-6], s => [115,2,530,53], t => [116,29,463,3], u => [117,46,733,56], v => [118,40,569,68], w => [119,26,934,54], x => [120,-59,756,3], y => [121,-80,680,32], z => [122,-23,597,58], braceleft => [123,63,427,6], bar => [124,319,98,320], braceright => [125,-36,429,103], asciitilde => [126,62,614,62], exclamdown => [161,-47,400,53], cent => [162,36,590,73], sterling => [163,-21,712,9], fraction => [164,-202,608,-202], yen => [165,28,746,-74], florin => [166,-32,750,-17], section => [167,-48,664,-6], currency => [168,48,617,34], quotesingle => [169,122,206,21], quotedblleft => [170,63,573,-50], guillemotleft => [171,-42,563,65], guilsinglleft => [172,-42,315,65], guilsinglright => [173,-7,315,30], fi => [174,-85,873,47], fl => [175,-85,916,4], endash => [177,-21,653,-21], dagger => [178,61,561,-12], daggerdbl => [179,-58,685,-17], periodcentered => [180,50,212,87], paragraph => [182,81,724,-13], bullet => [183,132,411,195], quotesinglbase => [184,-52,281,86], quotedblbase => [185,-85,575,96], quotedblright => [186,74,575,-63], guillemotright => [187,-7,563,30], ellipsis => [188,24,1024,170], perthousand => [189,31,1372,19], questiondown => [191,1,447,137], grave => [193,90,268,47], acute => [194,150,302,-46], circumflex => [195,28,417,-39], tilde => [196,41,451,-86], macron => [197,39,433,-65], breve => [198,81,394,-69], dotaccent => [199,176,174,54], dieresis => [200,41,436,-71], ring => [202,264,262,-120], cedilla => [203,-106,297,214], hungarumlaut => [205,28,547,-169], ogonek => [206,82,215,107], caron => [207,73,418,-85], emdash => [208,-21,1263,-21], AE => [225,-98,1200,-17], ordfeminine => [227,35,512,-45], Lslash => [232,-48,866,41], Oslash => [233,20,951,43], OE => [234,23,1172,-20], ordmasculine => [235,35,431,-32], ae => [241,-23,967,50], dotlessi => [245,46,384,43], lslash => [248,31,452,-9], oslash => [249,12,646,41], oe => [250,-6,994,51], germandbls => [251,-80,718,62], Yacute => [-1,18,929,-89], Ucircumflex => [-1,107,984,-75], Ugrave => [-1,107,984,-75], Zcaron => [-1,-35,907,-13], Ydieresis => [-1,18,929,-89], threesuperior => [-1,-4,429,-4], Uacute => [-1,107,984,-75], twosuperior => [-1,-19,458,-19], Udieresis => [-1,107,984,-75], middot => [-1,50,212,87], onesuperior => [-1,25,368,25], aacute => [-1,18,769,25], agrave => [-1,18,769,25], acircumflex => [-1,18,769,25], Scaron => [-1,1,811,23], Otilde => [-1,43,928,43], sfthyphen => [-1,12,319,74], atilde => [-1,18,769,25], aring => [-1,18,769,25], adieresis => [-1,18,769,25], Ograve => [-1,43,928,43], Ocircumflex => [-1,43,928,43], Odieresis => [-1,43,928,43], Ntilde => [-1,-69,1182,-73], edieresis => [-1,-2,606,29], eacute => [-1,-2,585,50], egrave => [-1,-2,585,50], Icircumflex => [-1,-50,642,-51], ecircumflex => [-1,-2,585,50], Igrave => [-1,-50,642,-51], Iacute => [-1,-50,642,-51], Idieresis => [-1,-50,657,-65], degree => [-1,85,366,36], Ecircumflex => [-1,-50,938,15], minus => [-1,50,614,74], multiply => [-1,50,617,71], divide => [-1,50,614,74], Egrave => [-1,-50,938,15], trademark => [-1,51,1146,-39], Oacute => [-1,43,928,43], thorn => [-1,-143,863,70], eth => [-1,12,646,41], Eacute => [-1,-50,938,15], ccedilla => [-1,3,590,61], idieresis => [-1,46,453,-25], iacute => [-1,46,440,-12], igrave => [-1,46,384,43], plusminus => [-1,50,614,74], onehalf => [-1,25,1019,4], onequarter => [-1,25,982,42], threequarters => [-1,-4,1012,42], icircumflex => [-1,46,420,7], Edieresis => [-1,-50,938,15], ntilde => [-1,3,779,52], Aring => [-1,-91,965,30], odieresis => [-1,12,646,41], oacute => [-1,12,646,41], ograve => [-1,12,646,41], ocircumflex => [-1,12,646,41], otilde => [-1,12,646,41], scaron => [-1,2,579,4], udieresis => [-1,46,733,56], uacute => [-1,46,733,56], ugrave => [-1,46,733,56], ucircumflex => [-1,46,733,56], yacute => [-1,-80,680,32], zcaron => [-1,-23,628,28], ydieresis => [-1,-80,680,32], copyright => [-1,28,854,29], registered => [-1,28,854,29], Atilde => [-1,-91,965,30], nbspace => [-1,0,0,350], Ccedilla => [-1,42,883,0], Acircumflex => [-1,-91,965,30], Agrave => [-1,-91,965,30], logicalnot => [-1,50,614,74], Aacute => [-1,-91,965,30], Eth => [-1,-59,1030,45], brokenbar => [-1,319,98,320], Thorn => [-1,-46,888,62], Adieresis => [-1,-91,965,30], mu => [-1,-109,889,56], '.notdef' => [-1,0,0,350], }} ); Prima-1.28/Prima/PS/fonts/Helvetica-Narrow0000644000175100017510000001512711150770061016120 0ustar dkdk('Helvetica-Narrow' => { name => 'Helvetica-Narrow', family => 'Helvetica', height => 1169, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 944, descent => 225, maximalWidth => 957, width => 957, internalLeading => 226, externalLeading => 74, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.63, yDeviceRes => 76.63, size => 1000, encoding => 'Latin1', chardata => { space => [32,24,0,241], exclam => [33,86,92,87], quotedbl => [34,66,206,66], numbersign => [35,26,480,25], dollar => [36,30,467,35], percent => [37,37,777,37], ampersand => [38,42,576,21], quoteright => [39,50,100,61], parenleft => [40,65,220,32], parenright => [41,32,220,65], asterisk => [42,37,296,38], plus => [43,37,485,37], comma => [44,82,100,82], hyphen => [45,42,234,42], period => [46,82,100,82], slash => [47,-16,299,-16], zero => [48,35,462,35], one => [49,97,246,189], two => [50,24,461,46], three => [51,32,467,32], four => [52,23,478,31], five => [53,30,461,40], six => [54,36,460,36], seven => [55,35,466,31], eight => [56,36,459,37], nine => [57,39,452,40], colon => [58,82,100,82], semicolon => [59,82,100,82], less => [60,45,468,45], equal => [61,37,485,37], greater => [62,45,468,45], question => [63,53,417,61], at => [64,141,690,140], A => [65,12,613,12], B => [66,71,529,38], C => [67,42,610,39], D => [68,77,569,45], E => [69,82,507,49], F => [70,82,475,26], G => [71,45,628,71], H => [72,73,545,72], I => [73,87,92,86], J => [74,16,393,68], K => [75,72,563,3], L => [76,72,441,18], M => [77,70,659,68], N => [78,72,547,72], O => [79,37,671,37], P => [80,82,513,43], Q => [81,37,671,37], R => [82,84,571,36], S => [83,46,547,45], T => [84,12,559,12], U => [85,75,541,74], V => [86,18,602,18], W => [87,15,874,15], X => [88,18,602,18], Y => [89,12,612,14], Z => [90,22,541,22], bracketleft => [91,60,178,26], backslash => [92,-16,299,-16], bracketright => [93,26,178,60], asciicircum => [94,-12,475,-12], underscore => [95,0,533,0], quoteleft => [96,61,100,50], a => [97,35,473,24], b => [98,56,439,37], c => [99,29,427,22], d => [100,33,444,54], e => [101,38,455,38], f => [102,12,238,15], g => [103,38,439,54], h => [104,61,409,61], i => [105,64,84,64], j => [106,-15,163,64], k => [107,64,416,-1], l => [108,64,84,64], m => [109,61,675,60], n => [110,61,409,61], o => [111,33,465,33], p => [112,56,439,37], q => [113,33,439,59], r => [114,73,244,1], s => [115,30,413,35], t => [116,12,233,19], u => [117,65,403,64], v => [118,8,462,8], w => [119,12,666,12], x => [120,10,459,9], y => [121,10,458,10], z => [122,29,420,29], braceleft => [123,39,239,40], bar => [124,90,70,88], braceright => [125,39,239,40], asciitilde => [126,58,443,58], exclamdown => [161,113,92,113], cent => [162,49,443,40], sterling => [163,31,485,16], fraction => [164,-158,478,-158], yen => [165,2,527,3], florin => [166,-10,490,52], section => [167,40,450,42], currency => [168,26,479,26], quotesingle => [169,56,70,57], quotedblleft => [170,36,258,24], guillemotleft => [171,93,346,93], guilsinglleft => [172,84,150,84], guilsinglright => [173,84,150,84], fi => [174,12,403,63], fl => [175,12,400,65], endash => [177,0,533,0], dagger => [178,40,451,40], daggerdbl => [179,40,451,40], periodcentered => [180,73,120,72], paragraph => [182,17,459,37], bullet => [183,17,301,16], quotesinglbase => [184,50,100,61], quotedblbase => [185,24,258,36], quotedblright => [186,24,258,36], guillemotright => [187,93,346,93], ellipsis => [188,109,738,109], perthousand => [189,7,945,5], questiondown => [191,87,417,80], grave => [193,12,189,116], acute => [194,116,189,12], circumflex => [195,19,279,19], tilde => [196,-3,326,-3], macron => [197,9,300,9], breve => [198,12,294,11], dotaccent => [199,115,87,115], dieresis => [200,38,241,38], ring => [202,71,176,71], cedilla => [203,43,204,71], hungarumlaut => [205,29,362,-72], ogonek => [206,70,204,44], caron => [207,19,279,19], emdash => [208,0,958,0], AE => [225,8,903,46], ordfeminine => [227,23,308,22], Lslash => [232,-18,533,18], Oslash => [233,37,672,36], OE => [234,35,889,33], ordmasculine => [235,23,303,22], ae => [241,35,777,39], dotlessi => [245,91,84,91], lslash => [248,-18,250,-18], oslash => [249,26,487,71], oe => [250,33,831,39], germandbls => [251,64,482,38], Yacute => [-1,12,612,14], Ucircumflex => [-1,75,541,74], Ugrave => [-1,75,541,74], Zcaron => [-1,22,541,22], Ydieresis => [-1,12,612,14], threesuperior => [-1,4,306,8], Uacute => [-1,75,541,74], twosuperior => [-1,3,306,9], Udieresis => [-1,75,541,74], middot => [-1,73,120,72], onesuperior => [-1,40,171,106], aacute => [-1,35,473,24], agrave => [-1,35,473,24], acircumflex => [-1,35,473,24], Scaron => [-1,46,547,45], Otilde => [-1,37,671,37], sfthyphen => [-1,42,234,42], atilde => [-1,35,473,24], aring => [-1,35,473,24], adieresis => [-1,35,473,24], Ograve => [-1,37,671,37], Ocircumflex => [-1,37,671,37], Odieresis => [-1,37,671,37], Ntilde => [-1,72,547,72], edieresis => [-1,38,455,38], eacute => [-1,38,455,38], egrave => [-1,38,455,38], Icircumflex => [-1,-5,279,-7], ecircumflex => [-1,38,455,38], Igrave => [-1,-12,191,87], Iacute => [-1,87,192,-14], Idieresis => [-1,12,241,11], degree => [-1,51,280,51], Ecircumflex => [-1,82,507,49], minus => [-1,37,485,37], multiply => [-1,37,485,37], divide => [-1,37,485,37], Egrave => [-1,82,507,49], trademark => [-1,44,820,93], Oacute => [-1,37,671,37], thorn => [-1,56,439,37], eth => [-1,33,466,32], Eacute => [-1,82,507,49], ccedilla => [-1,29,427,22], idieresis => [-1,12,241,11], iacute => [-1,91,189,-14], igrave => [-1,-12,189,90], plusminus => [-1,37,485,37], onehalf => [-1,40,700,58], onequarter => [-1,70,654,74], threequarters => [-1,43,732,23], icircumflex => [-1,-5,279,-7], Edieresis => [-1,82,507,49], ntilde => [-1,61,409,61], Aring => [-1,12,613,12], odieresis => [-1,33,465,33], oacute => [-1,33,465,33], ograve => [-1,33,465,33], ocircumflex => [-1,33,465,33], otilde => [-1,33,465,33], scaron => [-1,30,413,35], udieresis => [-1,65,403,64], uacute => [-1,65,403,64], ugrave => [-1,65,403,64], ucircumflex => [-1,65,403,64], yacute => [-1,10,458,10], zcaron => [-1,29,420,29], ydieresis => [-1,10,458,10], copyright => [-1,-12,734,-15], registered => [-1,-12,734,-15], Atilde => [-1,12,613,12], nbspace => [-1,24,0,241], Ccedilla => [-1,42,610,39], Acircumflex => [-1,12,613,12], Agrave => [-1,12,613,12], logicalnot => [-1,37,485,37], Aacute => [-1,12,613,12], Eth => [-1,0,646,45], brokenbar => [-1,90,70,88], Thorn => [-1,82,513,43], Adieresis => [-1,12,613,12], mu => [-1,65,403,64], '.notdef' => [-1,24,0,241], }} ); Prima-1.28/Prima/PS/fonts/AvantGarde-DemiOblique0000644000175100017510000001567611150770061017170 0ustar dkdk('AvantGarde-DemiOblique' => { name => 'AvantGarde-DemiOblique', family => 'AvantGarde', height => 1258, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 1007, descent => 251, maximalWidth => 1403, width => 1403, internalLeading => 268, externalLeading => 88, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 73, yDeviceRes => 73, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,352], exclam => [33,90,339,-77], quotedbl => [34,212,315,-75], numbersign => [35,96,686,-79], dollar => [36,125,597,-18], percent => [37,155,935,-10], ampersand => [38,89,842,-76], quoteright => [39,200,230,-77], parenleft => [40,153,457,-133], parenright => [41,16,457,3], asterisk => [42,221,395,-62], plus => [43,125,660,-31], comma => [44,59,230,62], hyphen => [45,153,376,-1], period => [46,90,198,62], slash => [47,2,727,-150], zero => [48,85,698,-79], one => [49,309,339,55], two => [50,52,725,-74], three => [51,66,651,-13], four => [52,25,715,-36], five => [53,62,674,-32], six => [54,77,656,-30], seven => [55,106,694,-96], eight => [56,86,645,-27], nine => [57,135,654,-85], colon => [58,90,284,-22], semicolon => [59,59,315,-22], less => [60,123,717,-85], equal => [61,101,706,-54], greater => [62,70,715,-31], question => [63,162,574,-32], at => [64,80,964,-114], A => [65,8,913,8], B => [66,85,678,-33], C => [67,115,963,-98], D => [68,85,837,-42], E => [69,85,671,-103], F => [70,85,645,-127], G => [71,114,1002,-60], H => [72,85,849,-79], I => [73,85,344,-77], J => [74,47,645,-89], K => [75,85,840,-145], L => [76,85,488,-20], M => [77,85,1143,-96], N => [78,85,925,-80], O => [79,114,986,-44], P => [80,85,718,-99], Q => [81,114,1003,-61], R => [82,85,740,-96], S => [83,61,666,-74], T => [84,149,548,-169], U => [85,137,748,-80], V => [86,182,862,-164], W => [87,181,1120,-169], X => [88,6,1016,-167], Y => [89,176,783,-179], Z => [90,22,729,-123], bracketleft => [91,125,413,-137], backslash => [92,278,354,172], bracketright => [93,16,418,-32], asciicircum => [94,163,603,-12], underscore => [95,-32,650,11], quoteleft => [96,202,228,-79], a => [97,94,808,-72], b => [98,67,806,-44], c => [99,96,745,-37], d => [100,95,847,-113], e => [101,95,740,-31], f => [102,71,447,-167], g => [103,37,860,-67], h => [104,67,703,-16], i => [105,67,339,-105], j => [106,-21,451,-103], k => [107,67,718,-56], l => [108,67,339,-105], m => [109,67,1129,-15], n => [110,67,703,-16], o => [111,95,753,-44], p => [112,25,844,-38], q => [113,96,801,-67], r => [114,67,450,-115], s => [115,61,544,-52], t => [116,93,397,-113], u => [117,110,706,-62], v => [118,130,694,-120], w => [119,142,974,-110], x => [120,1,790,-86], y => [121,91,752,-114], z => [122,25,639,-85], braceleft => [123,118,434,-124], bar => [124,305,322,127], braceright => [125,17,435,-25], asciitilde => [126,132,646,-23], exclamdown => [161,47,339,-35], cent => [162,133,612,-41], sterling => [163,50,724,-70], fraction => [164,-152,676,-323], yen => [165,64,849,-208], florin => [166,-55,868,-108], section => [167,85,679,-60], currency => [168,86,718,-100], quotesingle => [169,212,148,-84], quotedblleft => [170,200,489,-85], guillemotleft => [171,106,496,-25], guilsinglleft => [172,106,228,-33], guilsinglright => [173,123,228,-50], fi => [174,69,683,-98], fl => [175,69,683,-98], endash => [177,60,656,-88], dagger => [178,162,601,-59], daggerdbl => [179,120,652,-69], periodcentered => [180,149,197,5], paragraph => [182,167,667,-80], bullet => [183,239,431,84], quotesinglbase => [184,57,228,65], quotedblbase => [185,56,490,56], quotedblright => [186,197,490,-84], guillemotright => [187,123,496,-41], ellipsis => [188,125,1036,95], perthousand => [189,155,1455,-1], questiondown => [191,89,574,40], grave => [193,265,343,-80], acute => [194,257,356,-85], circumflex => [195,237,501,-60], tilde => [196,259,405,-60], macron => [197,237,373,-83], breve => [198,269,415,-80], dotaccent => [199,237,198,-84], dieresis => [200,237,462,-71], ring => [202,259,264,-70], cedilla => [203,52,254,120], hungarumlaut => [205,256,709,-85], ogonek => [206,65,230,132], caron => [207,269,501,-91], emdash => [208,60,1285,-88], AE => [225,21,1211,-100], ordfeminine => [227,113,490,-150], Lslash => [232,61,564,-22], Oslash => [233,114,1001,-59], OE => [234,125,1309,-101], ordmasculine => [235,113,454,-114], ae => [241,95,1298,-35], dotlessi => [245,67,296,-62], lslash => [248,74,454,-125], oslash => [249,95,759,-25], oe => [250,95,1294,-31], germandbls => [251,64,725,-35], Yacute => [-1,176,783,-179], Ucircumflex => [-1,137,748,-80], Ugrave => [-1,137,748,-80], Zcaron => [-1,22,754,-148], Ydieresis => [-1,176,783,-179], threesuperior => [-1,103,418,-99], Uacute => [-1,137,748,-80], twosuperior => [-1,88,465,-130], Udieresis => [-1,137,748,-80], middot => [-1,149,197,5], onesuperior => [-1,262,212,-52], aacute => [-1,94,808,-72], agrave => [-1,94,808,-72], acircumflex => [-1,94,808,-72], Scaron => [-1,61,740,-148], Otilde => [-1,114,986,-44], sfthyphen => [-1,153,376,-1], atilde => [-1,94,808,-72], aring => [-1,94,808,-72], adieresis => [-1,94,808,-72], Ograve => [-1,114,986,-44], Ocircumflex => [-1,114,986,-44], Odieresis => [-1,114,986,-44], Ntilde => [-1,85,925,-80], edieresis => [-1,95,740,-31], eacute => [-1,95,740,-31], egrave => [-1,95,740,-31], Icircumflex => [-1,85,533,-266], ecircumflex => [-1,95,740,-31], Igrave => [-1,85,478,-211], Iacute => [-1,85,440,-173], Idieresis => [-1,85,519,-252], degree => [-1,197,383,-77], Ecircumflex => [-1,85,684,-115], minus => [-1,124,661,-31], multiply => [-1,98,713,-56], divide => [-1,125,660,-31], Egrave => [-1,85,671,-103], trademark => [-1,244,1096,-83], Oacute => [-1,114,986,-44], thorn => [-1,25,844,-38], eth => [-1,95,759,-50], Eacute => [-1,85,671,-103], ccedilla => [-1,96,745,-37], idieresis => [-1,67,469,-235], iacute => [-1,67,432,-198], igrave => [-1,67,427,-193], plusminus => [-1,64,734,-44], onehalf => [-1,257,860,-61], onequarter => [-1,262,827,-33], threequarters => [-1,103,987,-33], icircumflex => [-1,49,501,-249], Edieresis => [-1,85,671,-103], ntilde => [-1,67,703,-16], Aring => [-1,8,913,8], odieresis => [-1,95,753,-44], oacute => [-1,95,753,-44], ograve => [-1,95,753,-44], ocircumflex => [-1,95,753,-44], otilde => [-1,95,753,-44], scaron => [-1,61,646,-154], udieresis => [-1,110,706,-62], uacute => [-1,110,706,-62], ugrave => [-1,110,706,-62], ucircumflex => [-1,110,706,-62], yacute => [-1,91,752,-114], zcaron => [-1,25,695,-142], ydieresis => [-1,91,752,-114], copyright => [-1,62,986,-118], registered => [-1,62,986,-118], Atilde => [-1,8,913,8], nbspace => [-1,0,0,352], Ccedilla => [-1,115,963,-98], Acircumflex => [-1,8,913,8], Agrave => [-1,8,913,8], logicalnot => [-1,147,661,-54], Aacute => [-1,8,913,8], Eth => [-1,91,884,-42], brokenbar => [-1,305,322,127], Thorn => [-1,85,685,-66], Adieresis => [-1,8,913,8], mu => [-1,25,792,-93], '.notdef' => [-1,0,0,352], }} ); Prima-1.28/Prima/PS/fonts/Bookman-Demi0000644000175100017510000001515411150770061015210 0ustar dkdk('Bookman-Demi' => { name => 'Bookman-Demi', family => 'Bookman', height => 1172, weigth => fw::Bold, style => fs::Bold, pitch => fp::Variable, vector => 1, ascent => 924, descent => 248, maximalWidth => 1541, width => 1541, internalLeading => 200, externalLeading => 66, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 74.35, yDeviceRes => 74.35, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,398], exclam => [33,96,234,91], quotedbl => [34,12,419,59], numbersign => [35,98,576,98], dollar => [36,56,670,46], percent => [37,14,1068,18], ampersand => [38,24,880,32], quoteright => [39,96,187,91], parenleft => [40,56,282,36], parenright => [41,23,283,67], asterisk => [42,72,401,64], plus => [43,59,590,52], comma => [44,91,209,97], hyphen => [45,23,375,23], period => [46,89,212,97], slash => [47,58,591,52], zero => [48,35,713,24], one => [49,160,505,107], two => [50,48,687,37], three => [51,43,696,33], four => [52,22,738,12], five => [53,51,678,43], six => [54,39,703,30], seven => [55,42,698,32], eight => [56,42,699,31], nine => [57,38,706,28], colon => [58,89,212,97], semicolon => [59,87,215,94], less => [60,57,596,49], equal => [61,59,590,52], greater => [62,56,596,50], question => [63,71,641,60], at => [64,70,818,72], A => [65,-39,934,-50], B => [66,23,788,31], C => [67,41,807,18], D => [68,23,853,37], E => [69,23,825,-4], F => [70,23,780,-7], G => [71,41,864,8], H => [72,23,914,23], I => [73,23,420,24], J => [74,-14,743,21], K => [75,23,909,4], L => [76,23,759,-32], M => [77,23,1059,18], N => [78,23,825,18], O => [79,41,860,36], P => [80,23,747,2], Q => [81,41,867,29], R => [82,23,894,-3], S => [83,24,724,24], T => [84,-4,828,-3], U => [85,17,830,18], V => [86,-23,879,-11], W => [87,-23,1152,-26], X => [88,1,901,11], Y => [89,-23,864,-21], Z => [90,7,737,5], bracketleft => [91,87,246,17], backslash => [92,58,591,52], bracketright => [93,24,246,80], asciicircum => [94,60,588,53], underscore => [95,0,586,0], quoteleft => [96,96,187,91], a => [97,32,656,-9], b => [98,-23,689,37], c => [99,36,608,35], d => [100,36,692,21], e => [101,36,605,37], f => [102,25,514,-94], g => [103,10,672,-3], h => [104,25,740,30], i => [105,25,366,29], j => [106,-110,435,72], k => [107,25,727,19], l => [108,10,366,21], m => [109,25,1122,23], n => [110,25,738,32], o => [111,36,649,41], p => [112,25,690,33], q => [113,36,705,-15], r => [114,25,515,-2], s => [115,25,550,32], t => [116,25,495,17], u => [117,25,739,8], v => [118,-7,702,8], w => [119,-7,956,-11], x => [120,9,683,10], y => [121,7,711,8], z => [122,25,615,15], braceleft => [123,39,288,46], bar => [124,284,139,278], braceright => [125,41,287,46], asciitilde => [126,59,590,52], exclamdown => [161,98,234,89], cent => [162,155,471,146], sterling => [163,11,760,1], fraction => [164,-227,593,-225], yen => [165,-32,848,-42], florin => [166,-53,843,-16], section => [167,42,614,46], currency => [168,90,594,89], quotesingle => [169,49,159,72], quotedblleft => [170,96,430,106], guillemotleft => [171,39,382,46], guilsinglleft => [172,39,180,37], guilsinglright => [173,39,180,37], fi => [174,25,806,35], fl => [175,25,806,35], endash => [177,-29,644,-29], dagger => [178,38,427,49], daggerdbl => [179,9,435,0], periodcentered => [180,89,212,97], paragraph => [182,16,870,50], bullet => [183,70,403,65], quotesinglbase => [184,96,187,91], quotedblbase => [185,96,431,105], quotedblright => [186,96,430,106], guillemotright => [187,39,382,46], ellipsis => [188,89,992,90], perthousand => [189,14,1563,16], questiondown => [191,72,641,59], grave => [193,79,303,85], acute => [194,79,303,85], circumflex => [195,79,424,82], tilde => [196,80,412,69], macron => [197,79,369,90], breve => [198,79,423,83], dotaccent => [199,79,223,71], dieresis => [200,79,437,69], ring => [202,79,242,76], cedilla => [203,79,253,89], hungarumlaut => [205,79,348,87], ogonek => [206,79,208,86], caron => [207,79,424,82], emdash => [208,-29,1230,-29], AE => [225,-39,1386,-10], ordfeminine => [227,31,432,4], Lslash => [232,23,759,-32], Oslash => [233,41,862,33], OE => [234,41,1387,1], ordmasculine => [235,19,428,19], ae => [241,32,965,32], dotlessi => [245,25,366,29], lslash => [248,10,366,21], oslash => [249,36,650,39], oe => [250,36,1027,37], germandbls => [251,-71,826,18], Yacute => [-1,-23,864,-21], Ucircumflex => [-1,17,830,18], Ugrave => [-1,17,830,18], Zcaron => [-1,7,737,5], Ydieresis => [-1,-23,864,-21], threesuperior => [-1,5,452,5], Uacute => [-1,17,830,18], twosuperior => [-1,16,447,0], Udieresis => [-1,17,830,18], middot => [-1,89,212,97], onesuperior => [-1,76,328,59], aacute => [-1,32,656,-9], agrave => [-1,32,656,-9], acircumflex => [-1,32,656,-9], Scaron => [-1,24,724,24], Otilde => [-1,41,860,36], sfthyphen => [-1,23,375,23], atilde => [-1,32,656,-9], aring => [-1,32,656,-9], adieresis => [-1,32,656,-9], Ograve => [-1,41,860,36], Ocircumflex => [-1,41,860,36], Odieresis => [-1,41,860,36], Ntilde => [-1,23,825,18], edieresis => [-1,36,605,37], eacute => [-1,36,605,37], egrave => [-1,36,605,37], Icircumflex => [-1,21,424,23], ecircumflex => [-1,36,605,37], Igrave => [-1,23,420,24], Iacute => [-1,23,420,24], Idieresis => [-1,21,437,10], degree => [-1,58,351,58], Ecircumflex => [-1,23,825,-4], minus => [-1,59,590,52], multiply => [-1,56,590,56], divide => [-1,59,590,52], Egrave => [-1,23,825,-4], trademark => [-1,49,1101,-2], Oacute => [-1,41,860,36], thorn => [-1,25,690,33], eth => [-1,36,649,41], Eacute => [-1,23,825,-4], ccedilla => [-1,36,608,35], idieresis => [-1,-2,437,-12], iacute => [-1,25,366,29], igrave => [-1,25,366,29], plusminus => [-1,59,590,52], onehalf => [-1,76,1072,11], onequarter => [-1,76,1057,26], threequarters => [-1,17,1115,26], icircumflex => [-1,-2,424,0], Edieresis => [-1,23,825,-4], ntilde => [-1,25,738,32], Aring => [-1,-39,934,-50], odieresis => [-1,36,649,41], oacute => [-1,36,649,41], ograve => [-1,36,649,41], ocircumflex => [-1,36,649,41], otilde => [-1,36,649,41], scaron => [-1,25,550,32], udieresis => [-1,25,739,8], uacute => [-1,25,739,8], ugrave => [-1,25,739,8], ucircumflex => [-1,25,739,8], yacute => [-1,7,711,8], zcaron => [-1,25,615,15], ydieresis => [-1,7,711,8], copyright => [-1,26,820,19], registered => [-1,26,820,19], Atilde => [-1,-39,934,-50], nbspace => [-1,0,0,398], Ccedilla => [-1,41,807,18], Acircumflex => [-1,-39,934,-50], Agrave => [-1,-39,934,-50], logicalnot => [-1,59,590,52], Aacute => [-1,-39,934,-50], Eth => [-1,23,853,37], brokenbar => [-1,284,139,278], Thorn => [-1,23,747,2], Adieresis => [-1,-39,934,-50], mu => [-1,25,739,8], '.notdef' => [-1,0,0,398], }} ); Prima-1.28/Prima/PS/fonts/Palatino-Italic0000644000175100017510000001525311150770061015720 0ustar dkdk('Palatino-Italic' => { name => 'Palatino-Italic', family => 'Palatino', height => 1213, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 937, descent => 276, maximalWidth => 1181, width => 1181, internalLeading => 204, externalLeading => 67, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 71.62, yDeviceRes => 71.62, size => 1000, encoding => 'Latin1', chardata => { space => [32,151,0,151], exclam => [33,92,262,49], quotedbl => [34,169,382,54], numbersign => [35,4,595,6], dollar => [36,18,530,58], percent => [37,89,891,97], ampersand => [38,57,872,14], quoteright => [39,94,218,24], parenleft => [40,65,336,2], parenright => [41,2,336,65], asterisk => [42,92,393,-13], plus => [43,61,611,61], comma => [44,9,236,57], hyphen => [45,23,345,35], period => [46,64,127,111], slash => [47,-48,524,-116], zero => [48,43,538,24], one => [49,65,417,123], two => [50,14,515,76], three => [51,26,515,64], four => [52,18,561,26], five => [53,16,578,10], six => [54,59,509,37], seven => [55,64,544,-2], eight => [56,43,525,37], nine => [57,38,528,38], colon => [58,53,197,52], semicolon => [59,-10,276,37], less => [60,64,607,63], equal => [61,61,611,61], greater => [62,64,607,63], question => [63,138,379,88], at => [64,32,838,35], A => [65,-23,844,54], B => [66,31,646,63], C => [67,54,735,19], D => [68,33,864,44], E => [69,36,655,49], F => [70,0,664,9], G => [71,60,781,33], H => [72,-3,974,-26], I => [73,8,420,-25], J => [74,-42,476,-30], K => [75,15,812,-19], L => [76,19,614,40], M => [77,-23,1163,4], N => [78,2,972,-31], O => [79,64,843,36], P => [80,10,709,20], Q => [81,64,843,36], R => [82,10,764,33], S => [83,50,562,60], T => [84,64,705,-29], U => [85,106,861,-24], V => [86,90,823,-38], W => [87,86,1102,-43], X => [88,24,866,-14], Y => [89,63,755,-9], Z => [90,24,748,36], bracketleft => [91,21,373,8], backslash => [92,98,524,112], bracketright => [93,8,373,21], asciicircum => [94,61,610,63], underscore => [95,0,606,0], quoteleft => [96,94,218,24], a => [97,4,487,46], b => [98,44,480,36], c => [99,30,441,21], d => [100,20,565,20], e => [101,18,435,18], f => [102,-196,697,-163], g => [103,-44,648,2], h => [104,12,559,35], i => [105,41,278,16], j => [106,-84,406,15], k => [107,9,534,-6], l => [108,43,260,32], m => [109,29,868,46], n => [110,29,594,50], o => [111,20,477,40], p => [112,-8,572,42], q => [113,29,494,37], r => [114,31,434,6], s => [115,10,407,53], t => [116,49,326,27], u => [117,38,582,53], v => [118,25,553,27], w => [119,25,822,27], x => [120,10,576,19], y => [121,-9,604,12], z => [122,-1,505,33], braceleft => [123,18,368,16], bar => [124,333,67,333], braceright => [125,16,368,18], asciitilde => [126,61,611,61], exclamdown => [161,18,264,121], cent => [162,67,439,99], sterling => [163,2,578,25], fraction => [164,-206,614,-206], yen => [165,42,578,-14], florin => [166,6,564,36], section => [167,16,544,44], currency => [168,16,572,16], quotesingle => [169,169,179,54], quotedblleft => [170,118,457,30], guillemotleft => [171,69,460,76], guilsinglleft => [172,69,258,76], guilsinglright => [173,76,258,69], fi => [174,-196,805,31], fl => [175,-196,827,30], endash => [177,-12,630,-12], dagger => [178,58,510,37], daggerdbl => [179,12,587,7], periodcentered => [180,64,127,111], paragraph => [182,40,701,-134], bullet => [183,104,417,84], quotesinglbase => [184,32,223,81], quotedblbase => [185,52,462,92], quotedblright => [186,118,457,30], guillemotright => [187,76,460,69], ellipsis => [188,123,935,154], perthousand => [189,87,1039,86], questiondown => [191,69,379,157], grave => [193,104,271,27], acute => [194,147,271,-15], circumflex => [195,67,356,-20], tilde => [196,76,396,-69], macron => [197,89,378,-64], breve => [198,111,365,-72], dotaccent => [199,212,131,60], dieresis => [200,94,363,-54], ring => [202,192,242,-31], cedilla => [203,-10,255,158], hungarumlaut => [205,55,411,-63], ogonek => [206,46,191,166], caron => [207,126,369,-92], emdash => [208,-12,1237,-12], AE => [225,-4,1098,47], ordfeminine => [227,72,316,14], Lslash => [232,-19,653,40], Oslash => [233,38,885,19], OE => [234,67,1131,47], ordmasculine => [235,80,310,13], ae => [241,1,754,18], dotlessi => [245,41,251,44], lslash => [248,-12,378,-29], oslash => [249,-21,579,-19], oe => [250,20,772,18], germandbls => [251,-194,786,14], Yacute => [-1,63,755,-9], Ucircumflex => [-1,106,861,-24], Ugrave => [-1,106,861,-24], Zcaron => [-1,24,748,36], Ydieresis => [-1,63,755,-9], threesuperior => [-1,33,334,-4], Uacute => [-1,106,861,-24], twosuperior => [-1,15,336,12], Udieresis => [-1,106,861,-24], middot => [-1,64,127,111], onesuperior => [-1,73,271,18], aacute => [-1,4,538,-4], agrave => [-1,4,487,46], acircumflex => [-1,4,487,46], Scaron => [-1,50,627,-3], Otilde => [-1,64,843,36], sfthyphen => [-1,23,345,35], atilde => [-1,4,536,-2], aring => [-1,4,487,46], adieresis => [-1,4,521,12], Ograve => [-1,64,843,36], Ocircumflex => [-1,64,843,36], Odieresis => [-1,64,843,36], Ntilde => [-1,2,972,-31], edieresis => [-1,18,474,-20], eacute => [-1,18,459,-6], egrave => [-1,18,435,18], Icircumflex => [-1,8,464,-69], ecircumflex => [-1,18,464,-10], Igrave => [-1,8,420,-25], Iacute => [-1,8,483,-88], Idieresis => [-1,8,474,-78], degree => [-1,109,363,12], Ecircumflex => [-1,36,655,49], minus => [-1,61,611,61], multiply => [-1,100,533,100], divide => [-1,61,611,61], Egrave => [-1,36,655,49], trademark => [-1,63,1090,59], Oacute => [-1,64,843,36], thorn => [-1,-47,572,81], eth => [-1,20,559,-41], Eacute => [-1,36,655,49], ccedilla => [-1,30,441,21], idieresis => [-1,41,384,-88], iacute => [-1,41,360,-64], igrave => [-1,41,287,8], plusminus => [-1,61,611,61], onehalf => [-1,37,836,35], onequarter => [-1,37,829,42], threequarters => [-1,42,824,42], icircumflex => [-1,35,356,-54], Edieresis => [-1,36,655,49], ntilde => [-1,29,594,50], Aring => [-1,-23,844,54], odieresis => [-1,20,505,12], oacute => [-1,20,481,36], ograve => [-1,20,477,40], ocircumflex => [-1,20,477,40], otilde => [-1,20,520,-2], scaron => [-1,10,497,-36], udieresis => [-1,38,582,53], uacute => [-1,38,599,36], ugrave => [-1,38,582,53], ucircumflex => [-1,38,582,53], yacute => [-1,-9,604,12], zcaron => [-1,-1,543,-3], ydieresis => [-1,-9,604,12], copyright => [-1,13,879,13], registered => [-1,13,879,13], Atilde => [-1,-23,844,54], nbspace => [-1,151,0,151], Ccedilla => [-1,54,735,19], Acircumflex => [-1,-23,844,54], Agrave => [-1,-23,844,54], logicalnot => [-1,61,611,61], Aacute => [-1,-23,844,54], Eth => [-1,23,875,44], brokenbar => [-1,333,67,333], Thorn => [-1,10,680,49], Adieresis => [-1,-23,844,54], mu => [-1,18,602,53], '.notdef' => [-1,151,0,151], }} ); Prima-1.28/Prima/PS/fonts/Times-BoldItalic0000644000175100017510000001537211150770061016035 0ustar dkdk('Times-BoldItalic' => { name => 'Times-BoldItalic', family => 'Times', height => 1167, weigth => fw::Bold, style => fs::Bold|fs::Italic, pitch => fp::Variable, vector => 1, ascent => 949, descent => 218, maximalWidth => 1197, width => 1197, internalLeading => 250, externalLeading => 82, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 78.81, yDeviceRes => 78.81, size => 1000, encoding => 'Latin1', chardata => { space => [32,145,0,145], exclam => [33,78,353,22], quotedbl => [34,158,466,22], numbersign => [35,-38,660,-38], dollar => [36,-23,603,3], percent => [37,45,879,46], ampersand => [38,5,809,92], quoteright => [39,114,238,36], parenleft => [40,32,368,-12], parenright => [41,-51,367,72], asterisk => [42,75,456,51], plus => [43,38,588,38], comma => [44,-70,238,123], hyphen => [45,2,313,72], period => [46,-10,172,129], slash => [47,-74,473,-74], zero => [48,19,536,26], one => [49,5,483,94], two => [50,-31,551,63], three => [51,-17,542,58], four => [52,-17,604,-3], five => [53,-12,581,15], six => [54,26,567,-10], seven => [55,60,551,-29], eight => [56,3,551,28], nine => [57,-14,568,29], colon => [58,26,281,80], semicolon => [59,-29,337,80], less => [60,36,592,36], equal => [61,38,588,38], greater => [62,36,592,36], question => [63,92,456,35], at => [64,73,825,72], A => [65,-78,770,86], B => [66,-28,756,50], C => [67,37,752,-11], D => [68,-53,853,43], E => [69,-31,793,16], F => [70,-15,785,8], G => [71,24,799,18], H => [72,-28,960,-24], I => [73,-37,511,-19], J => [74,-53,665,-28], K => [75,-24,843,-40], L => [76,-25,714,24], M => [77,-33,1103,-32], N => [78,-31,904,-30], O => [79,31,774,36], P => [80,-31,746,-2], Q => [81,31,774,36], R => [82,-33,760,51], S => [83,2,611,35], T => [84,58,700,-45], U => [85,78,790,-25], V => [86,75,758,-56], W => [87,75,1021,-59], X => [88,-28,837,-31], Y => [89,85,683,-56], Z => [90,-12,701,24], bracketleft => [91,-43,465,-33], backslash => [92,-1,326,-1], bracketright => [93,-65,465,-11], asciicircum => [94,78,508,78], underscore => [95,0,583,0], quoteleft => [96,149,238,1], a => [97,-24,555,52], b => [98,-16,534,65], c => [99,-5,463,60], d => [100,-24,627,-19], e => [101,5,458,53], f => [102,-197,717,-131], g => [103,-60,618,25], h => [104,-15,596,67], i => [105,2,303,18], j => [106,-220,546,-1], k => [107,-26,590,19], l => [108,2,336,-14], m => [109,-16,858,65], n => [110,-7,582,73], o => [111,-3,518,68], p => [112,-140,660,63], q => [113,1,548,33], r => [114,-24,478,0], s => [115,-22,410,65], t => [116,-12,340,-3], u => [117,17,556,74], v => [118,18,449,50], w => [119,18,697,61], x => [120,-53,601,36], y => [121,-109,567,60], z => [122,-50,479,24], braceleft => [123,5,502,-102], bar => [124,77,102,77], braceright => [125,-150,502,53], asciitilde => [126,63,539,63], exclamdown => [161,22,351,80], cent => [162,49,463,71], sterling => [163,-37,632,-11], fraction => [164,-197,575,-183], yen => [165,38,694,-149], florin => [166,-101,728,-43], section => [167,42,493,47], currency => [168,-30,644,-30], quotesingle => [169,149,163,11], quotedblleft => [170,61,536,-15], guillemotleft => [171,14,532,37], guilsinglleft => [172,37,316,35], guilsinglright => [173,11,316,60], fi => [174,-219,819,49], fl => [175,-217,862,3], endash => [177,-46,603,26], dagger => [178,106,470,7], daggerdbl => [179,11,563,8], periodcentered => [180,59,172,59], paragraph => [182,-66,722,-72], bullet => [183,0,408,0], quotesinglbase => [184,-5,238,156], quotedblbase => [185,-66,536,113], quotedblright => [186,61,536,-15], guillemotright => [187,14,532,37], ellipsis => [188,46,947,172], perthousand => [189,8,1154,4], questiondown => [191,35,456,92], grave => [193,99,247,42], acute => [194,162,280,-53], circumflex => [195,46,381,-39], tilde => [196,56,418,-86], macron => [197,59,399,-70], breve => [198,82,368,-63], dotaccent => [199,190,151,46], dieresis => [200,64,399,-74], ring => [202,148,248,-8], cedilla => [203,-93,275,206], hungarumlaut => [205,80,500,-192], ogonek => [206,-46,267,168], caron => [207,92,387,-91], emdash => [208,-46,1186,26], AE => [225,-74,1145,30], ordfeminine => [227,18,366,-74], Lslash => [232,-25,714,24], Oslash => [233,31,774,36], OE => [234,26,1077,-2], ordmasculine => [235,65,343,-58], ae => [241,-5,791,57], dotlessi => [245,2,275,46], lslash => [248,-15,366,-26], oslash => [249,-3,518,68], oe => [250,7,779,56], germandbls => [251,-233,785,31], Yacute => [-1,85,683,-56], Ucircumflex => [-1,78,790,-25], Ugrave => [-1,78,790,-25], Zcaron => [-1,-12,701,24], Ydieresis => [-1,85,683,-56], threesuperior => [-1,19,354,-24], Uacute => [-1,78,790,-25], twosuperior => [-1,2,362,-15], Udieresis => [-1,78,790,-25], middot => [-1,59,172,59], onesuperior => [-1,35,316,-1], aacute => [-1,-24,564,43], agrave => [-1,-24,555,52], acircumflex => [-1,-24,555,52], Scaron => [-1,2,611,35], Otilde => [-1,31,774,36], sfthyphen => [-1,2,313,72], atilde => [-1,-24,597,10], aring => [-1,-24,555,52], adieresis => [-1,-24,574,33], Ograve => [-1,31,774,36], Ocircumflex => [-1,31,774,36], Odieresis => [-1,31,774,36], Ntilde => [-1,-31,904,-30], edieresis => [-1,5,511,1], eacute => [-1,5,501,10], egrave => [-1,5,458,53], Icircumflex => [-1,-37,527,-36], ecircumflex => [-1,5,487,24], Igrave => [-1,-37,511,-19], Iacute => [-1,-37,512,-21], Idieresis => [-1,-37,556,-65], degree => [-1,96,333,36], Ecircumflex => [-1,-31,793,16], minus => [-1,59,588,59], multiply => [-1,56,553,56], divide => [-1,38,588,38], Egrave => [-1,-31,793,16], trademark => [-1,37,1092,37], Oacute => [-1,31,774,36], thorn => [-1,-140,660,63], eth => [-1,-3,533,53], Eacute => [-1,-31,793,16], ccedilla => [-1,-28,485,60], idieresis => [-1,2,417,-95], iacute => [-1,2,408,-86], igrave => [-1,2,301,21], plusminus => [-1,38,588,38], onehalf => [-1,-10,854,31], onequarter => [-1,8,833,33], threequarters => [-1,8,839,28], icircumflex => [-1,-2,381,-54], Edieresis => [-1,-31,793,16], ntilde => [-1,-7,595,60], Aring => [-1,-78,770,86], odieresis => [-1,-3,547,39], oacute => [-1,-3,543,43], ograve => [-1,-3,518,68], ocircumflex => [-1,-3,529,57], otilde => [-1,-3,576,10], scaron => [-1,-22,534,-58], udieresis => [-1,17,558,72], uacute => [-1,17,556,74], ugrave => [-1,17,556,74], ucircumflex => [-1,17,556,74], yacute => [-1,-109,617,10], zcaron => [-1,-50,544,-40], ydieresis => [-1,-109,620,7], copyright => [-1,35,802,33], registered => [-1,35,802,33], Atilde => [-1,-78,770,86], nbspace => [-1,145,0,145], Ccedilla => [-1,37,752,-11], Acircumflex => [-1,-78,770,86], Agrave => [-1,-78,770,86], logicalnot => [-1,59,588,59], Aacute => [-1,-78,770,86], Eth => [-1,-36,853,25], brokenbar => [-1,77,102,77], Thorn => [-1,-31,700,44], Adieresis => [-1,-78,770,86], mu => [-1,-70,672,70], '.notdef' => [-1,145,0,145], }} ); Prima-1.28/Prima/PS/fonts/Bookman-Light0000644000175100017510000001524211150770061015377 0ustar dkdk('Bookman-Light' => { name => 'Bookman-Light', family => 'Bookman', height => 1163, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 922, descent => 241, maximalWidth => 1455, width => 1455, internalLeading => 205, externalLeading => 67, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 75.43, yDeviceRes => 75.43, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,372], exclam => [33,87,167,94], quotedbl => [34,65,310,66], numbersign => [35,75,571,74], dollar => [36,39,650,31], percent => [37,25,989,31], ampersand => [38,52,862,15], quoteright => [39,53,153,48], parenleft => [40,88,234,25], parenright => [41,19,234,94], asterisk => [42,62,391,56], plus => [43,59,586,52], comma => [44,104,154,112], hyphen => [45,58,348,58], period => [46,106,148,116], slash => [47,86,532,79], zero => [48,46,634,39], one => [49,186,396,138], two => [50,48,621,51], three => [51,46,623,51], four => [52,29,668,23], five => [53,69,609,41], six => [54,52,633,34], seven => [55,69,611,39], eight => [56,51,626,43], nine => [57,43,626,51], colon => [58,106,148,116], semicolon => [59,104,154,112], less => [60,56,591,48], equal => [61,59,586,52], greater => [62,55,591,50], question => [63,31,566,30], at => [64,63,814,75], A => [65,-43,873,-39], B => [66,36,780,44], C => [67,51,765,44], D => [68,36,838,55], E => [69,36,783,17], F => [70,36,724,-16], G => [71,51,853,25], H => [72,36,858,36], I => [73,36,314,45], J => [74,-26,686,38], K => [75,36,836,-34], L => [76,36,695,-33], M => [77,30,1009,30], N => [78,30,809,20], O => [79,51,830,48], P => [80,36,676,8], Q => [81,51,843,59], R => [82,36,844,-43], S => [83,32,704,30], T => [84,-43,805,-41], U => [85,29,847,30], V => [86,-34,878,-29], W => [87,-34,1179,-27], X => [88,-34,912,-40], Y => [89,-34,809,-30], Z => [90,11,751,-18], bracketleft => [91,106,193,48], backslash => [92,86,532,79], bracketright => [93,47,193,108], asciicircum => [94,60,583,53], underscore => [95,0,581,0], quoteleft => [96,53,153,48], a => [97,40,641,-8], b => [98,-2,679,44], c => [99,43,536,25], d => [100,43,644,33], e => [101,43,528,33], f => [102,23,458,-109], g => [103,19,610,-2], h => [104,23,724,19], i => [105,23,311,13], j => [106,-126,375,100], k => [107,23,707,-9], l => [108,23,309,16], m => [109,19,1059,13], n => [110,23,731,12], o => [111,43,568,39], p => [112,23,654,43], q => [113,43,641,-10], r => [114,23,496,-8], s => [115,46,519,38], t => [116,23,427,-9], u => [117,23,736,31], v => [118,-26,647,-16], w => [119,-22,957,-27], x => [120,-18,688,-18], y => [121,-26,665,-10], z => [122,8,545,4], braceleft => [123,40,247,37], bar => [124,307,90,300], braceright => [125,40,247,37], asciitilde => [126,60,586,51], exclamdown => [161,87,167,94], cent => [162,134,459,126], sterling => [163,9,724,-12], fraction => [164,-218,608,-226], yen => [165,-25,778,-31], florin => [166,-33,769,-15], section => [167,38,526,39], currency => [168,67,587,66], quotesingle => [169,77,100,77], quotedblleft => [170,53,351,60], guillemotleft => [171,59,303,55], guilsinglleft => [172,59,160,59], guilsinglright => [173,59,160,59], fi => [174,23,683,13], fl => [175,23,681,16], endash => [177,-17,616,-17], dagger => [178,91,437,98], daggerdbl => [179,91,437,98], periodcentered => [180,106,151,113], paragraph => [182,16,654,26], bullet => [183,69,400,65], quotesinglbase => [184,53,153,48], quotedblbase => [185,53,351,60], quotedblright => [186,53,351,60], guillemotright => [187,59,303,55], ellipsis => [188,117,926,118], perthousand => [189,25,1446,16], questiondown => [191,26,566,34], grave => [193,79,239,76], acute => [194,79,239,76], circumflex => [195,79,330,79], tilde => [196,79,357,75], macron => [197,79,344,88], breve => [198,79,381,74], dotaccent => [199,79,137,86], dieresis => [200,79,326,82], ring => [202,79,213,79], cedilla => [203,79,219,73], hungarumlaut => [205,79,282,80], ogonek => [206,79,205,87], caron => [207,79,330,79], emdash => [208,-17,1197,-17], AE => [225,-41,1495,11], ordfeminine => [227,56,400,31], Lslash => [232,36,695,-33], Oslash => [233,51,830,48], OE => [234,51,1360,30], ordmasculine => [235,65,354,68], ae => [241,40,926,32], dotlessi => [245,23,311,13], lslash => [248,23,315,33], oslash => [249,43,568,39], oe => [250,43,975,27], germandbls => [251,-126,840,53], Yacute => [-1,-34,809,-30], Ucircumflex => [-1,29,847,30], Ugrave => [-1,29,847,30], Zcaron => [-1,11,751,-18], Ydieresis => [-1,-34,809,-30], threesuperior => [-1,13,404,13], Uacute => [-1,29,847,30], twosuperior => [-1,23,403,5], Udieresis => [-1,29,847,30], middot => [-1,106,151,113], onesuperior => [-1,93,258,81], aacute => [-1,40,641,-8], agrave => [-1,40,641,-8], acircumflex => [-1,40,641,-8], Scaron => [-1,32,704,30], Otilde => [-1,51,830,48], sfthyphen => [-1,58,348,58], atilde => [-1,40,641,-8], aring => [-1,40,641,-8], adieresis => [-1,40,641,-8], Ograve => [-1,51,830,48], Ocircumflex => [-1,51,830,48], Odieresis => [-1,51,830,48], Ntilde => [-1,30,809,20], edieresis => [-1,43,528,33], eacute => [-1,43,528,33], egrave => [-1,43,528,33], Icircumflex => [-1,32,330,32], ecircumflex => [-1,43,528,33], Igrave => [-1,36,314,45], Iacute => [-1,36,314,45], Idieresis => [-1,32,326,36], degree => [-1,58,348,58], Ecircumflex => [-1,36,783,17], minus => [-1,59,586,52], multiply => [-1,59,586,52], divide => [-1,59,586,52], Egrave => [-1,36,783,17], trademark => [-1,39,1042,58], Oacute => [-1,51,830,48], thorn => [-1,23,654,43], eth => [-1,43,568,39], Eacute => [-1,36,783,17], ccedilla => [-1,43,536,25], idieresis => [-1,9,326,12], iacute => [-1,23,311,13], igrave => [-1,23,311,13], plusminus => [-1,59,586,52], onehalf => [-1,93,936,52], onequarter => [-1,93,917,70], threequarters => [-1,60,973,47], icircumflex => [-1,9,330,9], Edieresis => [-1,36,783,17], ntilde => [-1,23,731,12], Aring => [-1,-43,873,-39], odieresis => [-1,43,568,39], oacute => [-1,43,568,39], ograve => [-1,43,568,39], ocircumflex => [-1,43,568,39], otilde => [-1,43,568,39], scaron => [-1,46,519,38], udieresis => [-1,23,736,31], uacute => [-1,23,736,31], ugrave => [-1,23,736,31], ucircumflex => [-1,23,736,31], yacute => [-1,-26,665,-10], zcaron => [-1,8,545,4], ydieresis => [-1,-26,665,-10], copyright => [-1,27,814,18], registered => [-1,26,814,19], Atilde => [-1,-43,873,-39], nbspace => [-1,0,0,372], Ccedilla => [-1,51,765,44], Acircumflex => [-1,-43,873,-39], Agrave => [-1,-43,873,-39], logicalnot => [-1,59,586,52], Aacute => [-1,-43,873,-39], Eth => [-1,36,838,55], brokenbar => [-1,307,90,300], Thorn => [-1,36,676,8], Adieresis => [-1,-43,873,-39], mu => [-1,23,736,31], '.notdef' => [-1,0,0,372], }} ); Prima-1.28/Prima/PS/fonts/Helvetica-Narrow-Oblique0000644000175100017510000001561711150770061017522 0ustar dkdk('Helvetica-Narrow-Oblique' => { name => 'Helvetica-Narrow-Oblique', family => 'Helvetica', height => 1169, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 944, descent => 225, maximalWidth => 1055, width => 1055, internalLeading => 226, externalLeading => 74, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.63, yDeviceRes => 76.63, size => 1000, encoding => 'Latin1', chardata => { space => [32,24,0,241], exclam => [33,86,238,-58], quotedbl => [34,161,258,-79], numbersign => [35,70,534,-71], dollar => [36,66,524,-58], percent => [37,140,711,0], ampersand => [38,73,545,19], quoteright => [39,144,151,-84], parenleft => [40,104,330,-115], parenright => [41,-8,330,-3], asterisk => [42,157,296,-81], plus => [43,81,499,-21], comma => [44,53,150,61], hyphen => [45,90,252,-23], period => [46,82,121,61], slash => [47,-19,452,-165], zero => [48,90,493,-50], one => [49,198,288,45], two => [50,24,566,-58], three => [51,71,513,-51], four => [52,58,493,-18], five => [53,64,530,-61], six => [54,86,502,-56], seven => [55,130,510,-108], eight => [56,70,510,-47], nine => [57,78,505,-50], colon => [58,82,205,-22], semicolon => [59,53,234,-22], less => [60,90,524,-54], equal => [61,60,541,-42], greater => [62,47,524,-12], question => [63,154,430,-51], at => [64,205,718,47], A => [65,12,613,12], B => [66,71,610,-42], C => [67,102,645,-56], D => [68,77,654,-39], E => [69,82,647,-91], F => [70,82,621,-119], G => [71,106,659,-19], H => [72,73,692,-73], I => [73,87,238,-59], J => [74,45,510,-77], K => [75,72,701,-134], L => [76,72,459,1], M => [77,70,805,-77], N => [78,72,693,-73], O => [79,100,690,-45], P => [80,82,623,-66], Q => [81,100,690,-45], R => [82,84,656,-49], S => [83,86,596,-43], T => [84,142,576,-133], U => [85,118,645,-71], V => [86,165,600,-127], W => [87,161,874,-130], X => [88,18,737,-116], Y => [89,160,612,-133], Z => [90,22,687,-123], bracketleft => [91,19,367,-120], backslash => [92,134,144,-12], bracketright => [93,-12,365,-86], asciicircum => [94,40,475,-66], underscore => [95,-25,543,15], quoteleft => [96,157,151,-97], a => [97,58,476,-2], b => [98,56,503,-26], c => [99,71,459,-51], d => [100,80,543,-91], e => [101,80,473,-21], f => [102,82,315,-132], g => [103,39,544,-51], h => [104,61,487,-16], i => [105,64,230,-81], j => [106,-57,351,-81], k => [107,64,510,-95], l => [108,64,230,-81], m => [109,61,755,-18], n => [110,61,487,-16], o => [111,79,480,-26], p => [112,12,547,-26], q => [113,80,499,-46], r => [114,73,353,-107], s => [115,60,446,-28], t => [116,98,254,-86], u => [117,90,485,-42], v => [118,114,464,-99], w => [119,120,666,-94], x => [120,10,558,-90], y => [121,14,561,-95], z => [122,29,517,-67], braceleft => [123,87,339,-106], bar => [124,86,223,-60], braceright => [125,0,340,-19], asciitilde => [126,106,450,3], exclamdown => [161,73,238,7], cent => [162,91,468,-26], sterling => [163,46,561,-74], fraction => [164,-162,625,-302], yen => [165,78,591,-136], florin => [166,-50,678,-94], section => [167,73,486,-26], currency => [168,57,562,-86], quotesingle => [169,150,121,-88], quotedblleft => [170,132,309,-122], guillemotleft => [171,140,390,2], guilsinglleft => [172,130,195,-7], guilsinglright => [173,106,194,18], fi => [174,82,479,-82], fl => [175,82,476,-80], endash => [177,49,547,-63], dagger => [178,128,467,-63], daggerdbl => [179,50,547,-64], periodcentered => [180,123,122,19], paragraph => [182,120,502,-108], bullet => [183,86,309,-60], quotesinglbase => [184,19,151,40], quotedblbase => [185,-5,309,15], quotedblright => [186,119,309,-109], guillemotright => [187,114,391,26], ellipsis => [188,109,759,88], perthousand => [189,84,902,-28], questiondown => [191,81,430,73], grave => [193,162,160,-3], acute => [194,237,218,-136], circumflex => [195,141,278,-100], tilde => [196,119,350,-150], macron => [197,136,312,-129], breve => [198,160,296,-137], dotaccent => [199,238,108,-28], dieresis => [200,161,263,-105], ring => [202,204,181,-66], cedilla => [203,2,220,95], hungarumlaut => [205,150,390,-222], ogonek => [206,40,197,80], caron => [207,169,279,-129], emdash => [208,49,973,-64], AE => [225,8,1042,-92], ordfeminine => [227,95,334,-75], Lslash => [232,39,492,1], Oslash => [233,40,812,-107], OE => [234,93,976,-111], ordmasculine => [235,95,353,-99], ae => [241,58,813,-19], dotlessi => [245,91,190,-15], lslash => [248,39,292,-119], oslash => [249,28,592,-35], oe => [250,79,845,-19], germandbls => [251,64,565,-44], Yacute => [-1,160,612,-133], Ucircumflex => [-1,118,645,-71], Ugrave => [-1,118,645,-71], Zcaron => [-1,22,687,-123], Ydieresis => [-1,160,612,-133], threesuperior => [-1,86,331,-99], Uacute => [-1,118,645,-71], twosuperior => [-1,60,369,-111], Udieresis => [-1,118,645,-71], middot => [-1,123,122,19], onesuperior => [-1,158,197,-37], aacute => [-1,58,505,-30], agrave => [-1,58,476,-2], acircumflex => [-1,58,476,-2], Scaron => [-1,86,596,-43], Otilde => [-1,100,690,-45], sfthyphen => [-1,90,252,-23], atilde => [-1,58,509,-35], aring => [-1,58,476,-2], adieresis => [-1,58,476,-2], Ograve => [-1,100,690,-45], Ocircumflex => [-1,100,690,-45], Odieresis => [-1,100,690,-45], Ntilde => [-1,72,693,-73], edieresis => [-1,80,473,-21], eacute => [-1,80,482,-30], egrave => [-1,80,473,-21], Icircumflex => [-1,87,344,-165], ecircumflex => [-1,80,473,-21], Igrave => [-1,87,248,-70], Iacute => [-1,87,381,-202], Idieresis => [-1,87,350,-171], degree => [-1,161,287,-65], Ecircumflex => [-1,82,647,-91], minus => [-1,81,499,-21], multiply => [-1,47,566,-54], divide => [-1,81,499,-21], Egrave => [-1,82,647,-91], trademark => [-1,177,834,-53], Oacute => [-1,100,690,-45], thorn => [-1,12,547,-26], eth => [-1,78,513,-58], Eacute => [-1,82,647,-91], ccedilla => [-1,71,459,-51], idieresis => [-1,91,307,-132], iacute => [-1,91,339,-163], igrave => [-1,91,205,-30], plusminus => [-1,37,555,-32], onehalf => [-1,108,695,-4], onequarter => [-1,143,625,30], threequarters => [-1,123,701,-25], icircumflex => [-1,91,301,-126], Edieresis => [-1,82,647,-91], ntilde => [-1,61,506,-35], Aring => [-1,12,613,12], odieresis => [-1,79,480,-26], oacute => [-1,79,483,-30], ograve => [-1,79,480,-26], ocircumflex => [-1,79,480,-26], otilde => [-1,79,497,-44], scaron => [-1,60,468,-50], udieresis => [-1,90,485,-42], uacute => [-1,90,485,-42], ugrave => [-1,90,485,-42], ucircumflex => [-1,90,485,-42], yacute => [-1,14,561,-95], zcaron => [-1,29,517,-67], ydieresis => [-1,14,561,-95], copyright => [-1,51,751,-97], registered => [-1,51,751,-97], Atilde => [-1,12,656,-30], nbspace => [-1,24,0,241], Ccedilla => [-1,102,645,-56], Acircumflex => [-1,12,613,12], Agrave => [-1,12,613,12], logicalnot => [-1,101,500,-42], Aacute => [-1,12,642,-16], Eth => [-1,66,665,-39], brokenbar => [-1,86,223,-60], Thorn => [-1,82,599,-43], Adieresis => [-1,12,613,12], mu => [-1,23,551,-42], '.notdef' => [-1,24,0,241], }} ); Prima-1.28/Prima/PS/fonts/Helvetica-Oblique0000644000175100017510000001573011150770061016250 0ustar dkdk('Helvetica-Oblique' => { name => 'Helvetica-Oblique', family => 'Helvetica', height => 1173, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 953, descent => 220, maximalWidth => 1287, width => 1287, internalLeading => 224, externalLeading => 73, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.15, yDeviceRes => 76.15, size => 1000, encoding => 'Latin1', chardata => { space => [32,249,0,76], exclam => [33,145,280,-99], quotedbl => [34,207,326,-117], numbersign => [35,63,697,-109], dollar => [36,80,638,-66], percent => [37,157,892,-7], ampersand => [38,97,658,26], quoteright => [39,194,167,-102], parenleft => [40,132,390,-132], parenright => [41,-8,389,9], asterisk => [42,198,354,-96], plus => [43,107,585,-8], comma => [44,64,186,75], hyphen => [45,113,297,-21], period => [46,102,147,76], slash => [47,-14,523,-182], zero => [48,114,586,-49], one => [49,243,340,68], two => [50,39,687,-75], three => [51,83,619,-50], four => [52,73,598,-19], five => [53,82,655,-85], six => [54,109,607,-64], seven => [55,160,626,-134], eight => [56,86,621,-56], nine => [57,97,605,-50], colon => [58,129,253,-56], semicolon => [59,91,289,-55], less => [60,102,642,-59], equal => [61,86,627,-29], greater => [62,56,642,-14], question => [63,215,523,-86], at => [64,93,1121,-24], A => [65,19,746,16], B => [66,92,741,-51], C => [67,131,771,-56], D => [68,104,785,-43], E => [69,105,775,-98], F => [70,105,755,-144], G => [71,127,821,-36], H => [72,97,839,-90], I => [73,117,292,-83], J => [74,55,626,-95], K => [75,92,860,-171], L => [76,93,552,5], M => [77,87,986,-97], N => [78,89,850,-92], O => [79,121,849,-58], P => [80,106,753,-77], Q => [81,121,849,-58], R => [82,109,794,-56], S => [83,104,733,-55], T => [84,185,692,-160], U => [85,145,792,-91], V => [86,217,721,-156], W => [87,207,1063,-164], X => [88,25,905,-148], Y => [89,197,760,-174], Z => [90,32,831,-147], bracketleft => [91,22,452,-148], backslash => [92,172,156,-2], bracketright => [93,-26,453,-100], asciicircum => [94,134,446,-31], underscore => [95,-69,715,5], quoteleft => [96,191,170,-100], a => [97,76,590,-14], b => [98,63,626,-37], c => [99,89,560,-63], d => [100,85,676,-110], e => [101,98,581,-28], f => [102,104,380,-158], g => [103,37,667,-52], h => [104,82,591,-21], i => [105,77,280,-97], j => [106,-76,437,-100], k => [107,68,616,-98], l => [108,79,280,-99], m => [109,83,916,-22], n => [110,82,591,-21], o => [111,93,581,-23], p => [112,8,679,-35], q => [113,83,628,-59], r => [114,80,430,-120], s => [115,71,538,-23], t => [116,113,315,-103], u => [117,103,593,-44], v => [118,143,558,-114], w => [119,138,823,-114], x => [120,19,663,-97], y => [121,9,682,-105], z => [122,36,616,-66], braceleft => [123,106,398,-113], bar => [124,63,306,-64], braceright => [125,-18,398,11], asciitilde => [126,160,536,-11], exclamdown => [161,89,282,18], cent => [162,112,573,-34], sterling => [163,51,685,-84], fraction => [164,-208,778,-374], yen => [165,117,699,-164], florin => [166,-37,853,-164], section => [167,73,616,-38], currency => [168,129,566,-43], quotesingle => [169,202,139,-118], quotedblleft => [170,171,355,-136], guillemotleft => [171,172,470,9], guilsinglleft => [172,164,229,-3], guilsinglright => [173,127,232,30], fi => [174,97,595,-106], fl => [175,103,582,-99], endash => [177,53,682,-84], dagger => [178,148,578,-75], daggerdbl => [179,59,667,-75], periodcentered => [180,194,148,-17], paragraph => [182,170,624,-164], bullet => [183,140,296,-26], quotesinglbase => [184,43,167,49], quotedblbase => [185,23,354,12], quotedblright => [186,175,354,-139], guillemotright => [187,141,465,44], ellipsis => [188,134,929,109], perthousand => [189,109,1092,-28], questiondown => [191,100,521,93], grave => [193,209,208,-28], acute => [194,255,281,-146], circumflex => [195,171,336,-117], tilde => [196,152,399,-161], macron => [197,187,340,-137], breve => [198,193,358,-161], dotaccent => [199,286,147,-43], dieresis => [200,186,336,-132], ring => [202,253,211,-73], cedilla => [203,1,308,80], hungarumlaut => [205,106,485,-201], ogonek => [206,41,247,102], caron => [207,206,336,-152], emdash => [208,49,1203,-79], AE => [225,12,1262,-102], ordfeminine => [227,125,391,-83], Lslash => [232,87,580,-16], Oslash => [233,37,979,-104], OE => [234,118,1181,-126], ordmasculine => [235,133,396,-102], ae => [241,69,1004,-30], dotlessi => [245,110,229,-14], lslash => [248,72,293,-105], oslash => [249,22,727,-32], oe => [250,99,1033,-25], germandbls => [251,147,620,-51], Yacute => [-1,197,760,-174], Ucircumflex => [-1,145,792,-91], Ugrave => [-1,145,792,-91], Zcaron => [-1,32,831,-147], Ydieresis => [-1,197,760,-174], threesuperior => [-1,144,389,-76], Uacute => [-1,145,792,-91], twosuperior => [-1,117,431,-91], Udieresis => [-1,145,792,-91], middot => [-1,194,148,-17], onesuperior => [-1,240,220,-3], aacute => [-1,76,592,-16], agrave => [-1,76,590,-14], acircumflex => [-1,76,590,-14], Scaron => [-1,104,733,-55], Otilde => [-1,121,849,-58], sfthyphen => [-1,113,297,-21], atilde => [-1,76,607,-31], aring => [-1,76,590,-14], adieresis => [-1,76,590,-14], Ograve => [-1,121,849,-58], Ocircumflex => [-1,121,849,-58], Odieresis => [-1,121,849,-58], Ntilde => [-1,89,850,-92], edieresis => [-1,98,581,-28], eacute => [-1,98,581,-28], egrave => [-1,98,581,-28], Icircumflex => [-1,117,415,-206], ecircumflex => [-1,98,581,-28], Igrave => [-1,117,326,-117], Iacute => [-1,117,444,-235], Idieresis => [-1,117,430,-221], degree => [-1,341,355,14], Ecircumflex => [-1,105,775,-98], minus => [-1,95,609,-19], multiply => [-1,132,533,18], divide => [-1,107,585,-8], Egrave => [-1,105,775,-98], trademark => [-1,243,1041,-112], Oacute => [-1,121,849,-58], thorn => [-1,8,679,-35], eth => [-1,93,581,-23], Eacute => [-1,105,775,-98], ccedilla => [-1,89,560,-63], idieresis => [-1,110,381,-165], iacute => [-1,110,395,-179], igrave => [-1,110,276,-60], plusminus => [-1,58,674,-48], onehalf => [-1,236,894,-21], onequarter => [-1,240,859,10], threequarters => [-1,144,955,10], icircumflex => [-1,110,365,-150], Edieresis => [-1,105,775,-98], ntilde => [-1,82,608,-38], Aring => [-1,19,746,16], odieresis => [-1,93,581,-23], oacute => [-1,93,581,-23], ograve => [-1,93,581,-23], ocircumflex => [-1,93,581,-23], otilde => [-1,93,590,-31], scaron => [-1,71,570,-55], udieresis => [-1,103,593,-44], uacute => [-1,103,593,-44], ugrave => [-1,103,593,-44], ucircumflex => [-1,103,593,-44], yacute => [-1,9,682,-105], zcaron => [-1,36,616,-66], ydieresis => [-1,9,682,-105], copyright => [-1,64,916,-116], registered => [-1,64,916,-116], Atilde => [-1,19,777,-15], nbspace => [-1,249,0,76], Ccedilla => [-1,131,771,-56], Acircumflex => [-1,19,746,16], Agrave => [-1,19,746,16], logicalnot => [-1,116,609,-41], Aacute => [-1,19,762,0], Eth => [-1,104,785,-43], brokenbar => [-1,63,306,-64], Thorn => [-1,106,723,-48], Adieresis => [-1,19,756,5], mu => [-1,21,674,-43], '.notdef' => [-1,249,0,76], }} ); Prima-1.28/Prima/PS/fonts/Helvetica-Narrow-BoldOblique0000644000175100017510000001566011150770061020321 0ustar dkdk('Helvetica-Narrow-BoldOblique' => { name => 'Helvetica-Narrow-BoldOblique', family => 'Helvetica', height => 1217, weigth => fw::Bold, style => fs::Bold|fs::Italic, pitch => fp::Variable, vector => 1, ascent => 989, descent => 228, maximalWidth => 1057, width => 1057, internalLeading => 271, externalLeading => 89, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.39, yDeviceRes => 76.39, size => 1000, encoding => 'Latin1', chardata => { space => [32,25,0,251], exclam => [33,93,301,-63], quotedbl => [34,192,334,-53], numbersign => [35,59,582,-87], dollar => [36,66,553,-65], percent => [37,136,763,-12], ampersand => [38,88,641,-9], quoteright => [39,166,194,-83], parenleft => [40,75,393,-136], parenright => [41,-25,393,-35], asterisk => [42,146,333,-91], plus => [43,81,526,-25], comma => [44,27,216,32], hyphen => [45,73,305,-46], period => [46,63,181,32], slash => [47,-36,502,-188], zero => [48,86,529,-60], one => [49,172,355,26], two => [50,25,592,-63], three => [51,65,541,-52], four => [52,60,535,-41], five => [53,64,570,-80], six => [54,85,531,-62], seven => [55,124,551,-120], eight => [56,69,545,-59], nine => [57,77,535,-58], colon => [58,91,259,-18], semicolon => [59,55,294,-18], less => [60,81,571,-70], equal => [61,58,573,-48], greater => [62,36,571,-25], question => [63,164,505,-59], at => [64,184,766,21], A => [65,19,681,19], B => [66,75,686,-41], C => [67,107,680,-66], D => [68,75,699,-54], E => [69,75,679,-88], F => [70,75,662,-127], G => [71,108,707,-38], H => [72,70,731,-81], I => [73,63,303,-88], J => [74,59,575,-80], K => [75,86,769,-135], L => [76,75,534,0], M => [77,69,845,-83], N => [78,69,735,-83], O => [79,107,714,-45], P => [80,75,660,-70], Q => [81,107,714,-45], R => [82,75,700,-55], S => [83,80,635,-49], T => [84,138,609,-138], U => [85,116,685,-81], V => [86,171,626,-132], W => [87,167,911,-137], X => [88,13,775,-122], Y => [89,166,637,-138], Z => [90,24,710,-125], bracketleft => [91,20,440,-129], backslash => [92,122,183,-29], bracketright => [93,-17,439,-90], asciicircum => [94,130,458,-6], underscore => [95,-26,565,15], quoteleft => [96,165,194,-82], a => [97,54,526,-26], b => [98,60,582,-34], c => [99,79,518,-42], d => [100,81,620,-92], e => [101,70,520,-36], f => [102,86,382,-136], g => [103,37,626,-54], h => [104,64,563,-18], i => [105,69,293,-85], j => [106,-42,405,-85], k => [107,69,598,-113], l => [108,69,292,-83], m => [109,63,844,-20], n => [110,64,563,-18], o => [111,81,559,-31], p => [112,18,625,-34], q => [113,80,582,-53], r => [114,63,424,-99], s => [115,63,519,-27], t => [116,99,321,-88], u => [117,97,559,-47], v => [118,125,529,-99], w => [119,122,756,-103], x => [120,14,631,-91], y => [121,41,609,-96], z => [122,19,562,-82], braceleft => [123,93,423,-129], bar => [124,80,271,-71], braceright => [125,-17,422,-17], asciitilde => [126,114,461,7], exclamdown => [161,49,303,-20], cent => [162,79,518,-42], sterling => [163,49,582,-77], fraction => [164,-174,659,-318], yen => [165,59,652,-156], florin => [166,-49,716,-111], section => [167,60,536,-42], currency => [168,26,652,-124], quotesingle => [169,164,155,-82], quotedblleft => [170,160,425,-87], guillemotleft => [171,135,434,-14], guilsinglleft => [172,129,222,-19], guilsinglright => [173,98,222,10], fi => [174,86,608,-85], fl => [175,86,607,-83], endash => [177,48,576,-70], dagger => [178,118,506,-69], daggerdbl => [179,46,580,-71], periodcentered => [180,109,165,2], paragraph => [182,97,589,-131], bullet => [183,82,337,-70], quotesinglbase => [184,41,194,41], quotedblbase => [185,35,427,36], quotedblright => [186,160,427,-88], guillemotright => [187,103,435,15], ellipsis => [188,91,845,60], perthousand => [189,75,960,-37], questiondown => [191,53,505,51], grave => [193,136,216,-20], acute => [194,236,278,-182], circumflex => [195,118,352,-138], tilde => [196,111,393,-172], macron => [197,121,360,-149], breve => [198,155,337,-160], dotaccent => [199,233,150,-52], dieresis => [200,136,344,-148], ring => [202,199,219,-86], cedilla => [203,-36,255,113], hungarumlaut => [205,137,506,-311], ogonek => [206,40,222,69], caron => [207,149,351,-169], emdash => [208,48,1019,-70], AE => [225,4,1092,-99], ordfeminine => [227,91,372,-94], Lslash => [232,34,575,0], Oslash => [233,35,856,-115], OE => [234,98,1012,-113], ordmasculine => [235,91,393,-120], ae => [241,55,865,-34], dotlessi => [245,69,251,-43], lslash => [248,40,366,-129], oslash => [249,21,677,-90], oe => [250,81,893,-32], germandbls => [251,69,586,-46], Yacute => [-1,166,637,-138], Ucircumflex => [-1,116,685,-81], Ugrave => [-1,116,685,-81], Zcaron => [-1,24,710,-125], Ydieresis => [-1,166,637,-138], threesuperior => [-1,91,348,-107], Uacute => [-1,116,685,-81], twosuperior => [-1,69,378,-115], Udieresis => [-1,116,685,-81], middot => [-1,109,165,2], onesuperior => [-1,147,239,-54], aacute => [-1,54,570,-70], agrave => [-1,54,526,-26], acircumflex => [-1,54,526,-26], Scaron => [-1,80,635,-49], Otilde => [-1,107,714,-45], sfthyphen => [-1,73,305,-46], atilde => [-1,54,562,-62], aring => [-1,54,526,-26], adieresis => [-1,54,537,-37], Ograve => [-1,107,714,-45], Ocircumflex => [-1,107,714,-45], Odieresis => [-1,107,714,-45], Ntilde => [-1,69,735,-83], edieresis => [-1,70,523,-38], eacute => [-1,70,556,-71], egrave => [-1,70,520,-36], Icircumflex => [-1,63,419,-205], ecircumflex => [-1,70,520,-36], Igrave => [-1,63,303,-88], Iacute => [-1,63,463,-249], Idieresis => [-1,63,429,-215], degree => [-1,174,292,-66], Ecircumflex => [-1,75,679,-88], minus => [-1,81,526,-25], multiply => [-1,57,575,-49], divide => [-1,81,526,-25], Egrave => [-1,75,679,-88], trademark => [-1,177,928,-108], Oacute => [-1,107,714,-45], thorn => [-1,18,625,-34], eth => [-1,81,586,-58], Eacute => [-1,75,679,-88], ccedilla => [-1,79,518,-42], idieresis => [-1,69,384,-176], iacute => [-1,69,418,-210], igrave => [-1,69,256,-48], plusminus => [-1,40,582,-40], onehalf => [-1,131,725,-24], onequarter => [-1,131,673,27], threequarters => [-1,99,737,-4], icircumflex => [-1,69,374,-166], Edieresis => [-1,75,679,-88], ntilde => [-1,64,579,-34], Aring => [-1,19,681,19], odieresis => [-1,81,559,-31], oacute => [-1,81,571,-43], ograve => [-1,81,559,-31], ocircumflex => [-1,81,559,-31], otilde => [-1,81,562,-34], scaron => [-1,63,548,-57], udieresis => [-1,97,559,-47], uacute => [-1,97,559,-47], ugrave => [-1,97,559,-47], ucircumflex => [-1,97,559,-47], yacute => [-1,41,609,-96], zcaron => [-1,19,564,-85], ydieresis => [-1,41,609,-96], copyright => [-1,55,777,-98], registered => [-1,54,777,-97], Atilde => [-1,19,719,-18], nbspace => [-1,25,0,251], Ccedilla => [-1,107,680,-66], Acircumflex => [-1,19,685,15], Agrave => [-1,19,681,19], logicalnot => [-1,104,526,-48], Aacute => [-1,19,728,-27], Eth => [-1,62,713,-54], brokenbar => [-1,80,271,-71], Thorn => [-1,75,640,-49], Adieresis => [-1,19,694,6], mu => [-1,21,635,-47], '.notdef' => [-1,25,0,251], }} ); Prima-1.28/Prima/PS/fonts/NewCenturySchlbk-Italic0000644000175100017510000001535111150770061017402 0ustar dkdk('NewCenturySchlbk-Italic' => { name => 'NewCenturySchlbk-Italic', family => 'NewCenturySchlbk', height => 1185, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 966, descent => 219, maximalWidth => 1185, width => 1185, internalLeading => 229, externalLeading => 75, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 75.59, yDeviceRes => 75.59, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,329], exclam => [33,35,338,20], quotedbl => [34,118,349,5], numbersign => [35,39,581,37], dollar => [36,3,631,23], percent => [37,54,884,48], ampersand => [38,28,887,93], quoteright => [39,46,226,-30], parenleft => [40,47,425,-78], parenright => [41,-110,424,80], asterisk => [42,40,495,56], plus => [43,43,596,78], comma => [44,-46,225,150], hyphen => [45,37,268,87], period => [46,20,146,162], slash => [47,165,386,165], zero => [48,34,590,34], one => [49,59,484,114], two => [50,-41,643,56], three => [51,-2,601,59], four => [52,-9,616,52], five => [53,4,635,18], six => [54,42,605,10], seven => [55,81,583,-5], eight => [56,9,615,34], nine => [57,8,606,43], colon => [58,49,251,28], semicolon => [59,-16,325,20], less => [60,40,603,74], equal => [61,42,597,78], greater => [62,62,603,52], question => [63,120,373,31], at => [64,33,829,22], A => [65,-97,888,42], B => [66,-36,828,63], C => [67,47,797,10], D => [68,-45,916,50], E => [69,-43,874,24], F => [70,-40,867,-36], G => [71,46,857,17], H => [72,-45,1072,-40], I => [73,-39,549,-28], J => [74,-15,780,-41], K => [75,-47,1011,-86], L => [76,-43,790,43], M => [77,-30,1183,-34], N => [78,-55,1073,-52], O => [79,47,823,50], P => [80,-39,824,4], Q => [81,47,823,50], R => [82,-48,867,59], S => [83,0,748,41], T => [84,47,812,-48], U => [85,110,908,-53], V => [86,42,872,-80], W => [87,62,1090,-55], X => [88,-86,998,-78], Y => [89,37,860,-86], Z => [90,-29,820,0], bracketleft => [91,-39,524,-91], backslash => [92,105,513,99], bracketright => [93,-98,523,-30], asciicircum => [94,61,594,61], underscore => [95,0,592,0], quoteleft => [96,72,226,-56], a => [97,1,618,60], b => [98,37,540,80], c => [99,5,469,50], d => [100,3,690,29], e => [101,-7,470,62], f => [102,-80,637,-162], g => [103,-93,713,16], h => [104,0,657,66], i => [105,31,302,60], j => [106,-196,572,-2], k => [107,-5,588,75], l => [108,18,329,46], m => [109,17,974,61], n => [110,16,649,58], o => [111,5,527,59], p => [112,-119,719,80], q => [113,0,591,67], r => [114,10,502,13], s => [115,-1,465,61], t => [116,29,360,27], u => [117,48,610,65], v => [118,40,487,87], w => [119,37,801,82], x => [120,-39,597,34], y => [121,-93,631,54], z => [122,-39,533,54], braceleft => [123,61,389,-56], bar => [124,318,80,318], braceright => [125,-116,389,120], asciitilde => [126,48,597,72], exclamdown => [161,-8,340,62], cent => [162,72,503,82], sterling => [163,-9,655,13], fraction => [164,-123,517,-196], yen => [165,47,690,-79], florin => [166,-67,734,-8], section => [167,-13,581,23], currency => [168,29,598,30], quotesingle => [169,135,175,18], quotedblleft => [170,74,437,-50], guillemotleft => [171,-17,494,28], guilsinglleft => [172,49,259,85], guilsinglright => [173,47,259,87], fi => [174,-71,739,55], fl => [175,-71,774,20], endash => [177,-21,635,-21], dagger => [178,75,537,-21], daggerdbl => [179,-35,661,-33], periodcentered => [180,91,146,91], paragraph => [182,104,660,5], bullet => [183,135,399,183], quotesinglbase => [184,-93,226,109], quotedblbase => [185,-93,436,118], quotedblright => [186,45,437,-21], guillemotright => [187,-20,494,30], ellipsis => [188,65,936,183], perthousand => [189,-7,1195,-3], questiondown => [191,8,374,143], grave => [193,86,225,82], acute => [194,156,264,-26], circumflex => [195,43,348,2], tilde => [196,61,388,-55], macron => [197,60,369,-35], breve => [198,81,356,-43], dotaccent => [199,139,116,138], dieresis => [200,69,355,-30], ring => [202,272,235,-113], cedilla => [203,3,251,139], hungarumlaut => [205,158,457,-221], ogonek => [206,80,209,104], caron => [207,86,361,-53], emdash => [208,-21,1227,-21], AE => [225,-109,1139,0], ordfeminine => [227,98,401,0], Lslash => [232,-43,790,43], Oslash => [233,1,869,50], OE => [234,42,1098,21], ordmasculine => [235,98,342,0], ae => [241,-21,811,65], dotlessi => [245,31,302,60], lslash => [248,18,386,-10], oslash => [249,-5,527,71], oe => [250,0,853,68], germandbls => [251,-90,712,36], Yacute => [-1,37,860,-86], Ucircumflex => [-1,110,908,-53], Ugrave => [-1,110,908,-53], Zcaron => [-1,-29,820,0], Ydieresis => [-1,37,860,-86], threesuperior => [-1,1,391,2], Uacute => [-1,110,908,-53], twosuperior => [-1,0,418,-23], Udieresis => [-1,110,908,-53], middot => [-1,91,146,91], onesuperior => [-1,50,315,28], aacute => [-1,1,618,60], agrave => [-1,1,618,60], acircumflex => [-1,1,618,60], Scaron => [-1,0,748,41], Otilde => [-1,47,823,50], sfthyphen => [-1,37,268,87], atilde => [-1,1,618,60], aring => [-1,1,618,60], adieresis => [-1,1,618,60], Ograve => [-1,47,823,50], Ocircumflex => [-1,47,823,50], Odieresis => [-1,47,823,50], Ntilde => [-1,-55,1073,-52], edieresis => [-1,-7,487,46], eacute => [-1,-7,494,39], egrave => [-1,-7,470,62], Icircumflex => [-1,-39,549,-28], ecircumflex => [-1,-7,470,62], Igrave => [-1,-39,549,-28], Iacute => [-1,-39,549,-28], Idieresis => [-1,-39,567,-46], degree => [-1,82,355,35], Ecircumflex => [-1,-43,874,24], minus => [-1,48,597,72], multiply => [-1,43,596,78], divide => [-1,43,596,78], Egrave => [-1,-43,874,24], trademark => [-1,56,1093,-24], Oacute => [-1,47,823,50], thorn => [-1,-119,719,80], eth => [-1,5,527,59], Eacute => [-1,-43,874,24], ccedilla => [-1,5,469,50], idieresis => [-1,31,381,-18], iacute => [-1,31,388,-26], igrave => [-1,31,302,60], plusminus => [-1,43,596,78], onehalf => [-1,39,961,-11], onequarter => [-1,39,948,1], threequarters => [-1,1,985,1], icircumflex => [-1,-3,348,49], Edieresis => [-1,-43,874,24], ntilde => [-1,16,649,58], Aring => [-1,-97,888,42], odieresis => [-1,5,527,59], oacute => [-1,5,527,59], ograve => [-1,5,527,59], ocircumflex => [-1,5,527,59], otilde => [-1,5,532,54], scaron => [-1,-1,515,11], udieresis => [-1,48,610,65], uacute => [-1,48,610,65], ugrave => [-1,48,610,65], ucircumflex => [-1,48,610,65], yacute => [-1,-93,631,54], zcaron => [-1,-39,564,23], ydieresis => [-1,-93,631,54], copyright => [-1,28,829,27], registered => [-1,27,829,28], Atilde => [-1,-97,888,42], nbspace => [-1,0,0,329], Ccedilla => [-1,47,797,10], Acircumflex => [-1,-97,888,42], Agrave => [-1,-97,888,42], logicalnot => [-1,48,597,72], Aacute => [-1,-97,888,42], Eth => [-1,-45,916,50], brokenbar => [-1,318,80,318], Thorn => [-1,-39,778,50], Adieresis => [-1,-97,888,42], mu => [-1,-82,741,65], '.notdef' => [-1,0,0,329], }} ); Prima-1.28/Prima/PS/fonts/Times-Bold0000644000175100017510000001512711150770061014705 0ustar dkdk('Times-Bold' => { name => 'Times-Bold', family => 'Times', height => 1166, weigth => fw::Bold, style => fs::Bold, pitch => fp::Variable, vector => 1, ascent => 948, descent => 218, maximalWidth => 1169, width => 1169, internalLeading => 272, externalLeading => 89, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 80.83, yDeviceRes => 80.83, size => 1000, encoding => 'Latin1', chardata => { space => [32,145,0,145], exclam => [33,94,198,95], quotedbl => [34,96,453,96], numbersign => [35,4,573,4], dollar => [36,33,516,32], percent => [37,144,877,143], ampersand => [38,72,845,53], quoteright => [39,92,214,81], parenleft => [40,53,303,31], parenright => [41,31,303,53], asterisk => [42,65,455,61], plus => [43,38,587,38], comma => [44,45,214,31], hyphen => [45,51,283,53], period => [46,47,197,46], slash => [47,-27,380,-27], zero => [48,27,527,27], one => [49,75,439,67], two => [50,19,537,25], three => [51,18,527,37], four => [52,22,531,29], five => [53,25,522,34], six => [54,32,521,29], seven => [55,19,536,26], eight => [56,32,517,32], nine => [57,30,521,31], colon => [58,95,197,95], semicolon => [59,95,214,78], less => [60,36,592,36], equal => [61,38,587,38], greater => [62,36,592,36], question => [63,66,452,64], at => [64,125,832,125], A => [65,10,792,38], B => [66,18,703,55], C => [67,57,743,40], D => [68,16,788,37], E => [69,18,728,30], F => [70,18,661,32], G => [71,43,837,26], H => [72,24,860,22], I => [73,23,408,22], J => [74,3,555,24], K => [75,34,861,10], L => [76,22,721,33], M => [77,16,1057,26], N => [78,18,798,24], O => [79,40,825,40], P => [80,18,680,12], Q => [81,40,825,40], R => [82,30,803,8], S => [83,40,557,50], T => [84,36,705,36], U => [85,18,798,24], V => [86,18,798,24], W => [87,22,1121,22], X => [88,18,796,26], Y => [89,17,797,26], Z => [90,32,706,38], bracketleft => [91,78,272,37], backslash => [92,-29,382,-29], bracketright => [93,37,272,78], asciicircum => [94,85,508,83], underscore => [95,0,583,0], quoteleft => [96,81,214,92], a => [97,29,539,13], b => [98,19,587,40], c => [99,29,472,16], d => [100,29,593,25], e => [101,29,467,20], f => [102,16,437,-65], g => [103,32,530,19], h => [104,18,603,25], i => [105,18,278,26], j => [106,-66,373,81], k => [107,25,607,15], l => [108,18,278,26], m => [109,18,930,22], n => [110,24,603,19], o => [111,29,525,27], p => [112,22,588,37], q => [113,39,585,23], r => [114,33,472,11], s => [115,29,391,32], t => [116,23,363,1], u => [117,18,607,22], v => [118,24,541,17], w => [119,26,797,17], x => [120,13,550,18], y => [121,18,541,23], z => [122,24,465,27], braceleft => [123,25,370,62], bar => [124,76,102,76], braceright => [125,62,370,25], asciitilde => [126,33,538,33], exclamdown => [161,95,198,94], cent => [162,61,472,48], sterling => [163,24,531,26], fraction => [164,-195,579,-188], yen => [165,-74,712,-54], florin => [166,0,580,2], section => [167,66,450,66], currency => [168,-30,643,-30], quotesingle => [169,87,150,86], quotedblleft => [170,37,529,16], guillemotleft => [171,26,524,31], guilsinglleft => [172,59,296,32], guilsinglright => [173,32,296,59], fi => [174,16,608,23], fl => [175,16,608,23], endash => [177,0,583,0], dagger => [178,54,473,54], daggerdbl => [179,52,479,51], periodcentered => [180,47,197,46], paragraph => [182,0,605,24], bullet => [183,40,326,40], quotesinglbase => [184,92,214,81], quotedblbase => [185,16,529,37], quotedblright => [186,16,529,37], guillemotright => [187,31,524,26], ellipsis => [188,95,973,96], perthousand => [189,8,1152,5], questiondown => [191,64,452,66], grave => [193,9,277,101], acute => [194,100,277,10], circumflex => [195,-2,392,-2], tilde => [196,-18,425,-18], macron => [197,1,384,2], breve => [198,17,353,17], dotaccent => [199,120,150,117], dieresis => [200,-2,395,-4], ring => [202,69,248,69], cedilla => [203,79,263,45], hungarumlaut => [205,-15,510,-107], ogonek => [206,104,267,16], caron => [207,-2,392,-2], emdash => [208,0,1166,0], AE => [225,4,1104,57], ordfeminine => [227,-1,352,-1], Lslash => [232,22,721,33], Oslash => [233,40,825,40], OE => [234,25,1118,22], ordmasculine => [235,20,342,20], ae => [241,38,769,33], dotlessi => [245,18,278,26], lslash => [248,-25,378,-29], oslash => [249,29,525,27], oe => [250,25,785,30], germandbls => [251,22,580,45], Yacute => [-1,17,797,26], Ucircumflex => [-1,18,798,24], Ugrave => [-1,18,798,24], Zcaron => [-1,32,706,38], Ydieresis => [-1,17,797,26], threesuperior => [-1,3,342,3], Uacute => [-1,18,798,24], twosuperior => [-1,0,349,0], Udieresis => [-1,18,798,24], middot => [-1,47,197,46], onesuperior => [-1,32,285,31], aacute => [-1,29,539,13], agrave => [-1,29,539,13], acircumflex => [-1,29,539,13], Scaron => [-1,40,557,50], Otilde => [-1,40,825,40], sfthyphen => [-1,51,283,53], atilde => [-1,29,539,13], aring => [-1,29,539,13], adieresis => [-1,29,539,13], Ograve => [-1,40,825,40], Ocircumflex => [-1,40,825,40], Odieresis => [-1,40,825,40], Ntilde => [-1,18,798,24], edieresis => [-1,29,467,20], eacute => [-1,29,467,20], egrave => [-1,29,467,20], Icircumflex => [-1,23,408,22], ecircumflex => [-1,29,467,20], Igrave => [-1,23,408,22], Iacute => [-1,23,408,22], Idieresis => [-1,23,408,22], degree => [-1,66,333,66], Ecircumflex => [-1,18,728,30], minus => [-1,38,587,38], multiply => [-1,55,552,55], divide => [-1,38,587,38], Egrave => [-1,18,728,30], trademark => [-1,27,1111,26], Oacute => [-1,40,825,40], thorn => [-1,22,588,37], eth => [-1,29,525,27], Eacute => [-1,18,728,30], ccedilla => [-1,29,472,16], idieresis => [-1,-41,395,-29], iacute => [-1,18,319,-13], igrave => [-1,-30,327,26], plusminus => [-1,38,587,38], onehalf => [-1,-8,911,-29], onequarter => [-1,32,833,8], threequarters => [-1,26,827,19], icircumflex => [-1,-41,392,-26], Edieresis => [-1,18,728,30], ntilde => [-1,24,603,19], Aring => [-1,10,792,38], odieresis => [-1,29,525,27], oacute => [-1,29,525,27], ograve => [-1,29,525,27], ocircumflex => [-1,29,525,27], otilde => [-1,29,525,27], scaron => [-1,29,394,30], udieresis => [-1,18,607,22], uacute => [-1,18,607,22], ugrave => [-1,18,607,22], ucircumflex => [-1,18,607,22], yacute => [-1,18,541,23], zcaron => [-1,24,465,27], ydieresis => [-1,18,541,23], copyright => [-1,30,810,30], registered => [-1,30,810,30], Atilde => [-1,10,792,38], nbspace => [-1,145,0,145], Ccedilla => [-1,57,743,40], Acircumflex => [-1,10,792,38], Agrave => [-1,10,792,38], logicalnot => [-1,38,587,38], Aacute => [-1,10,792,38], Eth => [-1,6,797,37], brokenbar => [-1,76,102,76], Thorn => [-1,18,680,12], Adieresis => [-1,10,792,38], mu => [-1,38,586,23], '.notdef' => [-1,145,0,145], }} ); Prima-1.28/Prima/PS/fonts/ZapfChancery-MediumItalic0000644000175100017510000001570211150770061017666 0ustar dkdk('ZapfChancery-MediumItalic' => { name => 'ZapfChancery-MediumItalic', family => 'ZapfChancery', height => 1087, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 821, descent => 266, maximalWidth => 1212, width => 1212, internalLeading => 144, externalLeading => 47, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.63, yDeviceRes => 76.63, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,239], exclam => [33,118,258,-72], quotedbl => [34,184,177,-122], numbersign => [35,68,579,-169], dollar => [36,65,435,-22], percent => [37,176,585,-22], ampersand => [38,131,797,-81], quoteright => [39,247,141,-128], parenleft => [40,126,321,-165], parenright => [41,18,321,-101], asterisk => [42,239,317,-100], plus => [43,111,445,7], comma => [44,32,201,5], hyphen => [45,125,201,-21], period => [46,116,131,-8], slash => [47,-6,588,-211], zero => [48,102,429,-53], one => [49,89,382,6], two => [50,51,458,-31], three => [51,39,457,-18], four => [52,75,419,-16], five => [53,72,541,-135], six => [54,103,475,-100], seven => [55,179,408,-109], eight => [56,81,455,-58], nine => [57,45,476,-43], colon => [58,106,207,-31], semicolon => [59,31,269,-40], less => [60,130,475,-40], equal => [61,117,445,2], greater => [62,129,475,-39], question => [63,141,398,-127], at => [64,110,720,-70], A => [65,25,721,-72], B => [66,81,616,-45], C => [67,95,594,-125], D => [68,93,731,-64], E => [69,82,643,-52], F => [70,65,731,-166], G => [71,128,600,-54], H => [72,35,951,-247], I => [73,88,434,-109], J => [74,1,532,-98], K => [75,95,829,-207], L => [76,35,650,-55], M => [77,63,1033,-183], N => [78,43,951,-233], O => [79,113,595,-56], P => [80,40,660,-114], Q => [81,113,811,-272], R => [82,41,856,-245], S => [83,0,561,-61], T => [84,63,717,-236], U => [85,126,719,-41], V => [86,113,766,-183], W => [87,113,1011,-168], X => [88,0,729,-120], Y => [89,33,795,-220], Z => [90,67,666,-59], bracketleft => [91,51,388,-178], backslash => [92,201,325,-4], bracketright => [93,25,389,-66], asciicircum => [94,230,282,52], underscore => [95,0,543,0], quoteleft => [96,248,168,-156], a => [97,94,440,-78], b => [98,94,411,-50], c => [99,94,321,-46], d => [100,94,589,-205], e => [101,94,318,-43], f => [102,-107,695,-240], g => [103,-84,607,-88], h => [104,81,468,-71], i => [105,88,250,-77], j => [106,-144,473,-90], k => [107,94,617,-233], l => [108,94,377,-210], m => [109,88,665,-79], n => [110,88,477,-65], o => [111,94,393,-53], p => [112,-8,532,-45], q => [113,94,432,-92], r => [114,88,356,-118], s => [115,44,365,-61], t => [116,104,321,-78], u => [117,89,473,-63], v => [118,94,459,-76], w => [119,94,728,-83], x => [120,76,557,-177], y => [121,11,502,-79], z => [122,50,466,-38], braceleft => [123,114,326,-179], bar => [124,341,53,170], braceright => [125,10,323,-73], asciitilde => [126,93,478,-6], exclamdown => [161,61,258,-16], cent => [162,138,354,-14], sterling => [163,4,469,4], fraction => [164,-125,429,-239], yen => [165,-11,689,-198], florin => [166,-53,691,-159], section => [167,68,435,-47], currency => [168,54,467,-43], quotesingle => [169,184,96,-107], quotedblleft => [170,248,294,-173], guillemotleft => [171,106,332,-69], guilsinglleft => [172,106,203,-48], guilsinglright => [173,93,215,-26], fi => [174,-113,771,-93], fl => [175,-114,885,-206], endash => [177,33,594,-84], dagger => [178,106,468,-75], daggerdbl => [179,106,468,-53], periodcentered => [180,117,131,-9], paragraph => [182,31,675,-163], bullet => [183,247,369,34], quotesinglbase => [184,43,141,10], quotedblbase => [185,44,266,-6], quotedblright => [186,247,266,-122], guillemotright => [187,94,347,-29], ellipsis => [188,115,855,116], perthousand => [189,176,883,-16], questiondown => [191,61,400,-27], grave => [193,188,117,-66], acute => [194,222,198,-95], circumflex => [195,198,232,-61], tilde => [196,198,358,-79], macron => [197,198,360,-81], breve => [198,198,361,-82], dotaccent => [199,223,111,-96], dieresis => [200,198,256,-64], ring => [202,247,196,-118], cedilla => [203,44,190,91], hungarumlaut => [205,198,304,-68], ogonek => [206,63,171,69], caron => [207,254,231,-116], emdash => [208,33,1138,-84], AE => [225,34,832,-63], ordfeminine => [227,88,264,-69], Lslash => [232,35,650,-55], Oslash => [233,119,648,-51], OE => [234,113,832,-54], ordmasculine => [235,106,244,-68], ae => [241,94,544,-52], dotlessi => [245,88,250,-77], lslash => [248,94,439,-207], oslash => [249,100,407,-29], oe => [250,95,558,-45], germandbls => [251,-138,688,-93], Yacute => [-1,33,795,-220], Ucircumflex => [-1,126,719,-41], Ugrave => [-1,126,719,-41], Zcaron => [-1,67,666,-59], Ydieresis => [-1,33,795,-220], threesuperior => [-1,75,297,-85], Uacute => [-1,126,719,-41], twosuperior => [-1,86,297,-97], Udieresis => [-1,126,719,-41], middot => [-1,117,131,-9], onesuperior => [-1,93,247,-54], aacute => [-1,94,440,-78], agrave => [-1,94,440,-78], acircumflex => [-1,94,440,-78], Scaron => [-1,0,659,-159], Otilde => [-1,113,623,-84], sfthyphen => [-1,125,201,-21], atilde => [-1,94,463,-101], aring => [-1,94,440,-78], adieresis => [-1,94,440,-78], Ograve => [-1,113,595,-56], Ocircumflex => [-1,113,595,-56], Odieresis => [-1,113,595,-56], Ntilde => [-1,43,951,-233], edieresis => [-1,94,350,-75], eacute => [-1,94,348,-73], egrave => [-1,94,318,-43], Icircumflex => [-1,88,441,-116], ecircumflex => [-1,94,336,-61], Igrave => [-1,88,434,-109], Iacute => [-1,88,434,-109], Idieresis => [-1,88,434,-109], degree => [-1,206,260,-32], Ecircumflex => [-1,82,643,-52], minus => [-1,59,547,-42], multiply => [-1,111,445,7], divide => [-1,111,445,7], Egrave => [-1,82,643,-52], trademark => [-1,179,961,-54], Oacute => [-1,113,595,-56], thorn => [-1,-8,532,-45], eth => [-1,94,510,-170], Eacute => [-1,82,643,-52], ccedilla => [-1,66,350,-46], idieresis => [-1,88,302,-129], iacute => [-1,88,301,-128], igrave => [-1,88,250,-77], plusminus => [-1,111,445,7], onehalf => [-1,104,611,1], onequarter => [-1,104,605,7], threequarters => [-1,85,634,-3], icircumflex => [-1,88,289,-116], Edieresis => [-1,82,643,-52], ntilde => [-1,88,480,-68], Aring => [-1,25,721,-72], odieresis => [-1,94,393,-53], oacute => [-1,94,393,-53], ograve => [-1,94,393,-53], ocircumflex => [-1,94,393,-53], otilde => [-1,94,441,-101], scaron => [-1,44,473,-170], udieresis => [-1,89,473,-63], uacute => [-1,89,473,-63], ugrave => [-1,89,473,-63], ucircumflex => [-1,89,473,-63], yacute => [-1,11,507,-84], zcaron => [-1,50,522,-94], ydieresis => [-1,11,502,-79], copyright => [-1,147,754,-97], registered => [-1,146,753,-95], Atilde => [-1,25,793,-144], nbspace => [-1,0,0,239], Ccedilla => [-1,95,594,-125], Acircumflex => [-1,25,721,-72], Agrave => [-1,25,721,-72], logicalnot => [-1,59,547,-42], Aacute => [-1,25,721,-72], Eth => [-1,93,731,-64], brokenbar => [-1,341,53,170], Thorn => [-1,40,632,-85], Adieresis => [-1,25,734,-85], mu => [-1,16,546,-63], '.notdef' => [-1,0,0,239], }} ); Prima-1.28/Prima/PS/fonts/Palatino-BoldItalic0000644000175100017510000001533111150770061016516 0ustar dkdk('Palatino-BoldItalic' => { name => 'Palatino-BoldItalic', family => 'Palatino', height => 1206, weigth => fw::Bold, style => fs::Bold|fs::Italic, pitch => fp::Variable, vector => 1, ascent => 935, descent => 271, maximalWidth => 1244, width => 1244, internalLeading => 209, externalLeading => 68, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 72.48, yDeviceRes => 72.48, size => 1000, encoding => 'Latin1', chardata => { space => [32,150,0,150], exclam => [33,69,318,13], quotedbl => [34,165,429,8], numbersign => [35,4,593,4], dollar => [36,24,551,27], percent => [37,67,885,119], ampersand => [38,89,888,26], quoteright => [39,91,272,-28], parenleft => [40,69,373,-42], parenright => [41,-14,373,42], asterisk => [42,101,428,6], plus => [43,60,610,60], comma => [44,-39,290,50], hyphen => [45,44,391,32], period => [46,57,167,75], slash => [47,1,378,0], zero => [48,50,540,12], one => [49,49,473,79], two => [50,1,546,55], three => [51,9,533,60], four => [52,3,583,15], five => [53,16,563,22], six => [54,47,541,14], seven => [55,83,572,-53], eight => [56,31,552,19], nine => [57,32,559,10], colon => [58,45,238,16], semicolon => [59,-39,337,3], less => [60,59,613,57], equal => [61,61,607,61], greater => [62,57,613,59], question => [63,109,432,-7], at => [64,98,798,107], A => [65,-42,868,44], B => [66,9,748,45], C => [67,83,754,-12], D => [68,0,900,37], E => [69,13,717,6], F => [70,-7,722,-44], G => [71,86,817,33], H => [72,-14,1010,-57], I => [73,-1,498,-27], J => [74,-34,537,-33], K => [75,-12,911,-28], L => [76,31,665,39], M => [77,-27,1215,-49], N => [78,-2,1002,-61], O => [79,91,865,47], P => [80,13,798,-7], Q => [81,91,865,47], R => [82,4,835,30], S => [83,60,563,47], T => [84,67,745,-75], U => [85,100,894,-56], V => [86,80,817,-94], W => [87,80,1213,-88], X => [88,-10,941,-60], Y => [89,65,748,-77], Z => [90,1,814,-10], bracketleft => [91,54,405,-57], backslash => [92,86,557,86], bracketright => [93,-25,405,21], asciicircum => [94,75,578,75], underscore => [95,0,603,0], quoteleft => [96,78,272,-15], a => [97,53,572,44], b => [98,53,542,51], c => [99,38,487,9], d => [100,45,617,7], e => [101,33,470,31], f => [102,-156,698,-139], g => [103,-60,698,-34], h => [104,26,603,41], i => [105,31,344,25], j => [106,-77,466,12], k => [107,41,595,33], l => [108,77,306,18], m => [109,22,945,36], n => [110,20,607,42], o => [111,57,547,65], p => [112,-25,647,48], q => [113,38,580,28], r => [114,24,471,-26], s => [115,30,459,45], t => [116,50,442,-24], u => [117,26,601,42], v => [118,22,595,51], w => [119,32,934,37], x => [120,-9,612,0], y => [121,15,636,18], z => [122,37,529,36], braceleft => [123,21,381,-1], bar => [124,312,106,312], braceright => [125,-1,381,21], asciitilde => [126,61,607,61], exclamdown => [161,2,309,89], cent => [162,62,487,53], sterling => [163,25,578,-1], fraction => [164,-205,612,-206], yen => [165,13,635,-45], florin => [166,9,568,25], section => [167,56,542,71], currency => [168,38,525,38], quotesingle => [169,153,200,-51], quotedblleft => [170,78,537,-13], guillemotleft => [171,42,510,50], guilsinglleft => [172,72,279,49], guilsinglright => [173,42,279,79], fi => [174,-156,865,27], fl => [175,-156,917,-24], endash => [177,-14,631,-14], dagger => [178,80,520,68], daggerdbl => [179,39,607,22], periodcentered => [180,80,167,53], paragraph => [182,16,741,-88], bullet => [183,157,414,157], quotesinglbase => [184,-3,268,36], quotedblbase => [185,-21,533,91], quotedblright => [186,88,537,-22], guillemotright => [187,42,510,50], ellipsis => [188,109,970,125], perthousand => [189,78,1021,106], questiondown => [191,-14,432,116], grave => [193,132,255,13], acute => [194,184,288,-71], circumflex => [195,106,394,-98], tilde => [196,98,432,-130], macron => [197,91,412,-102], breve => [198,115,381,-95], dotaccent => [199,243,148,9], dieresis => [200,108,405,-112], ring => [202,334,241,95], cedilla => [203,14,284,102], hungarumlaut => [205,-33,527,-91], ogonek => [206,38,248,114], caron => [207,136,400,-135], emdash => [208,-14,1234,-14], AE => [225,-34,1152,20], ordfeminine => [227,56,371,-26], Lslash => [232,7,689,39], Oslash => [233,68,892,43], OE => [234,47,1111,-20], ordmasculine => [235,61,355,-15], ae => [241,53,804,32], dotlessi => [245,31,322,48], lslash => [248,15,424,-38], oslash => [249,16,612,41], oe => [250,57,852,27], germandbls => [251,-157,820,8], Yacute => [-1,65,748,-77], Ucircumflex => [-1,100,894,-56], Ugrave => [-1,100,894,-56], Zcaron => [-1,1,814,-10], Ydieresis => [-1,65,748,-77], threesuperior => [-1,27,346,-12], Uacute => [-1,100,894,-56], twosuperior => [-1,31,355,-25], Udieresis => [-1,100,894,-56], middot => [-1,80,167,53], onesuperior => [-1,49,309,2], aacute => [-1,53,572,44], agrave => [-1,53,572,44], acircumflex => [-1,53,582,34], Scaron => [-1,60,617,-7], Otilde => [-1,91,865,47], sfthyphen => [-1,44,391,32], atilde => [-1,53,613,3], aring => [-1,53,572,44], adieresis => [-1,53,595,21], Ograve => [-1,91,865,47], Ocircumflex => [-1,91,865,47], Odieresis => [-1,91,865,47], Ntilde => [-1,-2,1002,-61], edieresis => [-1,33,547,-45], eacute => [-1,33,506,-4], egrave => [-1,33,470,31], Icircumflex => [-1,-1,535,-65], ecircumflex => [-1,33,534,-32], Igrave => [-1,-1,498,-27], Iacute => [-1,-1,507,-37], Idieresis => [-1,-1,548,-78], degree => [-1,60,361,60], Ecircumflex => [-1,13,717,6], minus => [-1,61,607,61], multiply => [-1,86,557,86], divide => [-1,60,610,60], Egrave => [-1,13,717,6], trademark => [-1,45,1113,47], Oacute => [-1,91,865,47], thorn => [-1,-25,647,48], eth => [-1,57,600,12], Eacute => [-1,13,717,6], ccedilla => [-1,38,487,9], idieresis => [-1,31,482,-112], iacute => [-1,31,441,-71], igrave => [-1,31,356,13], plusminus => [-1,60,610,60], onehalf => [-1,16,870,16], onequarter => [-1,21,861,21], threequarters => [-1,21,861,21], icircumflex => [-1,31,454,-84], Edieresis => [-1,13,717,6], ntilde => [-1,20,646,3], Aring => [-1,-42,868,44], odieresis => [-1,57,590,21], oacute => [-1,57,549,62], ograve => [-1,57,547,65], ocircumflex => [-1,57,563,49], otilde => [-1,57,609,3], scaron => [-1,30,559,-54], udieresis => [-1,26,622,21], uacute => [-1,26,601,42], ugrave => [-1,26,601,42], ucircumflex => [-1,26,601,42], yacute => [-1,15,636,18], zcaron => [-1,37,586,-20], ydieresis => [-1,15,636,18], copyright => [-1,31,836,32], registered => [-1,31,836,32], Atilde => [-1,-42,868,44], nbspace => [-1,150,0,150], Ccedilla => [-1,83,754,-12], Acircumflex => [-1,-42,868,44], Agrave => [-1,-42,868,44], logicalnot => [-1,61,607,61], Aacute => [-1,-42,868,44], Eth => [-1,0,900,37], brokenbar => [-1,312,106,312], Thorn => [-1,13,763,27], Adieresis => [-1,-42,868,44], mu => [-1,-18,646,42], '.notdef' => [-1,150,0,150], }} ); Prima-1.28/Prima/PS/fonts/Bookman-DemiItalic0000644000175100017510000001563611150770061016343 0ustar dkdk('Bookman-DemiItalic' => { name => 'Bookman-DemiItalic', family => 'Bookman', height => 1145, weigth => fw::Bold, style => fs::Bold|fs::Italic, pitch => fp::Variable, vector => 1, ascent => 927, descent => 218, maximalWidth => 1565, width => 1565, internalLeading => 195, externalLeading => 64, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.07, yDeviceRes => 76.07, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,389], exclam => [33,98,320,-52], quotedbl => [34,160,420,-145], numbersign => [35,179,563,35], dollar => [36,51,746,-19], percent => [37,121,907,-21], ampersand => [38,54,1108,-41], quoteright => [39,195,203,-33], parenleft => [40,35,408,-146], parenright => [41,-40,408,-70], asterisk => [42,144,437,-54], plus => [43,104,577,5], comma => [44,114,226,48], hyphen => [45,67,297,-44], period => [46,121,217,50], slash => [47,10,564,-162], zero => [48,99,705,-26], one => [49,140,506,131], two => [50,76,695,6], three => [51,82,699,-3], four => [52,72,738,-32], five => [53,89,676,12], six => [54,100,705,-27], seven => [55,140,705,-67], eight => [56,77,707,-6], nine => [57,81,733,-36], colon => [58,121,286,-18], semicolon => [59,114,288,-13], less => [60,90,582,36], equal => [61,104,577,5], greater => [62,101,582,25], question => [63,166,598,-54], at => [64,91,812,-11], A => [65,-30,911,-56], B => [66,16,856,-48], C => [67,89,774,-61], D => [68,16,905,-51], E => [69,16,873,-65], F => [70,16,857,-117], G => [71,88,859,-77], H => [72,16,1025,-125], I => [73,16,539,-120], J => [74,9,816,-115], K => [75,16,990,-113], L => [76,16,814,-97], M => [77,16,1094,-125], N => [78,16,951,-120], O => [79,89,833,-52], P => [80,-6,835,-96], Q => [81,42,879,-51], R => [82,16,859,-28], S => [83,67,769,-35], T => [84,80,838,-116], U => [85,128,850,-131], V => [86,82,855,-182], W => [87,82,1165,-103], X => [88,-8,964,-108], Y => [89,82,853,-179], Z => [90,26,820,-68], bracketleft => [91,10,417,-130], backslash => [92,83,574,5], bracketright => [93,-20,417,-99], asciicircum => [94,105,574,29], underscore => [95,0,572,0], quoteleft => [96,177,203,-14], a => [97,96,745,-62], b => [98,65,659,-37], c => [99,66,617,-42], d => [100,68,748,-38], e => [101,67,614,-41], f => [102,-219,953,-253], g => [103,24,741,-56], h => [104,106,736,-41], i => [105,95,385,-45], j => [106,-183,632,-82], k => [107,111,727,-36], l => [108,124,344,-34], m => [109,95,1045,-41], n => [110,95,723,-40], o => [111,67,650,-30], p => [112,-27,808,-25], q => [113,68,664,-22], r => [114,96,570,-93], s => [115,36,619,-37], t => [116,121,437,-54], u => [117,95,729,-45], v => [118,64,590,-36], w => [119,64,956,-35], x => [120,11,737,-38], y => [121,28,706,-48], z => [122,41,629,-29], braceleft => [123,60,407,-124], bar => [124,346,136,226], braceright => [125,-4,407,-59], asciitilde => [126,115,577,17], exclamdown => [161,73,320,-27], cent => [162,184,520,73], sterling => [163,0,901,-122], fraction => [164,-164,602,-299], yen => [165,105,790,-116], florin => [166,-32,882,-72], section => [167,52,677,-20], currency => [168,169,559,49], quotesingle => [169,144,193,-131], quotedblleft => [170,178,445,-28], guillemotleft => [171,70,393,-29], guilsinglleft => [172,70,214,-33], guilsinglright => [173,70,214,-33], fi => [174,-218,1191,-34], fl => [175,-218,1191,-34], endash => [177,45,610,-83], dagger => [178,101,431,-52], daggerdbl => [179,90,466,-75], periodcentered => [180,144,217,27], paragraph => [182,80,751,-52], bullet => [183,68,393,-50], quotesinglbase => [184,121,203,18], quotedblbase => [185,121,445,28], quotedblright => [186,195,445,-45], guillemotright => [187,70,393,-29], ellipsis => [188,98,980,66], perthousand => [189,121,1404,30], questiondown => [191,95,598,16], grave => [193,220,264,-50], acute => [194,201,264,-76], circumflex => [195,209,389,-49], tilde => [196,203,406,-60], macron => [197,202,405,-58], breve => [198,202,388,-64], dotaccent => [199,206,188,40], dieresis => [200,206,445,-56], ring => [202,211,253,-52], cedilla => [203,77,253,81], hungarumlaut => [205,207,498,-64], ogonek => [206,77,211,76], caron => [207,209,389,-49], emdash => [208,45,1182,-83], AE => [225,-30,1412,-76], ordfeminine => [227,62,503,-62], Lslash => [232,16,812,-96], Oslash => [233,24,945,-99], OE => [234,107,1317,-74], ordmasculine => [235,53,480,-30], ae => [241,44,1000,-37], dotlessi => [245,95,385,-45], lslash => [248,72,399,-36], oslash => [249,19,737,-69], oe => [250,54,1045,-46], germandbls => [251,-264,1068,-48], Yacute => [-1,82,853,-179], Ucircumflex => [-1,128,850,-131], Ugrave => [-1,128,850,-131], Zcaron => [-1,26,820,-68], Ydieresis => [-1,82,853,-179], threesuperior => [-1,98,454,-85], Uacute => [-1,128,850,-131], twosuperior => [-1,104,451,-88], Udieresis => [-1,128,850,-131], middot => [-1,144,217,27], onesuperior => [-1,135,329,2], aacute => [-1,96,745,-62], agrave => [-1,96,745,-62], acircumflex => [-1,96,745,-62], Scaron => [-1,67,769,-35], Otilde => [-1,89,833,-52], sfthyphen => [-1,67,297,-44], atilde => [-1,96,745,-62], aring => [-1,96,745,-62], adieresis => [-1,96,745,-62], Ograve => [-1,89,833,-52], Ocircumflex => [-1,89,833,-52], Odieresis => [-1,89,833,-52], Ntilde => [-1,16,951,-120], edieresis => [-1,67,614,-41], eacute => [-1,67,614,-41], egrave => [-1,67,614,-41], Icircumflex => [-1,16,548,-129], ecircumflex => [-1,67,614,-41], Igrave => [-1,16,539,-120], Iacute => [-1,16,539,-120], Idieresis => [-1,16,555,-136], degree => [-1,148,343,-34], Ecircumflex => [-1,16,873,-65], minus => [-1,104,577,5], multiply => [-1,104,577,5], divide => [-1,104,577,5], Egrave => [-1,16,873,-65], trademark => [-1,48,1076,-48], Oacute => [-1,89,833,-52], thorn => [-1,-27,808,-25], eth => [-1,67,690,-70], Eacute => [-1,16,873,-65], ccedilla => [-1,66,617,-42], idieresis => [-1,95,453,-113], iacute => [-1,95,385,-45], igrave => [-1,95,390,-50], plusminus => [-1,104,577,5], onehalf => [-1,135,1051,-18], onequarter => [-1,135,1071,-38], threequarters => [-1,98,1108,-38], icircumflex => [-1,95,400,-60], Edieresis => [-1,16,873,-65], ntilde => [-1,95,723,-40], Aring => [-1,-30,911,-56], odieresis => [-1,67,650,-30], oacute => [-1,67,650,-30], ograve => [-1,67,650,-30], ocircumflex => [-1,67,650,-30], otilde => [-1,67,650,-30], scaron => [-1,36,619,-37], udieresis => [-1,95,729,-45], uacute => [-1,95,729,-45], ugrave => [-1,95,729,-45], ucircumflex => [-1,95,729,-45], yacute => [-1,28,706,-48], zcaron => [-1,41,629,-29], ydieresis => [-1,28,706,-48], copyright => [-1,95,801,-3], registered => [-1,95,801,-3], Atilde => [-1,-30,911,-56], nbspace => [-1,0,0,389], Ccedilla => [-1,89,774,-61], Acircumflex => [-1,-30,911,-56], Agrave => [-1,-30,911,-56], logicalnot => [-1,92,577,40], Aacute => [-1,-30,911,-56], Eth => [-1,16,905,-51], brokenbar => [-1,346,136,226], Thorn => [-1,-6,809,-69], Adieresis => [-1,-30,911,-56], mu => [-1,61,762,-45], '.notdef' => [-1,0,0,389], }} ); Prima-1.28/Prima/PS/fonts/AvantGarde-Demi0000644000175100017510000001512111150770061015630 0ustar dkdk('AvantGarde-Demi' => { name => 'AvantGarde-Demi', family => 'AvantGarde', height => 1251, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 1000, descent => 251, maximalWidth => 1370, width => 1370, internalLeading => 261, externalLeading => 86, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 73, yDeviceRes => 73, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,350], exclam => [33,90,166,93], quotedbl => [34,92,261,96], numbersign => [35,42,615,42], dollar => [36,73,544,82], percent => [37,26,1018,31], ampersand => [38,43,786,20], quoteright => [39,90,166,93], parenleft => [40,92,344,38], parenright => [41,46,344,85], asterisk => [42,87,376,86], plus => [43,63,630,56], comma => [44,90,166,93], hyphen => [45,92,346,86], period => [46,90,166,93], slash => [47,32,521,21], zero => [48,37,619,43], one => [49,191,282,226], two => [50,42,607,50], three => [51,18,629,52], four => [52,0,663,37], five => [53,15,635,50], six => [54,26,640,33], seven => [55,81,544,75], eight => [56,38,615,46], nine => [57,27,638,35], colon => [58,90,166,93], semicolon => [59,90,166,93], less => [60,61,636,52], equal => [61,63,630,56], greater => [62,60,636,53], question => [63,40,566,93], at => [64,3,928,-6], A => [65,8,908,8], B => [66,85,600,40], C => [67,37,913,25], D => [68,85,740,50], E => [69,85,496,68], F => [70,85,470,45], G => [71,37,985,27], H => [72,85,673,92], I => [73,85,171,93], J => [74,11,506,82], K => [75,85,664,26], L => [76,85,454,11], M => [77,85,965,75], N => [78,85,749,91], O => [79,37,963,50], P => [80,85,590,25], Q => [81,37,998,15], R => [82,85,625,15], S => [83,17,599,33], T => [84,8,514,2], U => [85,85,624,91], V => [86,10,858,7], W => [87,8,1114,2], X => [88,6,839,5], Y => [89,3,779,-7], Z => [90,22,577,25], bracketleft => [91,92,272,35], backslash => [92,105,524,171], bracketright => [93,46,272,81], asciicircum => [94,78,600,71], underscore => [95,0,625,0], quoteleft => [96,90,166,93], a => [97,37,731,56], b => [98,67,730,27], c => [99,37,714,48], d => [100,37,729,58], e => [101,37,723,40], f => [102,12,330,7], g => [103,37,726,61], h => [104,67,614,68], i => [105,67,166,66], j => [106,21,235,68], k => [107,67,626,31], l => [108,67,166,66], m => [109,67,1039,68], n => [110,67,615,67], o => [111,37,736,26], p => [112,67,725,32], q => [113,37,726,61], r => [114,67,315,17], s => [115,23,501,25], t => [116,11,347,16], u => [117,67,616,66], v => [118,1,690,8], w => [119,12,969,18], x => [120,1,690,8], y => [121,7,703,15], z => [122,25,527,22], braceleft => [123,46,331,47], bar => [124,303,148,297], braceright => [125,47,331,46], asciitilde => [126,63,630,56], exclamdown => [161,90,166,93], cent => [162,48,590,61], sterling => [163,0,704,-3], fraction => [164,-151,501,-150], yen => [165,-43,780,-36], florin => [166,-21,639,82], section => [167,50,611,38], currency => [168,33,634,32], quotesingle => [169,92,95,87], quotedblleft => [170,87,425,87], guillemotleft => [171,45,440,90], guilsinglleft => [172,45,173,81], guilsinglright => [173,91,173,35], fi => [174,10,566,73], fl => [175,10,566,73], endash => [177,0,625,0], dagger => [178,60,571,68], daggerdbl => [179,60,571,68], periodcentered => [180,90,166,93], paragraph => [182,46,612,91], bullet => [183,167,421,161], quotesinglbase => [184,87,166,96], quotedblbase => [185,87,425,87], quotedblright => [186,87,425,87], guillemotright => [187,91,440,43], ellipsis => [188,125,999,126], perthousand => [189,26,1534,40], questiondown => [191,86,566,47], grave => [193,92,349,83], acute => [194,92,347,85], circumflex => [195,92,499,83], tilde => [196,92,414,93], macron => [197,92,346,86], breve => [198,92,412,95], dotaccent => [199,92,166,91], dieresis => [200,92,429,103], ring => [202,92,257,100], cedilla => [203,92,245,87], hungarumlaut => [205,92,694,88], ogonek => [206,92,227,105], caron => [207,92,499,83], emdash => [208,0,1251,0], AE => [225,21,1033,71], ordfeminine => [227,35,392,22], Lslash => [232,17,574,8], Oslash => [233,37,967,46], OE => [234,47,1208,70], ordmasculine => [235,38,384,27], ae => [241,37,1277,36], dotlessi => [245,67,166,66], lslash => [248,21,369,10], oslash => [249,37,738,50], oe => [250,37,1273,40], germandbls => [251,63,666,20], Yacute => [-1,3,779,-7], Ucircumflex => [-1,85,624,91], Ugrave => [-1,85,624,91], Zcaron => [-1,22,577,25], Ydieresis => [-1,3,779,-7], threesuperior => [-1,5,409,6], Uacute => [-1,85,624,91], twosuperior => [-1,12,395,12], Udieresis => [-1,85,624,91], middot => [-1,90,166,93], onesuperior => [-1,117,183,118], aacute => [-1,37,731,56], agrave => [-1,37,731,56], acircumflex => [-1,37,731,56], Scaron => [-1,17,599,33], Otilde => [-1,37,963,50], sfthyphen => [-1,92,346,86], atilde => [-1,37,731,56], aring => [-1,37,731,56], adieresis => [-1,37,731,56], Ograve => [-1,37,963,50], Ocircumflex => [-1,37,963,50], Odieresis => [-1,37,963,50], Ntilde => [-1,85,749,91], edieresis => [-1,37,723,40], eacute => [-1,37,723,40], egrave => [-1,37,723,40], Icircumflex => [-1,-70,499,-78], ecircumflex => [-1,37,723,40], Igrave => [-1,5,349,-3], Iacute => [-1,5,347,-2], Idieresis => [-1,-45,429,-33], degree => [-1,62,375,62], Ecircumflex => [-1,80,501,68], minus => [-1,63,630,56], multiply => [-1,63,630,56], divide => [-1,63,630,56], Egrave => [-1,85,496,68], trademark => [-1,88,1073,88], Oacute => [-1,37,963,50], thorn => [-1,67,725,32], eth => [-1,37,736,26], Eacute => [-1,85,496,68], ccedilla => [-1,37,714,48], idieresis => [-1,-70,429,-58], iacute => [-1,-20,347,-27], igrave => [-1,-20,349,-28], plusminus => [-1,63,630,56], onehalf => [-1,117,920,12], onequarter => [-1,117,928,5], threequarters => [-1,5,1040,5], icircumflex => [-1,-95,499,-103], Edieresis => [-1,85,496,68], ntilde => [-1,67,615,67], Aring => [-1,8,908,8], odieresis => [-1,37,736,26], oacute => [-1,37,736,26], ograve => [-1,37,736,26], ocircumflex => [-1,37,736,26], otilde => [-1,37,736,26], scaron => [-1,23,505,21], udieresis => [-1,67,616,66], uacute => [-1,67,616,66], ugrave => [-1,67,616,66], ucircumflex => [-1,67,616,66], yacute => [-1,7,703,15], zcaron => [-1,25,527,22], ydieresis => [-1,7,703,15], copyright => [-1,-15,964,-23], registered => [-1,-15,964,-23], Atilde => [-1,8,908,8], nbspace => [-1,0,0,350], Ccedilla => [-1,37,913,25], Acircumflex => [-1,8,908,8], Agrave => [-1,8,908,8], logicalnot => [-1,63,630,56], Aacute => [-1,8,908,8], Eth => [-1,17,860,50], brokenbar => [-1,303,148,297], Thorn => [-1,85,590,25], Adieresis => [-1,8,908,8], mu => [-1,67,616,36], '.notdef' => [-1,0,0,350], }} ); Prima-1.28/Prima/PS/fonts/Helvetica0000644000175100017510000001517711150770061014657 0ustar dkdk('Helvetica' => { name => 'Helvetica', family => 'Helvetica', height => 1173, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 953, descent => 220, maximalWidth => 1176, width => 1176, internalLeading => 224, externalLeading => 73, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.15, yDeviceRes => 76.15, size => 1000, encoding => 'Latin1', chardata => { space => [32,224,0,102], exclam => [33,145,98,82], quotedbl => [34,60,296,58], numbersign => [35,16,619,16], dollar => [36,30,577,44], percent => [37,34,973,35], ampersand => [38,60,686,35], quoteright => [39,75,109,75], parenleft => [40,85,255,49], parenright => [41,44,255,90], asterisk => [42,46,355,53], plus => [43,58,567,58], comma => [44,102,123,100], hyphen => [45,53,279,57], period => [46,102,121,102], slash => [47,-9,342,-7], zero => [48,50,544,57], one => [49,119,287,245], two => [50,39,559,52], three => [51,37,556,58], four => [52,32,577,42], five => [53,41,560,50], six => [54,50,551,50], seven => [55,53,556,42], eight => [56,43,558,50], nine => [57,44,552,55], colon => [58,129,121,75], semicolon => [59,129,123,73], less => [60,52,573,58], equal => [61,58,567,58], greater => [62,58,573,52], question => [63,90,506,55], at => [64,39,1075,75], A => [65,19,746,16], B => [66,92,638,51], C => [67,56,737,52], D => [68,104,677,64], E => [69,105,613,63], F => [70,105,573,37], G => [71,51,780,80], H => [72,97,658,91], I => [73,117,110,98], J => [74,19,479,86], K => [75,92,679,10], L => [76,93,531,26], M => [77,87,804,84], N => [78,89,668,89], O => [79,44,825,42], P => [80,106,616,58], Q => [81,44,825,42], R => [82,109,687,50], S => [83,56,672,53], T => [84,24,670,21], U => [85,99,656,90], V => [86,35,721,25], W => [87,25,1063,17], X => [88,25,735,21], Y => [89,15,760,7], Z => [90,32,651,32], bracketleft => [91,75,218,32], backslash => [92,-9,342,-7], bracketright => [93,26,218,80], asciicircum => [94,51,446,51], underscore => [95,-25,703,-25], quoteleft => [96,76,109,75], a => [97,49,578,24], b => [98,63,550,38], c => [99,36,523,26], d => [100,30,550,71], e => [101,46,554,50], f => [102,21,281,23], g => [103,34,539,78], h => [104,82,487,82], i => [105,77,98,84], j => [106,-21,200,80], k => [107,68,520,-2], l => [108,79,98,82], m => [109,82,811,83], n => [110,82,489,80], o => [111,42,556,53], p => [112,63,550,38], q => [113,30,550,71], r => [114,80,295,14], s => [115,39,498,48], t => [116,16,281,28], u => [117,76,489,86], v => [118,11,558,16], w => [119,7,823,16], x => [120,19,534,31], y => [121,23,537,25], z => [122,36,499,50], braceleft => [123,50,273,68], bar => [124,117,70,117], braceright => [125,34,273,84], asciitilde => [126,87,507,89], exclamdown => [161,141,98,150], cent => [162,60,537,53], sterling => [163,30,597,24], fraction => [164,-204,598,-198], yen => [165,12,626,12], florin => [166,12,622,16], section => [167,50,543,58], currency => [168,78,495,78], quotesingle => [169,56,110,57], quotedblleft => [170,56,294,39], guillemotleft => [171,114,418,118], guilsinglleft => [172,106,178,105], guilsinglright => [173,99,180,110], fi => [174,14,497,75], fl => [175,19,484,82], endash => [177,-5,663,-5], dagger => [178,44,557,50], daggerdbl => [179,44,557,50], periodcentered => [180,102,145,78], paragraph => [182,56,556,17], bullet => [183,58,293,58], quotesinglbase => [184,75,110,75], quotedblbase => [185,55,296,38], quotedblright => [186,57,296,36], guillemotright => [187,114,414,123], ellipsis => [188,134,903,134], perthousand => [189,10,1154,8], questiondown => [191,111,507,97], grave => [193,25,245,119], acute => [194,107,245,37], circumflex => [195,23,336,30], tilde => [196,5,368,16], macron => [197,32,321,36], breve => [198,17,353,19], dotaccent => [199,134,121,133], dieresis => [200,35,312,43], ring => [202,92,206,91], cedilla => [203,45,290,53], hungarumlaut => [205,-41,449,-17], ogonek => [206,66,243,79], caron => [207,22,336,31], emdash => [208,-10,1184,-1], AE => [225,12,1101,58], ordfeminine => [227,43,347,43], Lslash => [232,0,647,4], Oslash => [233,35,837,39], OE => [234,50,1074,48], ordmasculine => [235,46,333,48], ae => [241,39,951,51], dotlessi => [245,110,98,117], lslash => [248,0,248,11], oslash => [249,21,599,96], oe => [250,46,1007,52], germandbls => [251,147,516,52], Yacute => [-1,15,760,5], Ucircumflex => [-1,99,656,90], Ugrave => [-1,99,656,90], Zcaron => [-1,32,651,32], Ydieresis => [-1,15,760,7], threesuperior => [-1,18,358,34], Uacute => [-1,99,656,90], twosuperior => [-1,22,360,29], Udieresis => [-1,99,656,90], middot => [-1,102,145,78], onesuperior => [-1,71,188,151], aacute => [-1,49,578,24], agrave => [-1,49,578,24], acircumflex => [-1,49,578,24], Scaron => [-1,56,672,53], Otilde => [-1,44,825,42], sfthyphen => [-1,53,279,57], atilde => [-1,49,578,24], aring => [-1,49,578,24], adieresis => [-1,49,578,24], Ograve => [-1,44,825,42], Ocircumflex => [-1,44,825,42], Odieresis => [-1,44,825,42], Ntilde => [-1,89,668,89], edieresis => [-1,46,554,50], eacute => [-1,46,554,50], egrave => [-1,46,554,50], Icircumflex => [-1,-1,336,-9], ecircumflex => [-1,46,554,50], Igrave => [-1,1,245,79], Iacute => [-1,83,245,-2], Idieresis => [-1,10,312,3], degree => [-1,177,355,178], Ecircumflex => [-1,105,613,63], minus => [-1,46,591,46], multiply => [-1,111,460,112], divide => [-1,58,567,58], Egrave => [-1,105,613,63], trademark => [-1,73,1026,72], Oacute => [-1,44,825,42], thorn => [-1,63,548,38], eth => [-1,42,556,53], Eacute => [-1,105,613,63], ccedilla => [-1,36,523,26], idieresis => [-1,3,312,10], iacute => [-1,76,245,4], igrave => [-1,-5,245,86], plusminus => [-1,58,567,58], onehalf => [-1,71,918,29], onequarter => [-1,71,924,23], threequarters => [-1,18,977,23], icircumflex => [-1,-8,336,-2], Edieresis => [-1,105,613,63], ntilde => [-1,82,489,80], Aring => [-1,19,746,16], odieresis => [-1,42,556,53], oacute => [-1,42,556,53], ograve => [-1,42,556,53], ocircumflex => [-1,42,556,53], otilde => [-1,42,556,53], scaron => [-1,39,498,48], udieresis => [-1,76,489,86], uacute => [-1,76,489,86], ugrave => [-1,76,489,86], ucircumflex => [-1,76,489,86], yacute => [-1,23,537,25], zcaron => [-1,36,499,50], ydieresis => [-1,23,537,25], copyright => [-1,-15,896,-16], registered => [-1,-15,896,-16], Atilde => [-1,19,746,16], nbspace => [-1,224,0,102], Ccedilla => [-1,56,737,52], Acircumflex => [-1,19,746,16], Agrave => [-1,19,746,16], logicalnot => [-1,46,591,46], Aacute => [-1,19,746,16], Eth => [-1,23,758,64], brokenbar => [-1,117,70,117], Thorn => [-1,106,615,58], Adieresis => [-1,19,746,16], mu => [-1,76,561,14], '.notdef' => [-1,224,0,102], }} ); Prima-1.28/Prima/PS/fonts/AvantGarde-BookOblique0000644000175100017510000001572611150770061017200 0ustar dkdk('AvantGarde-BookOblique' => { name => 'AvantGarde-BookOblique', family => 'AvantGarde', height => 1199, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 972, descent => 227, maximalWidth => 1391, width => 1391, internalLeading => 233, externalLeading => 76, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 74.81, yDeviceRes => 74.81, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,332], exclam => [33,133,252,-32], quotedbl => [34,202,245,-77], numbersign => [35,61,706,-103], dollar => [36,134,555,-25], percent => [37,140,800,-11], ampersand => [38,111,816,-20], quoteright => [39,230,237,-46], parenleft => [40,127,438,-123], parenright => [41,11,440,-9], asterisk => [42,206,365,-62], plus => [43,119,621,-14], comma => [44,94,236,1], hyphen => [45,95,340,-38], period => [46,121,116,94], slash => [47,19,621,-116], zero => [48,85,659,-80], one => [49,335,252,75], two => [50,39,688,-63], three => [51,85,591,-11], four => [52,44,671,-51], five => [53,76,647,-59], six => [54,79,615,-29], seven => [55,129,622,-87], eight => [56,93,601,-31], nine => [57,134,615,-85], colon => [58,121,202,8], semicolon => [59,34,322,-25], less => [60,118,676,-68], equal => [61,98,664,-35], greater => [62,65,676,-15], question => [63,190,561,-43], at => [64,159,899,-19], A => [65,13,860,13], B => [66,91,636,-39], C => [67,127,914,-67], D => [68,91,836,-35], E => [69,91,648,-97], F => [70,91,613,-123], G => [71,128,943,-26], H => [72,91,800,-73], I => [73,91,252,-73], J => [74,49,601,-73], K => [75,91,774,-157], L => [76,91,470,-7], M => [77,91,1083,-73], N => [78,91,869,-73], O => [79,127,952,-37], P => [80,91,706,-87], Q => [81,125,968,-50], R => [82,91,715,-79], S => [83,67,609,-79], T => [84,158,508,-155], U => [85,142,715,-73], V => [86,176,817,-152], W => [87,176,1127,-152], X => [88,9,857,-136], Y => [89,166,705,-161], Z => [90,20,699,-143], bracketleft => [91,158,381,-118], backslash => [92,264,291,169], bracketright => [93,16,381,22], asciicircum => [94,61,683,-17], underscore => [95,-27,612,14], quoteleft => [96,281,151,-11], a => [97,105,758,-45], b => [98,75,758,-16], c => [99,105,708,-38], d => [100,105,804,-88], e => [101,105,691,-17], f => [102,121,414,-159], g => [103,71,780,-45], h => [104,75,654,1], i => [105,75,252,-88], j => [106,-97,429,-88], k => [107,75,624,-98], l => [108,75,252,-88], m => [109,75,1052,-3], n => [110,75,654,1], o => [111,104,697,-16], p => [112,32,800,-15], q => [113,104,758,-45], r => [114,75,399,-113], s => [115,51,458,-44], t => [116,121,392,-106], u => [117,118,655,-45], v => [118,130,645,-111], w => [119,129,979,-112], x => [120,9,677,-111], y => [121,116,636,-110], z => [122,11,583,-86], braceleft => [123,112,376,-68], bar => [124,364,240,200], braceright => [125,16,374,29], asciitilde => [126,118,623,-15], exclamdown => [161,89,252,10], cent => [162,135,577,-49], sterling => [163,69,715,-121], fraction => [164,-137,639,-302], yen => [165,116,754,-206], florin => [166,-25,846,-157], section => [167,136,577,22], currency => [168,61,676,-73], quotesingle => [169,202,110,-75], quotedblleft => [170,279,328,-5], guillemotleft => [171,115,450,-56], guilsinglleft => [172,115,242,-56], guilsinglright => [173,77,242,-19], fi => [174,117,555,-88], fl => [175,117,552,-88], endash => [177,58,615,-74], dagger => [178,175,537,-49], daggerdbl => [179,145,571,-53], periodcentered => [180,173,116,41], paragraph => [182,161,591,-76], bullet => [183,205,450,70], quotesinglbase => [184,92,236,95], quotedblbase => [185,92,412,97], quotedblright => [186,225,410,-55], guillemotright => [187,77,450,-19], ellipsis => [188,155,914,128], perthousand => [189,140,1279,-11], questiondown => [191,76,561,70], grave => [193,248,264,-59], acute => [194,237,285,-73], circumflex => [195,225,424,-47], tilde => [196,239,342,-56], macron => [197,225,418,-62], breve => [198,248,364,-69], dotaccent => [199,225,116,-75], dieresis => [200,225,292,-75], ring => [202,243,224,-69], cedilla => [203,55,218,115], hungarumlaut => [205,236,501,-75], ogonek => [206,63,179,118], caron => [207,252,424,-75], emdash => [208,58,1214,-74], AE => [225,13,1273,-97], ordfeminine => [227,109,462,-129], Lslash => [232,83,532,3], Oslash => [233,86,1022,-68], OE => [234,127,1401,-97], ordmasculine => [235,110,429,-97], ae => [241,105,1299,-17], dotlessi => [245,75,209,-45], lslash => [248,112,330,-83], oslash => [249,91,732,-40], oe => [250,105,1276,-19], germandbls => [251,70,619,-26], Yacute => [-1,166,705,-161], Ucircumflex => [-1,142,715,-73], Ugrave => [-1,142,715,-73], Zcaron => [-1,20,699,-143], Ydieresis => [-1,166,705,-161], threesuperior => [-1,109,382,-93], Uacute => [-1,142,715,-73], twosuperior => [-1,80,441,-123], Udieresis => [-1,142,715,-73], middot => [-1,173,116,41], onesuperior => [-1,272,171,-45], aacute => [-1,105,758,-45], agrave => [-1,105,758,-45], acircumflex => [-1,105,758,-45], Scaron => [-1,67,651,-121], Otilde => [-1,127,952,-37], sfthyphen => [-1,95,340,-38], atilde => [-1,105,758,-45], aring => [-1,105,758,-45], adieresis => [-1,105,758,-45], Ograve => [-1,127,952,-37], Ocircumflex => [-1,127,952,-37], Odieresis => [-1,127,952,-37], Ntilde => [-1,91,869,-73], edieresis => [-1,105,691,-17], eacute => [-1,105,691,-17], egrave => [-1,105,691,-17], Icircumflex => [-1,91,435,-255], ecircumflex => [-1,105,691,-17], Igrave => [-1,91,374,-194], Iacute => [-1,91,342,-163], Idieresis => [-1,91,383,-203], degree => [-1,188,365,-74], Ecircumflex => [-1,91,648,-97], minus => [-1,119,621,-14], multiply => [-1,83,693,-50], divide => [-1,119,621,-14], Egrave => [-1,91,648,-97], trademark => [-1,226,1062,-89], Oacute => [-1,127,952,-37], thorn => [-1,32,800,-15], eth => [-1,104,702,-21], Eacute => [-1,91,648,-97], ccedilla => [-1,105,708,-38], idieresis => [-1,75,341,-177], iacute => [-1,75,342,-178], igrave => [-1,75,330,-166], plusminus => [-1,61,691,-26], onehalf => [-1,248,799,-51], onequarter => [-1,260,748,-11], threequarters => [-1,109,899,-11], icircumflex => [-1,44,424,-229], Edieresis => [-1,91,648,-97], ntilde => [-1,75,654,1], Aring => [-1,13,860,13], odieresis => [-1,104,697,-16], oacute => [-1,104,697,-16], ograve => [-1,104,697,-16], ocircumflex => [-1,104,697,-16], otilde => [-1,104,697,-16], scaron => [-1,51,557,-143], udieresis => [-1,118,655,-45], uacute => [-1,118,655,-45], ugrave => [-1,118,655,-45], ucircumflex => [-1,118,655,-45], yacute => [-1,116,636,-110], zcaron => [-1,11,619,-122], ydieresis => [-1,116,636,-110], copyright => [-1,63,931,-99], registered => [-1,63,931,-99], Atilde => [-1,13,860,13], nbspace => [-1,0,0,332], Ccedilla => [-1,127,914,-67], Acircumflex => [-1,13,860,13], Agrave => [-1,13,860,13], logicalnot => [-1,141,621,-35], Aacute => [-1,13,860,13], Eth => [-1,111,871,-35], brokenbar => [-1,364,240,200], Thorn => [-1,91,672,-53], Adieresis => [-1,13,860,13], mu => [-1,32,742,-45], '.notdef' => [-1,0,0,332], }} ); Prima-1.28/Prima/PS/fonts/Times-Roman0000644000175100017510000001511711150770061015100 0ustar dkdk('Times-Roman' => { name => 'Times-Roman', family => 'Times', height => 1133, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 915, descent => 218, maximalWidth => 1169, width => 1169, internalLeading => 232, externalLeading => 76, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 80.21, yDeviceRes => 80.21, size => 1000, encoding => 'Latin1', chardata => { space => [32,141,0,141], exclam => [33,147,120,109], quotedbl => [34,87,287,87], numbersign => [35,5,556,4], dollar => [36,49,467,48], percent => [37,69,805,69], ampersand => [38,47,802,31], quoteright => [39,89,157,130], parenleft => [40,54,290,32], parenright => [41,32,290,54], asterisk => [42,78,411,77], plus => [43,33,571,33], comma => [44,63,157,62], hyphen => [45,44,278,54], period => [46,79,125,78], slash => [47,-10,335,-10], zero => [48,27,512,27], one => [49,125,320,120], two => [50,33,504,28], three => [51,48,439,78], four => [52,13,521,31], five => [53,36,459,70], six => [54,38,491,36], seven => [55,22,486,57], eight => [56,63,440,62], nine => [57,33,486,46], colon => [58,91,125,97], semicolon => [59,90,157,66], less => [60,31,575,31], equal => [61,33,571,33], greater => [62,31,575,31], question => [63,77,392,33], at => [64,131,785,126], A => [65,16,782,18], B => [66,19,652,83], C => [67,31,685,38], D => [68,18,757,41], E => [69,13,662,15], F => [70,13,605,11], G => [71,36,767,14], H => [72,21,773,22], I => [73,20,336,20], J => [74,11,407,21], K => [75,38,780,-1], L => [76,13,663,14], M => [77,13,964,29], N => [78,13,787,16], O => [79,38,740,38], P => [80,18,595,15], Q => [81,38,755,23], R => [82,19,727,9], S => [83,47,508,73], T => [84,19,652,20], U => [85,15,782,19], V => [86,18,771,28], W => [87,5,1050,13], X => [88,11,786,20], Y => [89,24,771,21], Z => [90,10,666,15], bracketleft => [91,99,239,38], backslash => [92,-10,335,-10], bracketright => [93,38,239,99], asciicircum => [94,27,478,26], underscore => [95,0,566,0], quoteleft => [96,130,157,89], a => [97,41,458,2], b => [98,3,526,36], c => [99,28,438,36], d => [100,30,525,10], e => [101,28,452,22], f => [102,22,411,-56], g => [103,31,500,33], h => [104,10,541,14], i => [105,18,268,28], j => [106,-79,299,95], k => [107,7,564,-5], l => [108,21,269,23], m => [109,18,859,3], n => [110,18,531,16], o => [111,32,499,33], p => [112,5,526,33], q => [113,27,525,13], r => [114,5,373,-2], s => [115,57,336,46], t => [116,14,301,-1], u => [117,10,532,23], v => [118,21,518,26], w => [119,23,762,31], x => [120,19,523,23], y => [121,15,522,28], z => [122,30,443,29], braceleft => [123,113,283,147], bar => [124,75,74,75], braceright => [125,147,283,113], asciitilde => [126,45,523,44], exclamdown => [161,109,120,147], cent => [162,60,447,58], sterling => [163,13,541,11], fraction => [164,-190,565,-185], yen => [165,-60,640,-13], florin => [166,7,547,11], section => [167,79,403,83], currency => [168,-24,616,-24], quotesingle => [169,54,96,53], quotedblleft => [170,48,420,33], guillemotleft => [171,47,469,49], guilsinglleft => [172,71,251,54], guilsinglright => [173,54,251,71], fi => [174,35,555,39], fl => [175,36,554,39], endash => [177,0,566,0], dagger => [178,66,433,65], daggerdbl => [179,65,435,65], periodcentered => [180,79,125,78], paragraph => [182,-24,534,3], bullet => [183,45,305,45], quotesinglbase => [184,89,157,130], quotedblbase => [185,50,420,31], quotedblright => [186,33,420,48], guillemotright => [187,49,469,47], ellipsis => [188,125,880,126], perthousand => [189,7,1118,6], questiondown => [191,33,392,77], grave => [193,21,252,103], acute => [194,105,253,18], circumflex => [195,12,352,12], tilde => [196,1,373,2], macron => [197,12,352,12], breve => [198,29,318,29], dotaccent => [199,133,112,131], dieresis => [200,20,337,19], ring => [202,75,225,75], cedilla => [203,58,236,81], hungarumlaut => [205,-3,430,-49], ogonek => [206,72,209,95], caron => [207,12,352,12], emdash => [208,0,1133,0], AE => [225,0,977,29], ordfeminine => [227,4,301,6], Lslash => [232,13,663,14], Oslash => [233,38,740,38], OE => [234,33,968,4], ordmasculine => [235,6,337,6], ae => [241,43,673,39], dotlessi => [245,18,268,28], lslash => [248,21,271,21], oslash => [249,32,499,33], oe => [250,33,747,36], germandbls => [251,13,516,36], Yacute => [-1,24,771,21], Ucircumflex => [-1,15,782,19], Ugrave => [-1,15,782,19], Zcaron => [-1,10,666,15], Ydieresis => [-1,24,771,21], threesuperior => [-1,16,312,10], Uacute => [-1,15,782,19], twosuperior => [-1,1,334,4], Udieresis => [-1,15,782,19], middot => [-1,79,125,78], onesuperior => [-1,64,216,58], aacute => [-1,41,458,2], agrave => [-1,41,458,2], acircumflex => [-1,41,458,2], Scaron => [-1,47,508,73], Otilde => [-1,38,740,38], sfthyphen => [-1,44,278,54], atilde => [-1,41,458,2], aring => [-1,41,458,2], adieresis => [-1,41,458,2], Ograve => [-1,38,740,38], Ocircumflex => [-1,38,740,38], Odieresis => [-1,38,740,38], Ntilde => [-1,13,787,16], edieresis => [-1,28,452,22], eacute => [-1,28,452,22], egrave => [-1,28,452,22], Icircumflex => [-1,12,352,12], ecircumflex => [-1,28,452,22], Igrave => [-1,20,336,20], Iacute => [-1,20,338,18], Idieresis => [-1,20,337,19], degree => [-1,64,324,64], Ecircumflex => [-1,13,662,15], minus => [-1,33,571,33], multiply => [-1,43,554,41], divide => [-1,33,571,33], Egrave => [-1,13,662,15], trademark => [-1,33,1050,26], Oacute => [-1,38,740,38], thorn => [-1,5,526,33], eth => [-1,32,500,32], Eacute => [-1,13,662,15], ccedilla => [-1,28,438,36], idieresis => [-1,12,292,10], iacute => [-1,18,310,-13], igrave => [-1,-9,295,28], plusminus => [-1,33,571,33], onehalf => [-1,35,810,4], onequarter => [-1,41,771,36], threequarters => [-1,16,796,36], icircumflex => [-1,-18,352,-19], Edieresis => [-1,13,662,15], ntilde => [-1,18,531,16], Aring => [-1,16,782,18], odieresis => [-1,32,499,33], oacute => [-1,32,499,33], ograve => [-1,32,499,33], ocircumflex => [-1,32,499,33], otilde => [-1,32,499,33], scaron => [-1,44,352,44], udieresis => [-1,10,532,23], uacute => [-1,10,532,23], ugrave => [-1,10,532,23], ucircumflex => [-1,10,532,23], yacute => [-1,15,522,28], zcaron => [-1,30,443,29], ydieresis => [-1,15,522,28], copyright => [-1,43,774,43], registered => [-1,43,774,43], Atilde => [-1,16,782,18], nbspace => [-1,141,0,141], Ccedilla => [-1,31,685,38], Acircumflex => [-1,16,782,18], Agrave => [-1,16,782,18], logicalnot => [-1,33,571,33], Aacute => [-1,16,782,18], Eth => [-1,18,757,41], brokenbar => [-1,75,74,75], Thorn => [-1,18,595,15], Adieresis => [-1,16,782,18], mu => [-1,40,539,-13], '.notdef' => [-1,141,0,141], }} ); Prima-1.28/Prima/PS/fonts/Helvetica-Bold0000644000175100017510000001517011150770061015526 0ustar dkdk('Helvetica-Bold' => { name => 'Helvetica-Bold', family => 'Helvetica', height => 1183, weigth => fw::Bold, style => fs::Bold, pitch => fp::Variable, vector => 1, ascent => 949, descent => 234, maximalWidth => 1177, width => 1177, internalLeading => 220, externalLeading => 72, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 75.04, yDeviceRes => 75.04, size => 1000, encoding => 'Latin1', chardata => { space => [32,253,0,75], exclam => [33,132,177,83], quotedbl => [34,59,442,59], numbersign => [35,3,650,3], dollar => [36,26,597,34], percent => [37,26,994,30], ampersand => [38,65,755,33], quoteright => [39,78,159,91], parenleft => [40,47,311,35], parenright => [41,26,311,56], asterisk => [42,27,395,37], plus => [43,59,571,60], comma => [44,75,177,75], hyphen => [45,30,321,41], period => [46,75,177,75], slash => [47,2,322,3], zero => [48,34,577,46], one => [49,80,366,210], two => [50,35,573,48], three => [51,34,576,47], four => [52,28,589,40], five => [53,31,579,46], six => [54,37,576,43], seven => [55,34,590,33], eight => [56,26,595,36], nine => [57,33,577,47], colon => [58,133,177,82], semicolon => [59,133,177,82], less => [60,47,578,65], equal => [61,59,572,59], greater => [62,47,578,65], question => [63,75,582,65], at => [64,31,1088,33], A => [65,30,800,22], B => [66,97,690,66], C => [67,52,758,43], D => [68,91,714,48], E => [69,93,644,50], F => [70,87,605,29], G => [71,49,791,79], H => [72,80,696,76], I => [73,74,177,76], J => [74,28,546,82], K => [75,87,760,5], L => [76,94,590,37], M => [77,78,839,67], N => [78,80,701,72], O => [79,47,830,42], P => [80,89,658,40], Q => [81,50,830,39], R => [82,94,706,53], S => [83,37,710,40], T => [84,16,690,15], U => [85,89,683,80], V => [86,28,737,23], W => [87,15,1087,14], X => [88,26,746,16], Y => [89,31,737,20], Z => [90,35,648,39], bracketleft => [91,78,286,29], backslash => [92,-14,356,-13], bracketright => [93,21,286,86], asciicircum => [94,72,545,73], underscore => [95,-26,709,-26], quoteleft => [96,79,159,89], a => [97,33,586,37], b => [98,69,610,42], c => [99,40,577,40], d => [100,34,610,78], e => [101,26,595,36], f => [102,16,353,23], g => [103,40,599,82], h => [104,79,560,82], i => [105,79,165,83], j => [106,4,243,80], k => [107,69,578,9], l => [108,79,165,83], m => [109,70,903,76], n => [110,74,571,76], o => [111,41,631,49], p => [112,68,610,43], q => [113,33,610,79], r => [114,74,363,22], s => [115,34,580,42], t => [116,16,339,37], u => [117,68,571,82], v => [118,16,617,23], w => [119,5,900,14], x => [120,18,613,24], y => [121,10,625,21], z => [122,24,528,37], braceleft => [123,43,331,85], bar => [124,118,94,118], braceright => [125,85,331,43], asciitilde => [126,70,542,76], exclamdown => [161,78,177,138], cent => [162,43,573,40], sterling => [163,36,598,22], fraction => [164,-204,603,-201], yen => [165,5,647,4], florin => [166,24,608,24], section => [167,39,573,44], currency => [168,30,596,30], quotesingle => [169,59,163,59], quotedblleft => [170,83,428,79], guillemotleft => [171,104,449,104], guilsinglleft => [172,98,197,98], guilsinglright => [173,94,197,101], fi => [174,10,637,74], fl => [175,14,631,76], endash => [177,-10,669,-1], dagger => [178,36,582,39], daggerdbl => [179,33,582,42], periodcentered => [180,75,146,106], paragraph => [182,23,602,31], bullet => [183,59,295,59], quotesinglbase => [184,78,159,91], quotedblbase => [185,85,425,80], quotedblright => [186,86,434,70], guillemotright => [187,104,442,111], ellipsis => [188,108,965,108], perthousand => [189,13,1158,11], questiondown => [191,60,583,79], grave => [193,20,231,141], acute => [194,143,231,18], circumflex => [195,9,376,8], tilde => [196,-10,418,-14], macron => [197,18,353,21], breve => [198,41,312,40], dotaccent => [199,132,130,131], dieresis => [200,21,350,22], ring => [202,91,212,89], cedilla => [203,31,315,46], hungarumlaut => [205,-52,454,-8], ogonek => [206,53,263,76], caron => [207,10,376,7], emdash => [208,-8,1194,-3], AE => [225,1,1141,40], ordfeminine => [227,36,352,48], Lslash => [232,0,706,16], Oslash => [233,36,856,27], OE => [234,33,1114,35], ordmasculine => [235,27,378,26], ae => [241,31,981,37], dotlessi => [245,79,165,83], lslash => [248,0,298,30], oslash => [249,13,694,15], oe => [250,27,1061,28], germandbls => [251,79,600,42], Yacute => [-1,31,737,20], Ucircumflex => [-1,89,683,80], Ugrave => [-1,89,683,80], Zcaron => [-1,35,648,39], Ydieresis => [-1,31,737,20], threesuperior => [-1,17,371,26], Uacute => [-1,89,683,80], twosuperior => [-1,18,369,27], Udieresis => [-1,89,683,80], middot => [-1,75,146,106], onesuperior => [-1,47,238,128], aacute => [-1,33,586,37], agrave => [-1,33,586,37], acircumflex => [-1,33,586,37], Scaron => [-1,37,710,40], Otilde => [-1,47,830,42], sfthyphen => [-1,30,321,41], atilde => [-1,33,586,37], aring => [-1,33,586,37], adieresis => [-1,33,586,37], Ograve => [-1,47,830,42], Ocircumflex => [-1,47,830,42], Odieresis => [-1,47,830,42], Ntilde => [-1,80,701,72], edieresis => [-1,26,595,36], eacute => [-1,26,595,36], egrave => [-1,26,595,36], Icircumflex => [-1,-22,376,-24], ecircumflex => [-1,26,595,36], Igrave => [-1,-11,263,76], Iacute => [-1,74,268,-14], Idieresis => [-1,-10,350,-10], degree => [-1,178,358,179], Ecircumflex => [-1,93,644,50], minus => [-1,47,596,47], multiply => [-1,93,503,93], divide => [-1,59,572,59], Egrave => [-1,93,644,50], trademark => [-1,83,1015,83], Oacute => [-1,47,830,42], thorn => [-1,68,610,43], eth => [-1,41,631,49], Eacute => [-1,93,644,50], ccedilla => [-1,40,577,40], idieresis => [-1,-10,350,-10], iacute => [-1,79,263,-14], igrave => [-1,-11,256,83], plusminus => [-1,66,557,67], onehalf => [-1,47,953,27], onequarter => [-1,47,958,22], threequarters => [-1,17,987,22], icircumflex => [-1,-22,376,-24], Edieresis => [-1,93,644,50], ntilde => [-1,74,571,76], Aring => [-1,30,800,22], odieresis => [-1,41,631,49], oacute => [-1,41,631,49], ograve => [-1,41,631,49], ocircumflex => [-1,41,631,49], otilde => [-1,41,631,49], scaron => [-1,34,580,42], udieresis => [-1,68,571,82], uacute => [-1,68,571,82], ugrave => [-1,68,571,82], ucircumflex => [-1,68,571,82], yacute => [-1,10,625,21], zcaron => [-1,24,528,37], ydieresis => [-1,10,625,21], copyright => [-1,-16,904,-16], registered => [-1,-16,904,-16], Atilde => [-1,30,800,22], nbspace => [-1,253,0,75], Ccedilla => [-1,52,758,43], Acircumflex => [-1,30,800,22], Agrave => [-1,30,800,22], logicalnot => [-1,47,596,47], Aacute => [-1,30,800,22], Eth => [-1,0,805,48], brokenbar => [-1,118,94,118], Thorn => [-1,89,658,40], Adieresis => [-1,30,800,22], mu => [-1,68,609,44], '.notdef' => [-1,253,0,75], }} ); Prima-1.28/Prima/PS/fonts/Times-Italic0000644000175100017510000001533311150770061015231 0ustar dkdk('Times-Italic' => { name => 'Times-Italic', family => 'Times', height => 1121, weigth => fw::Medium, style => fs::Italic, pitch => fp::Variable, vector => 1, ascent => 904, descent => 217, maximalWidth => 1180, width => 1180, internalLeading => 221, externalLeading => 72, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 80.3, yDeviceRes => 80.3, size => 1000, encoding => 'Latin1', chardata => { space => [32,140,0,140], exclam => [33,43,294,34], quotedbl => [34,161,322,-13], numbersign => [35,2,603,-44], dollar => [36,34,522,3], percent => [37,88,797,48], ampersand => [38,85,725,61], quoteright => [39,169,155,48], parenleft => [40,47,306,20], parenright => [41,17,306,49], asterisk => [42,143,408,8], plus => [43,96,564,95], comma => [44,-4,155,128], hyphen => [45,54,261,57], period => [46,30,124,125], slash => [47,-72,505,-121], zero => [48,35,521,3], one => [49,54,403,102], two => [50,13,493,53], three => [51,16,504,39], four => [52,1,535,23], five => [53,16,533,10], six => [54,33,550,-23], seven => [55,84,517,-41], eight => [56,33,519,7], nine => [57,25,525,8], colon => [58,56,236,80], semicolon => [59,30,262,80], less => [60,94,569,93], equal => [61,96,564,95], greater => [62,94,569,93], question => [63,147,381,31], at => [64,132,771,127], A => [65,-57,689,52], B => [66,-8,668,25], C => [67,73,698,-24], D => [68,-8,793,24], E => [69,-1,711,-25], F => [70,8,714,-38], G => [71,58,751,0], H => [72,-8,868,-50], I => [73,-8,439,-57], J => [74,-6,557,-52], K => [75,7,801,-61], L => [76,-8,635,-3], M => [77,-20,998,-44], N => [78,-22,837,-67], O => [79,67,724,17], P => [80,0,678,6], Q => [81,66,717,25], R => [82,-14,673,25], S => [83,19,550,-8], T => [84,66,643,-86], U => [85,114,743,-48], V => [86,85,686,-86], W => [87,79,936,-81], X => [88,-32,766,-49], Y => [89,87,622,-86], Z => [90,-6,686,-56], bracketleft => [91,23,414,-2], backslash => [92,-45,403,-45], bracketright => [93,13,414,7], asciicircum => [94,0,473,0], underscore => [95,0,560,0], quoteleft => [96,191,155,25], a => [97,19,514,26], b => [98,25,504,30], c => [99,33,442,21], d => [100,16,573,-30], e => [101,34,427,35], f => [102,-164,640,-163], g => [103,8,520,31], h => [104,21,514,24], i => [105,54,241,15], j => [106,-139,448,2], k => [107,15,501,-19], l => [108,45,266,-1], m => [109,13,775,20], n => [110,15,515,29], o => [111,30,494,35], p => [112,-84,609,34], q => [113,28,513,19], r => [114,50,411,-25], s => [115,17,392,25], t => [116,41,290,-20], u => [117,47,485,28], v => [118,23,454,20], w => [119,17,708,21], x => [120,-30,531,-3], y => [121,-26,504,20], z => [122,-2,428,10], braceleft => [123,57,399,-7], bar => [124,117,73,116], braceright => [125,-7,399,57], asciitilde => [126,44,517,43], exclamdown => [161,66,293,76], cent => [162,86,442,31], sterling => [163,11,568,-19], fraction => [164,-189,567,-190], yen => [165,30,645,-115], florin => [166,28,540,-7], section => [167,59,457,43], currency => [168,-24,609,-24], quotesingle => [169,147,122,-30], quotedblleft => [170,186,390,47], guillemotleft => [171,59,439,61], guilsinglleft => [172,57,257,58], guilsinglright => [173,58,257,57], fi => [174,-158,697,21], fl => [175,-158,738,-20], endash => [177,-6,572,-5], dagger => [178,113,433,13], daggerdbl => [179,24,525,10], periodcentered => [180,78,124,77], paragraph => [182,61,628,-104], bullet => [183,44,302,44], quotesinglbase => [184,49,155,168], quotedblbase => [185,63,390,169], quotedblright => [186,169,390,63], guillemotright => [187,61,439,59], ellipsis => [188,63,790,142], perthousand => [189,28,1104,-11], questiondown => [191,31,380,149], grave => [193,135,212,24], acute => [194,201,249,-78], circumflex => [195,102,329,-58], tilde => [196,112,366,-105], macron => [197,110,349,-87], breve => [198,131,337,-95], dotaccent => [199,232,109,31], dieresis => [200,119,334,-80], ring => [202,173,224,-24], cedilla => [203,-33,237,169], hungarumlaut => [205,104,440,-171], ogonek => [206,-22,246,149], caron => [207,135,341,-104], emdash => [208,-6,1008,-5], AE => [225,-30,1051,-24], ordfeminine => [227,47,347,-85], Lslash => [232,-8,635,-3], Oslash => [233,67,716,25], OE => [234,54,1025,-22], ordmasculine => [235,75,330,-58], ae => [241,25,691,30], dotlessi => [245,54,208,48], lslash => [248,41,302,-32], oslash => [249,31,494,34], oe => [250,22,701,23], germandbls => [251,-188,740,7], Yacute => [-1,87,622,-86], Ucircumflex => [-1,114,743,-48], Ugrave => [-1,114,743,-48], Zcaron => [-1,-6,686,-56], Ydieresis => [-1,87,622,-86], threesuperior => [-1,48,331,-43], Uacute => [-1,114,743,-48], twosuperior => [-1,36,326,-26], Udieresis => [-1,114,743,-48], middot => [-1,78,124,77], onesuperior => [-1,48,270,17], aacute => [-1,19,526,14], agrave => [-1,19,514,26], acircumflex => [-1,19,514,26], Scaron => [-1,19,563,-22], Otilde => [-1,67,724,17], sfthyphen => [-1,54,261,57], atilde => [-1,19,553,-12], aring => [-1,19,514,26], adieresis => [-1,19,529,12], Ograve => [-1,67,724,17], Ocircumflex => [-1,67,724,17], Odieresis => [-1,67,724,17], Ntilde => [-1,-22,837,-67], edieresis => [-1,34,470,-7], eacute => [-1,34,479,-16], egrave => [-1,34,427,35], Icircumflex => [-1,-8,485,-103], ecircumflex => [-1,34,459,3], Igrave => [-1,-8,439,-57], Iacute => [-1,-8,460,-78], Idieresis => [-1,-8,496,-114], degree => [-1,113,320,14], Ecircumflex => [-1,-1,711,-25], minus => [-1,96,564,95], multiply => [-1,104,548,104], divide => [-1,96,564,95], Egrave => [-1,-1,711,-25], trademark => [-1,33,1039,25], Oacute => [-1,67,724,17], thorn => [-1,-84,609,34], eth => [-1,30,510,20], Eacute => [-1,-1,711,-25], ccedilla => [-1,29,447,21], idieresis => [-1,54,340,-84], iacute => [-1,54,344,-87], igrave => [-1,54,263,-6], plusminus => [-1,96,564,95], onehalf => [-1,38,801,1], onequarter => [-1,36,788,15], threequarters => [-1,25,799,15], icircumflex => [-1,38,329,-56], Edieresis => [-1,-1,711,-25], ntilde => [-1,15,517,26], Aring => [-1,-57,689,52], odieresis => [-1,30,517,12], oacute => [-1,30,515,14], ograve => [-1,30,494,35], ocircumflex => [-1,30,494,35], otilde => [-1,30,525,4], scaron => [-1,17,490,-72], udieresis => [-1,47,489,23], uacute => [-1,47,487,25], ugrave => [-1,47,485,28], ucircumflex => [-1,47,485,28], yacute => [-1,-26,541,-16], zcaron => [-1,-2,488,-50], ydieresis => [-1,-26,521,3], copyright => [-1,45,760,45], registered => [-1,45,760,45], Atilde => [-1,-57,691,50], nbspace => [-1,140,0,140], Ccedilla => [-1,73,698,-24], Acircumflex => [-1,-57,689,52], Agrave => [-1,-57,689,52], logicalnot => [-1,96,564,95], Aacute => [-1,-57,689,52], Eth => [-1,-8,793,24], brokenbar => [-1,117,73,116], Thorn => [-1,0,637,47], Adieresis => [-1,-57,689,52], mu => [-1,-33,590,3], '.notdef' => [-1,140,0,140], }} ); Prima-1.28/Prima/PS/fonts/Courier-BoldOblique0000644000175100017510000001556511150770061016563 0ustar dkdk('Courier-BoldOblique' => { name => 'Courier-BoldOblique', family => 'Courier', height => 1100, weigth => fw::Bold, style => fs::Bold|fs::Italic, pitch => fp::Variable, vector => 1, ascent => 871, descent => 229, maximalWidth => 797, width => 797, internalLeading => 247, externalLeading => 81, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 84.72, yDeviceRes => 84.72, size => 1000, encoding => 'Latin1', chardata => { space => [32,424,0,235], exclam => [33,257,293,108], quotedbl => [34,267,383,8], numbersign => [35,111,574,-25], dollar => [36,110,561,-11], percent => [37,144,514,1], ampersand => [38,112,500,47], quoteright => [39,244,287,128], parenleft => [40,334,339,-14], parenright => [41,103,339,216], asterisk => [42,195,479,-15], plus => [43,111,569,-20], comma => [44,129,287,243], hyphen => [45,111,569,-20], period => [46,257,168,234], slash => [47,75,645,-61], zero => [48,143,519,-2], one => [49,102,479,78], two => [50,59,602,-2], three => [51,88,581,-9], four => [52,114,522,23], five => [53,91,579,-11], six => [54,169,559,-69], seven => [55,202,501,-44], eight => [56,125,543,-8], nine => [57,126,559,-26], colon => [58,257,243,159], semicolon => [59,129,344,185], less => [60,112,594,-46], equal => [61,89,612,-41], greater => [62,83,594,-17], question => [63,216,452,-8], at => [64,107,532,19], A => [65,-12,708,-36], B => [66,24,657,-22], C => [67,88,641,-69], D => [68,25,658,-24], E => [69,25,691,-57], F => [70,25,716,-81], G => [71,86,646,-73], H => [72,35,707,-82], I => [73,102,592,-35], J => [74,70,729,-139], K => [75,24,731,-95], L => [76,46,631,-17], M => [77,-11,811,-140], N => [78,23,753,-116], O => [79,82,631,-53], P => [80,25,653,-18], Q => [81,82,631,-53], R => [82,25,668,-34], S => [83,79,618,-37], T => [84,133,617,-90], U => [85,121,654,-115], V => [86,100,708,-148], W => [87,107,689,-137], X => [88,20,740,-101], Y => [89,140,622,-103], Z => [90,80,610,-30], bracketleft => [91,240,416,2], backslash => [92,240,313,105], bracketright => [93,114,416,128], asciicircum => [94,177,480,2], underscore => [95,-67,687,39], quoteleft => [96,414,172,72], a => [97,71,569,18], b => [98,2,683,-25], c => [99,102,586,-28], d => [100,81,649,-70], e => [101,81,578,0], f => [102,92,667,-100], g => [103,80,662,-82], h => [104,36,616,7], i => [105,79,525,55], j => [106,91,547,20], k => [107,46,620,-6], l => [108,79,525,55], m => [109,-9,708,-38], n => [110,36,605,18], o => [111,92,577,-9], p => [112,-46,731,-25], q => [113,82,683,-105], r => [114,70,644,-55], s => [115,91,559,8], t => [116,103,498,58], u => [117,103,559,-3], v => [118,89,662,-91], w => [119,90,662,-92], x => [120,33,672,-45], y => [121,-14,742,-68], z => [122,93,565,1], braceleft => [123,238,372,48], bar => [124,249,269,140], braceright => [125,158,372,128], asciitilde => [126,125,541,-6], exclamdown => [161,204,293,161], cent => [162,158,493,7], sterling => [163,70,557,31], fraction => [164,57,686,-83], yen => [165,146,616,-102], florin => [166,47,691,-79], section => [167,49,657,-47], currency => [168,105,583,-28], quotesingle => [169,377,163,118], quotedblleft => [170,248,392,18], guillemotleft => [171,88,631,-59], guilsinglleft => [172,88,379,192], guilsinglright => [173,300,378,-18], fi => [174,-4,700,-36], fl => [175,-8,718,-49], endash => [177,111,569,-20], dagger => [178,192,455,12], daggerdbl => [179,135,512,12], periodcentered => [180,311,168,180], paragraph => [182,118,620,-79], bullet => [183,232,336,91], quotesinglbase => [184,129,287,243], quotedblbase => [185,72,498,89], quotedblright => [186,182,498,-20], guillemotright => [187,47,631,-18], ellipsis => [188,37,608,14], perthousand => [189,114,575,-29], questiondown => [191,77,452,130], grave => [193,290,220,149], acute => [194,398,279,-17], circumflex => [195,260,388,11], tilde => [196,256,424,-20], macron => [197,273,386,0], breve => [198,287,388,-15], dotaccent => [199,401,134,124], dieresis => [200,287,361,11], ring => [202,333,276,50], cedilla => [203,157,261,240], hungarumlaut => [205,260,416,-17], ogonek => [206,244,232,183], caron => [207,290,388,-18], emdash => [208,33,726,-99], AE => [225,-11,799,-128], ordfeminine => [227,187,427,45], Lslash => [232,47,630,-17], Oslash => [233,4,784,-128], OE => [234,37,751,-128], ordmasculine => [235,184,437,37], ae => [241,15,716,-71], dotlessi => [245,79,525,55], lslash => [248,79,533,47], oslash => [249,18,717,-75], oe => [250,30,701,-72], germandbls => [251,24,601,34], Yacute => [-1,140,622,-103], Ucircumflex => [-1,121,654,-115], Ugrave => [-1,121,654,-115], Zcaron => [-1,80,628,-48], Ydieresis => [-1,140,622,-103], threesuperior => [-1,239,357,62], Uacute => [-1,121,654,-115], twosuperior => [-1,222,369,68], Udieresis => [-1,121,654,-115], middot => [-1,311,168,180], onesuperior => [-1,246,297,116], aacute => [-1,72,569,17], agrave => [-1,71,569,18], acircumflex => [-1,71,569,18], Scaron => [-1,79,643,-62], Otilde => [-1,82,639,-61], sfthyphen => [-1,111,569,-20], atilde => [-1,71,601,-13], aring => [-1,71,569,18], adieresis => [-1,71,569,18], Ograve => [-1,82,631,-53], Ocircumflex => [-1,82,631,-53], Odieresis => [-1,82,631,-53], Ntilde => [-1,23,753,-116], edieresis => [-1,81,578,0], eacute => [-1,81,578,0], egrave => [-1,81,578,0], Icircumflex => [-1,102,592,-35], ecircumflex => [-1,81,578,0], Igrave => [-1,102,592,-35], Iacute => [-1,102,592,-35], Idieresis => [-1,102,592,-35], degree => [-1,231,393,35], Ecircumflex => [-1,25,691,-57], minus => [-1,111,569,-20], multiply => [-1,138,512,8], divide => [-1,111,569,-20], Egrave => [-1,25,691,-57], trademark => [-1,66,739,-145], Oacute => [-1,82,631,-53], thorn => [-1,-46,731,-25], eth => [-1,91,587,-18], Eacute => [-1,25,691,-57], ccedilla => [-1,101,587,-28], idieresis => [-1,79,553,27], iacute => [-1,78,553,28], igrave => [-1,79,525,55], plusminus => [-1,57,646,-44], onehalf => [-1,27,726,-93], onequarter => [-1,27,712,-80], threequarters => [-1,19,720,-80], icircumflex => [-1,79,551,29], Edieresis => [-1,25,691,-57], ntilde => [-1,36,638,-14], Aring => [-1,-12,708,-36], odieresis => [-1,92,577,-9], oacute => [-1,92,577,-9], ograve => [-1,92,577,-9], ocircumflex => [-1,92,577,-9], otilde => [-1,92,596,-28], scaron => [-1,91,598,-29], udieresis => [-1,103,559,-3], uacute => [-1,103,559,-3], ugrave => [-1,103,559,-3], ucircumflex => [-1,103,559,-3], yacute => [-1,-14,742,-68], zcaron => [-1,93,587,-20], ydieresis => [-1,-14,742,-68], copyright => [-1,52,689,-82], registered => [-1,52,689,-82], Atilde => [-1,-12,708,-36], nbspace => [-1,424,0,235], Ccedilla => [-1,88,641,-69], Acircumflex => [-1,-12,708,-36], Agrave => [-1,-12,708,-36], logicalnot => [-1,137,478,44], Aacute => [-1,-12,708,-36], Eth => [-1,25,658,-24], brokenbar => [-1,249,269,140], Thorn => [-1,25,621,13], Adieresis => [-1,-12,708,-36], mu => [-1,79,584,-3], '.notdef' => [-1,424,0,235], }} ); Prima-1.28/Prima/PS/fonts/Helvetica-Narrow-Bold0000644000175100017510000001514311150770061016774 0ustar dkdk('Helvetica-Narrow-Bold' => { name => 'Helvetica-Narrow-Bold', family => 'Helvetica', height => 1203, weigth => fw::Bold, style => fs::Bold, pitch => fp::Variable, vector => 1, ascent => 975, descent => 228, maximalWidth => 962, width => 962, internalLeading => 257, externalLeading => 84, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 76.39, yDeviceRes => 76.39, size => 1000, encoding => 'Latin1', chardata => { space => [32,25,0,249], exclam => [33,89,151,87], quotedbl => [34,96,274,97], numbersign => [35,18,512,18], dollar => [36,28,487,32], percent => [37,27,821,27], ampersand => [38,52,638,20], quoteright => [39,68,137,68], parenleft => [40,34,274,19], parenright => [41,19,274,34], asterisk => [42,26,330,26], plus => [43,39,496,39], comma => [44,62,147,63], hyphen => [45,26,275,26], period => [46,62,147,63], slash => [47,-32,339,-32], zero => [48,31,486,31], one => [49,68,304,175], two => [50,25,478,44], three => [51,26,482,39], four => [52,26,492,30], five => [53,26,482,39], six => [54,30,482,36], seven => [55,24,496,27], eight => [56,31,486,31], nine => [57,30,484,33], colon => [58,90,147,90], semicolon => [59,90,147,90], less => [60,37,501,37], equal => [61,39,496,39], greater => [62,37,501,37], question => [63,58,489,54], at => [64,116,727,117], A => [65,19,673,19], B => [66,74,585,51], C => [67,43,631,37], D => [68,74,601,36], E => [69,74,537,45], F => [70,74,504,24], G => [71,43,660,63], H => [72,69,572,69], I => [73,62,147,63], J => [74,21,455,70], K => [75,85,626,0], L => [76,74,500,27], M => [77,68,685,67], N => [78,68,576,67], O => [79,43,680,43], P => [80,74,543,39], Q => [81,43,683,40], R => [82,74,593,44], S => [83,38,582,37], T => [84,13,576,13], U => [85,70,571,69], V => [86,19,619,19], W => [87,15,901,14], X => [88,13,630,14], Y => [89,14,629,14], Z => [90,24,554,24], bracketleft => [91,62,241,24], backslash => [92,-32,339,-32], bracketright => [93,24,241,62], asciicircum => [94,61,453,61], underscore => [95,0,548,0], quoteleft => [96,68,137,68], a => [97,28,490,28], b => [98,60,510,32], c => [99,33,483,31], d => [100,33,510,58], e => [101,22,498,27], f => [102,9,304,14], g => [103,39,505,57], h => [104,63,475,63], i => [105,68,137,68], j => [106,2,203,68], k => [107,68,486,-6], l => [108,68,137,68], m => [109,62,751,62], n => [110,63,475,63], o => [111,33,536,32], p => [112,61,508,32], q => [113,33,511,57], r => [114,62,305,15], s => [115,30,482,36], t => [116,9,294,24], u => [117,64,472,64], v => [118,13,522,13], w => [119,9,749,8], x => [120,14,519,14], y => [121,9,522,16], z => [122,19,454,19], braceleft => [123,46,312,24], bar => [124,83,110,83], braceright => [125,24,312,46], asciitilde => [126,60,455,60], exclamdown => [161,89,151,87], cent => [162,33,483,31], sterling => [163,27,506,14], fraction => [164,-167,499,-167], yen => [165,-8,565,-8], florin => [166,-9,518,39], section => [167,33,481,33], currency => [168,-2,553,-2], quotesingle => [169,68,97,68], quotedblleft => [170,62,368,62], guillemotleft => [171,86,375,86], guilsinglleft => [172,81,164,81], guilsinglright => [173,81,164,81], fi => [174,9,524,68], fl => [175,9,524,68], endash => [177,0,548,0], dagger => [178,36,476,36], daggerdbl => [179,36,476,36], periodcentered => [180,57,158,57], paragraph => [182,-8,540,16], bullet => [183,9,326,9], quotesinglbase => [184,68,137,68], quotedblbase => [185,62,368,62], quotedblright => [186,62,368,62], guillemotright => [187,86,375,86], ellipsis => [188,90,806,90], perthousand => [189,-2,991,-2], questiondown => [191,54,489,58], grave => [193,-22,244,107], acute => [194,107,244,-22], circumflex => [195,-9,347,-9], tilde => [196,-16,362,-16], macron => [197,-6,340,-6], breve => [198,-2,333,-2], dotaccent => [199,102,125,101], dieresis => [200,6,316,6], ring => [202,57,212,57], cedilla => [203,6,235,86], hungarumlaut => [205,8,471,-151], ogonek => [206,69,229,28], caron => [207,-9,347,-9], emdash => [208,0,986,0], AE => [225,4,935,45], ordfeminine => [227,21,321,21], Lslash => [232,-19,594,27], Oslash => [233,32,701,33], OE => [234,36,911,38], ordmasculine => [235,6,348,4], ae => [241,28,818,30], dotlessi => [245,68,137,68], lslash => [248,-18,310,-18], oslash => [249,21,559,21], oe => [250,33,866,31], germandbls => [251,68,502,31], Yacute => [-1,14,629,14], Ucircumflex => [-1,70,571,69], Ugrave => [-1,70,571,69], Zcaron => [-1,24,554,24], Ydieresis => [-1,14,629,14], threesuperior => [-1,8,312,7], Uacute => [-1,70,571,69], twosuperior => [-1,8,311,8], Udieresis => [-1,70,571,69], middot => [-1,57,158,57], onesuperior => [-1,25,208,95], aacute => [-1,28,490,28], agrave => [-1,28,490,28], acircumflex => [-1,28,490,28], Scaron => [-1,38,582,37], Otilde => [-1,43,680,43], sfthyphen => [-1,26,275,26], atilde => [-1,28,490,28], aring => [-1,28,490,28], adieresis => [-1,28,490,28], Ograve => [-1,43,680,43], Ocircumflex => [-1,43,680,43], Odieresis => [-1,43,680,43], Ntilde => [-1,68,576,67], edieresis => [-1,22,498,27], eacute => [-1,22,498,27], egrave => [-1,22,498,27], Icircumflex => [-1,-36,347,-37], ecircumflex => [-1,22,498,27], Igrave => [-1,-49,259,63], Iacute => [-1,62,262,-50], Idieresis => [-1,-20,316,-21], degree => [-1,56,281,56], Ecircumflex => [-1,74,537,45], minus => [-1,39,496,39], multiply => [-1,39,498,38], divide => [-1,39,496,39], Egrave => [-1,74,537,45], trademark => [-1,43,899,43], Oacute => [-1,43,680,43], thorn => [-1,61,508,32], eth => [-1,33,536,32], Eacute => [-1,74,537,45], ccedilla => [-1,33,483,31], idieresis => [-1,-20,316,-21], iacute => [-1,68,256,-50], igrave => [-1,-49,255,68], plusminus => [-1,39,496,39], onehalf => [-1,25,757,39], onequarter => [-1,25,730,67], threequarters => [-1,15,772,34], icircumflex => [-1,-36,347,-37], Edieresis => [-1,74,537,45], ntilde => [-1,63,475,63], Aring => [-1,19,673,19], odieresis => [-1,33,536,32], oacute => [-1,33,536,32], ograve => [-1,33,536,32], ocircumflex => [-1,33,536,32], otilde => [-1,33,536,32], scaron => [-1,30,482,36], udieresis => [-1,64,472,64], uacute => [-1,64,472,64], ugrave => [-1,64,472,64], ucircumflex => [-1,64,472,64], yacute => [-1,9,522,16], zcaron => [-1,19,454,19], ydieresis => [-1,9,522,16], copyright => [-1,-10,749,-12], registered => [-1,-10,748,-10], Atilde => [-1,19,673,19], nbspace => [-1,25,0,249], Ccedilla => [-1,43,631,37], Acircumflex => [-1,19,673,19], Agrave => [-1,19,673,19], logicalnot => [-1,39,496,39], Aacute => [-1,19,673,19], Eth => [-1,-4,680,36], brokenbar => [-1,83,110,83], Thorn => [-1,74,543,39], Adieresis => [-1,19,673,19], mu => [-1,64,472,64], '.notdef' => [-1,25,0,249], }} ); Prima-1.28/Prima/PS/fonts/Symbol0000644000175100017510000001363111150770061014211 0ustar dkdk('Symbol' => { name => 'Symbol', family => 'Symbol', height => 1303, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 1010, descent => 293, maximalWidth => 1271, width => 1271, internalLeading => 337, externalLeading => 111, firstChar => 32, lastChar => 221, defaultChar => 32, xDeviceRes => 74.81, yDeviceRes => 74.81, size => 1000, encoding => 'Specific', chardata => { space => [32,0,0,325], exclam => [33,166,145,121], universal => [34,40,846,41], numbersign => [35,26,600,24], existential => [36,32,590,92], percent => [37,82,922,80], ampersand => [38,53,923,36], suchthat => [39,62,476,32], parenleft => [40,69,321,42], parenright => [41,39,321,72], asteriskmath => [42,84,471,95], plus => [43,13,689,13], comma => [44,72,179,72], minus => [45,14,682,18], period => [46,89,145,89], slash => [47,0,330,31], zero => [48,29,583,37], one => [49,152,355,143], two => [50,32,586,32], three => [51,50,515,84], four => [52,20,590,40], five => [53,37,539,74], six => [54,46,561,42], seven => [55,31,552,67], eight => [56,70,502,78], nine => [57,40,558,52], colon => [58,105,145,110], semicolon => [59,108,179,74], less => [60,33,647,33], equal => [61,14,685,15], greater => [62,33,647,33], question => [63,91,445,41], congruent => [64,14,685,15], Alpha => [65,5,886,49], Beta => [66,37,733,97], Chi => [67,-11,929,23], Delta => [68,7,784,5], Epsilon => [69,41,762,-7], Phi => [70,33,931,28], Gamma => [71,31,762,-7], Eta => [72,50,899,-9], Iota => [73,41,370,22], theta1 => [74,23,788,10], Kappa => [75,45,895,0], Lambda => [76,7,878,7], Mu => [77,36,1119,2], Nu => [78,37,900,2], Omicron => [79,53,878,9], Pi => [80,32,938,29], Theta => [81,53,878,33], Rho => [82,36,697,-9], Sigma => [83,6,760,3], Tau => [84,42,747,5], Upsilon => [85,-10,914,-5], sigma1 => [86,52,515,3], Omega => [87,44,914,41], Xi => [88,52,728,59], Psi => [89,19,998,18], Zeta => [90,57,771,-32], bracketleft => [91,112,277,44], therefore => [92,212,701,211], bracketright => [93,42,277,113], perpendicular => [94,19,830,7], underscore => [95,-2,656,-2], radicalex => [96,625,794,-768], alpha => [97,53,757,11], beta => [98,79,591,44], chi => [99,15,664,35], delta => [100,52,574,16], epsilon => [101,28,527,15], phi => [102,35,603,40], gamma => [103,6,624,-95], eta => [104,0,686,99], iota => [105,0,392,36], phi1 => [106,46,717,20], kappa => [107,42,684,-11], lambda => [108,31,682,1], mu => [109,42,695,11], nu => [110,-11,630,59], omicron => [111,45,607,62], pi => [112,13,677,24], theta => [113,56,575,46], rho => [114,65,573,76], sigma => [115,39,727,19], tau => [116,13,531,27], upsilon => [117,9,687,53], omega1 => [118,15,858,54], omega => [119,54,836,2], xi => [120,35,575,31], psi => [121,15,897,-19], zeta => [122,78,530,35], braceleft => [123,75,441,108], bar => [124,84,91,84], braceright => [125,102,441,80], similar => [126,22,667,26], Upsilon1 => [161,-2,797,13], minute => [162,35,261,24], lessequal => [163,37,647,29], fraction => [164,-234,677,-225], infinity => [165,33,862,32], florin => [166,2,641,7], club => [167,112,747,121], diamond => [168,185,596,199], heart => [169,152,669,158], spade => [170,147,672,161], arrowboth => [171,31,1303,23], arrowleft => [172,41,1185,58], arrowup => [173,58,685,41], arrowright => [174,63,1185,36], arrowdown => [175,58,685,41], degree => [176,65,390,65], plusminus => [177,13,689,13], second => [178,26,512,-2], greaterequal => [179,37,647,29], multiply => [180,22,672,20], proportional => [181,35,797,96], partialdiff => [182,33,568,41], bullet => [183,65,469,65], divide => [184,13,685,16], notequal => [185,19,684,11], equivalence => [186,18,682,14], approxequal => [187,18,668,28], ellipsis => [188,144,1013,144], arrowvertex => [189,364,72,347], arrowhorizex => [190,-78,1446,-65], carriagereturn => [191,19,764,72], aleph => [192,228,633,211], Ifraktur => [193,13,740,140], Rfraktur => [194,33,955,46], weierstrass => [195,207,926,152], circlemultiply => [196,56,899,45], circleplus => [197,56,899,45], emptyset => [198,50,966,54], intersection => [199,52,901,46], union => [200,52,901,46], propersuperset => [201,26,850,52], reflexsuperset => [202,26,850,52], notsubset => [203,46,852,29], propersubset => [204,48,850,29], reflexsubset => [205,48,850,29], element => [206,58,599,271], notelement => [207,58,599,271], angle => [208,33,927,39], gradient => [209,46,840,41], registeredserif => [210,65,899,65], copyrightserif => [211,66,899,63], trademarkserif => [212,23,1090,45], product => [213,32,1013,26], radical => [214,13,658,44], dotmath => [215,89,130,105], logicalnot => [216,19,866,42], logicaland => [217,29,729,26], logicalor => [218,39,714,32], arrowdblboth => [219,35,1297,24], arrowdblleft => [220,39,1184,62], arrowdblup => [221,50,687,46], arrowdblright => [222,58,1184,42], arrowdbldown => [223,57,687,40], lozenge => [224,23,583,36], angleleft => [225,32,366,29], registeredsans => [226,65,899,65], copyrightsans => [227,63,899,66], trademarksans => [228,6,938,79], summation => [229,18,887,23], parenlefttp => [230,52,515,-67], parenleftex => [231,52,67,380], parenleftbt => [232,52,515,-67], bracketlefttp => [233,0,444,56], bracketleftex => [234,0,71,428], bracketleftbt => [235,0,443,57], bracelefttp => [236,261,310,71], braceleftmid => [237,18,314,311], bracelefttbt => [238,261,310,71], braceex => [239,261,70,311], euro => [240,69,871,52], angleright => [241,27,366,35], integral => [242,2,376,-22], integraltp => [243,432,499,-37], integralex => [244,432,108,353], integralbt => [245,50,489,353], parenrighttp => [246,70,515,-85], parenrightex => [247,518,67,-85], parenrightbt => [248,70,515,-85], bracketrighttp => [249,28,440,31], bracketrightex => [250,397,71,31], bracketrightbt => [251,26,443,31], bracerighttp => [252,22,310,311], bracerightmid => [253,261,314,67], bracerightbt => [254,22,310,311], '.notdef' => [-1,0,0,325], }} ); Prima-1.28/Prima/PS/fonts/NewCenturySchlbk-Roman0000644000175100017510000001516611150770061017255 0ustar dkdk('NewCenturySchlbk-Roman' => { name => 'NewCenturySchlbk-Roman', family => 'NewCenturySchlbk', height => 1198, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 979, descent => 219, maximalWidth => 1218, width => 1218, internalLeading => 242, externalLeading => 79, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 75.59, yDeviceRes => 75.59, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,333], exclam => [33,104,149,100], quotedbl => [34,73,319,73], numbersign => [35,39,588,38], dollar => [36,53,557,55], percent => [37,53,894,49], ampersand => [38,61,867,47], quoteright => [39,28,184,31], parenleft => [40,43,291,64], parenright => [41,64,291,43], asterisk => [42,67,463,68], plus => [43,61,603,61], comma => [44,76,184,71], hyphen => [45,50,298,50], period => [46,88,149,94], slash => [47,-27,389,-28], zero => [48,50,565,50], one => [49,119,474,71], two => [50,41,563,61], three => [51,50,546,69], four => [52,33,597,34], five => [53,53,547,64], six => [54,50,567,47], seven => [55,70,537,57], eight => [56,49,565,51], nine => [57,46,567,51], colon => [58,103,149,80], semicolon => [59,86,184,62], less => [60,58,609,57], equal => [61,61,603,61], greater => [62,57,609,58], question => [63,29,462,39], at => [64,51,793,38], A => [65,-9,885,-10], B => [66,35,766,62], C => [67,53,746,64], D => [68,34,842,55], E => [69,34,759,70], F => [70,34,729,34], G => [71,50,874,7], H => [72,34,928,34], I => [73,45,396,45], J => [74,5,637,22], K => [75,35,926,-29], L => [76,41,731,25], M => [77,26,1067,37], N => [78,22,928,25], O => [79,53,824,53], P => [80,33,743,21], Q => [81,53,843,34], R => [82,31,823,10], S => [83,61,645,47], T => [84,22,753,22], U => [85,20,936,19], V => [86,-9,885,-10], W => [87,7,1162,5], X => [88,-7,864,-14], Y => [89,-15,869,-10], Z => [90,28,660,43], bracketleft => [91,79,276,43], backslash => [92,88,548,88], bracketright => [93,43,275,80], asciicircum => [94,62,601,62], underscore => [95,0,599,0], quoteleft => [96,31,185,27], a => [97,52,597,15], b => [98,9,613,43], c => [99,40,469,21], d => [100,51,612,23], e => [101,41,516,40], f => [102,22,495,-119], g => [103,27,621,-5], h => [104,17,692,21], i => [105,21,324,31], j => [106,-98,359,93], k => [107,16,686,7], l => [108,22,321,33], m => [109,27,1012,25], n => [110,32,678,21], o => [111,40,517,40], p => [112,33,607,46], q => [113,43,613,9], r => [114,25,495,10], s => [115,61,443,50], t => [116,21,426,17], u => [117,25,686,20], v => [118,9,622,10], w => [119,17,896,17], x => [120,10,622,9], y => [121,3,632,7], z => [122,46,474,55], braceleft => [123,79,276,43], bar => [124,316,93,316], braceright => [125,43,276,79], asciitilde => [126,61,603,61], exclamdown => [161,103,149,101], cent => [162,85,488,92], sterling => [163,20,622,22], fraction => [164,-259,666,-206], yen => [165,-1,667,0], florin => [166,3,644,17], section => [167,69,467,62], currency => [168,31,603,31], quotesingle => [169,70,103,70], quotedblleft => [170,31,406,28], guillemotleft => [171,45,419,45], guilsinglleft => [172,45,219,45], guilsinglright => [173,46,218,45], fi => [174,19,685,27], fl => [175,19,687,25], endash => [177,0,666,0], dagger => [178,52,498,47], daggerdbl => [179,56,497,45], periodcentered => [180,91,149,92], paragraph => [182,58,608,58], bullet => [183,160,403,161], quotesinglbase => [184,28,184,31], quotedblbase => [185,28,404,32], quotedblright => [186,28,404,32], guillemotright => [187,46,418,45], ellipsis => [188,124,947,125], perthousand => [189,2,1184,10], questiondown => [191,35,462,33], grave => [193,20,269,109], acute => [194,109,269,20], circumflex => [195,11,374,11], tilde => [196,1,396,1], macron => [197,11,374,11], breve => [198,29,339,29], dotaccent => [199,140,119,138], dieresis => [200,20,358,20], ring => [202,80,238,80], cedilla => [203,34,249,115], hungarumlaut => [205,53,291,53], ogonek => [206,81,213,104], caron => [207,11,374,11], emdash => [208,0,1198,0], AE => [225,0,1153,44], ordfeminine => [227,5,388,5], Lslash => [232,40,731,26], Oslash => [233,35,842,53], OE => [234,22,1152,22], ordmasculine => [235,11,336,10], ae => [241,43,866,44], dotlessi => [245,21,324,31], lslash => [248,22,321,33], oslash => [249,40,517,40], oe => [250,40,917,39], germandbls => [251,34,606,46], Yacute => [-1,-15,869,-10], Ucircumflex => [-1,20,936,19], Ugrave => [-1,20,936,19], Zcaron => [-1,28,660,43], Ydieresis => [-1,-15,869,-10], threesuperior => [-1,21,354,22], Uacute => [-1,20,936,19], twosuperior => [-1,15,366,16], Udieresis => [-1,20,936,19], middot => [-1,91,149,92], onesuperior => [-1,46,305,46], aacute => [-1,52,597,15], agrave => [-1,52,597,15], acircumflex => [-1,52,597,15], Scaron => [-1,61,645,47], Otilde => [-1,53,824,53], sfthyphen => [-1,50,298,50], atilde => [-1,52,597,15], aring => [-1,52,597,15], adieresis => [-1,52,597,15], Ograve => [-1,53,824,53], Ocircumflex => [-1,53,824,53], Odieresis => [-1,53,824,53], Ntilde => [-1,22,928,25], edieresis => [-1,41,516,40], eacute => [-1,41,516,40], egrave => [-1,41,516,40], Icircumflex => [-1,45,396,45], ecircumflex => [-1,41,516,40], Igrave => [-1,45,396,45], Iacute => [-1,45,396,45], Idieresis => [-1,45,396,45], degree => [-1,59,359,59], Ecircumflex => [-1,34,759,70], minus => [-1,61,603,61], multiply => [-1,61,603,61], divide => [-1,61,603,61], Egrave => [-1,34,759,70], trademark => [-1,53,1090,53], Oacute => [-1,53,824,53], thorn => [-1,33,607,46], eth => [-1,40,517,40], Eacute => [-1,34,759,70], ccedilla => [-1,40,469,21], idieresis => [-1,9,358,9], iacute => [-1,21,346,9], igrave => [-1,9,336,31], plusminus => [-1,61,603,61], onehalf => [-1,46,936,15], onequarter => [-1,46,905,46], threequarters => [-1,33,918,46], icircumflex => [-1,1,374,1], Edieresis => [-1,34,759,70], ntilde => [-1,32,678,21], Aring => [-1,-9,885,-10], odieresis => [-1,40,517,40], oacute => [-1,40,517,40], ograve => [-1,40,517,40], ocircumflex => [-1,40,517,40], otilde => [-1,40,517,40], scaron => [-1,61,443,50], udieresis => [-1,25,686,20], uacute => [-1,25,686,20], ugrave => [-1,25,686,20], ucircumflex => [-1,25,686,20], yacute => [-1,3,632,7], zcaron => [-1,46,474,55], ydieresis => [-1,3,632,7], copyright => [-1,-9,900,-8], registered => [-1,-9,900,-8], Atilde => [-1,-9,885,-10], nbspace => [-1,0,0,333], Ccedilla => [-1,53,746,64], Acircumflex => [-1,-9,885,-10], Agrave => [-1,-9,885,-10], logicalnot => [-1,61,603,61], Aacute => [-1,-9,885,-10], Eth => [-1,34,842,55], brokenbar => [-1,316,93,316], Thorn => [-1,33,743,21], Adieresis => [-1,-9,885,-10], mu => [-1,25,686,20], '.notdef' => [-1,0,0,333], }} ); Prima-1.28/Prima/PS/fonts/NewCenturySchlbk-Bold0000644000175100017510000001520211150770061017050 0ustar dkdk('NewCenturySchlbk-Bold' => { name => 'NewCenturySchlbk-Bold', family => 'NewCenturySchlbk', height => 1213, weigth => fw::Bold, style => fs::Bold, pitch => fp::Variable, vector => 1, ascent => 990, descent => 223, maximalWidth => 1167, width => 1167, internalLeading => 253, externalLeading => 83, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 75.28, yDeviceRes => 75.28, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,348], exclam => [33,69,226,63], quotedbl => [34,-14,434,-15], numbersign => [35,49,596,49], dollar => [36,30,635,30], percent => [37,20,975,14], ampersand => [38,47,949,36], quoteright => [39,26,238,26], parenleft => [40,87,322,61], parenright => [41,60,322,88], asterisk => [42,67,474,64], plus => [43,61,611,61], comma => [44,47,238,50], hyphen => [45,50,302,50], period => [46,54,228,54], slash => [47,-27,394,-29], zero => [48,32,629,33], one => [49,100,494,100], two => [50,23,621,52], three => [51,29,613,53], four => [52,23,639,33], five => [53,37,611,47], six => [54,35,630,30], seven => [55,54,607,33], eight => [56,32,629,33], nine => [57,30,630,35], colon => [58,69,226,41], semicolon => [59,57,238,41], less => [60,59,617,58], equal => [61,61,611,61], greater => [62,58,617,59], question => [63,27,549,29], at => [64,29,846,30], A => [65,-21,965,-23], B => [66,20,872,50], C => [67,48,828,66], D => [68,23,938,48], E => [69,19,838,63], F => [70,26,810,38], G => [71,47,943,19], H => [72,24,1006,24], I => [73,33,471,32], J => [74,4,770,10], K => [75,18,974,-3], L => [76,23,827,25], M => [77,10,1159,19], N => [78,19,991,0], O => [79,47,915,47], P => [80,29,862,29], Q => [81,46,934,30], R => [82,24,966,-2], S => [83,61,705,41], T => [84,18,839,18], U => [85,18,981,10], V => [86,-21,965,-23], W => [87,7,1172,9], X => [88,-14,906,-15], Y => [89,-14,906,-15], Z => [90,29,739,40], bracketleft => [91,101,309,60], backslash => [92,60,612,61], bracketright => [93,37,309,124], asciicircum => [94,63,608,63], underscore => [95,0,606,0], quoteleft => [96,26,238,26], a => [97,43,680,16], b => [98,0,742,43], c => [99,37,601,35], d => [100,44,748,15], e => [101,38,616,41], f => [102,16,545,-90], g => [103,36,719,-14], h => [104,19,788,23], i => [105,33,379,35], j => [106,-99,429,97], k => [107,14,786,8], l => [108,19,382,25], m => [109,24,1118,25], n => [110,24,786,20], o => [111,37,664,38], p => [112,21,744,42], q => [113,41,735,9], r => [114,21,605,2], s => [115,46,519,41], t => [116,27,463,25], u => [117,15,793,21], v => [118,14,710,15], w => [119,23,1039,15], x => [120,15,709,15], y => [121,12,713,15], z => [122,42,557,50], braceleft => [123,101,314,55], bar => [124,294,144,295], braceright => [125,37,314,120], asciitilde => [126,61,611,61], exclamdown => [161,64,228,66], cent => [162,43,604,48], sterling => [163,24,656,15], fraction => [164,-201,605,-201], yen => [165,3,688,3], florin => [166,16,648,30], section => [167,76,454,75], currency => [168,40,614,41], quotesingle => [169,63,164,64], quotedblleft => [170,26,527,29], guillemotleft => [171,59,476,70], guilsinglleft => [172,87,235,81], guilsinglright => [173,89,236,77], fi => [174,18,790,21], fl => [175,18,789,23], endash => [177,0,606,0], dagger => [178,53,493,59], daggerdbl => [179,57,498,50], periodcentered => [180,55,228,53], paragraph => [182,42,822,41], bullet => [183,158,417,158], quotesinglbase => [184,26,238,26], quotedblbase => [185,27,527,27], quotedblright => [186,27,527,27], guillemotright => [187,67,479,59], ellipsis => [188,88,1035,88], perthousand => [189,9,1196,7], questiondown => [191,27,549,29], grave => [193,2,299,101], acute => [194,101,299,2], circumflex => [195,-9,425,-12], tilde => [196,-27,462,-30], macron => [197,-6,417,-7], breve => [198,10,382,10], dotaccent => [199,116,171,116], dieresis => [200,-13,431,-14], ring => [202,71,260,71], cedilla => [203,20,283,99], hungarumlaut => [205,82,360,-38], ogonek => [206,82,215,105], caron => [207,-9,425,-12], emdash => [208,0,1213,0], AE => [225,-35,1203,21], ordfeminine => [227,1,441,2], Lslash => [232,23,827,25], Oslash => [233,47,914,48], OE => [234,6,1191,15], ordmasculine => [235,1,431,12], ae => [241,36,978,40], dotlessi => [245,33,379,35], lslash => [248,19,382,25], oslash => [249,37,664,38], oe => [250,42,1015,42], germandbls => [251,7,690,43], Yacute => [-1,-14,906,-15], Ucircumflex => [-1,18,981,10], Ugrave => [-1,18,981,10], Zcaron => [-1,29,739,40], Ydieresis => [-1,-14,906,-15], threesuperior => [-1,9,397,9], Uacute => [-1,18,981,10], twosuperior => [-1,6,403,7], Udieresis => [-1,18,981,10], middot => [-1,55,228,53], onesuperior => [-1,47,321,48], aacute => [-1,43,680,16], agrave => [-1,43,680,16], acircumflex => [-1,43,680,16], Scaron => [-1,61,705,41], Otilde => [-1,47,915,47], sfthyphen => [-1,50,302,50], atilde => [-1,43,680,16], aring => [-1,43,680,16], adieresis => [-1,43,680,16], Ograve => [-1,47,915,47], Ocircumflex => [-1,47,915,47], Odieresis => [-1,47,915,47], Ntilde => [-1,19,991,0], edieresis => [-1,38,616,41], eacute => [-1,38,616,41], egrave => [-1,38,616,41], Icircumflex => [-1,33,471,32], ecircumflex => [-1,38,616,41], Igrave => [-1,33,471,32], Iacute => [-1,33,471,32], Idieresis => [-1,33,471,32], degree => [-1,60,363,60], Ecircumflex => [-1,19,838,63], minus => [-1,61,611,61], multiply => [-1,61,611,61], divide => [-1,61,611,61], Egrave => [-1,19,838,63], trademark => [-1,36,1140,36], Oacute => [-1,47,915,47], thorn => [-1,21,744,42], eth => [-1,37,664,38], Eacute => [-1,19,838,63], ccedilla => [-1,37,601,35], idieresis => [-1,9,431,7], iacute => [-1,33,390,24], igrave => [-1,25,388,35], plusminus => [-1,61,611,61], onehalf => [-1,47,961,35], onequarter => [-1,47,949,47], threequarters => [-1,9,987,47], icircumflex => [-1,13,425,9], Edieresis => [-1,19,838,63], ntilde => [-1,24,786,20], Aring => [-1,-21,965,-23], odieresis => [-1,37,664,38], oacute => [-1,37,664,38], ograve => [-1,37,664,38], ocircumflex => [-1,37,664,38], otilde => [-1,37,664,38], scaron => [-1,46,519,41], udieresis => [-1,15,793,21], uacute => [-1,15,793,21], ugrave => [-1,15,793,21], ucircumflex => [-1,15,793,21], yacute => [-1,12,713,15], zcaron => [-1,42,557,50], ydieresis => [-1,12,713,15], copyright => [-1,6,892,7], registered => [-1,6,892,7], Atilde => [-1,-21,965,-23], nbspace => [-1,0,0,348], Ccedilla => [-1,48,828,66], Acircumflex => [-1,-21,965,-23], Agrave => [-1,-21,965,-23], logicalnot => [-1,61,611,61], Aacute => [-1,-21,965,-23], Eth => [-1,23,938,48], brokenbar => [-1,294,144,295], Thorn => [-1,29,862,29], Adieresis => [-1,-21,965,-23], mu => [-1,15,793,21], '.notdef' => [-1,0,0,348], }} ); Prima-1.28/Prima/PS/fonts/Courier-Bold0000644000175100017510000001533211150770061015232 0ustar dkdk('Courier-Bold' => { name => 'Courier-Bold', family => 'Courier', height => 1100, weigth => fw::Bold, style => fs::Bold, pitch => fp::Variable, vector => 1, ascent => 871, descent => 229, maximalWidth => 674, width => 674, internalLeading => 247, externalLeading => 81, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 84.72, yDeviceRes => 84.72, size => 1000, encoding => 'Latin1', chardata => { space => [32,412,0,247], exclam => [33,242,177,240], quotedbl => [34,149,360,149], numbersign => [35,68,523,68], dollar => [36,91,477,91], percent => [37,88,485,86], ampersand => [38,82,476,101], quoteright => [39,161,224,273], parenleft => [40,290,246,123], parenright => [41,128,246,284], asterisk => [42,91,477,91], plus => [43,46,567,46], comma => [44,161,224,273], hyphen => [45,46,567,46], period => [46,247,165,247], slash => [47,91,477,91], zero => [48,91,477,91], one => [49,91,477,91], two => [50,59,499,101], three => [51,72,509,78], four => [52,82,476,101], five => [53,72,509,78], six => [54,115,478,66], seven => [55,82,476,101], eight => [56,91,477,91], nine => [57,116,478,64], colon => [58,247,165,247], semicolon => [59,161,224,273], less => [60,46,552,61], equal => [61,46,567,46], greater => [62,61,552,46], question => [63,114,454,91], at => [64,83,476,100], A => [65,-23,706,-23], B => [66,14,613,31], C => [67,36,584,39], D => [68,14,590,55], E => [69,14,590,55], F => [70,14,590,55], G => [71,36,614,8], H => [72,25,613,20], I => [73,91,477,91], J => [74,59,614,-14], K => [75,14,647,-2], L => [76,36,591,31], M => [77,-20,706,-25], N => [78,-8,660,8], O => [79,23,613,23], P => [80,14,567,78], Q => [81,23,613,23], R => [82,14,666,-20], S => [83,68,523,68], T => [84,46,567,46], U => [85,11,638,11], V => [86,-23,706,-23], W => [87,-11,682,-11], X => [88,11,638,11], Y => [89,23,613,23], Z => [90,80,499,80], bracketleft => [91,275,247,137], backslash => [92,91,477,91], bracketright => [93,137,247,275], asciicircum => [94,91,477,91], underscore => [95,-13,686,-13], quoteleft => [96,273,224,161], a => [97,46,581,31], b => [98,-8,636,31], c => [99,59,562,38], d => [100,36,638,-14], e => [101,36,568,55], f => [102,82,545,31], g => [103,36,614,8], h => [104,14,624,20], i => [105,68,523,68], j => [106,128,408,123], k => [107,36,591,31], l => [108,68,523,68], m => [109,-20,706,-25], n => [110,25,602,31], o => [111,46,567,46], p => [112,-8,636,31], q => [113,36,638,-14], r => [114,59,568,31], s => [115,80,499,80], t => [116,14,567,78], u => [117,14,613,31], v => [118,0,660,0], w => [119,0,660,0], x => [120,23,613,23], y => [121,23,613,23], z => [122,93,477,89], braceleft => [123,183,292,183], bar => [124,275,110,275], braceright => [125,183,292,183], asciitilde => [126,68,523,68], exclamdown => [161,242,177,240], cent => [162,91,457,111], sterling => [163,36,568,55], fraction => [164,23,614,22], yen => [165,23,613,23], florin => [166,62,540,57], section => [167,39,580,39], currency => [168,80,499,80], quotesingle => [169,259,140,259], quotedblleft => [170,107,444,107], guillemotleft => [171,36,591,31], guilsinglleft => [172,36,339,283], guilsinglright => [173,289,338,31], fi => [174,-15,696,-20], fl => [175,-18,697,-18], endash => [177,46,567,46], dagger => [178,103,453,103], daggerdbl => [179,103,453,103], periodcentered => [180,247,165,247], paragraph => [182,53,559,46], bullet => [183,165,328,166], quotesinglbase => [184,161,224,273], quotedblbase => [185,95,444,119], quotedblright => [186,95,444,119], guillemotright => [187,36,591,31], ellipsis => [188,27,605,27], perthousand => [189,0,660,0], questiondown => [191,91,454,114], grave => [193,137,247,275], acute => [194,275,247,137], circumflex => [195,137,386,136], tilde => [196,126,407,126], macron => [197,137,385,137], breve => [198,137,385,137], dotaccent => [199,264,132,264], dieresis => [200,149,360,149], ring => [202,194,270,194], cedilla => [203,198,249,212], hungarumlaut => [205,137,385,137], ogonek => [206,275,234,150], caron => [207,137,386,136], emdash => [208,-31,723,-31], AE => [225,-22,697,-15], ordfeminine => [227,129,408,122], Lslash => [232,13,614,31], Oslash => [233,9,639,11], OE => [234,-22,695,-13], ordmasculine => [235,134,393,132], ae => [241,-14,687,-13], dotlessi => [245,68,523,68], lslash => [248,68,523,68], oslash => [249,25,605,29], oe => [250,-12,686,-14], germandbls => [251,14,567,78], Yacute => [-1,23,613,23], Ucircumflex => [-1,11,638,11], Ugrave => [-1,11,638,11], Zcaron => [-1,80,499,80], Ydieresis => [-1,23,613,23], threesuperior => [-1,172,313,173], Uacute => [-1,11,638,11], twosuperior => [-1,163,308,188], Udieresis => [-1,11,638,11], middot => [-1,247,165,247], onesuperior => [-1,182,294,182], aacute => [-1,46,581,31], agrave => [-1,46,581,31], acircumflex => [-1,46,581,31], Scaron => [-1,68,523,68], Otilde => [-1,23,613,23], sfthyphen => [-1,46,567,46], atilde => [-1,46,581,31], aring => [-1,46,581,31], adieresis => [-1,46,581,31], Ograve => [-1,23,613,23], Ocircumflex => [-1,23,613,23], Odieresis => [-1,23,613,23], Ntilde => [-1,-8,660,8], edieresis => [-1,36,568,55], eacute => [-1,36,568,55], egrave => [-1,36,568,55], Icircumflex => [-1,91,477,91], ecircumflex => [-1,36,568,55], Igrave => [-1,91,477,91], Iacute => [-1,91,477,91], Idieresis => [-1,91,477,91], degree => [-1,137,385,137], Ecircumflex => [-1,14,590,55], minus => [-1,46,567,46], multiply => [-1,110,440,110], divide => [-1,46,567,46], Egrave => [-1,14,590,55], trademark => [-1,-36,718,-22], Oacute => [-1,23,613,23], thorn => [-1,-8,636,31], eth => [-1,46,567,46], Eacute => [-1,14,590,55], ccedilla => [-1,59,562,38], idieresis => [-1,68,523,68], iacute => [-1,68,523,68], igrave => [-1,68,523,68], plusminus => [-1,46,567,46], onehalf => [-1,-37,729,-31], onequarter => [-1,-37,729,-31], threequarters => [-1,-47,740,-33], icircumflex => [-1,68,523,68], Edieresis => [-1,14,590,55], ntilde => [-1,25,602,31], Aring => [-1,-23,706,-23], odieresis => [-1,46,567,46], oacute => [-1,46,567,46], ograve => [-1,46,567,46], ocircumflex => [-1,46,567,46], otilde => [-1,46,567,46], scaron => [-1,80,499,80], udieresis => [-1,14,613,31], uacute => [-1,14,613,31], ugrave => [-1,14,613,31], ucircumflex => [-1,14,613,31], yacute => [-1,23,613,23], zcaron => [-1,93,477,89], ydieresis => [-1,23,613,23], copyright => [-1,-7,674,-6], registered => [-1,-7,674,-6], Atilde => [-1,-23,706,-23], nbspace => [-1,412,0,247], Ccedilla => [-1,36,584,39], Acircumflex => [-1,-23,706,-23], Agrave => [-1,-23,706,-23], logicalnot => [-1,46,465,148], Aacute => [-1,-23,706,-23], Eth => [-1,0,605,55], brokenbar => [-1,275,114,270], Thorn => [-1,15,559,84], Adieresis => [-1,-23,706,-23], mu => [-1,14,613,31], '.notdef' => [-1,412,0,247], }} ); Prima-1.28/Prima/PS/fonts/AvantGarde-Book0000644000175100017510000001515111150770061015647 0ustar dkdk('AvantGarde-Book' => { name => 'AvantGarde-Book', family => 'AvantGarde', height => 1216, weigth => fw::Medium, style => fs::Normal, pitch => fp::Variable, vector => 1, ascent => 976, descent => 240, maximalWidth => 1267, width => 1267, internalLeading => 237, externalLeading => 78, firstChar => 32, lastChar => 263, defaultChar => 32, xDeviceRes => 73.82, yDeviceRes => 73.82, size => 1000, encoding => 'Latin1', chardata => { space => [32,0,0,336], exclam => [33,134,89,133], quotedbl => [34,89,198,87], numbersign => [35,6,661,6], dollar => [36,86,496,91], percent => [37,15,898,27], ampersand => [38,69,824,26], quoteright => [39,110,196,119], parenleft => [40,69,338,41], parenright => [41,41,338,69], asterisk => [42,77,359,79], plus => [43,62,612,62], comma => [44,110,196,29], hyphen => [45,37,329,36], period => [46,122,89,124], slash => [47,48,434,48], zero => [48,36,601,35], one => [49,188,241,243], two => [50,40,575,58], three => [51,40,572,60], four => [52,14,626,32], five => [53,31,610,31], six => [54,30,612,30], seven => [55,77,518,77], eight => [56,51,571,51], nine => [57,30,612,30], colon => [58,122,89,124], semicolon => [59,49,196,89], less => [60,59,618,58], equal => [61,62,612,62], greater => [62,58,618,59], question => [63,79,559,80], at => [64,86,882,85], A => [65,13,873,13], B => [66,92,569,36], C => [67,53,882,52], D => [68,92,758,53], E => [69,92,491,68], F => [70,92,456,41], G => [71,53,956,49], H => [72,92,645,92], I => [73,92,89,92], J => [74,13,480,92], K => [75,92,618,7], L => [76,92,462,7], M => [77,92,932,92], N => [78,92,715,92], O => [79,53,949,53], P => [80,92,594,32], Q => [81,53,966,38], R => [82,92,609,36], S => [83,26,552,26], T => [84,8,500,8], U => [85,92,611,92], V => [86,12,829,12], W => [87,12,1143,12], X => [88,9,721,9], Y => [89,2,715,2], Z => [90,20,555,7], bracketleft => [91,136,244,46], backslash => [92,102,462,171], bracketright => [93,46,244,136], asciicircum => [94,21,693,21], underscore => [95,0,608,0], quoteleft => [96,119,196,110], a => [97,51,702,76], b => [98,76,701,51], c => [99,51,688,47], d => [100,51,705,76], e => [101,51,691,47], f => [102,19,358,3], g => [103,51,690,76], h => [104,76,588,76], i => [105,76,89,76], j => [106,-54,224,76], k => [107,76,527,6], l => [108,76,89,76], m => [109,76,987,76], n => [110,76,588,76], o => [111,51,694,51], p => [112,76,701,51], q => [113,51,701,76], r => [114,76,278,10], s => [115,21,417,32], t => [116,14,383,14], u => [117,76,586,76], v => [118,9,654,9], w => [119,8,993,8], x => [120,9,564,9], y => [121,10,629,10], z => [122,12,492,12], braceleft => [123,44,284,97], bar => [124,369,77,369], braceright => [125,46,280,99], asciitilde => [126,62,612,62], exclamdown => [161,134,89,133], cent => [162,54,564,54], sterling => [163,21,697,-46], fraction => [164,-139,481,-139], yen => [165,0,716,-42], florin => [166,21,642,9], section => [167,105,537,104], currency => [168,31,610,31], quotesingle => [169,89,60,89], quotedblleft => [170,116,376,116], guillemotleft => [171,48,419,48], guilsinglleft => [172,48,207,48], guilsinglright => [173,48,207,48], fi => [174,15,499,76], fl => [175,15,497,76], endash => [177,0,608,0], dagger => [178,71,528,71], daggerdbl => [179,71,528,71], periodcentered => [180,122,89,124], paragraph => [182,44,552,88], bullet => [183,143,449,143], quotesinglbase => [184,108,196,125], quotedblbase => [185,108,375,126], quotedblright => [186,105,372,110], guillemotright => [187,48,419,48], ellipsis => [188,158,899,158], perthousand => [189,15,1383,27], questiondown => [191,80,559,79], grave => [193,89,279,89], acute => [194,89,276,89], circumflex => [195,89,430,89], tilde => [196,91,352,89], macron => [197,89,409,89], breve => [198,89,369,91], dotaccent => [199,89,89,89], dieresis => [200,89,268,89], ring => [202,89,223,89], cedilla => [203,89,214,89], hungarumlaut => [205,89,492,88], ogonek => [206,89,187,89], caron => [207,89,430,89], emdash => [208,0,1216,0], AE => [225,13,1124,68], ordfeminine => [227,37,374,36], Lslash => [232,31,578,18], Oslash => [233,53,948,53], OE => [234,53,1330,68], ordmasculine => [235,38,370,38], ae => [241,51,1308,47], dotlessi => [245,76,89,76], lslash => [248,43,284,36], oslash => [249,51,691,51], oe => [250,51,1284,47], germandbls => [251,71,565,36], Yacute => [-1,2,715,2], Ucircumflex => [-1,92,611,92], Ugrave => [-1,92,611,92], Zcaron => [-1,20,555,7], Ydieresis => [-1,2,715,2], threesuperior => [-1,15,372,15], Uacute => [-1,92,611,92], twosuperior => [-1,14,374,14], Udieresis => [-1,92,611,92], middot => [-1,122,89,124], onesuperior => [-1,119,164,120], aacute => [-1,51,702,76], agrave => [-1,51,702,76], acircumflex => [-1,51,702,76], Scaron => [-1,26,552,26], Otilde => [-1,53,949,53], sfthyphen => [-1,37,329,36], atilde => [-1,51,702,76], aring => [-1,51,702,76], adieresis => [-1,51,702,76], Ograve => [-1,53,949,53], Ocircumflex => [-1,53,949,53], Odieresis => [-1,53,949,53], Ntilde => [-1,92,715,92], edieresis => [-1,51,691,47], eacute => [-1,51,691,47], egrave => [-1,51,691,47], Icircumflex => [-1,-77,430,-77], ecircumflex => [-1,51,691,47], Igrave => [-1,-2,279,-2], Iacute => [-1,-1,276,0], Idieresis => [-1,3,268,2], degree => [-1,60,364,60], Ecircumflex => [-1,92,491,68], minus => [-1,62,612,62], multiply => [-1,62,612,62], divide => [-1,62,612,62], Egrave => [-1,92,491,68], trademark => [-1,76,1064,75], Oacute => [-1,53,949,53], thorn => [-1,76,701,51], eth => [-1,51,694,51], Eacute => [-1,92,491,68], ccedilla => [-1,51,688,47], idieresis => [-1,-12,268,-13], iacute => [-1,-15,276,-17], igrave => [-1,-18,279,-18], plusminus => [-1,62,612,62], onehalf => [-1,116,873,20], onequarter => [-1,122,853,34], threequarters => [-1,15,960,34], icircumflex => [-1,-93,430,-93], Edieresis => [-1,92,491,68], ntilde => [-1,76,588,76], Aring => [-1,13,873,13], odieresis => [-1,51,694,51], oacute => [-1,51,694,51], ograve => [-1,51,694,51], ocircumflex => [-1,51,694,51], otilde => [-1,51,694,51], scaron => [-1,20,430,20], udieresis => [-1,76,586,76], uacute => [-1,76,586,76], ugrave => [-1,76,586,76], ucircumflex => [-1,76,586,76], yacute => [-1,10,629,10], zcaron => [-1,12,492,12], ydieresis => [-1,10,629,10], copyright => [-1,-10,929,-9], registered => [-1,-10,929,-9], Atilde => [-1,13,873,13], nbspace => [-1,0,0,336], Ccedilla => [-1,53,882,52], Acircumflex => [-1,13,873,13], Agrave => [-1,13,873,13], logicalnot => [-1,62,612,62], Aacute => [-1,13,873,13], Eth => [-1,31,875,53], brokenbar => [-1,369,77,369], Thorn => [-1,92,594,32], Adieresis => [-1,13,873,13], mu => [-1,76,586,76], '.notdef' => [-1,0,0,336], }} ); Prima-1.28/Prima/PS/setup.fm0000644000175100017510000007206711150770061013364 0ustar dkdk# VBForm version file=1.1 builder=0.1 # [preload] Prima::ComboBox sub { return ( 'TabbedNotebook1' => { class => 'Prima::TabbedNotebook', module => 'Prima::Notebooks', extras => { Radio1 => '0', Radio2 => '0', Radio3 => '0', VBool => '1', Radio4 => '0', CopyCount => '0', Radio6 => '2', Radio7 => '2', LPRadio => '2', Orientation => '0', HelpBtn => '1', AddBtn => '3', LParams => '2', Label1 => '0', VList => '1', Label2 => '0', Label3 => '0', Label4 => '0', RenameBtn => '3', ImportBtn => '3', Scaling => '0', Profiles => '3', ImageViewer1 => '0', ValueBox => '1', VCombo => '1', ImageViewer2 => '0', ImageViewer3 => '0', ValueBook => '1', ImageViewer4 => '0', VHint => '1', Spool => '2', PaperSize => '0', SaveBtn => '3', Resolution => '0', DelBtn => '3', VText => '1', LPLabel => '2', CmdLine => '2', Color => '0', }, actions => { onChild => Prima::VB::VBLoader::GO_SUB('$_[2]-> defaultInsertPage( $_[1]-> {extras}-> {$_[3]}) ','TabbedNotebook1', 'onChild'), onChildCreate => Prima::VB::VBLoader::GO_SUB('$_[3]-> origin( $_[3]->left-$_[3]->owner->left, $_[3]-> bottom-$_[3]->owner->bottom); ','TabbedNotebook1', 'onChildCreate'), }, profile => { origin => [ 0, 64], name => 'TabbedNotebook1', tabs => ['Page setup', 'Advanced ', 'Spooling ', 'Profiles', ], size => [ 329, 366], owner => 'Form1', growMode => gm::GrowHiX | gm::GrowHiY, }}, 'Form1' => { class => 'Prima::Window', module => 'Prima::Classes', parent => 1, profile => { width => 330, onExecute => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; my $x = $self-> TabbedNotebook1-> Notebook; $x-> HelpBtn-> notify(\'Click\') if $x-> ValueBox-> ValueBook-> pageIndex == 3; ','Form1', 'onExecute'), name => 'Form1', onCreate => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> {imgConvProc} = sub { my $self = $_[0]; my $a = $self-> image-> dup; $a-> set( rop => rop::Whiteness, rop2 => rop::Blackness); $a-> map( $a-> pixel( $a-> width - 1, $a-> height - 1)); my $x = $self-> image-> dup; $x-> set( rop2 => rop::NoOper, rop => rop::Blackness); $x-> map( $x-> pixel( $x-> width - 1, $a-> height - 1)); my $i = Prima::Icon-> create; $i-> combine( $x, $a); $self-> image( $i); }; ','Form1', 'onCreate'), text => 'PostScript printer settings', bottom => 348, originDontCare => 0, origin => [ 440, 348], height => 430, size => [ 330, 430], sizeDontCare => 0, left => 440, }}, 'Label1' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 20, 252], name => 'Label1', owner => 'TabbedNotebook1', size => [ 100, 20], growMode => gm::GrowHiX, text => 'Paper si~ze:', }}, 'PaperSize' => { class => 'Prima::ComboBox', module => 'Prima::ComboBox', profile => { origin => [ 125, 252], style => cs::DropDownList, name => 'PaperSize', owner => 'TabbedNotebook1', size => [ 183, 21], growMode => gm::GrowLoX, }}, 'Label3' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 20, 200], name => 'Label3', size => [ 100, 20], owner => 'TabbedNotebook1', growMode => gm::GrowHiX, text => '~Scaling, %:', }}, 'Scaling' => { class => 'Prima::SpinEdit', module => 'Prima::Sliders', profile => { name => 'Scaling', min => 1, growMode => gm::GrowLoX, max => 1000, origin => [ 125, 201], size => [ 183, 20], owner => 'TabbedNotebook1', step => 10, value => 100, }}, 'Label4' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 20, 174], name => 'Label4', size => [ 100, 20], owner => 'TabbedNotebook1', growMode => gm::GrowHiX, text => '~Resolution:', }}, 'Label2' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 20, 226], name => 'Label2', size => [ 100, 20], owner => 'TabbedNotebook1', growMode => gm::GrowHiX, text => '~Copy count:', }}, 'Resolution' => { class => 'Prima::SpinEdit', module => 'Prima::Sliders', profile => { name => 'Resolution', growMode => gm::GrowLoX, min => 25, max => 32000, origin => [ 125, 175], size => [ 183, 20], owner => 'TabbedNotebook1', step => 100, value => 300, }}, 'Orientation' => { class => 'Prima::RadioGroup', module => 'Prima::Buttons', profile => { origin => [ 19, 97], name => 'Orientation', size => [ 287, 76], owner => 'TabbedNotebook1', growMode => gm::GrowHiX, text => 'Orientation', }}, 'CopyCount' => { class => 'Prima::SpinEdit', module => 'Prima::Sliders', profile => { name => 'CopyCount', min => 1, growMode => gm::GrowLoX, max => 1000, origin => [ 125, 226], size => [ 183, 20], owner => 'TabbedNotebook1', value => 1, }}, 'ImageViewer1' => { class => 'Prima::ImageViewer', module => 'Prima::ImageViewer', profile => { origin => [ 12, 17], onCreate => Prima::VB::VBLoader::GO_SUB('$_[0]-> owner-> owner-> owner-> owner-> {imgConvProc}->($_[0]); ','ImageViewer1', 'onCreate'), name => 'ImageViewer1', owner => 'Orientation', image => Prima::Image->create( width=>24, height=>29, type => im::bpp4, palette => [ 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,128,0,128,128,128,192,192,192,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255], data => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00x\x88\x88\x88\x88\x88\x88\x88". "\x88\x88\x88\x80\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x7f\xff\xff\xff". "\xff\xff\xff\xff\xff\xff\xff\x80\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80". "\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x7f\xff\xff\xff\xff\xff\xff\xff". "\xff\xff\xff\x80\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x7f\xff\xf7w". "\x7f\xff\xf7ww\x7f\xff\x80\x7f\xff\xff\x87\xff\xff\xff\x87x\xff\xff\x80". "\x7f\xff\xff\xf7\x8f\xff\xffw\x7f\xff\xff\x80\x7f\xff\xff\xf8\x7f\xff\xf8w". "\x8f\xff\xff\x80\x7f\xff\xff\xffwwww\xff\xff\xff\x80\x7f\xff\xff\xff". "x\xff\x87x\xff\xff\xff\x80\x7f\xff\xff\xff\x87\xffw\x7f\xff\xff\xff\x80". "\x7f\xff\xff\xff\xf7\x8fw\x8f\xff\xff\xff\x80\x7f\xff\xff\xff\xf8ww\xff". "\xff\xff\xff\x80\x7f\xff\xff\xff\xffwx\xff\xff\xff\xff\x80\x7f\xff\xff\xff". "\xff\x87\x7f\xff\xff\xff\xff\x80\x7f\xff\xff\xff\xff\xf7\x8f\xff\xff\xff\xff\x80". "\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x7f\xff\xff\xff\xff\xff\xff\xff". "\xff\xff\xff\x80\x7f\xff\xff\xff\xff\xff\xff\xff\xf7\x00\x00\x00\x7f\xff\xff\xff". "\xff\xff\xff\xff\xf7\xff\x87\x0d\x7f\xff\xff\xff\xff\xff\xff\xff\xf7\xf8p\xdd". "\x7f\xff\xff\xff\xff\xff\xff\xff\xf7\x87\x0d\xdd\x7f\xff\xff\xff\xff\xff\xff\xff". "\xf7p\xdd\xdd\x7f\xff\xff\xff\xff\xff\xff\xff\xf7\x0d\xdd\xddwwww". "wwwww\xdd\xdd\xdd". ''), size => [ 24, 29], autoHScroll => 0, autoVScroll => 0, }}, 'Radio1' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 47, 12], name => 'Radio1', owner => 'Orientation', size => [ 89, 36], text => '~Portrait', }}, 'ImageViewer2' => { class => 'Prima::ImageViewer', module => 'Prima::ImageViewer', profile => { origin => [ 142, 19], onCreate => Prima::VB::VBLoader::GO_SUB('$_[0]-> owner-> owner-> owner-> owner-> {imgConvProc}->($_[0]); ','ImageViewer2', 'onCreate'), name => 'ImageViewer2', owner => 'Orientation', image => Prima::Image->create( width=>29, height=>23, type => im::bpp4, palette => [ 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,128,0,128,128,128,192,192,192,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255], data => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01x\x88\x88\x88". "\x88\x88\x88\x88\x88\x88\x88\x88\x88\x88\x00\x01\x7f\xff\xff\xff\xff\xff\xff\xff". "\xff\xff\xff\xff\xff\xf8\x00\x01\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". "\xff\xf8\x00\x01\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf8\x00\x01". "\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf8\x00\x01\x7f\xff\xff\xf7". "w\x7f\xff\xf7ww\x7f\xff\xff\xf8\x00\x01\x7f\xff\xff\xff\x87\xff\xff\xff". "\x87x\xff\xff\xff\xf8\x00\x01\x7f\xff\xff\xff\xf7\x8f\xff\xffw\x7f\xff\xff". "\xff\xf8\x00\x01\x7f\xff\xff\xff\xf8\x7f\xff\xf8w\x8f\xff\xff\xff\xf8\x00\x01". "\x7f\xff\xff\xff\xffwwww\xff\xff\xff\xff\xf8\x00\x01\x7f\xff\xff\xff". "\xffx\xff\x87x\xff\xff\xff\xff\xf8\x00\x01\x7f\xff\xff\xff\xff\x87\xffw". "\x7f\xff\xff\xff\xff\xf8\x00\x01\x7f\xff\xff\xff\xff\xf7\x8fw\x8f\xff\xff\xff". "\xff\xf8\x00\x01\x7f\xff\xff\xff\xff\xf8ww\xff\xff\xff\xff\xff\xf8\x00\x01". "\x7f\xff\xff\xff\xff\xffwx\xff\xff\xff\xff\xff\xf8\x00\x01\x7f\xff\xff\xff". "\xff\xff\x87\x7f\xff\xff\xffp\x00\x00\x00\x01\x7f\xff\xff\xff\xff\xff\xf7\x8f". "\xff\xff\xff\x7f\xf8p\xd0\x01\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f". "\x87\x0d\xd0\x01\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xffxp\xdd\xd0\x01". "\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xffw\x0d\xdd\xd0\x01\x7f\xff\xff\xff". "\xff\xff\xff\xff\xff\xff\xffw\xdd\xdd\xd0\x01wwwwwwww". "www}\xdd\xdd\xd0\x01". ''), autoHScroll => 0, autoVScroll => 0, size => [ 29, 24], }}, 'Radio2' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 181, 12], name => 'Radio2', owner => 'Orientation', size => [ 100, 36], text => '~Landscape', }}, 'Color' => { class => 'Prima::RadioGroup', module => 'Prima::Buttons', profile => { origin => [ 19, 20], name => 'Color', size => [ 287, 76], owner => 'TabbedNotebook1', growMode => gm::GrowHiX, text => 'Color appearance', }}, 'ImageViewer3' => { class => 'Prima::ImageViewer', module => 'Prima::ImageViewer', profile => { origin => [ 11, 18], onCreate => Prima::VB::VBLoader::GO_SUB('$_[0]-> owner-> owner-> owner-> owner-> {imgConvProc}->($_[0]); ','ImageViewer3', 'onCreate'), name => 'ImageViewer3', owner => 'Color', image => Prima::Image->create( width=>26, height=>32, type => im::bpp4, palette => [ 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,128,0,128,128,128,192,192,192,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255], data => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00x\x88\x88\x88". "\x88\x88\x88\x88\x88\x88\x88\x88\x80\x00\x00\x00\x7f\xff\xff\xff\xff\xff\xff\xff". "\xff\xff\xff\xff\x80\x00\x00\x00\x7f\xf8\x88\x88\x88\x8f\xff\x00\x00\x00\x00\xff". "\x80\x00\x00\x00\x7f\x88\x88\x88\x88\x88\xf0\x00\x00\x00\x00\x0f\x80\x00\x00\x00". "\x7f\x88\x88\x88\x88\x88\xf0\x00\x00\x00\x00\x0f\x80\x00\x00\x00\x7f\x88\x88\x88". "\x88\x88\xf0\x00\x00\x00\x00\x0f\x80\x00\x00\x00\x7f\x88\x88\x88\x88\x88\xf0\x00". "\x00\x00\x00\x0f\x80\x00\x00\x00\x7f\xf8\x88\x88\x88\x8f\xff\x00\x00\x00\x00\xff". "\x80\x00\x00\x00\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x00\x00". "\x7f\xf7www\x7f\xffxxxx\xff\x80\x00\x00\x00\x7fwww". "ww\xf7\x87\x87\x87\x87\x8f\x80\x00\x00\x00\x7fwwwww\xf8x". "xxx\x7f\x80\x00\x00\x00\x7fwwwww\xf7\x87\x87\x87\x87\x8f". "\x80\x00\x00\x00\x7fwwwww\xf8xxxx\x7f\x80\x00\x00\x00". "\x7f\xf7www\x7f\xff\x87\x87\x87\x87\xff\x80\x00\x00\x00\x7f\xff\xff\xff". "\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x00\x00\x7f\xff\x8f\x8f\x8f\x8f\xffp". "ppp\xff\x80\x00\x00\x00\x7f\xf8\xf8\xf8\xf8\xf8\xf7\x07\x07\x07\x07\x0f". "\x80\x00\x00\x00\x7f\x8f\x8f\x8f\x8f\x8f\xf0pppp\x7f\x80\x00\x00\x00". "\x7f\xf8\xf8\xf8\xf8\xf8\xf7\x07\x07\x07\x07\x0f\x80\x00\x00\x00\x7f\x8f\x8f\x8f". "\x8f\x8f\xf0pppp\x7f\x80\x00\x00\x00\x7f\xf8\xf8\xf8\xf8\xff\xff\x07". "\x07\x07\x07\xff\x80\x00\x00\x00\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". "\x80\x00\x00\x00\x7f\xf7www\x7f\xff\x0f\x0f\x0f\x0f\xff\x80\x00\x00\x00". "\x7fwwwww\xf0\xf0\xf0\xf7\x00\x00\x00\x00\x00\x00\x7fwww". "ww\xff\x0f\x0f\x07\xff\xf7\x0d\x00\x00\x00\x7fwwwww\xf0\xf0". "\xf0\xf7\xffp\xdd\x00\x00\x00\x7fwwwww\xff\x0f\x0f\x07\xf7\x0d". "\xdd\x00\x00\x00\x7f\xf7www\x7f\xff\xf0\xf0\xf7p\xdd\xdd\x00\x00\x00". "\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xf7\x0d\xdd\xdd\x00\x00\x00wwww". "wwwwww\xdd\xdd\xdd\x00\x00\x00". ''), autoHScroll => 0, autoVScroll => 0, size => [ 26, 32], onMouseClick => Prima::VB::VBLoader::GO_SUB('my ($self, $btn, $mod, $x, $y, $dblclk) = @_; ','ImageViewer3', 'onMouseClick'), }}, 'ImageViewer4' => { class => 'Prima::ImageViewer', module => 'Prima::ImageViewer', profile => { origin => [ 141, 18], onCreate => Prima::VB::VBLoader::GO_SUB('$_[0]-> owner-> owner-> owner-> owner-> {imgConvProc}->($_[0]); ','ImageViewer4', 'onCreate'), name => 'ImageViewer4', owner => 'Color', image => Prima::Image->create( width=>26, height=>32, type => im::bpp4, palette => [ 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,128,0,128,128,128,192,192,192,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255], data => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00x\x88\x88\x88". "\x88\x88\x88\x88\x88\x88\x88\x88\x80\x00\x00\x00\x7f\xff\xff\xff\xff\xff\xff\xff". "\xff\xff\xff\xff\x80\x00\x80\@\x7f\xfe\xee\xee\xee\xef\xff\x11\x11\x11\x11\xff". "\x80\x00\x00\x00\x7f\xee\xee\xee\xee\xee\xf1\x11\x11\x11\x11\x1f\x80\x00\x00\x00". "\x7f\xee\xee\xee\xee\xee\xf1\x11\x11\x11\x11\x1f\x80\x00\x80\@\x7f\xee\xee\xee". "\xee\xee\xf1\x11\x11\x11\x11\x1f\x80\x00\x00\x00\x7f\xee\xee\xee\xee\xee\xf1\x11". "\x11\x11\x11\x1f\x80\x00\x00\x00\x7f\xfe\xee\xee\xee\xef\xff\x11\x11\x11\x11\xff". "\x80\x00\x80\@\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x00\x00". "\x7f\xf5UUU_\xff\xaa\xaa\xaa\xaa\xff\x80\x00\x00\x00\x7fUUU". "UU\xfa\xaa\xaa\xaa\xaa\xaf\x80\x00\x80\@\x7fUUUUU\xfa\xaa". "\xaa\xaa\xaa\xaf\x80\x00\x00\x00\x7fUUUUU\xfa\xaa\xaa\xaa\xaa\xaf". "\x80\x00\x00\x00\x7fUUUUU\xfa\xaa\xaa\xaa\xaa\xaf\x80\x00\x80\@". "\x7f\xf5UUU_\xff\xaa\xaa\xaa\xaa\xff\x80\x00\x00\x00\x7f\xff\xff\xff". "\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x00\x00\x7f\xfb\xbb\xbb\xbb\xbf\xff\xcc". "\xcc\xcc\xcc\xff\x80\x00\x80\@\x7f\xbb\xbb\xbb\xbb\xbb\xfc\xcc\xcc\xcc\xcc\xcf". "\x80\x00\x00\x00\x7f\xbb\xbb\xbb\xbb\xbb\xfc\xcc\xcc\xcc\xcc\xcf\x80\x00\x00\x00". "\x7f\xbb\xbb\xbb\xbb\xbb\xfc\xcc\xcc\xcc\xcc\xcf\x80\x00\x80\@\x7f\xbb\xbb\xbb". "\xbb\xbb\xfc\xcc\xcc\xcc\xcc\xcf\x80\x00\x00\x00\x7f\xfb\xbb\xbb\xbb\xbf\xff\xcc". "\xcc\xcc\xcc\xff\x80\x00\x00\x00\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". "\x80\x00\@\@\x7f\xf9\x99\x99\x99\x9f\xff3333\xff\x80\x00\x00\x00". "\x7f\x99\x99\x99\x99\x99\xf3337\x00\x00\x00\x00\x00\x00\x7f\x99\x99\x99". "\x99\x99\xf3337\xff\xf7\x0d\x00\xe0\@\x7f\x99\x99\x99\x99\x99\xf33". "37\xffp\xdd\x00\x00\x00\x7f\x99\x99\x99\x99\x99\xf3337\xf7\x0d". "\xdd\x00\x00\x00\x7f\xf9\x99\x99\x99\x9f\xff337p\xdd\xdd\x00\x80\@". "\x7f\xff\xff\xff\xff\xff\xff\xff\xff\xf7\x0d\xdd\xdd\x00\x00\x00wwww". "wwwwww\xdd\xdd\xdd\x00\x00\x00". ''), autoHScroll => 0, autoVScroll => 0, size => [ 26, 32], }}, 'Radio3' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 47, 12], name => 'Radio3', owner => 'Color', size => [ 89, 36], text => '~Gray', }}, 'Radio4' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 180, 12], name => 'Radio4', owner => 'Color', size => [ 100, 36], text => 'C~olor', }}, 'VList' => { class => 'Prima::DetailedList', module => 'Prima::DetailedList', profile => { columns => 2, onCreate => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> widths([($self->width / 2 ) x 2]); $self-> {helpData} = { UseDeviceFonts => < < < < < < < < < < < < <{helpData}->{$_} =~ s/\\n/ /g for keys %{$self->{helpData}}; ','VList', 'onCreate'), name => 'VList', items => [['UseDeviceFonts', ' ', '1', '1', ],['UseDeviceFontsOnly', ' ', '1', '0', ],['MediaType', ' ', '0', ' ', ],['MediaColor', ' ', '0', ' ', ],['MediaWeight', ' ', '0', ' ', ],['MediaClass', ' ', '0', ' ', ],['InsertSheet', ' ', '1', '0', ],['LeadingEdge', ' ', '2', '0', ],['ManualFeed', ' ', '1', '0', ],['TraySwitch', ' ', '1', '0', ],['MediaPosition', ' ', '0', ' ', ],['DeferredMediaSelection', ' ', '1', '0', ],['MatchAll', ' ', '1', '0', ],], dragable => 0, growMode => gm::GrowHiX | gm::GrowLoY, scalable => 1, origin => [ 13, 89], clickable => 0, owner => 'TabbedNotebook1', size => [ 299, 188], headers => ['Item', 'Setting', ], onSelectItem => Prima::VB::VBLoader::GO_SUB('my ( $self, $index, $selectState) = @_; my @i = @{$self-> get_items( $$index[0])}; my $vbox = $self-> owner-> ValueBox; $vbox-> text( "Change \'$i[0]\' setting"); if ( $vbox-> ValueBook-> pageIndex == 3) { $vbox-> ValueBook-> lock; $self-> owner-> HelpBtn-> notify(q(Click)); $self-> owner-> HelpBtn-> notify(q(Click)); $vbox-> ValueBook-> unlock; return; } $vbox-> ValueBook-> pageIndex( $i[2]); my @vdt = qw(VText VBool VCombo); my @vdv = qw(text checked focusedItem); $vbox-> ValueBook-> bring($vdt[$i[2]])-> set( $vdv[$i[2]] => $i[3]); ','VList', 'onSelectItem'), }}, 'ValueBox' => { class => 'Prima::GroupBox', module => 'Prima::Buttons', profile => { origin => [ 15, 14], name => 'ValueBox', size => [ 266, 66], owner => 'TabbedNotebook1', growMode => gm::GrowHiX | gm::GrowHiY, text => '', }}, 'ValueBook' => { class => 'Prima::Notebook', module => 'Prima::Notebooks', extras => { VBool => '1', VCombo => '2', VHint => '3', VText => '0', }, actions => { onChild => Prima::VB::VBLoader::GO_SUB('$_[2]-> defaultInsertPage( $_[1]-> {extras}-> {$_[3]}) ','ValueBook', 'onChild'), }, profile => { origin => [ 2, 3], name => 'ValueBook', size => [ 260, 47], owner => 'ValueBox', growMode => gm::GrowHiX | gm::GrowHiY, pageIndex => 4, pageCount => 5, }}, 'HelpBtn' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 286, 52], name => 'HelpBtn', size => [ 20, 20], owner => 'TabbedNotebook1', onClick => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; my $x = $self-> owner-> ValueBox-> ValueBook; if ( $x-> pageIndex == 3) { $x-> pageIndex( $self-> {opa}); } else { my $y = $self-> owner-> VList; my $i = $y-> get_items( $y-> focusedItem); $self-> {opa} = $x-> pageIndex; if ( exists $y-> {helpData}-> {$$i[0]}) { $x-> VHint-> text( $y-> {helpData}-> {$$i[0]}); $x-> pageIndex( 3); } } ','HelpBtn', 'onClick'), growMode => gm::GrowLoX, text => '?', font => {style => fs::Bold, }, }}, 'VText' => { class => 'Prima::InputLine', module => 'Prima::InputLine', profile => { origin => [ 9, 15], name => 'VText', owner => 'ValueBook', onChange => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; my $x = $self-> owner-> owner-> owner-> VList; my $i = $x-> get_items( $x-> focusedItem); my $t = $self-> text; if ( $i-> [0] eq \'MediaPosition\' || $i-> [0] eq \'MediaWeight\' ) { $t =~ s/^\\s*//; $t =~ s/\\s*$//; if ( length $t) { if ( $i-> [0] eq \'MediaWeight\') { return unless $t =~ m/^\\s*([+-]?)(?=\\d|\\.\\d)\\d*(\\.\\d*)?([Ee]([+-]?\\d+))?\\s*$/; } else { return unless $t =~ m/^\\d+$/; } } } $i-> [1] = $i-> [3] = $t; $x-> redraw_items( $x-> focusedItem); ','VText', 'onChange'), size => [ 240, 20], text => '', growMode => gm::Client, }}, 'VCombo' => { class => 'Prima::ComboBox', module => 'Prima::ComboBox', profile => { origin => [ 13, 14], style => cs::DropDownList, name => 'VCombo', items => ['None', 'Short edge, top of page', 'Long edge, right side of page', 'Short edge, bottom of page', 'Long edge, left side of page', ], owner => 'ValueBook', onChange => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; my $x = $self-> owner-> owner-> owner-> VList; my $i = $x-> get_items( $x-> focusedItem); $i->[1] = $self-> text; $i-> [3] = $self-> focusedItem; $x-> redraw_items( $x-> focusedItem); ','VCombo', 'onChange'), size => [ 233, 23], growMode => gm::Client, }}, 'VBool' => { class => 'Prima::CheckBox', module => 'Prima::Buttons', profile => { origin => [ 10, 8], name => 'VBool', owner => 'ValueBook', onCheck => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; my $x = $self-> owner-> owner-> owner-> VList; my $i = $x-> get_items( $x-> focusedItem); $i-> [3] = $self-> checked; $i->[1] = $i-> [3] ? \'Yes\' : \'No\'; $x-> redraw_items( $x-> focusedItem); ','VBool', 'onCheck'), size => [ 100, 36], growMode => gm::Client, text => '', }}, 'VHint' => { class => 'Prima::Edit', module => 'Prima::Edit', profile => { origin => [ 0, 0], backColor => wc::Dialog | cl::Back, name => 'VHint', owner => 'ValueBook', size => [ 260, 47], text => '', growMode => gm::Client, vScroll => 1, readOnly => 1, wordWrap => 1, }}, 'LPRadio' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 14, 148], name => 'LPRadio', onCreate => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> enabled( 0) if Prima::Application-> get_system_info->{apc} != apc::Unix; ','LPRadio', 'onCreate'), size => [ 272, 36], owner => 'Spool', growMode => gm::GrowHiX, text => 'Unix ~line printer (LP)', }}, 'Spool' => { class => 'Prima::RadioGroup', module => 'Prima::Buttons', profile => { origin => [ 16, 16], name => 'Spool', owner => 'TabbedNotebook1', size => [ 293, 208], growMode => gm::GrowHiX, text => 'Output', }}, 'Profiles' => { class => 'Prima::ListBox', module => 'Prima::Lists', profile => { origin => [ 15, 16], name => 'Profiles', size => [ 193, 259], owner => 'TabbedNotebook1', growMode => gm::GrowHiX | gm::GrowHiY, }}, 'LPLabel' => { class => 'Prima::Label', module => 'Prima::Label', siblings => [qw(focusLink)], profile => { origin => [ 14, 121], onCreate => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> enabled( 0) if Prima::Application-> get_system_info->{apc} != apc::Unix; ','LPLabel', 'onCreate'), name => 'LPLabel', owner => 'Spool', size => [ 74, 20], text => '~Parameters', }}, 'LParams' => { class => 'Prima::InputLine', module => 'Prima::InputLine', profile => { origin => [ 92, 122], name => 'LParams', onCreate => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> enabled( 0) if Prima::Application-> get_system_info->{apc} != apc::Unix; ','LParams', 'onCreate'), size => [ 186, 20], owner => 'Spool', growMode => gm::GrowHiX, text => '', }}, 'AddBtn' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 213, 240], name => 'AddBtn', owner => 'TabbedNotebook1', size => [ 96, 36], growMode => gm::GrowLoX | gm::GrowLoY, text => '~Add', }}, 'DelBtn' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 213, 161], name => 'DelBtn', size => [ 96, 36], owner => 'TabbedNotebook1', growMode => gm::GrowLoX | gm::GrowLoY, text => '~Remove', }}, 'Radio6' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 14, 79], name => 'Radio6', size => [ 272, 36], owner => 'Spool', growMode => gm::GrowHiX, text => '~File', }}, 'Radio7' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 14, 41], name => 'Radio7', size => [ 272, 36], owner => 'Spool', growMode => gm::GrowHiX, text => '~Command', }}, 'SaveBtn' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 214, 120], name => 'SaveBtn', owner => 'TabbedNotebook1', size => [ 96, 36], growMode => gm::GrowLoX | gm::GrowLoY, text => '~Save', }}, 'ImportBtn' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 214, 81], name => 'ImportBtn', onCreate => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> enabled( 0) if Prima::Application-> get_system_info->{apc} != apc::Unix; ','ImportBtn', 'onCreate'), size => [ 96, 36], owner => 'TabbedNotebook1', growMode => gm::GrowLoX | gm::GrowLoY, text => '~Import...', }}, 'RenameBtn' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 213, 200], name => 'RenameBtn', owner => 'TabbedNotebook1', size => [ 96, 36], growMode => gm::GrowLoX | gm::GrowLoY, text => 'Re~name', }}, 'CmdLine' => { class => 'Prima::InputLine', module => 'Prima::InputLine', profile => { origin => [ 37, 18], name => 'CmdLine', size => [ 241, 20], owner => 'Spool', growMode => gm::GrowHiX, text => '', }}, 'OK' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 5, 5], name => 'OK', owner => 'Form1', size => [ 96, 36], text => '~OK', default => 1, }}, 'Cancel' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 110, 5], name => 'Cancel', owner => 'Form1', onClick => Prima::VB::VBLoader::GO_SUB('my $self = $_[0]; $self-> owner-> cancel; ','Cancel', 'onClick'), size => [ 96, 36], text => 'Cancel', }}, ); } Prima-1.28/Prima/PS/locale/0000755000175100017510000000000011150770061013123 5ustar dkdkPrima-1.28/Prima/PS/locale/win-cp12500000644000175100017510000000344411150770061014560 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef quotesinglbase .notdef quotedblbase ellipsis dagger daggerdbl .notdef perthousand Scaron guilsinglleft Sacute Tcaron Zcaron Zacute .notdef quoteleft quoteright quotedblleft quotedblright bullet endash emdash .notdef trademark scaron guilsinglright sacute tcaron zcaron zacute .notdef .notdef caron breve Lslash currency Aogonek brokenbar section dieresis copyright Scedilla guillemotleft logicalnot hyphen registered Zdotaccent degree plusminus ogonek lslash acute mu paragraph periodcentered cedilla aogonek scedilla gullemotright Lcaron hungarumlaut lcaron zdotaccent Racute Aacute Acircumflex Abreve Adieresis Lacute Cacute Ccedilla Ccaron Eacute Eogonek Edieresis Ecaron Iacute Icircumflex Dcaron Dcroat Nacute Ncaron Oacute Ocircumflex Ohungarumlaut Odieresis multiply Rcaron Uring Uacute Uhungarumlaut Udieresis Yacute Tcedilla germandbls racute aacute acircumflex abreve adieresis lacute cacute ccedilla ccaron eacute eogonek edieresis ecaron iacute icircumflex dcaron dcroat nacute ncaron oacute ocircumflex ohungarumlaut odieresis divide rcaron uring uacute uhungarumlaut udieresis yacute tcedilla dotaccent Prima-1.28/Prima/PS/locale/ibm-cp8500000644000175100017510000000333211150770061014453 0ustar dkdk.notdef .notdef .notdef heart diamond club spade .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef paragraph section .notdef .notdef arrowup arrowdown .notdef .notdef .notdef arrowboth .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore acute a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright tilde .notdef Ccedilla udieresis eacute acircumflex adieresis agrave aring ccedilla ecircumflex edieresis egrave idieresis icircumflex igrave Adieresis Aring Eacute ae AE ocircumflex odieresis ograve ucircumflex ugrave ydieresis Odieresis Udieresis cent sterling yen .notdef florin aacute iacute oacute uacute ntilde Ntilde ordfeminine degree questiondown .notdef logicalnot onehalf onequarter exclamdown guillemotleft guillemotright .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef alpha germandbls Gamma pi Sigma sigma mu tau phi theta Omega delta infinity oslash epsilon intersection equivalence plusminus greaterequal lessequal integraltp integralbt divide approxequal degree dotaccent dotaccent radical .notdef twosuperior .notdef .notdef Prima-1.28/Prima/PS/locale/ibm-cp4370000644000175100017510000000367711150770061014470 0ustar dkdknull Wsmiley Bsmiley heart diamond club spade Bbullet Wbullet Bcircle Wcircle male female quarternote sixteenthnote sun pointerright pointerleft Varrowboth exclamdbl paragraph section cursorblock floor arrowup arrowdown arrowright arrowleft smallLLsingle arrowboth pointerup pointerdown blank exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore acute a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft brokenbar braceright asciitilde Delta Ccedilla udieresis eacute acircumflex adieresis agrave aring ccedilla ecircumflex edieresis egrave idieresis icircumflex igrave Adieresis Aring Eacute ae AE ocircumflex odieresis ograve ucircumflex ugrave ydieresis Odieresis Udieresis cent sterling yen point integral aacute iacute oacute uacute ntilde Ntilde aunder ounder questiondown smallULsingle smallURsingle half quarter exclamdown lessdbl greaterdbl lightbox mediumbox darkbox Vsingle VsingleTleftsingle VsingleTleftdbl VdblTleftsingle VdblURsingle VsingleURdbl VdblTleftdbl Vdbl VdblURdbl VdblLRdbl VdblLRsingle VsingleLRdbl VsingleURsingle VsingleLLsingle HsingleTupsingle HsingleTdownsingle VsingleTrightsingle Hsingle VsingleXsingle VsingleTrightdbl VdblTrightsingle VdblLLdbl VdblULdbl HdblTupdbl HdblTdowndbl VdblTrightdbl Hdbl VdblXdbl HdblTupsingle HsingleTupdbl HdblTdownsingle HsingleTdowndbl VdblLLsingle VsingleLLdbl VsingleULdbl VdblULsingle VdblXsingle VsingleXdbl VsingleLRsingle VsingleULsingle allblack botblack leftblack rightblack topblack alpha beta Gamma pi Sigma sigma mu tau Phi theta Omega delta infinity phi element intersection equivalence plusminus greaterequal lessequal integraltp integralbt divide approxequal degree bullet dotmath radical eta squared block blank Prima-1.28/Prima/PS/locale/ps-iso-latin10000644000175100017510000000337711150770061015460 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore quoteleft a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef dotlessi grave acute circumflex tilde macron breve dotaccent dieresis .notdef ring cedilla .notdef hungarumlaut ogonek caron .notdef exclamdown cent sterling currency yen brokenbar section dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered macron degree plusminus twosuperior threesuperior acute mu paragraph periodcentered cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls agrave aacute acircumflex atilde adieresis aring ae ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis eth ntilde ograve oacute ocircumflex otilde odieresis divide oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis Prima-1.28/Prima/PS/locale/iso8859-10000644000175100017510000000337411150770061014343 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclamdown cent sterling currency yen brokenbar section dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered macron degree plusminus twosuperior threesuperior acute mu paragraph periodcentered cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls agrave aacute acircumflex atilde adieresis aring ae ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis eth ntilde ograve oacute ocircumflex otilde odieresis divide oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis Prima-1.28/Prima/PS/locale/iso8859-70000644000175100017510000000330611150770061014344 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef quoteleft quoteright sterling currency yen brokenbar section dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered afii00208 degree plusminus twosuperior threesuperior tonos dieresistonos Alphatonos periodcentered Epsilontonos Etatonos Iotatonos guillemotright Omicrontonos onehalf Upsilontonos Omegatonos iotadieresistonos Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa Lambda Mu Nu Xi Omicron Pi Rho Ograve Sigma Tau Upsilon Phi Chi Psi Omega Iotadieresis Upsilondieresis alphatonos epsilontonos etatonos iotatonos upsilondieresistonos alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi omicron pi rho sigma1 sigma tau upsilon phi chi psi omega iotadieresis upsilondieresis omicrontonos upsilontonos omegatonos ydieresis Prima-1.28/Prima/PS/locale/iso8859-30000644000175100017510000000343611150770061014344 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef Hbar breve sterling currency yen Hcircumflex section dieresis Idotaccent Scedilla Gbreve Jcircumflex hyphen registered Zdotaccent degree hbar twosuperior threesuperior acute mu hcircumflex periodcentered cedilla dotlessi scedilla gbreve jcircumflex onehalf threequarters zdotaccent Agrave Aacute Acircumflex Atilde Adieresis Cdotaccent Ccircumflex Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve Oacute Ocircumflex Gdotaccent Odieresis multiply Gcircumflex Ugrave Uacute Ucircumflex Udieresis Ubreve Scircumflex germandbls agrave aacute acircumflex atilde adieresis cdotaccent ccircumflex ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis eth ntilde ograve oacute ocircumflex gdotaccent odieresis divide gcircumflex ugrave uacute ucircumflex udieresis ubreve scircumflex dotaccent Prima-1.28/Prima/PS/locale/iso8859-150000644000175100017510000000334411150770061014425 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef exclamdown cent sterling Euro yen Scaron section scaron copyright ordfeminine guillemotleft logicalnot hyphen registered macron degree plusminus twosuperior threesuperior Zcaron mu paragraph periodcentered zcaron onesuperior ordmasculine guillemotright OE oe Ydieresis questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls agrave aacute acircumflex atilde adieresis aring ae ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis eth ntilde ograve oacute ocircumflex otilde odieresis divide oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis Prima-1.28/Prima/PS/locale/iso8859-130000644000175100017510000000340111150770061014415 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef quotedblright cent sterling currency quotedblbase brokenbar section Oslash copyright rcedilla guillemotleft logicalnot hyphen registered AE degree plusminus twosuperior threesuperior quotedblleft mu paragraph periodcentered oslash onesuperior .notdef guillemotright onequarter onehalf threequarters ae Aogonek Iogonek Amacron Cacute Adieresis Aring Eogonek Emacron Ccaron Eacute Zacute Edotaccent Gcedilla Kcedilla Imacron Lcedilla Scaron Nacute Ncedilla Oacute Omacron Otilde Odieresis multiply Uogonek Lslash Uacute Ucircumflex Udieresis Zdotaccent Zcaron germandbls aogonek Iogonek amacron cacute adieresis aring eogonek emacron ccaron eacute zacute edotaccent gcedilla kcedilla imacron lcedilla scaron nacute ncedilla oacute omacron otilde odieresis divide uogonek lslash uacute ucircumflex udieresis zdotaccent zcaron quoteright Prima-1.28/Prima/PS/locale/ascii0000644000175100017510000000326211150770061014141 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore acute a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright tilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef Prima-1.28/Prima/PS/locale/win-cp12520000644000175100017510000000344011150770061014556 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef quotesinglbase florin quotedblbase ellipsis dagger daggerdbl circumflex perthousand Scaron guilsinglleft OE .notdef .notdef .notdef .notdef quoteleft quoteright quotedblleft quotedblright bullet endash emdash tilde trademark scaron guilsinglright oe .notdef .notdef Ydieresis space exclamdown cent sterling currency yen brokenbar section dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered macron degree plusminus twosuperior threesuperior acute mu paragraph periodcentered cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls agrave aacute acircumflex atilde adieresis aring ae ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis eth ntilde ograve oacute ocircumflex otilde odieresis divide oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis Prima-1.28/Prima/PS/locale/ps-standart0000644000175100017510000000334011150770061015306 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quoteright parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore quoteleft a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef exclamdown cent sterling slash yen florin section currency quotesingle quotedblleft guillemotleft guilsingleft guilsingright fi fl .notdef hyphen dagger daggerdbl periodcentered .notdef paragraph bullet quotesinglbase quotedblbase quotedblright guillemotright ellipsis perthousand .notdef questiondown .notdef grave acute circumflex tilde macron breve dotaccent dieresis .notdef ring cedilla .notdef hungarumlaut ogonek caron emdash .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef AE .notdef ordfeminine .notdef .notdef .notdef .notdef Lslash Oslash OE ordmasculine .notdef .notdef .notdef .notdef .notdef ae .notdef .notdef .notdef dotlessi .notdef .notdef lslash oslash oe germandbls .notdef .notdef .notdef .notdef Prima-1.28/Prima/PS/locale/iso8859-140000644000175100017510000000336111150770061014423 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef uni1E02 uni1E03 sterling Cdotaccent cdotaccent uni1E0A section Wgrave copyright Wacute uni1E0B Ygrave hyphen registered Ydieresis uni1E1E uni1E1F Gdotaccent gdotaccent uni1E40 uni1E41 paragraph uni1E56 wgrave uni1E57 wacute uni1E60 ygrave Wdieresis wdieresis uni1E61 Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Wcircumflex Ntilde Ograve Oacute Ocircumflex Otilde Odieresis uni1E6A Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Ycircumflex germandbls agrave aacute acircumflex atilde adieresis aring ae ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis wcircumflex ntilde ograve oacute ocircumflex otilde odieresis uni1E6B oslash ugrave uacute ucircumflex udieresis yacute ycircumflex ydieresis Prima-1.28/Prima/PS/locale/iso8859-100000644000175100017510000000327111150770061014417 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef Aogonek Emacron Gcedilla Imacron Itilde Kcedilla section Lcedilla Dcroat Scaron Tbar Zcaron hyphen Umacron Eng degree aogonek emacron gcedilla imacron itilde kcedilla periodcentered lcedilla dcroat scaron tbar zcaron macron umacron eng Amacron Aacute Acircumflex Atilde Adieresis Aring AE Iogonek Ccaron Eacute Eogonek Edieresis Emacron Iacute Icircumflex Idieresis Eth Ncedilla Omacron Oacute Ocircumflex Otilde Odieresis Utilde Oslash Uogonek Uacute Ucircumflex Udieresis Yacute Thorn germandbls amacron aacute acircumflex atilde adieresis aring ae iogonek ccaron eacute eogonek edieresis emacron iacute icircumflex idieresis eth ncedilla omacron oacute ocircumflex otilde odieresis utilde oslash uogonek uacute ucircumflex udieresis yacute thorn kgreenlandic Prima-1.28/Prima/PS/locale/iso8859-20000644000175100017510000000332211150770061014335 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef Aogonek breve Lslash currency Lcaron Sacute section dieresis Scaron Scedilla Tcaron Zacute hyphen Zcaron Zdotaccent degree aogonek ogonek lslash acute lcaron sacute caron cedilla scaron scedilla tcaron zacute hungarumlaut zcaron zdotaccent Racute Aacute Acircumflex Abreve Adieresis Lacute Cacute Ccedilla Ccaron Eacute Eogonek Edieresis Ecaron Iacute Icircumflex Dcaron Dcroat Nacute Ncaron Oacute Ocircumflex Ohungarumlaut Odieresis multiply Rcaron Uring Uacute Uhungarumlaut Udieresis Yacute Tcedilla germandbls racute aacute acircumflex abreve adieresis lacute cacute ccedilla ccaron eacute eogonek edieresis ecaron iacute icircumflex dcaron dcroat nacute ncaron oacute ocircumflex ohungarumlaut odieresis divide rcaron uring uacute uhungarumlaut udieresis yacute tcedilla dotaccent Prima-1.28/Prima/PS/locale/iso8859-90000644000175100017510000000342011150770061014343 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef exclamdown cent sterling currency yen brokenbar section dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered macron degree plusminus twosuperior threesuperior acute mu paragraph periodcentered cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Gbreve Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply Oslash Ugrave Uacute Ucircumflex Udieresis Idotaccent Scedilla germandbls agrave aacute acircumflex atilde adieresis aring ae ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis gbreve ntilde ograve oacute ocircumflex otilde odieresis divide oslash ugrave uacute ucircumflex udieresis dotlessi scedilla ydieresis Prima-1.28/Prima/PS/locale/iso8859-40000644000175100017510000000330511150770061014340 0ustar dkdk.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space exclam quotedbl numbersign dollar percent ampersand quotesingle parenleft parenright asterisk plus comma minus period slash zero one two three four five six seven eight nine colon semicolon less equal greater question at A B C D E F G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar braceright asciitilde .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef Aogonek kgreenlandic Rcedilla currency Itilde Lcedilla section dieresis Scaron Emacron Gcedilla Tbar hyphen Zcaron macron degree aogonek ogonek rcedilla acute itilde lcedilla caron cedilla scaron emacron gcedilla tbar Eng zcaron eng Amacron Aacute Acircumflex Atilde Adieresis Aring AE Iogonek Ccaron Eacute Eogonek Edieresis Edotaccent Iacute Icircumflex Imacron Dcroat Ncedilla Omacron Kcedilla Ocircumflex Otilde Odieresis multiply Oslash Uogonek Uacute Ucircumflex Udieresis Utilde Umacron germandbls amacron aacute acircumflex atilde adieresis aring ae iogonek ccaron eacute eogonek edieresis edotaccent iacute icircumflex imacron dcroat ncedilla omacron kcedilla ocircumflex otilde odieresis divide oslash uogonek uacute ucircumflex udieresis utilde umacron dotaccent Prima-1.28/Prima/PS/Setup.pm0000644000175100017510000002354411150770061013332 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # $Id: Setup.pm,v 1.12 2008/04/09 20:10:14 dk Exp $ # # Setup dialog management use strict; package Prima::PS::Printer; sub sdlg_export { my ( $self, $p) = @_; my $d = $self-> {setupDlg}-> TabbedNotebook1-> Notebook; my $i = $d-> VList-> items; my $a = 0; my %hk = map { $$_[0] => $a++ } @$i; $p-> {color} = $d-> Color-> index ? 1 : 0; $p-> {portrait} = $d-> Orientation-> index ? 0 : 1; $p-> {scaling} = $d-> Scaling-> value / 100; $p-> {resolution} = $d-> Resolution-> value; $p-> {copies} = $d-> CopyCount-> text; $p-> {page} = $d-> PaperSize-> text; $p-> {devParms} = { map { my $j = $i-> [ $hk{ $_}]; @$j[0,3] } keys %{$self-> {data}-> {devParms}}}; $p-> {useDeviceFontsOnly} = $i-> [ $hk{UseDeviceFontsOnly}]-> [3]; $p-> {useDeviceFonts} = $i-> [ $hk{UseDeviceFonts}]-> [3]; $p-> {useDeviceFonts} = 1 if $p-> {useDeviceFontsOnly}; $p-> {spoolerType} = $d-> Spool-> index; $p-> {spoolerData} = $d-> Spool-> bring(( $p-> {spoolerType} == lpr) ? 'LParams' : 'CmdLine')-> text; } sub sdlg_import { my ( $self, $p) = @_; my $d = $self-> {setupDlg}-> TabbedNotebook1-> Notebook; $d-> Color-> index( $p-> {color} ? 1 : 0); $d-> Orientation-> index( $p-> {portrait} ? 0 : 1); $d-> Scaling-> value( int( $p-> {scaling} * 100)); $d-> Resolution-> value( int( $p-> {resolution})); $d-> CopyCount-> value( int( $p-> {copies})); $d-> PaperSize-> text( $p-> {page}); my $i = $d-> VList-> items; my $a = 0; my %hk = map { $$_[0] => $a++ } @$i; for ( keys %{$p-> {devParms}}) { my $j = $i-> [ $hk{$_}]; $j-> [3] = $p-> {devParms}-> {$_}; } $i-> [ $hk{UseDeviceFontsOnly}]-> [3] = $p-> {useDeviceFontsOnly}; $i-> [ $hk{UseDeviceFonts}]-> [3] = $p-> {useDeviceFonts}; $i-> [ $hk{UseDeviceFonts}]-> [3] = 1 if $p-> {useDeviceFontsOnly}; for ( @$i) { if ( $$_[2] == 0) { $$_[1] = $$_[3]; } elsif ( $$_[2] == 1) { $$_[1] = $$_[3] ? 'Yes' : 'No'; } elsif ( $$_[2] == 2) { my $i = $d-> ValueBox-> ValueBook-> VCombo-> items; $$_[1] = $i-> [ $$_[3] ]; } } $p-> {spoolerType} = file if $p-> {spoolerType} == lpr && !$unix; my $sp = $d-> Spool; $sp-> index( $p-> {spoolerType}); $sp-> CmdLine-> text( ''); $sp-> LParams-> text( ''); $sp-> bring( ($p-> {spoolerType} == lpr) ? 'LParams' : 'CmdLine')-> text( $p-> {spoolerData}); } sub sdlg_exec { my $self = $_[0]; unless ( defined $self-> {setupDlg}) { eval "use Prima::VB::VBLoader"; die "$@\n" if $@; eval "use Prima::MsgBox"; die "$@\n" if $@; $self-> {setupDlg} = Prima::VBLoad( 'Prima::PS::setup.fm', 'Form1' => { visible => 0, centered => 1, designScale => [ 7, 16 ]}, 'PaperSize' => { items => [ sort keys %pageSizes ], }, 'OK' => { onClick => sub { my $t = $_[0]-> owner-> TabbedNotebook1-> Notebook; my $x = $t-> Profiles; my $i = $x-> get_items( $x-> focusedItem); $self-> sdlg_export( $self-> {vprinters}-> { $i}); if ( $i ne $self-> {current}) { return if Prima::MsgBox::message_box( $self-> {setupDlg}-> text, "Current settings do not belong to printer \'$self->{current}\'. Procced anyway?", mb::Warning|mb::OKCancel) != mb::OK; } unless ( exists $self-> {vprinters}-> {$self-> {current}}) { Prima::MsgBox::message_box( $self-> {setupDlg}-> text, "Printer profile \'$self->{current}\' is not present. Please create one", mb::Error|mb::OK); return; } RETRY_SAVE: if ( $self-> {bigChange}) { my $res = Prima::MsgBox::message_box( $self-> {setupDlg}-> text, "The printer profile configurations have been changed significantly. Would you like to save them?", mb::Warning|mb::YesNoCancel); if ( $res == mb::Yes) { $t-> SaveBtn-> notify(q(Click)); goto RETRY_SAVE; } elsif ( $res != mb::No) { return; } } $_[0]-> owner-> ok; } }, 'Profiles' => { onSelectItem => sub { my ( $me, $index, $state) = @_; $index = $$index[0]; if ( defined $self-> {lastFocItem}) { $self-> sdlg_export( $self-> {vprinters}-> { $me-> get_items( $self-> {lastFocItem}) } ); } $self-> sdlg_import( $self-> {vprinters}-> { $me-> get_items( $index)} ); $me-> owner-> VList-> notify(q(SelectItem), [ $me-> owner-> VList-> focusedItem], 1 ); $self-> {lastFocItem} = $index; }}, 'AddBtn' => { onClick => sub { my $x = $_[0]-> owner-> Profiles; my $n = 1; my $vp = $self-> {vprinters}; while ( 1) { last unless exists $vp-> {"New <$n>"}; $n++; } $n = "New <$n>"; $vp-> {$n} = deepcopy( $self-> {defaultData}); $x-> add_items( $n); $self-> {bigChange} = 1; }}, 'DelBtn' => { onClick => sub { my $x = $_[0]-> owner-> Profiles; my $f = $x-> focusedItem; my $i = $x-> get_items( $f); return if ( $i eq $self-> {current}) && ( Prima::MsgBox::message_box( $self-> {setupDlg}-> text, "This profile is for currently selected printer, and should not be deleted. Proceed anyway?", mb::Warning|mb::OKCancel) != mb::OK); if ( $x-> count == 1) { Prima::message("At least one printer profile should be always present."); return; } $x-> delete_items( $f); delete $self-> {vprinters}-> {$i}; $self-> {bigChange} = 1; $self-> {lastFocItem} = undef; $x-> focusedItem( $f ? $f - 1 : 0); }}, 'RenameBtn' => { onClick => sub { my $x = $_[0]-> owner-> Profiles; my $i = $x-> get_items( $x-> focusedItem); AGAIN: my $n = Prima::MsgBox::input_box( 'Rename printer profile', 'Enter new name:', $i ); return unless defined $n; if (( $n ne $i) && exists ( $self-> {vprinters}-> {$n})) { Prima::message( "Profile \'$n\' already exists"); goto AGAIN; } $self-> {vprinters}-> {$n} = $self-> {vprinters}-> {$i}; delete $self-> {vprinters}-> {$i}; my @i = @{$x-> items}; $i[$x-> focusedItem] = $n; $x-> items( \@i); $self-> {bigChange} = 1; }}, 'SaveBtn' => { onClick => sub { my $n = $self-> {resFile}; my $x = $_[0]-> owner-> Profiles; $self-> sdlg_export( $self-> {vprinters}-> { $x-> get_items( $x-> focusedItem)} ); unless ( -f $n) { my $x = $n; $x =~ s/[\\\/]?[^\\\/]+$//; unless ( -d $x) { eval "use File::Path"; die "$@\n" if $@; File::Path::mkpath( $x); } } SAVE: unless ( open F, "> $n") { goto SAVE if Prima::MsgBox::message_box( $self-> {setupDlg}-> text, "Error writing to '$n':$!", mb::Retry|mb::Cancel) == mb::Retry; return; } print F "# Prima toolkit postscript printer configuration file\n{\n"; for ( keys %{$self-> {vprinters}}) { my $z = $_; $z =~ s/(\\|\')/\\$1/g; print F "'$z' => {\n"; my $p = $self-> {vprinters}-> {$_}; for ( keys %$p) { next if $_ eq 'devParms'; $z = $$p{$_}; $z =~ s/(\\|\')/\\$1/g; print F "$_ => '$z',\n"; } print F "devParms => {\n"; $p = $p-> {devParms}; for ( keys %$p) { $z = $$p{$_}; $z =~ s/(\\|\')/\\$1/g; print F "\t$_ => '$z',\n"; } print F "}},\n"; } print F "}\n"; close F; $self-> {printers} = { map { $_ => deepcopy($self-> {vprinters}-> {$_}) } keys %{$self-> {vprinters}}}; $self-> {bigChange} = 0; }}, 'ImportBtn' => { onClick => sub { my $c = Prima::MsgBox::input_box( "Import printer resources", "Enter file name:", "/etc/printcap"); return unless defined $c; my @imported = $self-> import_printers( 'vprinters', $c); if ( @imported) { if ( defined $imported[0]) { $_[0]-> owner-> Profiles-> add_items( @imported); $self-> {bigChange} = 1; } else { Prima::message( "Error opening '$c':$!"); } } else { Prima::message("No importable resources found"); } }}, ); Prima::message("$@"), return unless $self-> {setupDlg}; unless ( $self-> {setupDlg}) { Prima::message( $@ ); return } $self-> {setupDlg}-> TabbedNotebook1-> Notebook-> VList-> focusedItem( 0); } my $d = $self-> {setupDlg}-> TabbedNotebook1-> Notebook; my $p = $self-> {data}; $self-> {bigChange} = 0; $d-> Profiles-> focusedItem( -1); $d-> Profiles-> items( [ keys %{$self-> {printers}}]); $self-> {vprinters} = { map { $_ => deepcopy($self-> {printers}-> {$_}) } keys %{$self-> {printers}}}; my $index = 0; for ( keys %{$self-> {printers}}) { last if $_ eq $self-> {current}; $index++; } $self-> {lastFocItem} = undef; $d-> Profiles-> focusedItem( $index); $self-> sdlg_import( $p); return if $self-> {setupDlg}-> execute != mb::OK; $p = {}; $self-> sdlg_export( $p); $self-> data( $p); } 1; Prima-1.28/Prima/PS/Fonts.pm0000644000175100017510000002741711150770061013326 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # $Id: Fonts.pm,v 1.11 2007/09/13 15:12:25 dk Exp $ # package Prima::PS::Fonts; use strict; use Prima; use Prima::Utils; use Prima::PS::Encodings; use vars qw(%files %enum_families $defaultFontName $variablePitchName $fixedPitchName $symbolFontName); my %cache; $defaultFontName = 'Helvetica'; $variablePitchName = 'Helvetica'; $fixedPitchName = 'Courier'; $symbolFontName = 'Symbol'; sub query_metrics { my $f = $_[0]; my ( $file, $name, $family); if ( exists $enum_families{$f}) { $family = $f; $f = $enum_families{$f}; } $name = $f; if ( exists $files{$f}) { $file = $files{ $f}; unless ( defined $family) { # pick up family for ( keys %enum_families) { $family = $_, last if $f =~ m[^$_]; } } $family = $defaultFontName unless defined $family; } else { $family = $defaultFontName; $name = $enum_families{$family}; $file = $files{ $name}; } return $cache{$file} if exists $cache{$file}; my $defFN = $files{ $defaultFontName}; my $fx = Prima::Utils::find_image( $file); unless ( $fx) { if ( $name eq $defaultFontName) { warn("Prima::PS::Fonts: can't load default font\n"); return undef; } else { warn("Broken Prima::PS::Fonts installation: $name not found\n"), return query_metrics( $defaultFontName) } } unless ( open F, $fx) { warn( "Prima::PS::Fonts: cannot open file: $fx\n") ; return undef if $f eq $defaultFontName; return query_metrics( $defaultFontName); } { local $/; my @ra; my $z = '@ra = ' . ; close F; eval($z); if ( $@ || scalar(@ra) < 2) { warn( "Prima::PS::Fonts: invalid file: $fx\n"); return undef if $name eq $defaultFontName; return query_metrics( $defaultFontName); } $ra[1]-> {docname} = $name; $ra[1]-> {name} = $name; $ra[1]-> {family} = $family; $ra[1]-> {charheight} = $ra[1]-> {height}; $cache{$file} = $ra[1]; } return $cache{$file}; } sub enum_fonts { my ( $family, $encoding) = @_; my @names; $family = undef if defined $family && !length $family; $encoding = undef if defined $encoding && !length $encoding; if ( defined $family) { return [] unless defined $enum_families{$family}; for ( keys %enum_families) { push @names, $_ if $_ eq $family; } } else { @names = keys %enum_families; } my @ret; for ( @names) { my %x = %{query_metrics( $_)}; $x{name} = $x{family}; delete $x{docname}; delete $x{chardata}; $_ = \%x; my $latin = exists( $Prima::PS::Encodings::files{$x{encoding}}); next if defined($encoding) && ( $latin ? ! exists $Prima::PS::Encodings::files{$encoding} : ($x{encoding} ne $encoding) ); if ( !defined $family && !defined $encoding) { $x{encodings} = $latin ? [ Prima::PS::Encodings::unique ] : [ $x{encoding} ]; } if ( defined $family && !defined $encoding && exists( $Prima::PS::Encodings::files{$x{encoding}}) ) { push @ret, map { my %n = %x; $n{encoding} = $_; \%n; } Prima::PS::Encodings::unique; } else { $_-> {encoding} = $encoding if defined( $encoding) && $latin; push @ret, $_; } } return \@ret; } sub enum_family { my $family = $_[0]; my @names; return unless defined $enum_families{$family}; for ( keys %files) { push @names, $_ if m/^$family/; } return @names; } sub font_pick { my ( $src, $dest, %options) = @_; my $bySize = exists( $src-> {size}) && !exists( $src-> {height}); $dest = Prima::Drawable-> font_match( $src, $dest, 0); $dest-> {encoding} = '' if ( ! exists ( $Prima::PS::Encodings::fontspecific{ $dest-> {encoding}}) && ! exists ( $Prima::PS::Encodings::files{ $dest-> {encoding}})); # find name my $m1 = query_metrics( $dest-> {name}); # find encoding if ( length $dest-> {encoding}) { if ( defined $dest-> {encoding}) { if ( exists ( $Prima::PS::Encodings::files{ $dest-> {encoding}} ) && ! exists ( $Prima::PS::Encodings::files{ $m1-> {encoding}})) { $m1 = query_metrics( $fixedPitchName); $dest-> {encoding} = $m1-> {encoding}; $dest-> {name} = $m1-> {name}; $dest-> {family} = $m1-> {family}; } elsif ( exists ( $Prima::PS::Encodings::fontspecific{ $dest-> {encoding}}) && ! exists ( $Prima::PS::Encodings::fontspecific{ $m1-> {encoding}}) ) { $m1 = query_metrics( $symbolFontName); $dest-> {encoding} = $m1-> {encoding}; $dest-> {name} = $m1-> {name}; $dest-> {family} = $m1-> {family}; } } } else { $dest-> {encoding} = $m1-> {encoding}; } # find pitch if ( $dest-> {pitch} != fp::Default && $dest-> {pitch} != $m1-> {pitch}) { if ( $dest-> {pitch} == fp::Variable) { $m1 = query_metrics( $variablePitchName); } else { $m1 = query_metrics( $fixedPitchName); } } # get all family members my @famx = map { query_metrics( $_) } enum_family( $m1-> {family}); # find style my $m2; for ( @famx) { # exact match $m2 = $_, last if $_-> {style} == $dest-> {style}; } unless ( $m2) { # second pass my $maxDiff = 1000; my ( $italic, $bold) = ( ( $dest-> {style} & fs::Italic) ? 1 : 0, ($dest-> {style} & fs::Bold) ? 1 :0 ); for ( @famx) { my ( $i, $b) = ( ( $_-> {style} & fs::Italic) ? 1 : 0, ( $_-> {style} & fs::Bold) ? 1 : 0 ); my $diff = (( $i == $italic) ? 0 : 2) + (( $b == $bold) ? 0 : 1); $m2 = $_, $maxDiff = $diff if $diff < $maxDiff; } } $m2 = $m1 unless defined $m2; # scale dimensions my $res = $options{resolution} ? $options{resolution} : $m2-> {yDeviceRes}; if ( $bySize) { $dest-> {height} = int( $dest-> {size} * $res / 72.27 + 0.5); } else { $dest-> {size} = int( $dest-> {height} * 72.27 / $res + 0.5); } my $a = $dest-> {height} / $m2-> {height}; my %muls = %$m2; my $charheight = $muls{height}; my $du = $dest-> {style} & fs::Underlined; my $ds = $dest-> {style} & fs::StruckOut; my $dw = $dest-> {width}; $muls{$_} = int ( $muls{$_} * $a + 0.5) for qw( height ascent descent width maximalWidth internalLeading externalLeading); delete $muls{size}; my $enc = $dest-> {encoding}; $dest-> {$_} = $muls{$_} for keys %muls; $dest-> {encoding} = $enc; $dest-> {style} |= fs::Underlined if $du; $dest-> {style} |= fs::StruckOut if $ds; $dest-> {width} = $dw if $dw != 0; $dest-> {charheight} = $charheight; return $dest; } %files = map { $_ => "PS/fonts/$_" } ( 'Bookman-Demi' , 'Bookman-DemiItalic' , 'Bookman-Light' , 'Bookman-LightItalic' , 'Courier' , 'Courier-Oblique' , 'Courier-Bold' , 'Courier-BoldOblique' , 'AvantGarde-Book' , 'AvantGarde-BookOblique' , 'AvantGarde-Demi' , 'AvantGarde-DemiOblique' , 'Helvetica' , 'Helvetica-Oblique' , 'Helvetica-Bold' , 'Helvetica-BoldOblique' , 'Helvetica-Narrow' , 'Helvetica-Narrow-Oblique' , 'Helvetica-Narrow-Bold' , 'Helvetica-Narrow-BoldOblique', 'Palatino-Roman' , 'Palatino-Italic' , 'Palatino-Bold' , 'Palatino-BoldItalic' , 'NewCenturySchlbk-Roman' , 'NewCenturySchlbk-Italic' , 'NewCenturySchlbk-Bold' , 'NewCenturySchlbk-BoldItalic' , 'Times-Roman' , 'Times-Italic' , 'Times-Bold' , 'Times-BoldItalic' , 'Symbol' , 'ZapfChancery-MediumItalic' , 'ZapfDingbats' , ); # The keys of %enum_families are only font names, - in Prima terms. # The only problem that the family field is always the same as the # font name %enum_families = ( 'Bookman' => 'Bookman-Light', 'Courier' => 'Courier', 'AvantGarde' => 'AvantGarde-Book', 'Helvetica' => 'Helvetica', 'Helvetica-Narrow' => 'Helvetica-Narrow', 'Palatino' => 'Palatino-Roman', 'NewCenturySchlbk' => 'NewCenturySchlbk-Roman', 'Times' => 'Times-Roman', 'Symbol' => 'Symbol', 'ZapfChancery' => 'ZapfChancery-MediumItalic', 'ZapfDingbats' => 'ZapfDingbats', ); 1; __END__ =pod =head1 NAME Prima::PS::Fonts - PostScript device fonts metrics =head1 SYNOPSIS use Prima; use Prima::PS::Fonts; =head1 DESCRIPTION This module primary use is to be invoked from Prima::PS::Drawable module. Assumed that some common fonts like Times and Courier are supported by PS interpreter, and it is assumed that typeface is preserved more-less the same, so typesetting based on font's a-b-c metrics can be valid. 35 font files are supplied with 11 font families. Font files with metrics located into 'fonts' subdirectory. =over =item query_metrics( $fontName) Returns font metric hash with requested font data, uses $defaultFontName if give name is not found. Metric hash is the same as Prima::Types::Font record, plus 3 extra fields: 'docname' containing font name ( equals always to 'name'), 'chardata' - hash of named glyphs, 'charheight' - the height that 'chardata' is rendered to. Every hash entry in 'chardata' record contains four numbers - suggested character index and a, b and c glyph dimensions with height equals 'charheight'. =item enum_fonts( $fontFamily) Returns font records for given family, or all families perpesented by one member, if no family name given. If encoding specified, returns only the fonts with the encoding given. Compliant to Prima::Application::fonts interface. =item files & enum_families Hash with paths to font metric files. File names not necessarily should be as font names, and it is possible to override font name contained in the file just by specifying different font key - this case will be recognized on loading stage and loaded font structure patched correspondingly. Example: $Prima::PS::Fonts::files{Standard Symbols} = $Prima::PS::Fonts::files{Symbol}; $Prima::PS::Fonts::files{'Device-specific symbols, set 1'} = 'my/devspec/data.1'; $Prima::PS::Fonts::files{'Device-specific symbols, set 2'} = 'my/devspec/data.2'; $Prima::PS::Fonts::enum_families{DevSpec} = 'Device-specific symbols, set 1'; =item font_pick( $src, $dest, %options) Merges two font records using Prima::Drawable::font_match, picks the result and returns new record. $variablePitchName and $fixedPitchName used on this stage. Options can include the following fields: - resolution - vertical resolution. The default value is taken from font resolution. =item enum_family( $fontFamily) Returns font names that are presented in given family =back =cut Prima-1.28/Prima/PS/Drawable.pm0000644000175100017510000012572111150770061013753 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # $Id: Drawable.pm,v 1.41 2008/05/01 09:46:13 dk Exp $ # package Prima::PS::Drawable; use vars qw(@ISA); @ISA = qw(Prima::Drawable); use strict; use Prima; use Prima::PS::Fonts; use Prima::PS::Encodings; use Encode; { my %RNT = ( %{Prima::Drawable-> notification_types()}, Spool => nt::Action, ); sub notification_types { return \%RNT; } } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( copies => 1, font => { %{$def-> {font}}, name => $Prima::PS::Fonts::defaultFontName, }, grayscale => 0, pageDevice => undef, pageSize => [ 598, 845], pageMargins => [ 12, 12, 12, 12], resolution => [ 300, 300], reversed => 0, rotate => 0, scale => [ 1, 1], textOutBaseline => 1, useDeviceFonts => 1, useDeviceFontsOnly => 0, ); @$def{keys %prf} = values %prf; return $def; } sub profile_check_in { my ( $self, $p, $default) = @_; Prima::Component::profile_check_in( $self, $p, $default); $p-> { font} = {} unless exists $p-> { font}; $p-> { font} = Prima::Drawable-> font_match( $p-> { font}, $default-> { font}, 0); } sub init { my $self = shift; $self-> {clipRect} = [0,0,0,0]; $self-> {pageSize} = [0,0]; $self-> {pageMargins} = [0,0,0,0]; $self-> {resolution} = [72,72]; $self-> {scale} = [ 1, 1]; $self-> {copies} = 1; $self-> {rotate} = 1; $self-> {font} = {}; $self-> {useDeviceFonts} = 1; my %profile = $self-> SUPER::init(@_); $self-> $_( $profile{$_}) for qw( grayscale copies pageDevice useDeviceFonts rotate reversed useDeviceFontsOnly); $self-> $_( @{$profile{$_}}) for qw( pageSize pageMargins resolution scale); $self-> {localeEncoding} = []; return %profile; } # internal routines sub cmd_rgb { my ( $r, $g, $b) = ( int((($_[1] & 0xff0000) >> 16) * 100 / 256 + 0.5) / 100, int((($_[1] & 0xff00) >> 8) * 100 / 256 + 0.5) / 100, int(($_[1] & 0xff)*100/256 + 0.5) / 100); unless ( $_[0]-> {grayscale}) { return "$r $g $b A"; } else { my $i = int( 100 * ( 0.31 * $r + 0.5 * $g + 0.18 * $b) + 0.5) / 100; return "$i G"; } } sub emit { my $self = $_[0]; return 0 unless $self-> {canDraw}; $self-> {psData} .= $_[1] . "\n"; if ( length($self-> {psData}) > 10240) { $self-> abort_doc unless $self-> spool( $self-> {psData}); $self-> {psData} = ''; } return 1; } sub save_state { my $self = $_[0]; $self-> {saveState} = {}; $self-> set_font( $self-> get_font) if $self-> {useDeviceFonts}; $self-> {saveState}-> {$_} = $self-> $_() for qw( color backColor fillPattern lineEnd linePattern lineWidth rop rop2 textOpaque textOutBaseline font lineJoin fillWinding ); $self-> {saveState}-> {$_} = [$self-> $_()] for qw( translate clipRect ); $self-> {saveState}-> {localeEncoding} = $self-> {useDeviceFonts} ? [ @{$self-> {localeEncoding}}] : []; } sub restore_state { my $self = $_[0]; for ( qw( color backColor fillPattern lineEnd linePattern lineWidth rop rop2 textOpaque textOutBaseline font lineJoin fillWinding)) { $self-> $_( $self-> {saveState}-> {$_}); } for ( qw( translate clipRect)) { $self-> $_( @{$self-> {saveState}-> {$_}}); } $self-> {localeEncoding} = $self-> {saveState}-> {localeEncoding}; } sub pixel2point { my $self = shift; my $i; my @res; for ( $i = 0; $i < scalar @_; $i+=2) { my ( $x, $y) = @_[$i,$i+1]; push( @res, int( $x * 7227 / $self-> {resolution}-> [0] + 0.5) / 100 ); push( @res, int( $y * 7227 / $self-> {resolution}-> [1] + 0.5) / 100 ) if defined $y; } return @res; } sub point2pixel { my $self = shift; my $i; my @res; for ( $i = 0; $i < scalar @_; $i+=2) { my ( $x, $y) = @_[$i,$i+1]; push( @res, $x * $self-> {resolution}-> [0] / 72.27); push( @res, $y * $self-> {resolution}-> [1] / 72.27) if defined $y; } return @res; } sub change_transform { return if $_[0]-> {delay}; my @tp = $_[0]-> translate; my @cr = $_[0]-> clipRect; my @sc = $_[0]-> scale; my $ro = $_[0]-> rotate; $cr[2] -= $cr[0]; $cr[3] -= $cr[1]; my $doClip = grep { $_ != 0 } @cr; my $doTR = grep { $_ != 0 } @tp; my $doSC = grep { $_ != 0 } @sc; if ( !$doClip && !$doTR && !$doSC && !$ro) { $_[0]-> emit(':') if $_[1]; return; } @cr = $_[0]-> pixel2point( @cr); @tp = $_[0]-> pixel2point( @tp); my $mcr2 = -$cr[2]; $_[0]-> emit(';') unless $_[1]; $_[0]-> emit(':'); $_[0]-> emit(< emit("@tp T") if $doTR; $_[0]-> emit("@sc Z") if $doSC; $_[0]-> emit("$ro R") if $ro != 0; $_[0]-> {changed}-> {$_} = 1 for qw(fill linePattern lineWidth lineJoin lineEnd font); } sub fill { my ( $self, $start, $code, $end) = @_; my ( $r1, $r2) = ( $self-> rop, $self-> rop2); return if $r1 == rop::NoOper && $r1 == rop::NoOper; $self-> emit( $start) if length $start; if ( $r2 != rop::NoOper && $self-> {fpType} ne 'F') { my $bk = ( $r2 == rop::Blackness) ? 0 : ( $r2 == rop::Whiteness) ? 0xffffff : $self-> backColor; $self-> {changed}-> {fill} = 1; $self-> emit( $self-> cmd_rgb( $bk)); $self-> emit( $code); } if ( $r1 != rop::NoOper && $self-> {fpType} ne 'B') { my $c = ( $r1 == rop::Blackness) ? 0 : ( $r1 == rop::Whiteness) ? 0xffffff : $self-> color; if ($self-> {changed}-> {fill}) { if ( $self-> {fpType} eq 'F') { $self-> emit( $self-> cmd_rgb( $c)); } else { my ( $r, $g, $b) = ( int((($c & 0xff0000) >> 16) * 100 / 256 + 0.5) / 100, int((($c & 0xff00) >> 8) * 100 / 256 + 0.5) / 100, int(($c & 0xff)*100/256 + 0.5) / 100); if ( $self-> {grayscale}) { my $i = int( 100 * ( 0.31 * $r + 0.5 * $g + 0.18 * $b) + 0.5) / 100; $self-> emit(<{fpType} SC GRAYPAT } else { $self-> emit(<{fpType} SC RGBPAT } } $self-> {changed}-> {fill} = 0; } $self-> emit( $code); } $self-> emit( $end) if length $end; } sub stroke { my ( $self, $start, $code, $end) = @_; my ( $r1, $r2) = ( $self-> rop, $self-> rop2); my $lp = $self-> linePattern; return if $r1 == rop::NoOper && $r2 == rop::NoOper; $self-> emit( $start) if length $start; if ( $r2 != rop::NoOper && $lp ne lp::Solid ) { my $bk = ( $r2 == rop::Blackness) ? 0 : ( $r2 == rop::Whiteness) ? 0xffffff : $self-> backColor; $self-> {changed}-> {linePattern} = 1; $self-> {changed}-> {fill} = 1; $self-> emit( $self-> cmd_rgb( $bk)); $self-> emit( $code); } if ( $r1 != rop::NoOper && length( $lp)) { my $fk = ( $r1 == rop::Blackness) ? 0 : ( $r1 == rop::Whiteness) ? 0xffffff : $self-> color; if ( $self-> {changed}-> {linePattern}) { if ( length( $lp) == 1) { $self-> emit('[] 0 SD'); } else { my @x = split('', $lp); push( @x, 0) if scalar(@x) % 1; @x = map { ord($_) } @x; $self-> emit("[@x] 0 SD"); } $self-> {changed}-> {linePattern} = 0; } if ( $self-> {changed}-> {lineWidth}) { my ($lw) = $self-> pixel2point($self-> lineWidth); $self-> emit( $lw . ' SW'); $self-> {changed}-> {lineWidth} = 0; } if ( $self-> {changed}-> {lineEnd}) { my $le = $self-> lineEnd; my $id = ( $le == le::Round) ? 1 : (( $le == le::Square) ? 2 : 0); $self-> emit( "$id SL"); } if ( $self-> {changed}-> {lineJoin}) { my $lj = $self-> lineJoin; my $id = ( $lj == lj::Round) ? 1 : (( $lj == lj::Bevel) ? 2 : 0); $self-> emit( "$id SJ"); } if ( $self-> {changed}-> {fill}) { $self-> emit( $self-> cmd_rgb( $fk)); } $self-> emit( $code); } $self-> emit( $end) if length $end; } # Prima::Printer interface sub begin_doc { my ( $self, $docName) = @_; return 0 if $self-> get_paint_state; $self-> {psData} = ''; $self-> {canDraw} = 1; $docName = $::application ? $::application-> name : "Prima::PS::Drawable" unless defined $docName; my $data = scalar localtime; my @b2 = ( $self-> {pageSize}-> [0] - $self-> {pageMargins}-> [2], $self-> {pageSize}-> [1] - $self-> {pageMargins}-> [3] ); $self-> {fpHash} = {}; $self-> {pages} = 1; my ($x,$y) = ( $self-> {pageSize}-> [0] - $self-> {pageMargins}-> [0] - $self-> {pageMargins}-> [2], $self-> {pageSize}-> [1] - $self-> {pageMargins}-> [1] - $self-> {pageMargins}-> [3] ); my $extras = ''; my $setup = ''; my %pd = defined( $self-> {pageDevice}) ? %{$self-> {pageDevice}} : (); if ( $self-> {copies} > 1) { $pd{NumCopies} = $self-> {copies}; $extras .= "\%\%Requirements: numcopies($self->{copies})\n"; } if ( scalar keys %pd) { my $jd = join( "\n", map { "/$_ $pd{$_}"} keys %pd); $setup .= <> SPD %%EndFeature NUMPAGES } $self-> {localeData} = {}; $self-> {fontLocaleData} = {}; $self-> emit( <{pageMargins}}[0,1] @b2 $extras %%LanguageLevel: 2 %%DocumentNeededFonts: (atend) %%DocumentSuppliedFonts: (atend) %%EndComments /d/def load def/,/load load d/~/exch , d/S/show , d/:/gsave , d/;/grestore , d/N/newpath , d/M/moveto , d/L/rlineto , d/X/closepath , d/C/clip , d/T/translate , d/R/rotate , d/P/showpage , d/Z/scale , d/I/imagemask , d/@/dup , d/G/setgray , d/A/setrgbcolor , d/l/lineto , d/F/fill , d/FF/findfont , d/XF/scalefont , d/SF/setfont , d/O/stroke , d/SD/setdash , d/SL/setlinecap , d/SW/setlinewidth , d/SJ/setlinejoin , d/E/eofill , d/SS/setcolorspace , d/SC/setcolor , d/SM/setmatrix , d/SPD/setpagedevice , d/SP/setpattern , d/CP/currentpoint , d/MX/matrix , d/MP/makepattern , d/b/begin , d/e/end , d/t/true , d/f/false , d/?/ifelse , d/a/arc , d/dummy/_dummy %%BeginSetup $setup %%EndSetup %%Page: 1 1 PSHEADER $self-> {pagePrefix} = <{pageMargins}}[0,1] T N 0 0 M 0 $y L $x 0 L 0 -$y L X C PREFIX $self-> {pagePrefix} .= "0 0 M 90 R 0 -$x T\n" if $self-> {reversed}; $self-> {changed} = { map { $_ => 0 } qw( fill lineEnd linePattern lineWidth lineJoin font)}; $self-> {docFontMap} = {}; $self-> SUPER::begin_paint; $self-> save_state; $self-> {delay} = 1; $self-> restore_state; $self-> {delay} = 0; $self-> emit( $self-> {pagePrefix}); $self-> change_transform( 1); $self-> {changed}-> {linePattern} = 0; return 1; } sub abort_doc { my $self = $_[0]; return unless $self-> {canDraw}; $self-> {canDraw} = 0; $self-> SUPER::end_paint; $self-> restore_state; delete $self-> {$_} for qw (saveState localeData psData changed fontLocaleData pagePrefix); $self-> {plate}-> destroy, $self-> {plate} = undef if $self-> {plate}; } sub end_doc { my $self = $_[0]; return 0 unless $self-> {canDraw}; $self-> emit(<{pages} %%EOF PSFOOTER # if ( $self-> {locale}) { # my @z = map { '/' . $_ } keys %{$self-> {docFontMap}}; # my $xcl = "/FontList [@z] d\n"; # } my $ret = $self-> spool( $self-> {psData}); $self-> {canDraw} = 0; $self-> SUPER::end_paint; $self-> restore_state; delete $self-> {$_} for qw (saveState localeData changed fontLocaleData psData pagePrefix); $self-> {plate}-> destroy, $self-> {plate} = undef if $self-> {plate}; return $ret; } # Prima::Drawable interface sub begin_paint { return $_[0]-> begin_doc; } sub end_paint { $_[0]-> abort_doc; } sub begin_paint_info { my $self = $_[0]; return 0 if $self-> get_paint_state; my $ok = $self-> SUPER::begin_paint_info; return 0 unless $ok; $self-> save_state; } sub end_paint_info { my $self = $_[0]; return if $self-> get_paint_state != 2; $self-> SUPER::end_paint_info; $self-> restore_state; } sub new_page { return 0 unless $_[0]-> {canDraw}; my $self = $_[0]; $self-> {pages}++; $self-> emit("; P\n%%Page: $self->{pages} $self->{pages}\n"); $self-> $_( @{$self-> {saveState}-> {$_}}) for qw( translate clipRect); $self-> change_transform(1); $self-> emit( $self-> {pagePrefix}); return 1; } sub pages { $_[0]-> {pages} } sub spool { shift-> notify( 'Spool', @_); return 1; # my $p = $_[1]; # open F, ">> ./test.ps"; # print F $p; # close F; } # properties sub color { return $_[0]-> SUPER::color unless $#_; $_[0]-> SUPER::color( $_[1]); return unless $_[0]-> {canDraw}; $_[0]-> {changed}-> {fill} = 1; } sub fillPattern { return $_[0]-> SUPER::fillPattern unless $#_; $_[0]-> SUPER::fillPattern( $_[1]); return unless $_[0]-> {canDraw}; my $self = $_[0]; my @fp = @{$self-> SUPER::fillPattern}; my $solidBack = ! grep { $_ != 0 } @fp; my $solidFore = ! grep { $_ != 0xff } @fp; my $fpid; my @scaleto = $self-> pixel2point( 8, 8); if ( !$solidBack && !$solidFore) { $fpid = join( '', map { sprintf("%02x", $_)} @fp); unless ( exists $self-> {fpHash}-> {$fpid}) { $self-> emit( < I ; e } bind >> MX MP \/Pat_$fpid ~ d PATTERNDEF $self-> {fpHash}-> {$fpid} = 1; } } $self-> {fpType} = $solidBack ? 'B' : ( $solidFore ? 'F' : $fpid); $self-> {changed}-> {fill} = 1; } sub lineEnd { return $_[0]-> SUPER::lineEnd unless $#_; $_[0]-> SUPER::lineEnd($_[1]); return unless $_[0]-> {canDraw}; $_[0]-> {changed}-> {lineEnd} = 1; } sub lineJoin { return $_[0]-> SUPER::lineJoin unless $#_; $_[0]-> SUPER::lineJoin($_[1]); return unless $_[0]-> {canDraw}; $_[0]-> {changed}-> {lineJoin} = 1; } sub fillWinding { return $_[0]-> SUPER::fillWinding unless $#_; $_[0]-> SUPER::fillWinding($_[1]); } sub linePattern { return $_[0]-> SUPER::linePattern unless $#_; $_[0]-> SUPER::linePattern($_[1]); return unless $_[0]-> {canDraw}; $_[0]-> {changed}-> {linePattern} = 1; } sub lineWidth { return $_[0]-> SUPER::lineWidth unless $#_; $_[0]-> SUPER::lineWidth($_[1]); return unless $_[0]-> {canDraw}; $_[0]-> {changed}-> {lineWidth} = 1; } sub rop { return $_[0]-> SUPER::rop unless $#_; my ( $self, $rop) = @_; $rop = rop::CopyPut if $rop != rop::Blackness || $rop != rop::Whiteness || $rop != rop::NoOper; $self-> SUPER::rop( $rop); } sub rop2 { return $_[0]-> SUPER::rop2 unless $#_; my ( $self, $rop) = @_; $rop = rop::CopyPut if $rop != rop::Blackness || $rop != rop::Whiteness || $rop != rop::NoOper; $self-> SUPER::rop2( $rop); } sub translate { return $_[0]-> SUPER::translate unless $#_; my $self = shift; $self-> SUPER::translate(@_); $self-> change_transform; } sub clipRect { return @{$_[0]-> {clipRect}} unless $#_; $_[0]-> {clipRect} = [@_[1..4]]; $_[0]-> change_transform; } sub region { return undef; } sub scale { return @{$_[0]-> {scale}} unless $#_; my $self = shift; $self-> {scale} = [@_[0,1]]; $self-> change_transform; } sub reversed { return $_[0]-> {reversed} unless $#_; my $self = $_[0]; $self-> {reversed} = $_[1] unless $self-> get_paint_state; $self-> calc_page; } sub rotate { return $_[0]-> {rotate} unless $#_; my $self = $_[0]; $self-> {rotate} = $_[1]; $self-> change_transform; } sub resolution { return @{$_[0]-> {resolution}} unless $#_; return if $_[0]-> get_paint_state; my ( $x, $y) = @_[1..2]; return if $x <= 0 || $y <= 0; $_[0]-> {resolution} = [$x, $y]; $_[0]-> calc_page; } sub copies { return $_[0]-> {copies} unless $#_; $_[0]-> {copies} = $_[1] unless $_[0]-> get_paint_state; } sub pageDevice { return $_[0]-> {pageDevice} unless $#_; $_[0]-> {pageDevice} = $_[1] unless $_[0]-> get_paint_state; } sub useDeviceFonts { return $_[0]-> {useDeviceFonts} unless $#_; if ( $_[1]) { delete $_[0]-> {font}-> {width}; $_[0]-> set_font( $_[0]-> get_font); } $_[0]-> {useDeviceFonts} = $_[1] unless $_[0]-> get_paint_state; $_[0]-> {useDeviceFonts} = 1 if $_[0]-> {useDeviceFontsOnly}; } sub useDeviceFontsOnly { return $_[0]-> {useDeviceFontsOnly} unless $#_; $_[0]-> useDeviceFonts(1) if $_[0]-> {useDeviceFontsOnly} = $_[1] && !$_[0]-> get_paint_state; } sub grayscale { return $_[0]-> {grayscale} unless $#_; $_[0]-> {grayscale} = $_[1] unless $_[0]-> get_paint_state; } sub set_locale { my ( $self, $loc) = @_; return if !$self-> {useDeviceFonts} || !$self-> {canDraw}; $self-> {locale} = $loc; my $le = $self-> {localeEncoding} = Prima::PS::Encodings::load( $loc); unless ( scalar keys %{$self-> {localeData}}) { return if ! defined($loc); $self-> emit( < {localeData}-> {$loc}) { $self-> {localeData}-> {$loc} = 1; $self-> emit( "/Encoding_$loc ["); my $i = 0; for ( $i = 0; $i < 16; $i++) { $self-> emit( join('', map {'/' . $_ } @$le[$i * 16 .. $i * 16 + 15])); } $self-> emit("] d\n"); } } sub calc_page { my $self = $_[0]; my @s = @{$self-> {pageSize}}; my @m = @{$self-> {pageMargins}}; if ( $self-> {reversed}) { @s = @s[1,0]; @m = @m[1,0,3,2]; } $self-> {size} = [ int(( $s[0] - $m[0] - $m[2]) * $self-> {resolution}-> [0] / 72.27 + 0.5), int(( $s[1] - $m[1] - $m[3]) * $self-> {resolution}-> [1] / 72.27 + 0.5), ]; } sub pageSize { return @{$_[0]-> {pageSize}} unless $#_; my ( $self, $px, $py) = @_; return if $self-> get_paint_state; $px = 1 if $px < 1; $py = 1 if $py < 1; $self-> {pageSize} = [$px, $py]; $self-> calc_page; } sub pageMargins { return @{$_[0]-> {pageMargins}} unless $#_; my ( $self, $px, $py, $px2, $py2) = @_; return if $self-> get_paint_state; $px = 0 if $px < 0; $py = 0 if $py < 0; $px2 = 0 if $px2 < 0; $py2 = 0 if $py2 < 0; $self-> {pageMargins} = [$px, $py, $px2, $py2]; $self-> calc_page; } sub size { return @{$_[0]-> {size}} unless $#_; $_[0]-> raise_ro("size"); } # primitives sub arc { my ( $self, $x, $y, $dx, $dy, $start, $end) = @_; my $try = $dy / $dx; ( $x, $y, $dx, $dy) = $self-> pixel2point( $x, $y, $dx, $dy); my $rx = $dx / 2; $end -= $start; $self-> stroke( < pixel2point( $x, $y, $dx, $dy); my $rx = $dx / 2; $end -= $start; $self-> stroke(< pixel2point( $x, $y, $dx, $dy); my $rx = $dx / 2; $self-> stroke(< pixel2point( $x, $y, $dx, $dy); my $rx = $dx / 2; $end -= $start; my $F = $self-> fillWinding ? 'F' : 'E'; $self-> fill( < pixel2point( $x, $y, $dx, $dy); my $rx = $dx / 2; $self-> fill(< pixel2point( $x, $y, $dx, $dy); my $rx = $dx / 2; $end -= $start; $self-> stroke(< pixel2point( $x, $y, $dx, $dy); my $rx = $dx / 2; $end -= $start; my $F = $self-> fillWinding ? 'F' : 'E'; $self-> fill(< {canDraw} and length $text; $y += $self-> {font}-> {descent} if !$self-> textOutBaseline; ( $x, $y) = $self-> pixel2point( $x, $y); my $n = $self-> {typeFontMap}-> {$self-> {font}-> {name}}; my $spec = exists ( $self-> {font}-> {encoding}) ? exists ( $Prima::PS::Encodings::fontspecific{ $self-> {font}-> {encoding}}) : 0; if ( $n == 1) { my $fn = $self-> {font}-> {docname}; unless ( $spec || ( !defined( $self-> {locale}) && !defined($self-> {fontLocaleData}-> {$fn})) || ( defined( $self-> {locale}) && defined($self-> {fontLocaleData}-> {$fn}) && ($self-> {fontLocaleData}-> {$fn} eq $self-> {locale}))) { $self-> {fontLocaleData}-> {$fn} = $self-> {locale}; $self-> emit( "Encoding_$self->{locale} /$fn reencode_font"); $self-> {changed}-> {font} = 1; } if ( $self-> {changed}-> {font}) { $self-> emit( "/$fn FF $self->{font}->{size} XF SF"); $self-> {changed}-> {font} = 0; } } my $wmul = $self-> {font}-> {width} / $self-> {fontWidthDivisor}; $self-> emit(": $x $y T"); $self-> emit("$wmul 1 Z") if $wmul != 1; $self-> emit("0 0 M"); if ( $self-> {font}-> {direction} != 0) { my $r = $self-> {font}-> {direction}; $self-> emit("$r R"); } my @rb; if ( $self-> textOpaque || $self-> {font}-> {style} & (fs::Underlined|fs::StruckOut)) { my ( $ds, $bs) = ( $self-> {font}-> {direction}, $self-> textOutBaseline); $self-> {font}-> {direction} = 0; $self-> textOutBaseline(1) unless $bs; @rb = $self-> pixel2point( @{$self-> get_text_box( $text)}); $self-> {font}-> {direction} = $ds; $self-> textOutBaseline($bs) unless $bs; } if ( $self-> textOpaque) { $self-> emit( $self-> cmd_rgb( $self-> backColor)); $self-> emit( ": N @rb[0,1] M @rb[2,3] l @rb[6,7] l @rb[4,5] l X F ;"); } $self-> emit( $self-> cmd_rgb( $self-> color)); my ( $rm, $nd) = $self-> get_rmap; my ( $xp, $yp) = ( $x, $y); my $c = $self-> {font}-> {chardata}; my $le = $self-> {localeEncoding}; my $adv = 0; my ( @t, @umap); my $unicode = Encode::is_utf8( $text); if ( defined($self-> {font}-> {encoding}) && $unicode) { # known encoding? eval { Encode::encode( $self-> {font}-> {encoding}, ''); }; unless ( $@) { # convert as much of unicode text as possible into the current encoding while ( 1) { my $conv = Encode::encode( $self-> {font}-> {encoding}, $text, Encode::FB_QUIET ); push @t, split( '', $conv); push @umap, (undef) x length $conv; last unless length $text; push @t, substr( $text, 0, 1, ''); push @umap, 1; } } else { @t = split '', $text; @umap = map { undef } @t; } } else { @t = split '', $text; @umap = map { undef } @t; } my $i = -1; for my $j ( @t) { $i++; my $advance; my $u = $umap[$i]||0; if ( !$umap[$i] && # not unicode $n == 1 && # postscript font ( $le-> [ ord $j] ne '.notdef') && ( # $spec || # fontspecific exists ( $c-> {$le-> [ ord $j]} # have predefined font metrics ) )) { $j =~ s/([\\()])/\\$1/g; my $adv2 = int( $adv * 100 + 0.5) / 100; $self-> emit( "$adv2 0 M") if $adv2 != 0; $self-> emit("($j) S"); my $xr = $rm-> [ ord $j]; $advance = $$xr[1] + $$xr[2] + $$xr[3]; } else { my ( $pg, $a, $b, $c) = $self-> place_glyph( $j); if ( length $pg) { my $adv2 = $adv + $a * 72.27 / $self-> {resolution}-> [0]; $adv2 = int( $adv * 100 + 0.5) / 100; $self-> emit( "$adv2 $self->{plate}->{yd} M : CP T"); $self-> emit( $pg); $self-> emit(";"); $advance = $a + $b + $c; } else { $advance = $$nd[1] + $$nd[2] + $$nd[3]; } } $adv += $advance * 72.27 / $self-> {resolution}-> [0]; } #$text =~ s/([\\()])/\\$1/g; #$self-> emit("($text) S"); if ( $self-> {font}-> {style} & (fs::Underlined|fs::StruckOut)) { my $lw = $self-> {font}-> {size}/30; # XXX empiric $self-> emit("[] 0 SD 0 SL $lw SW"); if ( $self-> {font}-> {style} & fs::Underlined) { $self-> emit("N @rb[0,3] M $rb[4] 0 L O"); } if ( $self-> {font}-> {style} & fs::StruckOut) { $rb[3] += $rb[1]/2; $self-> emit("N @rb[0,3] M $rb[4] 0 L O"); } } $self-> emit(";"); return 1; } sub bar { my ( $self, $x1, $y1, $x2, $y2) = @_; ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); $self-> fill('', "N $x1 $y1 M $x1 $y2 l $x2 $y2 l $x2 $y1 l X F", ''); } sub rectangle { my ( $self, $x1, $y1, $x2, $y2) = @_; ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); $self-> stroke( '', "N $x1 $y1 M $x1 $y2 l $x2 $y2 l $x2 $y1 l X O", ''); } sub clear { my ( $self, $x1, $y1, $x2, $y2) = @_; if ( grep { ! defined } $x1, $y1, $x2, $y2) { ($x1, $y1, $x2, $y2) = $self-> clipRect; unless ( grep { $_ != 0 } $x1, $y1, $x2, $y2) { ($x1, $y1, $x2, $y2) = (0,0,@{$self-> {size}}); } } ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); my $c = $self-> cmd_rgb( $self-> backColor); $self-> emit(< {changed}-> {fill} = 1; } sub line { my ( $self, $x1, $y1, $x2, $y2) = @_; ( $x1, $y1, $x2, $y2) = $self-> pixel2point( $x1, $y1, $x2, $y2); $self-> stroke('', "N $x1 $y1 M $x2 $y2 l O", ''); } sub lines { my ( $self, $array) = @_; my $i; my $c = scalar @$array; my @a = $self-> pixel2point( @$array); $c = int( $c / 4) * 4; my $z = ''; for ( $i = 0; $i < $c; $i += 4) { $z .= "N @a[$i,$i+1] M @a[$i+2,$i+3] l O"; } $self-> stroke( '', $z, ''); } sub polyline { my ( $self, $array) = @_; my $i; my $c = scalar @$array; my @a = $self-> pixel2point( @$array); $c = int( $c / 2) * 2; return if $c < 2; my $z = "N @a[0,1] M "; for ( $i = 2; $i < $c; $i += 2) { $z .= "@a[$i,$i+1] l "; } $z .= "O"; $self-> stroke( '', $z, ''); } sub fillpoly { my ( $self, $array) = @_; my $i; my $c = scalar @$array; $c = int( $c / 2) * 2; return if $c < 2; my @a = $self-> pixel2point( @$array); my $x = "N @a[0,1] M "; for ( $i = 2; $i < $c; $i += 2) { $x .= "@a[$i,$i+1] l "; } $x .= 'X ' . ($self-> fillWinding ? 'F' : 'E'); $self-> fill( '', $x, ''); } sub flood_fill { return 0; } sub pixel { my ( $self, $x, $y, $pix) = @_; return cl::Invalid unless defined $pix; my $c = $self-> cmd_rgb( $pix); ($x, $y) = $self-> pixel2point( $x, $y); $self-> emit(< {changed}-> {fill} = 1; } # methods sub put_image_indirect { return 0 unless $_[0]-> {canDraw}; my ( $self, $image, $x, $y, $xFrom, $yFrom, $xDestLen, $yDestLen, $xLen, $yLen) = @_; my $touch; $touch = 1, $image = $image-> image if $image-> isa('Prima::DeviceBitmap'); unless ( $xFrom == 0 && $yFrom == 0 && $xLen == $image-> width && $yLen == $image-> height) { $image = $image-> extract( $xFrom, $yFrom, $xLen, $yLen); $touch = 1; } my $ib = $image-> get_bpp; if ( $ib != $self-> get_bpp) { $image = $image-> dup unless $touch; if ( $self-> {grayscale} || $image-> type & im::GrayScale) { $image-> type( im::Byte); } else { $image-> type( im::RGB); } } elsif ( $self-> {grayscale} || $image-> type & im::GrayScale) { $image = $image-> dup unless $touch; $image-> type( im::Byte); } $ib = $image-> get_bpp; $image-> type( im::RGB) if $ib != 8 && $ib != 24; my @is = $image-> size; ($x, $y, $xDestLen, $yDestLen) = $self-> pixel2point( $x, $y, $xDestLen, $yDestLen); my @fullScale = ( $is[0] / $xLen * $xDestLen, $is[1] / $yLen * $yDestLen, ); my $g = $image-> data; my $bt = ( $image-> type & im::BPP) * $is[0] / 8; my $ls = int(( $is[0] * ( $image-> type & im::BPP) + 31) / 32) * 4; my ( $i, $j); $self-> emit(": $x $y T @fullScale Z"); $self-> emit("/scanline $bt string d"); $self-> emit("@is 8 [$is[0] 0 0 $is[1] 0 0]"); $self-> emit('{currentfile scanline readhexstring pop}'); $self-> emit(( $image-> type & im::GrayScale) ? "image" : "false 3 colorimage"); for ( $i = 0; $i < $is[1]; $i++) { my $w = substr( $g, $ls * $i, $bt); $w =~ s/(.)(.)(.)/$3$2$1/g if $ib == 24; $w =~ s/(.)/sprintf("%02x",ord($1))/eg; $self-> emit( $w); } $self-> emit(';'); return 1; } sub get_bpp { return $_[0]-> {grayscale} ? 8 : 24 } sub get_nearest_color { return $_[1] } sub get_physical_palette { return $_[0]-> {grayscale} ? [map { $_, $_, $_ } 0..255] : 0 } sub get_handle { return 0 } # fonts sub fonts { my ( $self, $family, $encoding) = @_; $family = undef if defined $family && !length $family; $encoding = undef if defined $encoding && !length $encoding; my $f1 = $self-> {useDeviceFonts} ? Prima::PS::Fonts::enum_fonts( $family, $encoding) : []; return $f1 if !$::application || $self-> {useDeviceFontsOnly}; my $f2 = $::application-> fonts( $family, $encoding); if ( !defined($family) && !defined($encoding)) { my %f = map { $_-> {name} => $_ } @$f1; my @add; for ( @$f2) { if ( $f{$_}) { push @{$f{$_}-> {encodings}}, @{$_-> {encodings}}; } else { push @add, $_; } } push @$f1, @add; } else { push @$f1, @$f2; } return $f1; } sub font_encodings { my @r; if ( $_[0]-> {useDeviceFonts}) { @r = Prima::PS::Encodings::unique, keys %Prima::PS::Encodings::fontspecific; } if ( $::application && !$_[0]-> {useDeviceFontsOnly}) { my %h = map { $_ => 1 } @r; for ( @{$::application-> font_encodings}) { next if $h{$_}; push @r, $_; } } return \@r; } sub get_font { my $z = {%{$_[0]-> {font}}}; delete $z-> {charmap}; delete $z-> {docname}; return $z; } sub set_font { my ( $self, $font) = @_; $font = { %$font }; my $n = exists($font-> {name}) ? $font-> {name} : $self-> {font}-> {name}; my $gui_font; $n = $self-> {useDeviceFonts} ? $Prima::PS::Fonts::defaultFontName : 'Default' unless defined $n; $font-> {height} = int(( $font-> {size} * $self-> {resolution}-> [1]) / 72.27 + 0.5) if exists $font-> {size}; AGAIN: if ( $self-> {useDeviceFontsOnly} || !$::application || ( $self-> {useDeviceFonts} && ( # enter, if there's a device font exists $Prima::PS::Fonts::enum_families{ $n} || exists $Prima::PS::Fonts::files{ $n} || ( # or the font encoding is PS::Encodings-specific, # not present in the GUI space exists $font-> {encoding} && ( exists $Prima::PS::Encodings::fontspecific{$font-> {encoding}} || exists $Prima::PS::Encodings::files{$font-> {encoding}} ) && ( !grep { $_ eq $font-> {encoding} } @{$::application-> font_encodings} ) ) ) && # and, the encoding is supported ( !exists $font-> {encoding} || !length ($font-> {encoding}) || ( exists $Prima::PS::Encodings::fontspecific{$font-> {encoding}} || exists $Prima::PS::Encodings::files{$font-> {encoding}} ) ) ) ) { $self-> {font} = Prima::PS::Fonts::font_pick( $font, $self-> {font}, resolution => $self-> {resolution}-> [1]); $self-> {fontCharHeight} = $self-> {font}-> {charheight}; $self-> {docFontMap}-> {$self-> {font}-> {docname}} = 1; $self-> {typeFontMap}-> {$self-> {font}-> {name}} = 1; $self-> {fontWidthDivisor} = $self-> {font}-> {maximalWidth}; $self-> set_locale( $self-> {font}-> {encoding}); } else { my $wscale = $font-> {width}; my $wsize = $font-> {size}; my $wfsize = $self-> {font}-> {size}; delete $font-> {width}; delete $font-> {size}; delete $self-> {font}-> {size}; unless ( $gui_font) { $gui_font = Prima::Drawable-> font_match( $font, $self-> {font}); if ( $gui_font-> {name} ne $n && $self-> {useDeviceFonts}) { # back up my $pitch = (exists ( $font-> {pitch} ) ? $font-> {pitch} : $self-> {font}-> {pitch}) || fp::Variable; $n = $font-> {name} = ( $pitch == fp::Variable) ? $Prima::PS::Fonts::variablePitchName : $Prima::PS::Fonts::fixedPitchName; $font-> {width} = $wscale if defined $wscale; $font-> {wsize} = $wsize if defined $wsize; $self-> {font}-> {size} = $wfsize if defined $wfsize; goto AGAIN; } } $self-> {font} = $gui_font; $self-> {font}-> {size} = int( $self-> {font}-> {height} * 72.27 / $self-> {resolution}-> [1] + 0.5); $self-> {typeFontMap}-> {$self-> {font}-> {name}} = 2; $self-> {fontWidthDivisor} = $self-> {font}-> {width}; $self-> {font}-> {width} = $wscale if $wscale; $self-> {fontCharHeight} = $self-> {font}-> {height}; } $self-> {changed}-> {font} = 1; $self-> {plate}-> destroy, $self-> {plate} = undef if $self-> {plate}; } my %fontmap = (Prima::Application-> get_system_info-> {apc} == apc::Win32) ? ( 'Helvetica' => 'Arial', 'Times' => 'Times New Roman', 'Courier' => 'Courier New', ) : (); sub plate { my $self = $_[0]; return $self-> {plate} if $self-> {plate}; return {ABC => []} if $self-> {useDeviceFontsOnly}; my ( $dimx, $dimy) = ( $self-> {font}-> {maximalWidth}, $self-> {font}-> {height}); my %f = %{$self-> {font}}; $f{style} &= ~(fs::Underlined|fs::StruckOut); if ( $self-> {useDeviceFonts} && exists $Prima::PS::Fonts::files{$f{name}}) { $f{name} =~ s/^([^-]+)\-.*$/$1/; $f{pitch} = fp::Default unless $f{pitch} == fp::Fixed; $f{name} = $fontmap{$f{name}} if exists $fontmap{$f{name}}; } delete $f{size}; delete $f{width}; delete $f{direction}; $self-> {plate} = Prima::Image-> create( type => im::BW, width => $dimx, height => $dimy, font => \%f, backColor => cl::Black, color => cl::White, textOutBaseline => 1, preserveType => 1, conversion => ict::None, ); my ( $f, $l) = ( $self-> {plate}-> font-> {firstChar}, $self-> {plate}-> font-> {lastChar}); my $x = $self-> {plate}-> {ABC} = $self-> {plate}-> get_font_abc( $f, $l); my $j = (230 - $f) * 3; return $self-> {plate}; } sub place_glyph { return '' if $_[0]-> {useDeviceFontsOnly}; my ( $self, $char) = @_; my $z = $_[0]-> plate; my $x = ord $char; my $d = $z-> font-> descent; my ( $dimx, $dimy) = $z-> size; my ( $f, $l) = ( $z-> font-> firstChar, $z-> font-> lastChar); my $ls = int(( $dimx + 31) / 32) * 4; my $la = int ($dimx / 8) + (( $dimx & 7) ? 1 : 0); my $ax = ( $dimx & 7) ? (( 0xff << (7-( $dimx & 7))) & 0xff) : 0xff; my $xsf = 0; my ( $a, $b, $c); if ( Encode::is_utf8( $char)) { ( $a, $b, $c) = @{ $z-> get_font_abc( $x, $x, 1)}; } else { my $abc = $z-> {ABC}; ( $a, $b, $c) = ( $abc-> [ ( $x - $f) * 3], $abc-> [ ( $x - $f) * 3 + 1], $abc-> [ ( $x - $f) * 3 + 2], ); } return '' if $b <= 0; $z-> begin_paint; $z-> clear; $z-> text_out( chr( $x), ($a < 0) ? -$a : 0, $d); $z-> end_paint; my $dd = $z-> data; my ($j, $k); my @emmap = (0) x $dimy; my @bbox = ( $a, 0, $b - $a, $dimy - 1); for ( $j = $dimy - 1; $j >= 0; $j--) { #my @ss = map { my $x = ord $_; map { ($x & (0x80>>$_))?'X':'.'} 0..7 } split( '', substr( $dd, $ls * $j, $la)); my @xdd = map { ord $_ } split( '', substr( $dd, $ls * $j, $la)); #print "@ss @xdd\n"; $xdd[-1] &= $ax; $emmap[$j] = 1 unless grep { $_ } @xdd; } for ( $j = 0; $j < $dimy; $j++) { last unless $emmap[$j]; $bbox[1]++; } for ( $j = $dimy - 1; $j >= 0; $j--) { last unless $emmap[$j]; $bbox[3]--; } if ( $bbox[3] >= 0) { $bbox[1] -= $d; $bbox[3] -= $d; my $zd = $z-> extract( ( $a < 0) ? 0 : $a, $bbox[1] + $d, $b, $bbox[3] - $bbox[1] + 1, ); # $z-> save("a.gif"); my $bby = $bbox[3] - $bbox[1] + 1; my $zls = int(( $b + 31) / 32) * 4; my $zla = int ($b / 8) + (( $b & 7) ? 1 : 0); $zd = $zd-> data; my $cd = ''; for ( $j = $bbox[3] - $bbox[1]; $j >= 0; $j--) { $cd .= substr( $zd, $j * $zls, $zla); } my $cdz = ''; for ( $j = 0; $j < length $cd; $j++) { $cdz .= sprintf("%02x", ord substr( $cd, $j, 1)); } $_[0]-> {plate}-> {yd} = $bbox[1] * 72.27 / $_[0]-> {resolution}-> [1]; my $scalex = 72.27 * $b / $_[0]-> {resolution}-> [0]; my $scaley = 72.27 * $bby / $_[0]-> {resolution}-> [1]; return "$scalex $scaley scale $b $bby true [$b 0 0 -$bby 0 $bby] <$cdz> imagemask", $a, $b, $c; } return ''; } sub get_rmap { my @rmap; my $c = $_[0]-> {font}-> {chardata}; my $le = $_[0]-> {localeEncoding}; my $nd = $c-> {'.notdef'}; my $fs = $_[0]-> {font}-> {height} / $_[0]-> {fontCharHeight}; if ( defined $nd) { $nd = [ @$nd ]; $$nd[$_] *= $fs for 1..3; } else { $nd = [0,0,0,0]; } my ( $f, $l) = ( $_[0]-> {font}-> {firstChar}, $_[0]-> {font}-> {lastChar}); my $i; my $abc; if ( $_[0]-> {typeFontMap}-> {$_[0]-> {font}-> {name}} == 1) { for ( $i = 0; $i < 255; $i++) { if (( $le-> [$i] ne '.notdef') && $c-> { $le-> [ $i]}) { $rmap[$i] = [ $i, map { $_ * $fs } @{$c-> { $le-> [ $i]}}[1..3]]; } elsif ( $i >= $f && $i <= $l) { $abc = $_[0]-> plate-> {ABC} unless $abc; my $j = ( $i - $f) * 3; $rmap[$i] = [ $i, @$abc[ $j .. $j + 2]]; } } } else { $abc = $_[0]-> plate-> {ABC}; for ( $i = $f; $i <= $l; $i++) { my $j = ( $i - $f) * 3; $rmap[$i] = [ $i, @$abc[ $j .. $j + 2]]; } } # @rmap = map { $c-> {$_} } @{$_[0]-> {localeEncoding}}; return \@rmap, $nd; } sub get_font_abc { my ( $self, $first, $last) = @_; my $lim = ( defined ($self-> {font}-> {encoding}) && exists($Prima::PS::Encodings::fontspecific{$self-> {font}-> {encoding}})) ? 255 : 127; $first = 0 if !defined $first || $first < 0; $first = $lim if $first > $lim; $last = $lim if !defined $last || $last < 0 || $last > $lim; my $i; my @ret; my ( $rmap, $nd) = $self-> get_rmap; my $wmul = $self-> {font}-> {width} / $self-> {fontWidthDivisor}; for ( $i = $first; $i < $last; $i++) { my $cd = $rmap-> [ $i] || $nd; push( @ret, map { $_ * $wmul } @$cd[1..3]); } return \@ret; } sub get_font_ranges { my $self = $_[0]; return [ $self-> {font}-> {firstChar}, $self-> {font}-> {lastChar}]; } sub get_text_width { my ( $self, $text, $addOverhang) = @_; my $i; my $len = length $text; return 0 unless $len; my ( $rmap, $nd) = $self-> get_rmap; my $cd; my $w = 0; for ( $i = 0; $i < $len; $i++) { my $cd = $rmap-> [ ord( substr( $text, $i, 1))] || $nd; $w += $cd-> [1] + $cd-> [2] + $cd-> [3]; } if ( $addOverhang) { $cd = $rmap-> [ ord( substr( $text, 0, 1))] || $nd; $w += ( $cd-> [1] < 0) ? -$cd-> [1] : 0; $cd = $rmap-> [ ord( substr( $text, $len - 1, 1))] || $nd; $w += ( $cd-> [3] < 0) ? -$cd-> [3] : 0; } return $w * $self-> {font}-> {width} / $self-> {fontWidthDivisor}; } sub get_text_box { my ( $self, $text) = @_; my ( $rmap, $nd) = $self-> get_rmap; my $len = length $text; return [ (0) x 10 ] unless $len; my $cd; my $wmul = $self-> {font}-> {width} / $self-> {fontWidthDivisor}; $cd = $rmap-> [ ord( substr( $text, 0, 1))] || $nd; my $ovxa = $wmul * (( $cd-> [1] < 0) ? -$cd-> [1] : 0); $cd = $rmap-> [ ord( substr( $text, $len - 1, 1))] || $nd; my $ovxb = $wmul * (( $cd-> [3] < 0) ? -$cd-> [3] : 0); my $w = $self-> get_text_width( $text); my @ret = ( -$ovxa, $self-> {font}-> {ascent} - 1, -$ovxa, -$self-> {font}-> {descent}, $w - $ovxb, $self-> {font}-> {ascent} - 1, $w - $ovxb, -$self-> {font}-> {descent}, $w, 0 ); unless ( $self-> textOutBaseline) { $ret[$_] += $self-> {font}-> {descent} for (1,3,5,7,9); } if ( $self-> {font}-> {direction} != 0) { my $s = sin( $self-> {font}-> {direction} / 57.29577951); my $c = cos( $self-> {font}-> {direction} / 57.29577951); my $i; for ( $i = 0; $i < 10; $i+=2) { my ( $x, $y) = @ret[$i,$i+1]; $ret[$i] = $x * $c - $y * $s; $ret[$i+1] = $x * $s + $y * $c; } } return \@ret; } 1; __END__ =pod =head1 NAME Prima::PS::Drawable - PostScript interface to Prima::Drawable =head1 SYNOPSIS use Prima; use Prima::PS::Drawable; my $x = Prima::PS::Drawable-> create( onSpool => sub { open F, ">> ./test.ps"; print F $_[1]; close F; }); die "error:$@" unless $x-> begin_doc; $x-> font-> size( 30); $x-> text_out( "hello!", 100, 100); $x-> end_doc; =head1 DESCRIPTION Realizes the Prima library interface to PostScript level 2 document language. The module is designed to be compliant with Prima::Drawable interface. All properties' behavior is as same as Prima::Drawable's, except those described below. =head2 Inherited properties =over =item ::resolution Can be set while object is in normal stage - cannot be changed if document is opened. Applies to fillPattern realization and general pixel-to-point and vice versa calculations =item ::region - ::region is not realized ( yet?) =back =head2 Specific properties =over =item ::copies amount of copies that PS interpreter should print =item ::grayscale could be 0 or 1 =item ::pageSize physical page dimension, in points =item ::pageMargins non-printable page area, an array of 4 integers: left, bottom, right and top margins in points. =item ::reversed if 1, a 90 degrees rotated document layout is assumed =item ::rotate and ::scale along with Prima::Drawable::translate provide PS-specific transformation matrix manipulations. ::rotate is number, measured in degrees, counter-clockwise. ::scale is array of two numbers, respectively x- and y-scale. 1 is 100%, 2 is 200% etc. =item ::useDeviceFonts 1 by default; optimizes greatly text operations, but takes the risk that a character could be drawn incorrectly or not drawn at all - this behavior depends on a particular PS interpreter. =item ::useDeviceFontsOnly If 1, the system fonts, available from Prima::Application interfaces can not be used. It is designed for developers and the outside-of-Prima applications that wish to use PS generation module without graphics. If 1, C<::useDeviceFonts> is set to 1 automatically. Default value is 0 =back =head2 Internal methods =over =item emit Can be called for direct PostScript code injection. Example: $x-> emit('0.314159 setgray'); $x-> bar( 10, 10, 20, 20); =item pixel2point and point2pixel Helpers for translation from pixel to points and vice versa. =item fill & stroke Wrappers for PS outline that is expected to be filled or stroked. Apply colors, line and fill styles if necessary. =item spool Prima::PS::Drawable is not responsible for output of generated document, it just calls ::spool when document is closed through ::end_doc. By default just skips data. Prima::PS::Printer handles spooling logic. =item fonts Returns Prima::Application::font plus those that defined into Prima::PS::Fonts module. =back =cut Prima-1.28/Prima/PS/Encodings.pm0000644000175100017510000001217311150770061014137 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # $Id: Encodings.pm,v 1.7 2005/10/13 17:22:52 dk Exp $ # package Prima::PS::Encodings; use vars qw(%files %fontspecific %cache); use strict; use Prima::Utils; %files = ( 'default' => 'PS/locale/ascii', '1276' => 'PS/locale/ps-standart', 'ps-standart'=> 'PS/locale/ps-standart', '1277' => 'PS/locale/ps-iso-latin1', 'ps-latin1' => 'PS/locale/ps-iso-latin1', 'Latin1' => 'PS/locale/ps-iso-latin1', 'iso8859-1' => 'PS/locale/iso8859-1', 'iso8859-2' => 'PS/locale/iso8859-2', 'iso8859-3' => 'PS/locale/iso8859-3', 'iso8859-4' => 'PS/locale/iso8859-4', 'iso8859-7' => 'PS/locale/iso8859-7', 'iso8859-9' => 'PS/locale/iso8859-9', 'iso8859-10' => 'PS/locale/iso8859-10', 'iso8859-11' => 'PS/locale/iso8859-11', 'iso8859-13' => 'PS/locale/iso8859-13', 'iso8859-14' => 'PS/locale/iso8859-14', 'iso8859-15' => 'PS/locale/iso8859-15', 'ibm-437' => 'PS/locale/ibm-cp437', '437' => 'PS/locale/ibm-cp437', 'ibm-850' => 'PS/locale/ibm-cp850', '850' => 'PS/locale/ibm-cp850', 'win-1250' => 'PS/locale/win-cp1250', '1250' => 'PS/locale/win-cp1250', 'win-1252' => 'PS/locale/win-cp1252', '1252' => 'PS/locale/win-cp1252', ); %fontspecific = ( 'Specific' => 1, ); sub exists { my $cp = defined( $_[0]) ? ( lc $_[0]) : 'default'; $cp = $1 if $cp =~ /\.([^\.]*)$/; $cp =~ s/_//g; return exists($files{$cp}); } sub unique { my %h; my @ret; for (sort keys %files) { next if m/^\d+$/ || $h{$files{$_}}; $h{$files{$_}} = 1; push @ret, $_; } return @ret; } sub load { my $cp = defined( $_[0]) ? $_[0] : 'default'; $cp = $1 if $cp =~ /\.([^\.]*)$/; $cp =~ s/_//g; if ( $cp eq 'null') { return $cache{null} if exists $cache{null}; return $cache{null} = [('.notdef') x 256]; } my $fx = exists($files{$cp}) ? $files{$cp} : $files{default}; return $cache{$fx} if exists $cache{$fx}; my $f = Prima::Utils::find_image( $fx); unless ( $f) { warn("Prima::PS::Encodings: cannot find encoding file for $cp\n"); return load('default') unless $cp eq 'default'; return; } unless ( open F, $f) { warn("Prima::PS::Encodings: cannot load $f\n"); return load('default') unless $cp eq 'default'; return; } my @f = map { chomp; length($_) ? $_ : ()} ; close F; splice( @f, 256) if 256 < @f; push( @f, '.notdef') while 256 > @f; return $cache{$fx} = \@f; } __END__ =pod =head1 NAME Prima::PS::Encodings - manage latin-based encodings =head1 SYNOPSIS use Prima::PS::Encodings; =head1 DESCRIPTION This module provides code tables for major latin-based encodings, for the glyphs that usually provided by every PS-based printer or interpreter. Prima::PS::Drawable uses these encodings when it decides whether the document have to be supplied with a bitmap character glyph or a character index, thus relying on PS interpreter capabilities. Latter is obviously preferable, but as it's not possible to know beforehand what glyphs are supported by PS interpreter, the Latin glyph set was selected as a ground level. =over =item files It's unlikely that users will need to supply their own encodings, however this can be accomplished by: use Prima::PS::Encodings; $Prima::PS::Encodings::files{iso8859-5} = 'PS/locale/greek-iso'; =item fontspecific The only non-latin encoding currently present is 'Specific'. If any other specific-encoded fonts are to be added, the encoding string must be added as a key to %fontspecific =item load Loads encoding file by given string. Tries to be smart to guess actual file from identifier string returned from setlocale(NULL). If fails, loads default encoding, which defines only glyphs from 32 to 126. Special case is 'null' encoding, returns array of 256 .notdef's. =item unique Returns list of Latin-based encoding string unique keys. =back =cut Prima-1.28/Prima/PS/Printer.pm0000644000175100017510000004757411150770061013666 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # $Id: Printer.pm,v 1.25 2008/05/06 09:34:03 dk Exp $ # =pod =head1 NAME Prima::PS::Printer - PostScript interface to Prima::Printer =head1 SYNOPSIS use Prima; use Prima::PS::Printer; =head1 DESCRIPTION Realizes the Prima printer interface to PostScript level 2 document language through Prima::PS::Drawable module. Allows different user profiles to be created and managed with GUI setup dialog. The module is designed to be compliant with Prima::Printer interface. Also contains convenience classes (File, LPR, Pipe) for non-GUI use. =head1 SYNOPSIS use Prima::PS::Printer; my $x; if ( $preview) { $x = Prima::PS::Pipe-> create( command => 'gv -'); } elsif ( $print_in_file) { $x = Prima::PS::File-> create( file => 'out.ps'); } else { $x = Prima::PS::LPR-> create( args => '-Pcolorprinter'); } $x-> begin_doc; $x-> font-> size( 300); $x-> text_out( "hello!", 100, 100); $x-> end_doc; =cut use strict; use Prima; use Prima::Utils; use IO::Handle; use Prima::PS::Drawable; package Prima::PS::Printer; use vars qw(@ISA %pageSizes $unix); @ISA = qw(Prima::PS::Drawable); $unix = Prima::Application-> get_system_info-> {apc} == apc::Unix; use constant lpr => 0; use constant file => 1; use constant cmd => 2; sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( resFile => Prima::Utils::path . '/Printer', printer => undef, gui => 1, defaultData => { color => 1, resolution => 300, page => 'A4', copies => 1, scaling => 1, portrait => 1, useDeviceFonts => 1, useDeviceFontsOnly => 0, spoolerType => $unix ? lpr : file, spoolerData => '', devParms => { MediaType => '', MediaColor => '', MediaWeight => '', MediaClass => '', InsertSheet => 0, LeadingEdge => 0, ManualFeed => 0, TraySwitch => 0, MediaPosition => '', DeferredMediaSelection => 0, MatchAll => 0, }, }, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> {defaultData} = {}; $self-> {data} = {}; $self-> $_($profile{$_}) for qw(defaultData resFile); $self-> {printers} = {}; $self-> {gui} = $profile{gui}; my $pr = $profile{printer} if defined $profile{printer}; if ( open F, $self-> {resFile}) { local $/; my $fc = '$fc = ' . ; close F; eval "$fc"; $self-> {printers} = $fc if !$@ && defined($fc) && ref($fc) eq 'HASH'; } unless ( scalar keys %{$self-> {printers}}) { $self-> {printers}-> {'Default printer'} = deepcopy( $self-> {defaultData}); if ( $unix) { $self-> import_printers( 'printers', '/etc/printcap'); $self-> {printers}-> {GhostView} = deepcopy( $self-> {defaultData}); $self-> {printers}-> {GhostView}-> {spoolerType} = cmd; $self-> {printers}-> {GhostView}-> {spoolerData} = 'gv -'; } $self-> {printers}-> {File} = deepcopy( $self-> {defaultData}); $self-> {printers}-> {File}-> {spoolerType} = file; } unless ( defined $pr) { if ( defined $self-> {printers}-> {'Default printer'}) { $pr = 'Default printer'; } else { my @k = keys %{$self-> {printers}}; $pr = $k[0]; } } $self-> printer( $pr); return %profile; } sub import_printers { my ( $self, $slot, $file) = @_; return undef unless open PRINTERS, $file; my $np; my @names; while ( ) { chomp; if ( $np) { $np = 0 unless /\\\\s*$/; } else { next if /^\#/ || /^\s*$/; push( @names, $1) if m/^([^\|\:]+)/; $np = 1 if /\\\s*$/; } } close PRINTERS; my @ret; for ( @names) { s/^\s*//g; s/\s*$//g; next unless length; my $n = "Printer '$_'"; my $j = 0; while ( exists $self-> {$slot}-> {$n}) { $n = "Printer '$_' #$j"; $j++; } $self-> {$slot}-> {$n} = deepcopy( $self-> {defaultData}); $self-> {$slot}-> {$n}-> {spoolerType} = lpr; $self-> {$slot}-> {$n}-> {spoolerData} = "-P$_"; push @ret, $n; } return @ret; } sub printers { my $self = $_[0]; my @res; for ( keys %{$self-> {printers}}) { my $d = $self-> {printers}-> {$_}; push @res, { name => $_, device => (( $d-> {spoolerType} == lpr ) ? "lp $d->{spoolerData}" : (( $d-> {spoolerType} == file) ? 'file' : $d-> {spoolerData})), defaultPrinter => ( $self-> {current} eq $_) ? 1 : 0, }, } return \@res; } sub resolution { return $_[0]-> SUPER::resolution unless $#_; $_[0]-> raise_ro("resolution") if @_ != 3; # pass inherited call shift-> SUPER::resolution( @_); } sub resFile { return $_[0]-> {resFile} unless $#_; my ( $self, $fn) = @_; if ( $fn =~ /^\s*~/) { my $home = defined( $ENV{HOME}) ? $ENV{HOME} : '/'; $fn =~ s/^\s*~/$home/; } $self-> {resFile} = $fn; } sub printer { return $_[0]-> {current} unless $#_; my ( $self, $printer) = @_; return undef unless exists $self-> {printers}-> {$printer}; $self-> end_paint_info if $self-> get_paint_state == 2; $self-> end_paint if $self-> get_paint_state; $self-> {current} = $printer; $self-> {data} = {}; $self-> data( $self-> {defaultData}); $self-> data( $self-> {printers}-> {$printer}); $self-> translate( 0, 0); return 1; } sub data { return $_[0]-> {data} unless $#_; my ( $self, $dd) = @_; my $dv = $dd-> {devParms}; my $p = $self-> {data}; for ( keys %$dd) { next if $_ eq 'devParms'; $p-> {$_} = $dd-> {$_}; } if ( defined $dv) { for ( keys %$dv) { $p-> {devParms}-> {$_} = $dv-> {$_}; } } $self-> SUPER::resolution( $p-> {resolution}, $p-> {resolution}) if exists $dd-> {resolution}; $self-> scale( $p-> {scaling}, $p-> {scaling}) if exists $dd-> {scaling}; $self-> reversed( $p-> {portrait} ? 0 : 1) if exists $dd-> {portrait}; $self-> pageSize( @{exists($pageSizes{$p-> {page}}) ? $pageSizes{$p-> {page}} : $pageSizes{A4}} ) if exists $dd-> {page}; if ( exists $dd-> {page}) { $self-> useDeviceFonts( $p-> {useDeviceFonts}); $self-> useDeviceFontsOnly( $p-> {useDeviceFontsOnly}); } if ( defined $dv) { my %dp = %{$p-> {devParms}}; for ( keys %dp) { delete $dp{$_} unless length $dp{$_}; } for ( qw( LeadingEdge InsertSheet ManualFeed DeferredMediaSelection TraySwitch MatchAll)) { delete $dp{$_} unless $dp{$_}; } $dp{LeadingEdge}-- if exists $dp{LeadingEdge}; for ( qw( MediaType MediaColor MediaWeight MediaClass)) { next unless exists $dp{$_}; $dp{$_} =~ s/(\\|\(|\))/\\$1/g; $dp{$_} = '(' . $dp{$_} . ')'; } for ( qw( InsertSheet ManualFeed TraySwitch DeferredMediaSelection MatchAll)) { next unless exists $dp{$_}; $dp{$_} = $dp{$_} ? 'true' : 'false'; } $self-> pageDevice( \%dp); } $self-> grayscale( $p-> {color} ? 0 : 1) if exists $dd-> {color}; } sub defaultData { return $_[0]-> {defaultData} unless $#_; my ( $self, $dd) = @_; my $dv = $dd-> {devParms}; delete $dd-> {devParms}; for ( keys %$dd) { $self-> {defaultData}-> {$_} = $dd-> {$_}; } if ( defined $dv) { for ( keys %$dv) { $self-> {defaultData}-> {devParms}-> {$_} = $dv-> {$_}; } } } %pageSizes = ( # in points 'A0' => [ 2391, 3381], 'A1' => [ 1688, 2391], 'A2' => [ 1193, 1688], 'A3' => [ 843, 1193], 'A4' => [ 596, 843], 'A5' => [ 419, 596], 'A6' => [ 297, 419], 'A7' => [ 209, 297], 'A8' => [ 146, 209], 'A9' => [ 103, 146], 'B0' => [ 2929, 4141], 'B1' => [ 2069, 2929], 'B10' => [ 89, 126], 'B2' => [ 1463, 2069], 'B3' => [ 1034, 1463], 'B4' => [ 729, 1034], 'B5' => [ 516, 729], 'B6' => [ 362, 516], 'B7' => [ 257, 362], 'B8' => [ 180, 257], 'B9' => [ 126, 180], 'C5E' => [ 462, 650], 'US Common #10 Envelope' => [ 297, 684], 'DLE' => [ 311, 624], 'Executive' => [ 541, 721], 'Folio' => [ 596, 937], 'Ledger' => [ 1227, 792], 'Legal' => [ 613, 1011], 'Letter' => [ 613, 792], 'Tabloid' => [ 792, 1227], ); sub deepcopy { my %h = %{$_[0]}; $h{devParms} = {%{$h{devParms}}}; return \%h; } sub setup_dialog { return unless $_[0]-> {gui}; eval "use Prima::PS::Setup"; die "$@\n" if $@; $_[0]-> sdlg_exec; } sub begin_doc { my ( $self, $docName) = @_; return 0 if $self-> get_paint_state; $self-> {spoolHandle} = undef; if ( $self-> {data}-> {spoolerType} == file) { if ( $self-> {gui}) { eval "use Prima::MsgBox"; die "$@\n" if $@; my $f = Prima::MsgBox::input_box( 'Print to file', 'Output file name:', '', mb::OKCancel, buttons => { mb::OK, { modalResult => undef, onClick => sub { $_[0]-> clear_event; my $f = $_[0]-> owner-> InputLine1-> text; if ( -f $f) { return 0 if Prima::MsgBox::message( "File $f already exists. Overwrite?", mb::Warning|mb::OKCancel) != mb::OK; } else { unless ( open F, "> $f") { Prima::MsgBox::message( "Error opening $f:$!", mb::Error|mb::OK); return 0; } close F; unlink $f; } $_[0]-> owner-> modalResult( mb::OK); $_[0]-> owner-> end_modal; }}}); return 0 unless defined $f; my $h = IO::Handle-> new; unless ( open $h, "> $f") { undef $h; Prima::message("Error opening $f:$!"); goto AGAIN; } $self-> {spoolHandle} = $h; $self-> {spoolName} = $f; } else { # no gui my $h = IO::Handle-> new; my $f = $self-> {data}-> {spoolerData}; unless ( open $h, "> $f") { undef $h; return 0; } $self-> {spoolHandle} = $h; $self-> {spoolName} = $f; } unless ( $self-> SUPER::begin_doc( $docName)) { unlink( $self-> {spoolName}); close( $self-> {spoolHandle}); return 0; } return 1; } return $self-> SUPER::begin_doc( $docName); } my ( $sigpipe); sub __end { my $self = $_[0]; close( $self-> {spoolHandle}) if $self-> {spoolHandle}; if ( $self-> {data}-> {spoolerType} != file) { defined($sigpipe) ? $SIG{PIPE} = $sigpipe : delete($SIG{PIPE}); } $self-> {spoolHandle} = undef; $sigpipe = undef; } sub end_doc { my $self = $_[0]; $self-> SUPER::end_doc; $self-> __end; } sub abort_doc { my $self = $_[0]; $self-> SUPER::abort_doc; $self-> __end; unlink $self-> {spoolName} if $self-> {data}-> {spoolerType} == file; } sub spool { my ( $self, $data) = @_; my $piped = 0; if ( $self-> {data}-> {spoolerType} != file && !$self-> {spoolHandle}) { my @cmds; if ( $self-> {data}-> {spoolerType} == lpr) { push( @cmds, map { $_ . ' ' . $self-> {data}-> {spoolerData}} qw( lp lpr /bin/lp /bin/lpr /usr/bin/lp /usr/bin/lpr)); } else { push( @cmds, $self-> {data}-> {spoolerData}); } my $ok = 0; $sigpipe = $SIG{PIPE}; $SIG{PIPE} = 'IGNORE'; CMDS: for ( @cmds) { $piped = 0; my $f = IO::Handle-> new; next unless open $f, "|$_"; $f-> autoflush(1); $piped = 1 unless print $f $data; close( $f), next if $piped; $ok = 1; $self-> {spoolHandle} = $f; $self-> {spoolName} = $_; last; } Prima::message("Error printing to '$cmds[0]'") if !$ok && $self-> {gui}; return $ok; } if ( !(print {$self-> {spoolHandle}} $data) || ( $piped && $self-> {data}-> {spoolerType} != file ) ) { Prima::message( "Error printing to '$self->{spoolName}'") if $self-> {gui}; return 0; } return 1; } sub options { my $self = shift; if ( 0 == @_) { return qw( Color Resolution PaperSize Copies Scaling Orientation UseDeviceFonts UseDeviceFontsOnly ), keys %{$self->{data}->{devParms}}; } elsif ( 1 == @_) { # get value my $v = shift; my $d = $self-> {data}; return $d->{devParms}->{$v} if exists $d->{devParms}->{$v}; if ( $v eq 'Orientation') { return $d->{portrait} ? 'Portrait' : 'Landscape' } elsif ( $v eq 'Color') { return $d->{color} ? 'Color' : 'Monochrome' } else { $v = 'page' if $v eq 'PaperSize'; $v = lcfirst $v; return $d-> {$v}; } } else { my %newdata; my $successfully_set = 0; while ( @_ ) { # set value my ( $opt, $val) = ( shift, shift); my $d = $self-> {data}; if ( exists $d->{devParms}->{$opt}) { $newdata{devParms}->{$opt} = $val; } elsif ( $opt eq 'Orientation') { next unless $val =~ /^(?:(Landscape)|(Portrait))$/; $newdata{portrait} = $2 ? 1 : 0; } elsif ( $opt eq 'Color') { next unless $val =~ /^(?:(Color)|(Monochrome))$/; $newdata{color} = $1 ? 1 : 0; } else { $opt = lcfirst $opt; $opt = 'page' if $opt eq 'PaperSize'; next unless exists $d->{$opt}; $newdata{$opt} = $val; } $successfully_set++; } $self-> data( \%newdata); return $successfully_set; } } package Prima::PS::File; use vars qw(@ISA); @ISA=q(Prima::PS::Printer); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( file => 'out.ps', gui => 0, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> {data}-> {spoolerType} = Prima::PS::Printer::file; $self-> {data}-> {spoolerData} = $profile{file}; } sub file { return $_[0]-> {data}-> {spoolerData} unless $#_; $_[0]-> {data}-> {spoolerData} = $_[1]; } package Prima::PS::LPR; use vars qw(@ISA); @ISA=q(Prima::PS::Printer); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( gui => 0, args => '', ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> {data}-> {spoolerType} = Prima::PS::Printer::lpr; $self-> {data}-> {spoolerData} = $profile{args}; } sub args { return $_[0]-> {data}-> {spoolerData} unless $#_; $_[0]-> {data}-> {spoolerData} = $_[1]; } package Prima::PS::Pipe; use vars qw(@ISA); @ISA=q(Prima::PS::Printer); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( gui => 0, command => '', ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $self-> {data}-> {spoolerType} = Prima::PS::Printer::cmd; $self-> {data}-> {spoolerData} = $profile{command}; } sub command { return $_[0]-> {data}-> {spoolerData} unless $#_; $_[0]-> {data}-> {spoolerData} = $_[1]; } 1; =pod =head1 Printer options Below is the list of options supported by C method: =over =item Color STRING One of : C =item Resolution INTEGER Dots per inch. =item PageSize STRING One of: C, BI, Executive, Folio, Ledger, Legal, Letter, Tabloid, US Common #10 Envelope>. =item Copies INTEGER =item Scaling FLOAT 1 is 100%, 1.5 is 150%, etc. =item Orientation One of : C, C. =item UseDeviceFonts BOOLEAN If 1, use limited set of device fonts in addition to exported bitmap fonts. =item UseDeviceFontsOnly BOOLEAN If 1, use limited set of device fonts instead of exported bitmap fonts. Its usage may lead to that some document fonts will be mismatched. =item MediaType STRING An arbitrary string representing special attributes of the medium other than its size, color, and weight. This parameter can be used to identify special media such as envelopes, letterheads, or preprinted forms. =item MediaColor STRING A string identifying the color of the medium. =item MediaWeight FLOAT The weight of the medium in grams per square meter. "Basis weight" or or null "ream weight" in pounds can be converted to grams per square meter by multiplying by 3.76; for example, 10-pound paper is approximately 37.6 grams per square meter. =item MediaClass STRING (Level 3) An arbitrary string representing attributes of the medium that may require special action by the output device, such as the selection of a color rendering dictionary. Devices should use the value of this parameter to trigger such media-related actions, reserving the MediaType parameter (above) for generic attributes requiring no device-specific action. The MediaClass entry in the output device dictionary defines the allowable values for this parameter on a given device; attempting to set it to an unsupported value will cause a configuration error. =item InsertSheet BOOLEAN (Level 3) A flag specifying whether to insert a sheet of some special medium directly into the output document. Media coming from a source for which this attribute is Yes are sent directly to the output bin without passing through the device's usual imaging mechanism (such as the fuser assembly on a laser printer). Consequently, nothing painted on the current page is actually imaged on the inserted medium. =item LeadingEdge BOOLEAN (Level 3) A value specifying the edge of the input medium that will enter the printing engine or imager first and across which data will be imaged. Values reflect positions relative to a canonical page in portrait orientation (width smaller than height). When duplex printing is enabled, the canonical page orientation refers only to the front (recto) side of the medium. =item ManualFeed BOOLEAN Flag indicating whether the input medium is to be fed manually by a human operator (Yes) or automatically (No). A Yes value asserts that the human operator will manually feed media conforming to the specified attributes ( MediaColor, MediaWeight, MediaType, MediaClass, and InsertSheet). Thus, those attributes are not used to select from available media sources in the normal way, although their values may be presented to the human operator as an aid in selecting the correct medium. On devices that offer more than one manual feeding mechanism, the attributes may select among them. =item TraySwitch BOOLEAN (Level 3) A flag specifying whether the output device supports automatic switching of media sources. When the originally selected source runs out of medium, some devices with multiple media sources can switch automatically, without human intervention, to an alternate source with the same attributes (such as PageSize and MediaColor) as the original. =item MediaPosition STRING (Level 3) The position number of the media source to be used. This parameter does not override the normal media selection process described in the text, but if specified it will be honored - provided it can satisfy the input media request in a manner consistent with normal media selection - even if the media source it specifies is not the best available match for the requested attributes. =item DeferredMediaSelection BOOLEAN (Level 3) A flag determining when to perform media selection. If Yes, media will be selected by an independent printing subsystem associated with the output device itself. =item MatchAll BOOLEAN A flag specifying whether input media request should match to all non-null values - MediaColor, MediaWeight etc. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, Prima-1.28/Prima/Utils.pm0000644000175100017510000001653411150770061013011 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by: # Vadim Belman # Anton Berezin # # $Id: Utils.pm,v 1.14 2007/05/18 12:21:06 dk Exp $ package Prima::Utils; use strict; require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = qw( query_drives_map query_drive_type getdir get_os get_gui beep sound username xcolor find_image path alarm post ); sub xcolor { # input: '#rgb' or '#rrggbb' or '#rrrgggbbb' # output: internal color used by Prima my ($r,$g,$b,$d); $_ = $_[0]; $d=1/16, ($r,$g,$b) = /^#([\da-fA-F]{3})([\da-fA-F]{3})([\da-fA-F]{3})/ or $d=1, ($r,$g,$b) = /^#([\da-fA-F]{2})([\da-fA-F]{2})([\da-fA-F]{2})/ or $d=16, ($r,$g,$b) = /^#([\da-fA-F])([\da-fA-F])([\da-fA-F])/ or return 0; ($r,$g,$b) = (hex($r)*$d,hex($g)*$d,hex($b)*$d); return ($r<<16)|($g<<8)|($b); } sub find_image { my $mod = @_ > 1 ? shift : 'Prima'; my $name = shift; $name =~ s!::!/!g; $mod =~ s!::!/!g; for (@INC) { return "$_/$mod/$name" if -f "$_/$mod/$name" && -r _; } return undef; } # returns a preferred path for the toolkit configuration files, # or, if a filename given, returns the name appended to the path # and proofs that the path exists sub path { my $path; if ( exists $ENV{HOME}) { $path = "$ENV{HOME}/.prima"; } elsif ( $^O =~ /win/i && exists $ENV{USERPROFILE}) { $path = "$ENV{USERPROFILE}/.prima"; } elsif ( $^O =~ /win/i && exists $ENV{WINDIR}) { $path = "$ENV{WINDIR}/.prima"; } else { $path = "/.prima"; } if ( $_[0]) { unless ( -d $path) { eval "use File::Path"; die "$@\n" if $@; File::Path::mkpath( $path); } $path .= "/$_[0]"; } return $path; } sub alarm { my ( $timeout, $sub, @params) = @_; return 0 unless $::application; my $timer = Prima::Timer-> create( name => $sub, timeout => $timeout, owner => $::application, onTick => sub { $_[0]-> destroy; $sub-> (@params); } ); $timer-> start; return 1 if $timer-> get_active; $timer-> destroy; return 0; } sub post { my ( $sub, @params) = @_; return 0 unless $::application; my $id; $id = $::application-> add_notification( 'PostMessage', sub { my ( $me, $parm1, $parm2) = @_; if ( defined($parm1) && $parm1 eq 'Prima::Utils::post' && $parm2 == $id) { $::application-> remove_notification( $id); $sub-> ( @params); $me-> clear_event; } }); return 0 unless $id; $::application-> post_message( 'Prima::Utils::post', $id); return 1; } 1; __DATA__ =head1 NAME Prima::Utils - miscellanneous routines =head1 DESCRIPTION The module contains several helper routines, implemented in both C and perl. Whereas the C-coded parts are accessible only if 'use Prima;' statement was issued prior to the 'use Prima::Utils' invocation, the perl-coded are always available. This makes the module valuable when used without the rest of toolkit code. =head1 API =over =item alarm $TIMEOUT, $SUB, @PARAMS Calls SUB with PARAMS after TIMEOUT milliseconds. =item beep [ FLAGS = mb::Error ] Invokes the system-depended sound and/or visual bell, corresponding to one of following constants: mb::Error mb::Warning mb::Information mb::Question =item get_gui Returns one of C constants, reflecting the graphic user interface used in the system: gui::Default gui::PM gui::Windows gui::XLib gui::GTK2 =item get_os Returns one of C constants, reflecting the platfrom. Currently, the list of the supported platforms is: apc::Os2 apc::Win32 apc::Unix =item ceil DOUBLE Obsolete function. Returns stdlib's ceil() of DOUBLE =item find_image PATH Converts PATH from perl module notation into a file path, and searches for the file in C<@INC> paths set. If a file is found, its full filename is returned; otherwise C is returned. =item floor DOUBLE Obsolete function. Returns stdlib's floor() of DOUBLE =item getdir PATH Reads content of PATH directory and returns array of string pairs, where the first item is a file name, and the second is a file type. The file type is a string, one of the following: "fifo" - named pipe "chr" - character special file "dir" - directory "blk" - block special file "reg" - regular file "lnk" - symbolic link "sock" - socket "wht" - whiteout This function was implemented for faster directory reading, to avoid successive call of C for every file. =item path [ FILE ] If called with no parameters, returns path to a directory, usually F<~/.prima>, that can be used to contain the user settings of a toolkit module or a program. If FILE is specified, appends it to the path and returns the full file name. In the latter case the path is automatically created by C unless it already exists. =item post $SUB, @PARAMS Postpones a call to SUB with PARAMS until the next event loop tick. =item query_drives_map [ FIRST_DRIVE = "A:" ] Returns anonymous array to drive letters, used by the system. FIRST_DRIVE can be set to other value to start enumeration from. Some OSes can probe eventual diskette drives inside the drive enumeration routines, so there is a chance to increase responsiveness of the function it might be reasonable to set FIRST_DRIVE to C string. If the system supports no drive letters, empty array reference is returned ( unix ). =item query_drive_type DRIVE Returns one of C constants, describing the type of drive, where DRIVE is a 1-character string. If there is no such drive, or the system supports no drive letters ( unix ), C is returned. dt::None dt::Unknown dt::Floppy dt::HDD dt::Network dt::CDROM dt::Memory =item sound [ FREQUENCY = 2000, DURATION = 100 ] Issues a tone of FREQUENCY in Hz with DURATION in milliseconds. =item username Returns the login name of the user. Sometimes is preferred to the perl-provided C ( see L ) . =item xcolor COLOR Accepts COLOR string on one of the three formats: #rgb #rrggbb #rrrgggbbb and returns 24-bit RGB integer value. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L Prima-1.28/Prima/Lists.pm0000644000175100017510000017452011150770061013007 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by: # Dmitry Karasik # Anton Berezin # # $Id: Lists.pm,v 1.57 2008/04/09 20:14:27 dk Exp $ package Prima::Lists; # contains: # AbstractListViewer # AbstractListBox # ListViewer # ListBox # ProtectedListBox use strict; use Prima::Const; use Prima::Classes; use Prima::ScrollBar; use Prima::StdBitmap; use Prima::IntUtils; use Prima::Utils; use Cwd; package ci; BEGIN { eval 'use constant Grid => 1 + MaxId;' unless exists $ci::{Grid}; } package Prima::AbstractListViewer; use vars qw(@ISA); @ISA = qw(Prima::Widget Prima::MouseScroller Prima::GroupScroller); use Prima::Classes; { my %RNT = ( %{Prima::Widget-> notification_types()}, SelectItem => nt::Default, DrawItem => nt::Action, Stringify => nt::Action, MeasureItem => nt::Action, DragItem => nt::Default, ); sub notification_types { return \%RNT; } } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( autoHeight => 1, autoHScroll => 1, autoVScroll => 1, borderWidth => 2, extendedSelect => 0, drawGrid => 1, dragable => 0, focusedItem => -1, gridColor => cl::Black, hScroll => 0, integralHeight => 0, integralWidth => 0, itemHeight => $def-> {font}-> {height}, itemWidth => $def-> {width} - 2, multiSelect => 0, multiColumn => 0, offset => 0, topItem => 0, scaleChildren => 0, selectable => 1, selectedItems => [], vertical => 1, vScroll => 1, widgetClass => wc::ListBox, ); @$def{keys %prf} = values %prf; return $def; } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); $p-> { multiSelect} = 1 if exists $p-> { extendedSelect} && $p-> {extendedSelect} && !exists $p-> {multiSelect}; $p-> { autoHeight} = 0 if exists $p-> { itemHeight} && !exists $p-> {autoHeight}; my $multi_column = exists($p->{multiColumn}) ? $p->{multiColumn} : $default->{multiColumn}; my $vertical = exists($p->{vertical}) ? $p->{vertical} : $default->{vertical}; $p-> { integralHeight} = 1 if ! exists $p->{integralHeight} and ( not($multi_column) or $vertical); $p-> { integralWidth} = 1 if ! exists $p->{integralWidth} and $multi_column and not($vertical); $p-> {autoHScroll} = 0 if exists $p-> {hScroll}; $p-> {autoVScroll} = 0 if exists $p-> {vScroll}; } sub init { my $self = shift; for ( qw( lastItem topItem focusedItem)) { $self-> {$_} = -1; } for ( qw( autoHScroll autoVScroll scrollTransaction gridColor dx dy hScroll vScroll itemWidth offset multiColumn count autoHeight multiSelect extendedSelect borderWidth dragable )) { $self-> {$_} = 0; } for ( qw( drawGrid itemHeight integralWidth integralHeight vertical)) { $self-> {$_} = 1; } $self-> {selectedItems} = {}; my %profile = $self-> SUPER::init(@_); $self-> setup_indents; $self-> {selectedItems} = {} unless $profile{multiSelect}; for ( qw( autoHScroll autoVScroll gridColor hScroll vScroll offset multiColumn itemHeight autoHeight itemWidth multiSelect extendedSelect integralHeight integralWidth focusedItem topItem selectedItems borderWidth dragable vertical drawGrid)) { $self-> $_( $profile{ $_}); } $self-> reset; $self-> reset_scrolls; return %profile; } sub draw_items { my ($self, $canvas) = (shift, shift); my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(DrawItem)); $self-> push_event; for ( @_) { $notifier-> ( @notifyParms, $canvas, @$_); } $self-> pop_event; } sub item2rect { my ( $self, $item, @size) = @_; my @a = $self-> get_active_area( 0, @size); if ( $self-> {multiColumn}) { $item -= $self-> {topItem}; my $who = $self-> {vertical} ? 'rows' : 'columns'; my ($j,$i,$ih,$iw,$dg) = ( $self-> {$who} ? ( int( $item / $self-> {$who} - (( $item < 0) ? 1 : 0)), $item % $self-> {$who} ) : (-1, 1), $self-> {itemHeight}, $self-> {itemWidth}, $self-> {drawGrid} ); ($i,$j)=($j,$i) unless $self->{vertical}; return $a[0] + $j * ( $iw + $dg), $a[3] - $ih * ( $i + 1), $a[0] + $j * ( $iw + $dg) + $iw, $a[3] - $ih * ( $i + 1) + $ih; } else { my ($i,$ih) = ( $item - $self-> {topItem}, $self-> {itemHeight}); return $a[0], $a[3] - $ih * ( $i + 1), $a[2], $a[3] - $ih * $i; } } sub on_paint { my ($self,$canvas) = @_; my @size = $canvas-> size; unless ( $self-> enabled) { $self-> color( $self-> disabledColor); $self-> backColor( $self-> disabledBackColor); } my ( $ih, $iw, $dg, @a) = ( $self-> { itemHeight}, $self-> {itemWidth}, $self-> {drawGrid}, $self-> get_active_area( 1, @size) ); my $i; my $j; my $locWidth = $a[2] - $a[0] + 1; my @invalidRect = $canvas-> clipRect; $self-> draw_border( $canvas, undef, @size); if ( $self-> {multiColumn}) { my $xstart = $a[0]; my $yend = $size[1] - $self-> {active_rows} * $ih - 1; my $uncover = $self->{uncover}; my $ymiddle = $a[1] + $uncover->{y} + $self->{yedge} - 1 if defined($uncover); for ( $i = 0; $i < $self-> {partial_columns}; $i++) { my $y = ( defined($uncover) and $i >= $uncover->{x} and $i < $self-> {active_columns} ) ? $ymiddle : (( $i < $self->{active_columns}) ? $yend : $a[3] ); $canvas-> clear( $xstart, $a[1], ( $xstart + $iw - 1 > $a[2]) ? $a[2] : $xstart + $iw - 1, $y ) if $xstart >= $a[0] and $y >= $a[1]; $xstart += $iw + $dg; } if ( $self-> {drawGrid}) { my $c = $canvas-> color; $canvas-> color( $self-> {gridColor}); for ( $i = 1; $i < 1 + $self-> {whole_columns}; $i++) { $canvas-> line( $a[0] + $i * ( $iw + $dg) - 1, $a[1], $a[0] + $i * ( $iw + $dg) - 1, $a[3] ); } $canvas-> color( $c); } } else { $canvas-> clear( @a[0..2], $a[1] + $self-> {uncover}) if defined $self-> {uncover}; } my $focusedState = $self-> focused ? ( exists $self-> {unfocState} ? 0 : 1) : 0; $self-> {unfocVeil} = ( $focusedState && $self-> {focusedItem} < 0 && $locWidth > 0) ? 1 : 0; my $foci = $self-> {focusedItem}; if ( $self-> {count} > 0 && $locWidth > 0) { $canvas-> clipRect( @a); my @paintArray; my $item = $self-> {topItem}; if ( $self-> {multiColumn}) { my $di = $self-> {vertical} ? 1 : $self-> {active_columns}; MAIN:for ( $j = 0; $j < $self-> {active_columns}; $j++) { $item = $self-> {topItem} + $j unless $self-> {vertical}; for ( $i = 0; $i < $self-> {active_rows}; $i++) { if ( $self-> {vertical}) { last MAIN if $item > $self-> {lastItem}; } else { last if $item > $self-> {lastItem}; } my @itemRect = ( $a[0] + $j * ( $iw + $dg), $a[3] - $ih * ( $i + 1) + 1, $a[0] + $j * ( $iw + $dg) + $iw, $a[3] - $ih * ( $i + 1) + $ih + 1 ); $item += $di, next if $itemRect[3] < $invalidRect[1] || $itemRect[1] > $invalidRect[3] || $itemRect[2] < $invalidRect[0] || $itemRect[0] > $invalidRect[2]; my $sel = $self-> {multiSelect} ? exists $self-> {selectedItems}-> {$item} : (( $self-> {focusedItem} == $item) ? 1 : 0); my $foc = ( $foci == $item) ? $focusedState : 0; $foc = 1 if $item == 0 && $self-> {unfocVeil}; push( @paintArray, [ $item, # item number $itemRect[0], $itemRect[1], $itemRect[2]-1, $itemRect[3]-1, $sel, $foc, # selected and focused states $j # column ]); $item += $di; } } } else { for ( $i = 0; $i < $self-> {rows}; $i++) { last if $item > $self-> {lastItem}; my @itemRect = ( $a[0], $a[3] - $ih * ( $i + 1) + 1, $a[2], $a[3] - $ih * $i ); $item++, next if $itemRect[3] < $invalidRect[1] || $itemRect[1] > $invalidRect[3]; my $sel = $self-> {multiSelect} ? exists $self-> {selectedItems}-> {$item} : (( $foci == $item) ? 1 : 0); my $foc = ( $foci == $item) ? $focusedState : 0; $foc = 1 if $item == 0 && $self-> {unfocVeil}; push( @paintArray, [ $item, # item number $itemRect[0] - $self-> {offset}, $itemRect[1], # logic rect $itemRect[2], $itemRect[3], # $sel, $foc, # selected and focused state 0 #column ]); $item++; } } $self-> draw_items( $canvas, @paintArray); } } sub is_default_selection { return $_[0]-> {unfocVeil}; } sub on_enable { $_[0]-> repaint; } sub on_disable { $_[0]-> repaint; } sub on_enter { $_[0]-> redraw_items( $_[0]-> focusedItem); } sub on_keydown { my ( $self, $code, $key, $mod) = @_; return if $mod & km::DeadKey; $mod &= ( km::Shift|km::Ctrl|km::Alt); $self-> notify(q(MouseUp),0,0,0) if defined $self-> {mouseTransaction}; if ( $mod & km::Ctrl && $self-> {multiSelect}) { my $c = chr ( $code & 0xFF); if ( $c eq '/' || $c eq chr(ord('\\')-ord('@'))) { $self-> selectedItems(( $c eq '/') ? [0..$self-> {count}-1] : []); $self-> clear_event; return; } } return if ( $code & 0xFF) && ( $key == kb::NoKey); if ( scalar grep { $key == $_ } ( kb::Left,kb::Right,kb::Up,kb::Down,kb::Home,kb::End,kb::PgUp,kb::PgDn )) { my $newItem = $self-> {focusedItem}; my $doSelect = 0; if ( $mod == 0 || ( $mod & km::Shift && $self-> {multiSelect} && $self-> { extendedSelect}) ) { my $pgStep = $self-> {whole_rows} - 1; $pgStep = 1 if $pgStep <= 0; my $cols = $self-> {whole_columns}; my $mc = $self-> {multiColumn}; my $dx = $self-> {vertical} ? $self-> {rows} : 1; my $dy = $self-> {vertical} ? 1 : $self-> {active_columns}; if ( $key == kb::Up) { $newItem -= $dy; } elsif ( $key == kb::Down) { $newItem += $dy; } elsif ( $key == kb::Left) { $newItem -= $dx if $mc } elsif ( $key == kb::Right) { $newItem += $dx if $mc } elsif ( $key == kb::Home) { $newItem = $self-> {topItem} } elsif ( $key == kb::End) { $newItem = $mc ? $self-> {topItem} + $self-> {whole_rows} * $cols - 1 : $self-> {topItem} + $pgStep; } elsif ( $key == kb::PgDn) { $newItem += $mc ? $self-> {whole_rows} * $cols : $pgStep } elsif ( $key == kb::PgUp) { $newItem -= $mc ? $self-> {whole_rows} * $cols : $pgStep }; $doSelect = $mod & km::Shift; } if ( ( $mod & km::Ctrl) || ( (( $mod & ( km::Shift|km::Ctrl))==(km::Shift|km::Ctrl)) && $self-> {multiSelect} && $self-> { extendedSelect} ) ) { if ( $key == kb::PgUp || $key == kb::Home) { $newItem = 0}; if ( $key == kb::PgDn || $key == kb::End) { $newItem = $self-> {count} - 1}; $doSelect = $mod & km::Shift; } if ( $doSelect ) { my ( $a, $b) = ( defined $self-> {anchor} ? $self-> {anchor} : $self-> {focusedItem}, $newItem ); ( $a, $b) = ( $b, $a) if $a > $b; $self-> selectedItems([$a..$b]); $self-> {anchor} = $self-> {focusedItem} unless defined $self-> {anchor}; } else { $self-> selectedItems([$self-> focusedItem]) if exists $self-> {anchor}; delete $self-> {anchor}; } $self-> offset( $self-> {offset} + 5 * (( $key == kb::Left) ? -1 : 1)) if !$self-> {multiColumn} && ($key == kb::Left || $key == kb::Right); $self-> focusedItem( $newItem >= 0 ? $newItem : 0); $self-> clear_event; return; } else { delete $self-> {anchor}; } if ( $mod == 0 && ( $key == kb::Space || $key == kb::Enter)) { $self-> toggle_item( $self-> {focusedItem}) if $key == kb::Space && $self-> {multiSelect} && !$self-> {extendedSelect}; $self-> clear_event; $self-> notify(q(Click)) if $key == kb::Enter && ($self-> focusedItem >= 0); return; } } sub on_leave { my $self = $_[0]; if ( $self-> {mouseTransaction}) { $self-> capture(0) if $self-> {mouseTransaction}; $self-> {mouseTransaction} = undef; } $self-> redraw_items( $self-> focusedItem); } sub point2item { my ( $self, $x, $y) = @_; my ( $ih, @a) = ( $self-> {itemHeight}, $self-> get_active_area); if ( $self-> {multiColumn}) { my ( $r, $t, $l, $c, $ac) = ( $self-> {active_rows}, $self-> {topItem}, $self-> {lastItem}, $self-> {whole_columns}, $self-> {active_columns}, ); $x -= $a[0]; $y -= $a[1] + $self-> {yedge} + ( $self-> {rows} - $self->{active_rows} ) * $ih; $x /= $self-> {itemWidth} + $self-> {drawGrid}; $y /= $ih; if ( $self->{whole_rows} > 0) { $r -= $self->{rows} - $self->{whole_rows}; } else { $y++; } $y = $r - $y; $x = int( $x - (( $x < 0) ? 1 : 0)); $y = int( $y - (( $y < 0) ? 1 : 0)); $y = $r if $y > $r; if ( $self-> {vertical}) { return $t - $r if $y < 0 && $x < 1; return $t + $r * $x, -1 if $y < 0 && $x >= 0 && $x < $c; return $t + $r * $c if $y < 0 && $x >= $c; return $l + $y + 1 - (( $c and $l < $self->{count}-1) ? $r : 0), $ac <= $c ? 0 : $r if $x > $c && $y >= 0 && $y < $r; return $t + $y - $r if $x < 0 && $y >= 0 && $y < $r; return $l + $r if $x >= $c - 1 && $y >= $r; return $t + $r * ($x + 1)-1, ( $l < $self->{count} -1 ) ? 1 : 0 if $y >= $r && $x >= 0 && $x < $c; return $t + $r - 1 if $x < 0 && $y >= $r; return $x * $r + $y + $t; } else { if ( $y >= $r) { $x = 0 if $x < 0; $x = $ac - 1 if $x >= $ac; my $i = $t + $y * $ac + $x; return $i if $i <= $self->{count}; return $t + ($r - 1) * $ac + $x, ( $t + $y * $ac <= $self->{count}) ? 1 : 0 } if ( $y < 0) { $x = 0 if $x < 0; $x = $ac - 1 if $x >= $ac; my $i = $t - $ac + $x; return ( $i < 0 && $t == 0) ? $x : $i; } return $t + $y * $ac, -1 if $x < 0; return $t + ( $y + 1) * $ac - 1, ( $l < $self->{count} -1 ) ? 1 : 0 if $x >= $ac; return $t + $y * $ac + $x; } } else { return $self-> {topItem} - 1 if $y >= $a[3]; return $self-> {topItem} + $self-> {rows} if $y <= $a[1]; my $h = $a[3]; my $i = $self-> {topItem}; while ( $y > 0) { return $i if $y <= $h && $y > $h - $ih; $h -= $ih; $i++; } } } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; my $bw = $self-> { borderWidth}; $self-> clear_event; return if $btn != mb::Left; my @a = $self-> get_active_area; return if defined $self-> {mouseTransaction} || $y < $a[1] || $y >= $a[3] || $x < $a[0] || $x >= $a[2]; my $item = $self-> point2item( $x, $y); my $foc = $item >= 0 ? $item : 0; if ( $self-> {multiSelect}) { if ( $self-> {extendedSelect}) { if ($mod & km::Shift) { my $foc = $self-> focusedItem; return $self-> selectedItems(( $foc < $item) ? [$foc..$item] : [$item..$foc] ); } elsif ( $mod & km::Ctrl) { return $self-> toggle_item( $item); } elsif ( !$mod) { $self-> {anchor} = $item; $self-> selectedItems([$foc]); } } elsif ( $mod & (km::Ctrl||km::Shift)) { return $self-> toggle_item( $item); } } $self-> {mouseTransaction} = (( $mod & ( km::Alt | ($self-> {multiSelect} ? 0 : km::Ctrl))) && $self-> {dragable}) ? 2 : 1; if ( $self-> {mouseTransaction} == 2) { $self-> {dragItem} = $foc; $self-> {mousePtr} = $self-> pointer; $self-> pointer( cr::Move); } $self-> focusedItem( $foc); $self-> capture(1); } sub on_mouseclick { my ( $self, $btn, $mod, $x, $y, $dbl) = @_; $self-> clear_event; return if $btn != mb::Left || !$dbl; $self-> notify(q(Click)) if $self-> focusedItem >= 0; } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; return unless defined $self-> {mouseTransaction}; my $bw = $self-> { borderWidth}; my ($item, $aux) = $self-> point2item( $x, $y); my @a = $self-> get_active_area; if ( $y >= $a[3] || $y < $a[1] || $x >= $a[2] || $x < $a[0]) { $self-> scroll_timer_start unless $self-> scroll_timer_active; return unless $self-> scroll_timer_semaphore; $self-> scroll_timer_semaphore(0); } else { $self-> scroll_timer_stop; } if ( $aux) { my $top = $self-> {topItem}; $self-> topItem( $self-> {topItem} + $aux); $item += (( $top != $self-> {topItem}) ? $aux : 0); } if ( $self-> {multiSelect} && $self-> {extendedSelect} && exists $self-> {anchor} && $self-> {mouseTransaction} != 2 ) { my ( $a, $b, $c) = ( $self-> {anchor}, $item, $self-> {focusedItem}); my $globSelect = 0; if (( $b <= $a && $c > $a) || ( $b >= $a && $c < $a)) { $globSelect = 1 } elsif ( $b > $a) { if ( $c < $b) { $self-> add_selection([$c + 1..$b], 1) } elsif ( $c > $b) { $self-> add_selection([$b + 1..$c], 0) } else { $globSelect = 1 } } elsif ( $b < $a) { if ( $c < $b) { $self-> add_selection([$c..$b], 0) } elsif ( $c > $b) { $self-> add_selection([$b..$c], 1) } else { $globSelect = 1 } } else { $globSelect = 1 } if ( $globSelect ) { ( $a, $b) = ( $b, $a) if $a > $b; $self-> selectedItems([$a..$b]); } } $self-> focusedItem( $item >= 0 ? $item : 0); $self-> offset( $self-> {offset} + 5 * (( $x < $a[0]) ? -1 : 1)) if $x >= $a[2] || $x < $a[0]; } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return if $btn != mb::Left; return unless defined $self-> {mouseTransaction}; my @dragnotify; if ( $self-> {mouseTransaction} == 2) { $self-> pointer( $self-> {mousePtr}); my $fci = $self-> focusedItem; @dragnotify = ($self-> {dragItem}, $fci) if $fci != $self-> {dragItem} and $self-> {dragItem} >= 0; } delete $self-> {mouseTransaction}; delete $self-> {mouseHorizontal}; delete $self-> {anchor}; $self-> capture(0); $self-> clear_event; $self-> notify(q(DragItem), @dragnotify) if @dragnotify; } sub on_mousewheel { my ( $self, $mod, $x, $y, $z) = @_; $z = int( $z/120); $z *= $self-> {whole_columns} if $self-> {multiColumn} and not $self->{vertical}; $z *= $self-> {whole_rows} if $mod & km::Ctrl; my $newTop = $self-> topItem - $z; my $cols = $self-> {whole_columns}; my $maxTop = $self-> {count} - $self-> {whole_rows} * $cols; $self-> topItem( $newTop > $maxTop ? $maxTop : $newTop); } sub on_size { my $self = $_[0]; $self-> reset; $self-> reset_scrolls; } sub reset { my $self = $_[0]; my @size = $self-> get_active_area( 2); my $ih = $self-> {itemHeight}; my $iw = $self-> {itemWidth}; $self-> {whole_rows} = int( $size[1] / $ih); $self-> {partial_rows} = ( $size[1] > $self-> {whole_rows} * $ih ) ? 1 : 0; $self-> {whole_rows} = 0 if $self-> {whole_rows} < 0; $self-> {partial_rows} += $self-> {whole_rows}; $self-> {yedge} = $size[1] - $self-> {whole_rows} * $ih; $self-> {yedge} = 0 if $self-> {yedge} < 0; if ( $self-> {multiColumn}) { my $top = $self-> {topItem}; my $max = $self-> {count} - 1; my $dg = $self-> {drawGrid}; $self-> {whole_columns} = int( $size[0] / ( $dg + $iw)); $self-> {partial_columns} = ( $size[0] > $self-> {whole_columns} * ( $dg + $iw)) ? 1 : 0; $self-> {whole_columns} = 0 if $self-> {whole_columns} < 0; $self-> {partial_columns} += $self-> {whole_columns}; $self-> {uncover} = undef; $self-> {rows} = $self-> {integralHeight} ? ( $self-> {whole_rows} || $self-> {partial_rows} ) : $self-> {partial_rows}; $self-> {columns} = $self-> {integralWidth} ? ( $self-> {whole_columns} || $self-> {partial_columns} ) : $self-> {partial_columns}; my $seen_items = $self->{rows} * $self-> {columns}; $self-> {lastItem} = ( $top + $seen_items - 1 > $max) ? $max : $top + $seen_items - 1; $seen_items = $self-> {lastItem} - $top + 1; if ( $self-> {vertical} ) { if ( $self-> {rows} > 0) { $self-> {active_rows} = ( $seen_items > $self-> {rows} ) ? $self->{rows} : $seen_items; $self-> {active_columns} = int( $seen_items / $self-> {rows}) + (( $seen_items % $self-> {rows}) ? 1 : 0); $seen_items %= $self->{rows}; $self-> {uncover} = { x => $self-> {active_columns} - 1, y => $ih * ($self-> {whole_rows} - $seen_items) } if $seen_items } else { $self-> {active_columns} = $self-> {active_rows} = 0; } } else { if ( $self-> {columns} > 0) { $self-> {active_columns} = ( $seen_items > $self-> {columns} ) ? $self-> {columns} : $seen_items; $self-> {active_rows} = int( $seen_items / $self-> {columns}) + (int( $seen_items % $self-> {columns}) > 0); $seen_items %= $self->{columns}; $self-> {uncover} = { x => $seen_items, y => $ih * ($self-> {whole_rows} - $self-> {active_rows} + 1), } if $seen_items } else { $self-> {active_columns} = $self-> {active_rows} = 0; } } $self-> {xedge} = $size[0] - $self-> {whole_columns} * ($iw + $dg); $self-> {xedge} = 0 if $self-> {xedge} < 0; } else { $self-> {$_} = 1 for qw(partial_columns whole_columns active_columns columns); $self-> {xedge} = 0; $self-> {rows} = ( $self-> {integralHeight} and $self-> {whole_rows} > 0 ) ? $self-> {whole_rows} : $self-> {partial_rows}; my ($max, $last) = ( $self-> {count} - 1, $self-> {topItem} + $self-> {rows} - 1 ); $self-> {lastItem} = $max > $last ? $last : $max; $self-> {active_rows} = $self->{lastItem} - $self-> {topItem} + 1; $self-> {uncover} = $size[1] - $self-> {active_rows} * $ih - 1 if $self->{active_rows} < $self-> {partial_rows}; } $self-> {uncover} = undef if $size[0] <= 0 or $size[1] <= 0; } sub reset_scrolls { my $self = $_[0]; my $count = $self-> {count}; my $cols = $self-> {whole_columns}; my $rows = $self-> {whole_rows}; $cols++ if ( $self->{whole_columns} == 0 and $self->{active_columns} > 0 ) or ( $self->{partial_columns} > $self->{whole_columns} and $self->{yedge} > $self-> {itemHeight} * 0.66 ); $rows++ if ( $self->{whole_rows} == 0 and $self->{active_rows} > 0 ) or ( $self->{partial_rows} > $self->{whole_rows} and $self->{xedge} > $self-> {itemWidth} * 0.66 ); if ( !($self-> {scrollTransaction} & 1)) { $self-> vScroll( $self->{whole_rows} * $self->{whole_columns} < $count) if $self-> {autoVScroll}; $self-> {vScrollBar}-> set( step => ( $self-> {multiColumn} and not $self->{vertical}) ? $self-> {active_columns} : 1, max => $count - $self->{whole_rows} * $self->{whole_columns}, whole => $count, partial => $rows * $cols, value => $self-> {topItem}, pageStep => $rows, ) if $self-> {vScroll}; } if ( !($self-> {scrollTransaction} & 2)) { if ( $self-> {multiColumn}) { $self-> hScroll( $self->{whole_rows} * $self->{whole_columns} < $count) if $self-> {autoHScroll}; $self-> {hScrollBar}-> set( max => $count - $self->{whole_rows} * $self->{whole_columns}, step => $rows, pageStep => $rows * $cols, whole => $count, partial => $rows * $cols, value => $self-> {topItem}, ) if $self-> {hScroll}; } else { my @sz = $self-> get_active_area( 2); my $iw = $self-> {itemWidth}; if ( $self-> {autoHScroll}) { my $hs = ( $sz[0] < $iw) ? 1 : 0; if ( $hs != $self-> {hScroll}) { $self-> hScroll( $hs); @sz = $self-> get_active_area( 2); } } $self-> {hScrollBar}-> set( max => $iw - $sz[0], whole => $iw, value => $self-> {offset}, partial => $sz[0], pageStep => $iw / 5, ) if $self-> {hScroll}; } } } sub select_all { my $self = $_[0]; $self-> selectedItems([0..$self-> {count}-1]); } sub deselect_all { my $self = $_[0]; $self-> selectedItems([]); } sub set_auto_height { my ( $self, $auto) = @_; $self-> itemHeight( $self-> font-> height) if $auto; $self-> {autoHeight} = $auto; } sub reset_indents { my ( $self) = @_; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub set_count { my ( $self, $count) = @_; $count = 0 if $count < 0; my $oldCount = $self-> {count}; $self-> { count} = $count; my $doFoc = undef; if ( $oldCount > $count) { for ( keys %{$self-> {selectedItems}}) { delete $self-> {selectedItems}-> {$_} if $_ >= $count; } } $self-> reset; $self-> reset_scrolls; $self-> focusedItem( -1) if $self-> {focusedItem} >= $count; $self-> repaint; } sub set_extended_select { my ( $self, $esel) = @_; $self-> {extendedSelect} = $esel; } sub set_focused_item { my ( $self, $foc) = @_; my $oldFoc = $self-> {focusedItem}; $foc = $self-> {count} - 1 if $foc >= $self-> {count}; $foc = -1 if $foc < -1; return if $self-> {focusedItem} == $foc; return if $foc < -1; $self-> {focusedItem} = $foc; $self-> selectedItems([$foc]) if $self-> {multiSelect} && $self-> {extendedSelect} && ! exists $self-> {anchor} && ( !defined($self-> {mouseTransaction}) || $self-> {mouseTransaction} != 2); $self-> notify(q(SelectItem), [ $foc], 1) if $foc >= 0 && !exists $self-> {selectedItems}-> {$foc}; my $topSet = undef; if ( $foc >= 0) { my $mc = $self-> {multiColumn}; my $rows = $self-> {whole_rows} || 1; my $cols = $self-> {whole_columns} || 1; ( $cols, $rows) = ( $rows, $cols) if $mc and not $self->{vertical}; if ( $foc < $self-> {topItem}) { $topSet = $mc ? $foc - $foc % $rows : $foc; } elsif ( $foc >= $self-> {topItem} + $rows * $cols) { $topSet = $mc ? $foc - $foc % $rows - $rows * ( $cols - 1) : $foc - $rows + 1; } } $oldFoc = 0 if $oldFoc < 0; $self-> redraw_items( $foc, $oldFoc); $self-> topItem( $topSet) if defined $topSet; } sub colorIndex { my ( $self, $index, $color) = @_; return ( $index == ci::Grid) ? $self-> {gridColor} : $self-> SUPER::colorIndex( $index) if $#_ < 2; ( $index == ci::Grid) ? ( $self-> gridColor( $color), $self-> notify(q(ColorChanged), ci::Grid)) : ( $self-> SUPER::colorIndex( $index, $color)); } sub dragable { return $_[0]-> {dragable} unless $#_; $_[0]-> {dragable} = $_[1]; } sub set_draw_grid { my ( $self, $dg) = @_; $dg = ( $dg ? 1 : 0); return if $dg == $self-> {drawGrid}; $self-> {drawGrid} = $dg; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub set_grid_color { my ( $self, $gc) = @_; return if $gc == $self-> {gridColor}; $self-> {gridColor} = $gc; $self-> repaint if $self-> {drawGrid}; } sub set_integral_height { my ( $self, $ih) = @_; return if $self-> {integralHeight} == $ih; $self-> {integralHeight} = $ih; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub set_integral_width { my ( $self, $iw) = @_; return if $self-> {integralWidth} == $iw; $self-> {integralWidth} = $iw; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub set_item_height { my ( $self, $ih) = @_; $ih = 1 if $ih < 1; $self-> autoHeight(0); return if $ih == $self-> {itemHeight}; $self-> {itemHeight} = $ih; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub set_item_width { my ( $self, $iw) = @_; $iw = 1 if $iw < 1; return if $iw == $self-> {itemWidth}; $self-> {itemWidth} = $iw; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub set_multi_column { my ( $self, $mc) = @_; return if $mc == $self-> {multiColumn}; $self-> offset(0) if $self-> {multiColumn} = $mc; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub set_multi_select { my ( $self, $ms) = @_; return if $ms == $self-> {multiSelect}; unless ( $self-> {multiSelect} = $ms) { $self-> selectedItems([]); $self-> repaint; } else { $self-> selectedItems([$self-> focusedItem]); } } sub set_offset { my ( $self, $offset) = @_; $self-> {offset} = 0, return if $self-> {multiColumn}; my @sz = $self-> size; my ( $iw, @a) = ( $self-> {itemWidth}, $self-> get_active_area( 0, @sz)); my $lc = $a[2] - $a[0]; if ( $iw > $lc) { $offset = $iw - $lc if $offset > $iw - $lc; $offset = 0 if $offset < 0; } else { $offset = 0; } return if $self-> {offset} == $offset; my $oldOfs = $self-> {offset}; $self-> {offset} = $offset; my $dt = $offset - $oldOfs; $self-> reset; if ( $self-> {hScroll} && !$self-> {multiColumn} && !($self-> {scrollTransaction} & 2)) { $self-> {scrollTransaction} |= 2; $self-> {hScrollBar}-> value( $offset); $self-> {scrollTransaction} &= ~2; } $self-> scroll( -$dt, 0, clipRect => \@a); if ( $self-> focused) { my $focId = ( $self-> {focusedItem} >= 0) ? $self-> {focusedItem} : 0; $self-> invalidate_rect( $self-> item2rect( $focId, @sz)); } } sub redraw_items { my $self = shift; my @sz = $self-> size; $self-> invalidate_rect( $self-> item2rect( $_, @sz)) for @_; } sub set_selected_items { my ( $self, $items) = @_; return if !$self-> { multiSelect} && ( scalar @{$items} > 0); my $ptr = $::application-> pointer; $::application-> pointer( cr::Wait) if scalar @{$items} > 500; my $sc = $self-> {count}; my %newItems; for (@{$items}) { $newItems{$_}=1 if $_>=0 && $_<$sc; } my @stateChangers; # $#stateChangers = scalar @{$items}; my $k; while (defined($k = each %{$self-> {selectedItems}})) { next if exists $newItems{$k}; push( @stateChangers, $k); }; my @indices; my $sel = $self-> {selectedItems}; $self-> {selectedItems} = \%newItems; $self-> notify(q(SelectItem), [@stateChangers], 0) if scalar @stateChangers; while (defined($k = each %newItems)) { next if exists $sel-> {$k}; push( @stateChangers, $k); push( @indices, $k); }; $self-> notify(q(SelectItem), [@indices], 1) if scalar @indices; $::application-> pointer( $ptr); return unless scalar @stateChangers; $self-> redraw_items( @stateChangers); } sub get_selected_items { return $_[0]-> {multiSelect} ? [ sort { $a<=>$b } keys %{$_[0]-> {selectedItems}}] : ( ( $_[0]-> {focusedItem} < 0) ? [] : [$_[0]-> {focusedItem}] ); } sub get_selected_count { return scalar keys %{$_[0]-> {selectedItems}}; } sub is_selected { return exists($_[0]-> {selectedItems}-> {$_[1]}) ? 1 : 0; } sub set_item_selected { my ( $self, $index, $sel) = @_; return unless $self-> {multiSelect}; return if $index < 0 || $index >= $self-> {count}; return if $sel == exists $self-> {selectedItems}-> {$index}; $sel ? $self-> {selectedItems}-> {$index} = 1 : delete $self-> {selectedItems}-> {$index}; $self-> notify(q(SelectItem), [ $index], $sel); $self-> invalidate_rect( $self-> item2rect( $index)); } sub select_item { $_[0]-> set_item_selected( $_[1], 1); } sub unselect_item { $_[0]-> set_item_selected( $_[1], 0); } sub toggle_item { $_[0]-> set_item_selected( $_[1], $_[0]-> is_selected( $_[1]) ? 0 : 1)} sub add_selection { my ( $self, $items, $sel) = @_; return unless $self-> {multiSelect}; my @notifiers; my $count = $self-> {count}; my @sz = $self-> size; for ( @{$items}) { next if $_ < 0 || $_ >= $count; next if exists $self-> {selectedItems}-> {$_} == $sel; $sel ? $self-> {selectedItems}-> {$_} = 1 : delete $self-> {selectedItems}-> {$_}; push ( @notifiers, $_); $self-> invalidate_rect( $self-> item2rect( $_, @sz)); } return unless scalar @notifiers; $self-> notify(q(SelectItem), [ @notifiers], $sel) if scalar @notifiers; } sub set_top_item { my ( $self, $topItem) = @_; $topItem = 0 if $topItem < 0; # first validation $topItem = $self-> {count} - 1 if $topItem >= $self-> {count}; $topItem = 0 if $topItem < 0; # count = 0 case return if $topItem == $self-> {topItem}; my $oldTop = $self-> {topItem}; $self-> {topItem} = $topItem; my ( $ih, $iw, @a) = ( $self-> {itemHeight}, $self-> {itemWidth}, $self-> get_active_area); my $dt = $topItem - $oldTop; $self-> reset; if ( !($self-> {scrollTransaction} & 1) && $self-> {vScroll}) { $self-> {scrollTransaction} |= 1; $self-> {vScrollBar}-> value( $topItem); $self-> {scrollTransaction} &= ~1; } if ( !($self-> {scrollTransaction} & 2) && $self-> {hScroll} && $self-> {multiColumn}) { $self-> {scrollTransaction} |= 2; $self-> {hScrollBar}-> value( $topItem); $self-> {scrollTransaction} &= ~2; } $self-> repaint; return; if ( $self-> { multiColumn}) { $iw += $self-> {drawGrid}; if ( $self-> {vertical}) { $a[1] += $self-> {yedge}; if (( $self-> {rows} != 0) && ( $dt % $self-> {rows} == 0)) { $self-> scroll( -( $dt / $self-> {rows}) * $iw, 0, clipRect => \@a ); } else { $self-> scroll( 0, $ih * $dt, clipRect => \@a); } } else { $a[2] = $a[0] + int(( $a[2] - $a[0] ) / $iw) * $iw; if (( $self-> {whole_columns} != 0) && ( $dt % $self-> {whole_columns} == 0)) { $self-> scroll( 0, ( $dt / $self-> {whole_columns}) * $ih, clipRect => \@a ); } else { $self-> scroll(- $iw * $dt, 0, clipRect => \@a); } } } else { $a[1] += $self-> {yedge} if $self-> {integralHeight} and $self-> {whole_rows} > 0; $self-> scroll( 0, $dt * $ih, clipRect => \@a); } $self-> update_view; } sub set_vertical { my ( $self, $vertical) = @_; return if $self-> {vertical} == $vertical; $self-> {vertical} = $vertical; $self-> reset; $self-> reset_scrolls; $self-> repaint; } sub VScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction} & 1; $self-> {scrollTransaction} |= 1; $self-> topItem( $scr-> value); $self-> {scrollTransaction} &= ~1; } sub HScroll_Change { my ( $self, $scr) = @_; return if $self-> {scrollTransaction} & 2; $self-> {scrollTransaction} |= 2; $self-> {multiColumn} ? $self-> topItem( $scr-> value) : $self-> offset( $scr-> value); $self-> {scrollTransaction} &= ~2; } #sub on_drawitem #{ # my ($self, $canvas, $itemIndex, $x, $y, $x2, $y2, $selected, $focused) = @_; #} #sub on_selectitem #{ # my ($self, $itemIndex, $selectState) = @_; #} #sub on_dragitem #{ # my ( $self, $from, $to) = @_; #} sub autoHeight {($#_)?$_[0]-> set_auto_height ($_[1]):return $_[0]-> {autoHeight} } sub count {($#_)?$_[0]-> set_count ($_[1]):return $_[0]-> {count} } sub extendedSelect{($#_)?$_[0]-> set_extended_select($_[1]):return $_[0]-> {extendedSelect} } sub drawGrid {($#_)?$_[0]-> set_draw_grid ($_[1]):return $_[0]-> {drawGrid} } sub gridColor {($#_)?$_[0]-> set_grid_color ($_[1]):return $_[0]-> {gridColor} } sub focusedItem {($#_)?$_[0]-> set_focused_item ($_[1]):return $_[0]-> {focusedItem} } sub integralHeight{($#_)?$_[0]-> set_integral_height($_[1]):return $_[0]-> {integralHeight} } sub integralWidth {($#_)?$_[0]-> set_integral_width ($_[1]):return $_[0]-> {integralWidth } } sub itemHeight {($#_)?$_[0]-> set_item_height ($_[1]):return $_[0]-> {itemHeight} } sub itemWidth {($#_)?$_[0]-> set_item_width ($_[1]):return $_[0]-> {itemWidth} } sub multiSelect {($#_)?$_[0]-> set_multi_select ($_[1]):return $_[0]-> {multiSelect} } sub multiColumn {($#_)?$_[0]-> set_multi_column ($_[1]):return $_[0]-> {multiColumn} } sub offset {($#_)?$_[0]-> set_offset ($_[1]):return $_[0]-> {offset} } sub selectedCount {($#_)?$_[0]-> raise_ro("selectedCount") :return $_[0]-> get_selected_count;} sub selectedItems {($#_)?shift-> set_selected_items (@_):return $_[0]-> get_selected_items;} sub topItem {($#_)?$_[0]-> set_top_item ($_[1]):return $_[0]-> {topItem} } sub vertical {($#_)?$_[0]-> set_vertical ($_[1]):return $_[0]-> {vertical} } # section for item text representation sub get_item_text { my ( $self, $index) = @_; my $txt = ''; $self-> notify(q(Stringify), $index, \$txt); return $txt; } sub get_item_width { my ( $self, $index) = @_; my $w = 0; $self-> notify(q(MeasureItem), $index, \$w); return $w; } sub on_stringify { my ( $self, $index, $sref) = @_; $$sref = ''; } sub on_measureitem { my ( $self, $index, $sref) = @_; $$sref = 0; } sub draw_text_items { my ( $self, $canvas, $first, $last, $step, $x, $y, $textShift, $clipRect) = @_; my ($i,$j); for ( $i = $first, $j = 1; $i <= $last; $i += $step, $j++) { next if $self-> get_item_width( $i) + $self-> {offset} + $x + 1 < $clipRect-> [0]; $canvas-> text_out( $self-> get_item_text( $i), $x, $y + $textShift - $j * $self-> {itemHeight} + 1 ); } } sub std_draw_text_items { my ($self,$canvas) = (shift,shift); my @clrs = ( $self-> color, $self-> backColor, $self-> colorIndex( ci::HiliteText), $self-> colorIndex( ci::Hilite) ); my @clipRect = $canvas-> clipRect; my $i; my $drawVeilFoc = -1; my $atY = ( $self-> {itemHeight} - $canvas-> font-> height) / 2; my $ih = $self-> {itemHeight}; my $offset = $self-> {offset}; my $step = ( $self-> {multiColumn} and !$self-> {vertical}) ? $self-> {active_columns} : 1; my @colContainer; for ( $i = 0; $i < $self-> {columns}; $i++){ push ( @colContainer, []) }; for ( $i = 0; $i < scalar @_; $i++) { push ( @{$colContainer[ $_[$i]-> [7]]}, $_[$i]); $drawVeilFoc = $i if $_[$i]-> [6]; } my ( $lc, $lbc) = @clrs[0,1]; for ( @colContainer) { my @normals; my @selected; my ( $lastNormal, $lastSelected) = (undef, undef); my $isSelected = 0; # sorting items in single column { $_ = [ sort { $$a[0]<=>$$b[0] } @$_]; } # calculating conjoint bars for ( $i = 0; $i < scalar @$_; $i++) { my ( $itemIndex, $x, $y, $x2, $y2, $selected, $focusedItem) = @{$$_[$i]}; if ( $selected) { if ( defined $lastSelected && ( $y2 + 1 == $lastSelected) ) { ${$selected[-1]}[1] = $y; ${$selected[-1]}[5] = $$_[$i]-> [0]; } else { push ( @selected, [ $x, $y, $x2, $y2, $$_[$i]-> [0], $$_[$i]-> [0], 1 ]); } $lastSelected = $y; $isSelected = 1; } else { if ( defined $lastNormal && ( $y2 + 1 == $lastNormal) && ( ${$normals[-1]}[3] - $lastNormal < 100)) { ${$normals[-1]}[1] = $y; ${$normals[-1]}[5] = $$_[$i]-> [0]; } else { push ( @normals, [ $x, $y, $x2, $y2, $$_[$i]-> [0], $$_[$i]-> [0], 0 ]); } $lastNormal = $y; } } for ( @selected) { push ( @normals, $_); } # draw items for ( @normals) { my ( $x, $y, $x2, $y2, $first, $last, $selected) = @$_; my $c = $clrs[ $selected ? 3 : 1]; if ( $c != $lbc) { $canvas-> backColor( $c); $lbc = $c; } $canvas-> clear( $x, $y, $x2, $y2); $c = $clrs[ $selected ? 2 : 0]; if ( $c != $lc) { $canvas-> color( $c); $lc = $c; } $self-> draw_text_items( $canvas, $first, $last, $step, $x, $y2, $atY, \@clipRect); } } # draw veil if ( $drawVeilFoc >= 0) { my ( $itemIndex, $x, $y, $x2, $y2) = @{$_[$drawVeilFoc]}; $canvas-> rect_focus( $x + $self-> {offset}, $y, $x2, $y2); } } package Prima::AbstractListBox; use vars qw(@ISA); @ISA = qw(Prima::AbstractListViewer); sub draw_items { shift-> std_draw_text_items(@_); } sub on_measureitem { my ( $self, $index, $sref) = @_; $$sref = $self-> get_text_width( $self-> get_item_text( $index)); } package Prima::ListViewer; use vars qw(@ISA); @ISA = qw(Prima::AbstractListViewer); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( items => [], autoWidth => 1, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; $self-> {items} = []; $self-> {widths} = []; $self-> {maxWidth} = 0; $self-> {autoWidth} = 0; my %profile = $self-> SUPER::init(@_); $self-> autoWidth( $profile{autoWidth}); $self-> items ( $profile{items}); $self-> focusedItem ( $profile{focusedItem}); return %profile; } sub calibrate { my $self = $_[0]; $self-> recalc_widths; $self-> itemWidth( $self-> {maxWidth}) if $self-> {autoWidth}; $self-> offset( $self-> offset); } sub get_item_width { return $_[0]-> {widths}-> [$_[1]]; } sub on_fontchanged { my $self = $_[0]; $self-> itemHeight( $self-> font-> height), $self-> {autoHeight} = 1 if $self-> { autoHeight}; $self-> calibrate; } sub recalc_widths { my $self = $_[0]; my @w; my $maxWidth = 0; my $i; my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureItem)); $self-> push_event; $self-> begin_paint_info; for ( $i = 0; $i < scalar @{$self-> {items}}; $i++) { my $iw = 0; $notifier-> ( @notifyParms, $i, \$iw); $maxWidth = $iw if $maxWidth < $iw; push ( @w, $iw); } $self-> end_paint_info; $self-> pop_event; $self-> {widths} = [@w]; $self-> {maxWidth} = $maxWidth; } sub set_items { my ( $self, $items) = @_; return unless ref $items eq q(ARRAY); my $oldCount = $self-> {count}; $self-> {items} = [@{$items}]; $self-> recalc_widths; $self-> reset; scalar @$items == $oldCount ? $self-> repaint : $self-> SUPER::count( scalar @$items); $self-> itemWidth( $self-> {maxWidth}) if $self-> {autoWidth}; $self-> offset( $self-> offset); $self-> selectedItems([]); } sub get_items { my $self = shift; my @inds = (@_ == 1 and ref($_[0]) eq q(ARRAY)) ? @{$_[0]} : @_; my ($c,$i) = ($self-> {count}, $self-> {items}); for ( @inds) { $_ = ( $_ >= 0 && $_ < $c) ? $i-> [$_] : undef; } return wantarray ? @inds : $inds[0]; } sub insert_items { my ( $self, $where) = ( shift, shift); $where = $self-> {count} if $where < 0; my ( $is, $iw, $mw) = ( $self-> {items}, $self-> {widths}, $self-> {maxWidth}); if (@_ == 1 and ref($_[0]) eq q(ARRAY)) { return unless scalar @{$_[0]}; $self-> {items} = [@{$_[0]}]; } else { return unless scalar @_; $self-> {items} = [@_]; } $self-> {widths} = []; my $num = scalar @{$self-> {items}}; $self-> recalc_widths; splice( @{$is}, $where, 0, @{$self-> {items}}); splice( @{$iw}, $where, 0, @{$self-> {widths}}); ( $self-> {items}, $self-> {widths}) = ( $is, $iw); $self-> itemWidth( $self-> {maxWidth} = $mw) if $self-> {autoWidth} && $self-> {maxWidth} < $mw; $self-> SUPER::count( scalar @{$self-> {items}}); $self-> itemWidth( $self-> {maxWidth}) if $self-> {autoWidth}; $self-> focusedItem( $self-> {focusedItem} + $num) if $self-> {focusedItem} >= 0 && $self-> {focusedItem} >= $where; $self-> offset( $self-> offset); my @shifters; for ( keys %{$self-> {selectedItems}}) { next if $_ < $where; push ( @shifters, $_); } for ( @shifters) { delete $self-> {selectedItems}-> {$_}; } for ( @shifters) { $self-> {selectedItems}-> {$_ + $num} = 1; } $self-> repaint if scalar @shifters; } sub replace_items { my ( $self, $where) = ( shift, shift); return if $where < 0; my ( $is, $iw) = ( $self-> {items}, $self-> {widths}); my $new; if (@_ == 1 and ref($_[0]) eq q(ARRAY)) { return unless scalar @{$_[0]}; $new = [@{$_[0]}]; } else { return unless scalar @_; $new = [@_]; } my $num = scalar @$new; if ( $num + $where >= $self-> {count}) { $num = $self-> {count} - $where; return if $num <= 0; splice @$new, $num; } $self-> {items} = $new; $self-> {widths} = []; $self-> recalc_widths; splice( @{$is}, $where, $num, @{$self-> {items}}); splice( @{$iw}, $where, $num, @{$self-> {widths}}); ( $self-> {items}, $self-> {widths}) = ( $is, $iw); if ( $self-> {autoWidth}) { my $mw = 0; for (@{$iw}) { $mw = $_ if $mw < $_; } $self-> itemWidth( $self-> {maxWidth} = $mw); $self-> offset( $self-> offset); } if ( $where <= $self-> {lastItem} && $where + $num >= $self-> {topItem}) { $self-> redraw_items( $where .. $where + $num); } } sub add_items { shift-> insert_items( -1, @_); } sub delete_items { my $self = shift; my ( $is, $iw, $mw) = ( $self-> {items}, $self-> {widths}, $self-> {maxWidth}); my %indices; if (@_ == 1 and ref($_[0]) eq q(ARRAY)) { return unless scalar @{$_[0]}; %indices = map{$_=>1}@{$_[0]}; } else { return unless scalar @_; %indices = map{$_=>1}@_; } my @removed; my $wantarray = wantarray; my @newItems; my @newWidths; my $i; my $num = scalar keys %indices; my ( $items, $widths) = ( $self-> {items}, $self-> {widths}); $self-> focusedItem( -1) if exists $indices{$self-> {focusedItem}}; for ( $i = 0; $i < scalar @{$self-> {items}}; $i++) { unless ( exists $indices{$i}) { push ( @newItems, $$items[$i]); push ( @newWidths, $$widths[$i]); } else { push ( @removed, $$items[$i]) if $wantarray; } } my $newFoc = $self-> {focusedItem}; for ( keys %indices) { $newFoc-- if $newFoc >= 0 && $_ < $newFoc; } my @selected = sort {$a<=>$b} keys %{$self-> {selectedItems}}; $i = 0; my $dec = 0; my $d; for $d ( sort {$a<=>$b} keys %indices) { while ($i < scalar(@selected) and $d > $selected[$i]) { $selected[$i] -= $dec; $i++; } last if $i >= scalar @selected; $selected[$i++] = -1 if $d == $selected[$i]; $dec++; } while ($i < scalar(@selected)) { $selected[$i] -= $dec; $i++; } $self-> {selectedItems} = {}; for ( @selected) {$self-> {selectedItems}-> {$_} = 1;} delete $self-> {selectedItems}-> {-1}; ( $self-> {items}, $self-> {widths}) = ([@newItems], [@newWidths]); my $maxWidth = 0; for ( @newWidths) { $maxWidth = $_ if $maxWidth < $_; } $self-> lock; $self-> itemWidth( $self-> {maxWidth} = $maxWidth) if $self-> {autoWidth} && $self-> {maxWidth} > $maxWidth; $self-> SUPER::count( scalar @{$self-> {items}}); $self-> focusedItem( $newFoc); $self-> unlock; return @removed if $wantarray; } sub on_keydown { my ( $self, $code, $key, $mod) = @_; $self-> notify(q(MouseUp),0,0,0) if defined $self-> {mouseTransaction}; return if $mod & km::DeadKey; if ( (( $code & 0xFF) >= ord(' ')) && ( $key == kb::NoKey) && !($mod & ~km::Shift) && $self-> {count} ) { my $i; my ( $c, $hit, $items) = ( lc chr ( $code & 0xFF), undef, $self-> {items}); for ( $i = $self-> {focusedItem} + 1; $i < $self-> {count}; $i++) { my $fc = substr( $self-> get_item_text($i), 0, 1); next unless defined $fc; $hit = $i, last if lc $fc eq $c; } unless ( defined $hit) { for ( $i = 0; $i < $self-> {focusedItem}; $i++) { my $fc = substr( $self-> get_item_text($i), 0, 1); next unless defined $fc; $hit = $i, last if lc $fc eq $c; } } if ( defined $hit) { $self-> focusedItem( $hit); $self-> clear_event; return; } } $self-> SUPER::on_keydown( $code, $key, $mod); } sub on_dragitem { my ( $self, $from, $to) = @_; my ( $is, $iw) = ( $self-> {items}, $self-> {widths}); if ( $self-> {multiSelect}) { my @k = sort { $b <=> $a } keys %{$self-> {selectedItems}}; my @is = @$is[@k]; my @iw = @$iw[@k]; my $nto = $to; for my $k ( @k) { $nto-- if $k <= $to; splice( @$is, $k, 1); splice( @$iw, $k, 1); } $nto++ if $nto != $to; splice( @$is, $nto, 0, reverse @is); splice( @$iw, $nto, 0, reverse @iw); @{$self-> {selectedItems}}{$nto .. $nto + @k - 1} = delete @{$self-> {selectedItems}}{@k}; } else { splice( @$is, $to, 0, splice( @$is, $from, 1)); splice( @$iw, $to, 0, splice( @$iw, $from, 1)); } $self-> repaint; $self-> clear_event; } sub autoWidth {($#_)?$_[0]-> {autoWidth} = $_[1] :return $_[0]-> {autoWidth} } sub count {($#_)?$_[0]-> raise_ro('count') :return $_[0]-> {count} } sub items {($#_)?$_[0]-> set_items( $_[1]) :return $_[0]-> {items} } package Prima::ProtectedListBox; use vars qw(@ISA); @ISA = qw(Prima::ListViewer); BEGIN { for ( qw( font color backColor rop rop2 linePattern lineWidth lineEnd textOutBaseline fillPattern clipRect) ) { my $sb = $_; $sb =~ s/([A-Z]+)/"_\L$1"/eg; $sb = "set_$sb"; eval <SUPER::$sb(\@_); \$self->{protect}->{$_} = 1 if exists \$self->{protect}; } PROC } } sub draw_items { my ( $self, $canvas, @items) = @_; return if $canvas != $self; # this does not support 'uncertain' drawings due that my %protect; # it's impossible to override $canvas's methods dynamically for ( qw( font color backColor rop rop2 linePattern lineWidth lineEnd textOutBaseline fillPattern) ) { $protect{$_} = $canvas-> $_(); } my @clipRect = $canvas-> clipRect; $self-> {protect} = {}; my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(DrawItem)); $self-> push_event; for ( @items) { $notifier-> ( @notifyParms, $canvas, @$_); $canvas-> clipRect( @clipRect), delete $self-> {protect}-> {clipRect} if exists $self-> {protect}-> {clipRect}; for ( keys %{$self-> {protect}}) { $self-> $_($protect{$_}); } $self-> {protect} = {}; } $self-> pop_event; delete $self-> {protect}; } package Prima::ListBox; use vars qw(@ISA); @ISA = qw(Prima::ListViewer); sub get_item_text { return $_[0]-> {items}-> [$_[1]]; } sub on_stringify { my ( $self, $index, $sref) = @_; $$sref = $self-> {items}-> [$index]; } sub on_measureitem { my ( $self, $index, $sref) = @_; $$sref = $self-> get_text_width( $self-> {items}-> [$index]); } sub draw_items { shift-> std_draw_text_items(@_) } 1; __DATA__ =pod =head1 NAME Prima::Lists - user-selectable item list widgets =head1 DESCRIPTION The module provides classes for several abstraction layers of item representation. The hierarchy of classes is as follows: AbstractListViewer AbstractListBox ListViewer ProtectedListBox ListBox The root class, C, provides common interface, while by itself it is not directly usable. The main differences between classes are centered around the way the item list is stored. The simplest organization of a text-only item list, provided by C, stores an array of text scalars in a widget. More elaborated storage and representation types are not realized, and the programmer is urged to use the more abstract classes to derive own mechanisms. For example, for a list of items that contain text strings and icons see L. To organize an item storage, different from C, it is usually enough to overload either the C, C, and C events, or their method counterparts: C, C, and C. =head1 Prima::AbstractListViewer C is a descendant of C, and some properties are not described here. See L. The class provides interface to generic list browsing functionality, plus functionality for text-oriented lists. The class is not usable directly. =head2 Properties =over =item autoHeight BOOLEAN If 1, the item height is changed automatically when the widget font is changed; this is useful for text items. If 0, item height is not changed; this is useful for non-text items. Default value: 1 =item count INTEGER An integer property, destined to reflect number of items in the list. Since it is tied to the item storage organization, and hence, to possibility of changing the number of items, this property is often declared as read-only in descendants of C. =item dragable BOOLEAN If 1, allows the items to be dragged interactively by pressing control key together with left mouse button. If 0, item dragging is disabled. Default value: 1 =item drawGrid BOOLEAN If 1, vertical grid lines between columns are drawn with C. Actual only in multi-column mode. Default value: 1 =item extendedSelect BOOLEAN Regards the way the user selects multiple items and is only actual when C is 1. If 0, the user must click each item in order to mark as selected. If 1, the user can drag mouse or use C key plus arrow keys to perform range selection; the C key can be used to select individual items. Default value: 0 =item focusedItem INDEX Selects the focused item index. If -1, no item is focused. It is mostly a run-time property, however, it can be set during the widget creation stage given that the item list is accessible on this stage as well. Default value: -1 =item gridColor COLOR Color, used for drawing vertical divider lines for multi-column list widgets. The list classes support also the indirect way of setting the grid color, as well as widget does, via the C property. To achieve this, C constant is declared ( for more detail see L ). Default value: C. =item integralHeight BOOLEAN If 1, only the items that fit vertically in the widget interiors are drawn. If 0, the items that are partially visible are drawn also. Default value: 0 =item integralWidth BOOLEAN If 1, only the items that fit horizontally in the widget interiors are drawn. If 0, the items that are partially visible are drawn also. Actual only in multi-column mode. Default value: 0 =item itemHeight INTEGER Selects the height of the items in pixels. Since the list classes do not support items with different dimensions, changes to this property affect all items. Default value: default font height =item itemWidth INTEGER Selects the width of the items in pixels. Since the list classes do not support items with different dimensions, changes to this property affect all items. Default value: default widget width =item multiSelect BOOLEAN If 0, the user can only select one item, and it is reported by the C property. If 1, the user can select more than one item. In this case, C'th item is not necessarily selected. To access selected item list, use C property. Default value: 0 =item multiColumn BOOLEAN If 0, the items are arrayed vertically in one column, and the main scroll bar is vertical. If 1, the items are arrayed in several columns, C pixels wide each. In this case, the main scroll bar is horizontal. =item offset INTEGER Horizontal offset of an item list in pixels. =item topItem INTEGER Selects the first item drawn. =item selectedCount INTEGER A read-only property. Returns number of selected items. =item selectedItems ARRAY ARRAY is an array of integer indices of selected items. =item vertical BOOLEAN Sets seneral direction of items in multi-column mode. If 1, items increase down-to-right. Otherwise, right-to-down. Doesn't have any effect in single-column mode. Default value: 1. =back =head2 Methods =over =item add_selection ARRAY, FLAG Sets item indices from ARRAY in selected or deselected state, depending on FLAG value, correspondingly 1 or 0. Only for multi-select mode. =item deselect_all Removes selection from all items. Only for multi-select mode. =item draw_items CANVAS, ITEM_DRAW_DATA Called from within C notification to draw items. The default behavior is to call C notification for every item in ITEM_DRAW_DATA array. ITEM_DRAW_DATA is an array or arrays, where each array consists of parameters, passed to C notification. This method is overridden in some descendant classes, to increase the speed of drawing routine. For example, C is the optimized routine for drawing unified text-based items. It is used in C class. See L for parameters description. =item draw_text_items CANVAS, FIRST, LAST, STEP, X, Y, OFFSET, CLIP_RECT Called by C to draw sequence of text items with indices from FIRST to LAST, by STEP, on CANVAS, starting at point X, Y, and incrementing the vertical position with OFFSET. CLIP_RECT is a reference to array of four integers with inclusive-inclusive coordinates of the active clipping rectangle. =item get_item_text INDEX Returns text string assigned to INDEXth item. Since the class does not assume the item storage organization, the text is queried via C notification. =item get_item_width INDEX Returns width in pixels of INDEXth item. Since the class does not assume the item storage organization, the value is queried via C notification. =item is_selected INDEX Returns 1 if INDEXth item is selected, 0 if it is not. =item item2rect INDEX, [ WIDTH, HEIGHT ] Calculates and returns four integers with rectangle coordinates of INDEXth item within the widget. WIDTH and HEIGHT are optional parameters with pre-fetched dimension of the widget; if not set, the dimensions are queried by calling C property. If set, however, the C property is not called, thus some speed-up can be achieved. =item point2item X, Y Returns the index of an item that contains point (X,Y). If the point belongs to the item outside the widget's interior, returns the index of the first item outside the widget's interior in the direction of the point. =item redraw_items INDICES Redraws all items in INDICES array. =item select_all Selects all items. Only for multi-select mode. =item set_item_selected INDEX, FLAG Sets selection flag of INDEXth item. If FLAG is 1, the item is selected. If 0, it is deselected. Only for multi-select mode. =item select_item INDEX Selects INDEXth item. Only for multi-select mode. =item std_draw_text_items CANVAS, ITEM_DRAW_DATA An optimized method, draws unified text-based items. It is fully compatible to C interface, and is used in C class. The optimization is derived from the assumption that items maintain common background and foreground colors, that differ in selected and non-selected states only. The routine groups drawing requests for selected and non-selected items, and draws items with reduced number of calls to C property. While the background is drawn by the routine itself, the foreground ( usually text ) is delegated to the C method, so the text positioning and eventual decorations would not require full rewrite of code. ITEM_DRAW_DATA is an array of arrays of scalars, where each array contains parameters of C notification. See L for parameters description. =item toggle_item INDEX Toggles selection of INDEXth item. Only for multi-select mode. =item unselect_item INDEX Deselects INDEXth item. Only for multi-select mode. =back =head2 Events =over =item Click Called when the user presses return key or double-clicks on an item. The index of the item is stored in C. =item DragItem OLD_INDEX, NEW_INDEX Called when the user finishes the drag of an item from OLD_INDEX to NEW_INDEX position. The default action rearranges the item list in accord with the dragging action. =item DrawItem CANVAS, INDEX, X1, Y1, X2, Y2, SELECTED, FOCUSED Called when an INDEXth item is to be drawn on CANVAS. X1, Y1, X2, Y2 designate the item rectangle in widget coordinates, where the item is to be drawn. SELECTED and FOCUSED are boolean flags, if the item must be drawn correspondingly in selected and focused states. =item MeasureItem INDEX, REF Puts width in pixels of INDEXth item into REF scalar reference. This notification must be called from within C block. =item SelectItem INDEX, FLAG Called when the item changed its selection state. INDEX is the index of the item, FLAG is its new selection state: 1 if it is selected, 0 if it is not. =item Stringify INDEX, TEXT_REF Puts text string, assigned to INDEXth item into TEXT_REF scalar reference. =back =head1 Prima::AbstractListBox Exactly the same as its ascendant, C, except that it does not propagate C message, assuming that the items must be drawn as text. =head1 Prima::ListViewer The class implements items storage mechanism, but leaves the items format to the programmer. The items are accessible via C property and several other helper routines. The class also defines the user navigation, by accepting character keyboard input and jumping to the items that have text assigned with the first letter that match the input. C is derived from C. =head2 Properties =over =item autoWidth BOOLEAN Selects if the gross item width must be recalculated automatically when either the font changes or item list is changed. Default value: 1 =item count INTEGER A read-only property; returns number of items. =item items ARRAY Accesses the storage array of items. The format of items is not defined, it is merely treated as one scalar per index. =back =head2 Methods =over =item add_items ITEMS Appends array of ITEMS to the end of the list. =item calibrate Recalculates all item widths and adjusts C if C is set. =item delete_items INDICES Deletes items from the list. INDICES can be either an array, or a reference to an array of item indices. =item get_item_width INDEX Returns width in pixels of INDEXth item from internal cache. =item get_items INDICES Returns array of items. INDICES can be either an array, or a reference to an array of item indices. Depending on the caller context, the results are different: in array context the item list is returned; in scalar - only the first item from the list. The semantic of the last call is naturally usable only for single item retrieval. =item insert_items OFFSET, ITEMS Inserts array of items at OFFSET index in the list. Offset must be a valid index; to insert items at the end of the list use C method. ITEMS can be either an array, or a reference to an array of items. =item replace_items OFFSET, ITEMS Replaces existing items at OFFSET index in the list. Offset must be a valid index. ITEMS can be either an array, or a reference to an array of items. =back =head1 Prima::ProtectedListBox A semi-demonstrational class, derived from C, that applies certain protection for every item drawing session. Assuming that several item drawing routines can be assembled in one widget, C provides a safety layer between these, so, for example, one drawing routine that selects a font or a color and does not care to restore the old value back, does not affect the outlook of the other items. This functionality is implementing by overloading C method and also all graphic properties. =head1 Prima::ListBox Descendant of C, declares format of items as a single text string. Incorporating all of functionality of its predecessors, provides a standard listbox widget. =head2 Synopsis my $lb = Prima::ListBox-> create( items => [qw(First Second Third)], focusedItem => 2, onClick => sub { print $_[0]-> get_items( $_[0]-> focusedItem), " is selected\n"; } ); =head2 Methods =over =item get_item_text INDEX Returns text string assigned to INDEXth item. Since the item storage organization is implemented, does so without calling C notification. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L, L, F =cut Prima-1.28/Prima/VB/0000755000175100017510000000000011150770061011651 5ustar dkdkPrima-1.28/Prima/VB/classes.gif0000644000175100017510000001646611150770061014012 0ustar dkdkGIF89a ³€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ!ù2, „°ÉI«½8ëÍ»ÿ`(ŽdižÝ¡®l뾪t, ˆ"#Àl3¶ÍÎÇÛŒ´šfVCàr2—¦ÒžE#2ùx2±áPV<"w²ë¨E.3Êe“Äno.|N¯Ëid_FPš÷å}x%zQS‡=WhŽd‚$„‰x-“",$;•Šš?œœ§Š¦Š˜Œ…‡°¬®”–—•­£¡µ·³›»e²¹ÀÁ‰ƒp±ˆU\pļË4ÍΠÐÃÓU‰DÒÓxÚ†ÉDyÛΑ¾¤×‚#ÖÜÆ’pnñ£ôô!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ°ÉI+6[¬àfcH^ßg®Þ÷¼oZ•"#8~ìª'^¯œPÈ l8Àp‰8Ð.žGòÃ:MÈdÕzÜH·Ûë3 f^EßòòìUW‹m·yœ–éö5¦'!çuOQ€~vlqˆ‰r‹ŒnŽP‡}“;apc3™”D<#–žŸ¢4¤$)¤©,®¯°±²³!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÿ°ÉI«½èÍ»ÿšdiž(ù¬+ ˆã¢Õxž¯øá6#ãAÔŒFÝî±ñ½„ŒâF©äÀÃÌP<Ú¨8^ ;b™Ïè³éj»7€BfP(4ö¼Þfþe„Dwvrrz |%~Pu†yˆ#ŠŒ\Žƒ‚†ˆ$”" {}qaLi¦£+XwL}h|¦®‹°>³ªV<¸•6©¨£¬f¶°ž@½ªÈÀ"¦5ĽÎÊW²¬Åµ£‰qºÚ¼ÛÑ6ÞÓá,|8ÖÌiêG¥ -æî£ëq  èÆé÷àY£oÁ9{¤>H`П¸n Û‘ôl™ÄcÜ:ÅyÃQ†#!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÈ°ÉI«½èÍ»ÿš äcžhŠ" ˆÈ‚¨´Ê>Gþ6cYÿÛ0O¤ÙÊyÁdLJ­ÞN»ÖŠ”x^óŠËÚÂètøŠxjW긗íN%að·K7¯dVZm~H>KAƒuvˆL8:FŒ‰Q,‘†Jˆ7I…&SV-œ—ž‡G5›$¨?©–PK™6¢ª¤4I¨´¯o¨€‚•«6¦+ºÁ6­Å¶·ÈÀÊvÃŽ£°­¾¡.Î[²Ä‹“³eÝÞÛNY æç!êë!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿÊ°ÉI«½èÍ»ÿš äcžhŠ" ˆÈ‚¨´Ê>Gþ6cYÿÛ0O¤ÙÊyÁdLJ­ÞN»–2º]^qÙ#r¹jŸÚÎÉn»sÆmò ¨Ûïøû!Ž”Ñó€x{Pr$ˆƒicon|cd&7Ia…]@”$–}Vžš,\j5 œ‘¨6Z›¢b©)¦­]I¥«¡„¤“2Ÿ¶§“+>ª\¾®¿µÃ²°?±¸©´4̋ƺŸ_ijÁ°M:É’AMDØßàkh èé!ìí!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ°É9½8_Ê©}`(Ž ÐqÀ“’¬hžÍº’L«Âó,2uû¢.¯GúU4´Ï×ѵzËbÓFGF‰3 ºº¦T¢R\?£V¬™ÊÎƺָ|roÙ,;¯ßSûsie@~6}†yk‰_…‚u‹Œ„“R…–‘Žš•™ž ¡Z£”¢¦no ªZ¯°!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿr°ÉI«½8ëÍ»ÿ`(Ždiž ®lë¾-#Ïócßx®«t¯ÿ@^¯ö ÖŽ œp˜,:Éèó¶âšÒl®ê³5¡E¢À”ݾҳ˜Kó^§ZÛøFƒåä²×¶¯óL@‚ce_ƒA0‰Š-(Ž‘’“”•!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ‚°ÉI«½8ëÍ»ÿ 4cX=(¢«¢pŒfÏq¨+ŽØ|Ô˜šŽåÒ_‡à G<:¡sªƒZ¤Tªõ´ÌN·¬÷žˆÇÕd´‹N+Ûdõ• G”%gø½‘oïûhtzr\unk‡8‚ŠHoŒ…aƒ~“f2™š1—>Ÿ >&£¤¥¦!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿŸ°ÉI«½8ëÍ»ÿ 4cX=(¢«¢pŒfÏq¨+ŽØ|Ô˜šŽåÒ_‡à G<:¡sªƒZ¤Tªõ´ÌN·¬÷žˆ² e,KΡª‹s7àr©l3W{hIQ{j9-vxEzdƒW…‡ˆ}UGŽm\~Œž™U›a{>=•„c_¢f©‚–®¡°±|Qi·¸v ¥¼½6&ÀÁÂÃ!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ§°ÉI«½8ëÍ»ÿ 4cX=(¢«¢pŒfÏq¨+ŽØ|Ô˜šŽåÒ_‡à G<:¡sªƒZ¤Tªõ´ÌN·ì1õMF»ÕÚïñ4_ÑÈ¥mOÄ/•-_wsû+.?}Ju.t8vxtˆˆ|‹~apƒ-‰pŒ xŠ‹c”wp;d(¤›;k{¡…S­m¯^²g´e³·U¢2¾¿1¼>ÄÅ>&ÈÉÊË!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ‘°ÉI«½8ëÍ»ÿ`(Ž¤œhª®,zG,ÏtmË0¢ï|ïÿˆ×ñ(ÈC™,sÍhq}¥@’Ú´¥Z$7éņcd¹˜2jQSéúœeŸµéã:Û®»™UB_ta„€]‚lG…‹‡d‰~Š|yF{mo|a•NXbržŸqœ^@§¨A7«¬4%¯°±²³´±!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿé°ÉI«½ø‚ (ïY$dŽ%6œ„’A÷’*öÊe˜eÎ&l÷ÚE=ØhGÌÅVEe‚ÉÊ6š°šPµÉ&›ÎS]l†µD™‹øâKinŽù,—ÒIGb=#}}w„Ej‡N_Z: †q•‚ƒ:—‰ka.4–|™-?Ij&g¢D¤Œ KS¯›> oT¤¿¸IkjŠÆÈÂZºBÅÇÁʦ8®ÖØ@>ൿØÙÕÔxÝØ¥Üb¬å.@µ+ë“é+ÀÉÇmùÀ Žä÷^ƒ*Ì!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ_°ÉI«½8ëÍ%]8}¢øåv¢i¶¶îÊ”<ÓMâžÎ÷>ÜÎÆÊ„¬`k<Áœ#bŠ}Mo9iˆZ;štà/8ÜáV´*l׫1[Ðh~v×ÙoyŒ>Îí?‚)!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ·°ÉI«½èÍ»ÿšGí6l¬«ãø/ÒAH¤‡´Y ˆC8ŸÐ¨Ô™{Ü‚¥`«åÖ¶ÙÚLx›ÏhóÁĦßèu»>€éZùuÊç³ØW;;zA‚0J6…&50Œ$3O%HŽ”B”T"}œP#‘Š†'™+¡¢%¤’§£Ÿš8«(©›­¥¯°&²¸¹¶ª½»U¹Â´µ&ÀÄ=‰¼Á=?É°ˆm ÕÖ!ÙÚ!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿаÉI«½èÍ»ÿš äcžhŠ" ˆÈ‚¨´Ê>Gþ6c¹’ÀàªuE™IHS.‰:d0æ³M[§]Ë9íV“Xœ6¹ª5±ˆ#|šåÞð¸ü m“æ<}Í•áó5{[vi€um8s‹qˆKV^[$c\_l)3“,ŽT]M’I”_^@¡@•e«5›ª‰e¦¨£|¬¢—d®Ž˜I2N‰ºµ°K¦%ÁƒÃfǼ¿d²Ì¿Ò§™³œÂÊK¾6¡Y»ÓÅ¡o¯Ù†âF伆Pj îïòó!ù2,ƒ€€€ÌÌÌÿÿÿÿÿJH ª˜TÁ{Í@ÇdðQb©†( 0Pn¡ ß2ÖÁíÏžï ‘†0ÝN æh9NÉѨ®%ºÚh·OK-×¾dQ!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ|°ÉI«½8ëÍ»ÿ`(Ždij@ª®lúO,Ï3¼¢ï¼.7¬G €8"OaD sJSçì £ÓcКS³Ú¤À»©[Îu¼‡Ÿe¦™WUC‚±ûÍåå÷uWegti‚weD(G‘‡(-–*'™š›œžŸ$!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿv°ÉI«½8ëÍ»ÿ`(Ždižhª®à¾p,Ïñcßx®ï¶û @Ä÷8Ç_ðà •NàAHL€ðD¿VkõÊ6]]p±Ê&s³Ûôp.‡e8µWùzKEH„mWK>„Š‹ŒG42,“”•–—˜™š!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿµ°ÉI«½èÍ»ÿšdiž(ùO ˆ"Ïtm#ëz¼Íh§)YŽÄóÑH·¤Ž;"bI[ÎÕ”A¡QZîY¼Î°Y!‹ÛD…µã]ù¬LwŸìÛVÝ‹ãâ¹Ç£Kowx+3~h…k‡b‰|‚q„2†‹8>l‘“‹›‡S+Šž#LŽ”•-£|©ª#]«²³´³,§ ¹ +"«´™À.—KzNrÀ°Æ@HÊÃ;—ºÔ ×Ø!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿm°ÉI«½8ëÍ»ÿ`ˆbœ$YZjº^®úVîLö&Ó#ºK- °$HYÐÇl2ˆƒu¨Z¯X+*Í>N„xL.‹·Q€ù 8 ßðø-•³§ø_¢ÿf~979…‚ˆ‰Š‹ŒŽŠ!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿm°ÉI«½8ëÍ»ÿ`(Ž`ž(@6À㾯J¶Hm#‡<Ò5`ç+Þ©œ=)œNÄ»)ƒƒt*]†RX( f5oÅÝÑù4R©Ý6¥ÝºÒžïÞ¡%ÃÌñ°,¶ùˆt%cNxWQgUAk'+Ž!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿx°ÉI«½8ëÍ»ÿ`(Ždij@ª®lúO,Ï3¼¢ï%‡©ÚuI\ÑÅJ7LÞÕúEåÄ]²ÖšVÏ\¸¸œaŽm)¯öÞt/‘mEYo‚tNH‹Œ‹‡-’+'•–—˜™š›$!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ¤°ÉI«½8ëÍ»ÿ`(Ž¤œhª®,zG,ÏtmË0¢ï|ïÿˆ×ñ(ÈC™| …Ä"àxj.‹½gN:•6‹×G6¸v»ÞcXÐi‡Æ³ 6"PA2<-§3±H|Àqm#s½ªÇú",ÚrÁÝÊ×éh·#TÙs5{جv‹e‘¬^Xê„0KÌpy\Z“ΰttN±p`^€Øûÿ}{px"~€†wr|}Žz‹`flmf#]/™˜bmNv"u¥6¢@oŸ o¨–ž˜nCP`¦·¯ª­l³g5°«Ÿ½¹M·¦Äa¬(¾£MʼÈÏcÌ©ÎÒËÑ×daÀÚ®bd‰;}‡IDƒnq~OZ‘pV•P—…#&NŠ¢/'h]‘_¥tZ„®’¤ ¬–¨˜Ÿ¡¢‰±¸³œµž«Ž­^ '1.0', '1.0' => '1.1', '1.1' => '1.2', ); sub check_version { my $header = $_[0]; return (0, 'unknown') unless $header =~ /file=(\d+\.*\d*)/; my $fv = $1; while( $fv ne $fileVersion) { $fv = $fileVerCompat{$fv}, next if exists $fileVerCompat{$fv}; return (0, $1); } return (1, $fv); } sub GO_SUB { if ( $builderActive) { my $x = $_[0]; $x =~ s/\n$//s; return $x; } my $x = eval "sub { $_[0] }"; if ( $@) { @eventContext = ( $_[1], $_[2]); die $@; } return $x; } sub AUTOFORM_REALIZE { my ( $seq, $parms) = @_; my %ret = (); my %modules = (); my $main; my $i; my %dep; for ( $i = 0; $i < scalar @$seq; $i+= 2) { $dep{$$seq[$i]} = $$seq[$i + 1]; } for ( keys %dep) { $modules{$dep{$_}-> {module}} = 1 if $dep{$_}-> {module}; $main = $_ if $dep{$_}-> {parent}; } $form = $main; for ( keys %modules) { my $c = $_; eval("use $c;"); die "$@" if $@; } my %owners = ( $main => 0); my %siblings; for ( keys %dep) { next if $_ eq $main; $owners{$_} = exists $parms-> {$_}-> {owner} ? $parms-> {$_}-> {owner} : ( exists $dep{$_}-> {profile}-> {owner} ? $dep{$_}-> {profile}-> {owner} : $main); delete $dep{$_}-> {profile}-> {owner}; } my @actNames = qw( onBegin onFormCreate onCreate onChild onChildCreate onEnd); my %actions = map { $_ => {}} @actNames; my %instances = (); for ( keys %dep) { my $key = $_; my $act = $dep{$_}-> {actions}; $instances{$_} = {}; $instances{$_}-> {extras} = $dep{$_}-> {extras} if $dep{$_}-> {extras}; for ( @actNames) { next unless exists $act-> {$_}; $actions{$_}-> {$key} = $act-> {$_}; } } $actions{onBegin}-> {$_}-> ($_, $instances{$_}) for keys %{$actions{onBegin}}; for ( @{$dep{$main}-> {siblings}}) { if ( exists $dep{$main}-> {profile}-> {$_}) { $siblings{$main}-> {$_} = $dep{$main}-> {profile}-> {$_}; delete $dep{$main}-> {profile}-> {$_}; } if ( exists $parms-> {$main}-> {$_}) { $siblings{$main}-> {$_} = $parms-> {$main}-> {$_}; delete $parms-> {$main}-> {$_}; } } delete $dep{$main}-> {profile}-> {owner}; $dep{$main}-> {code}-> () if defined $dep{$main}-> {code} ; $ret{$main} = $dep{$main}-> {class}-> create( %{$dep{$main}-> {profile}}, %{$parms-> {$main}}, ); $ret{$main}-> lock; $actions{onFormCreate}-> {$_}-> ($_, $instances{$_}, $ret{$main}) for keys %{$actions{onFormCreate}}; $actions{onCreate}-> {$main}-> ($main, $instances{$_}, $ret{$main}) if $actions{onCreate}-> {$main}; my $do_layer; $do_layer = sub { my $id = $_[0]; my $i; for ( $i = 0; $i < scalar @$seq; $i += 2) { my $name = $$seq[$i]; next unless $owners{$name} eq $id; # validating owner entry $owners{$name} = $main unless exists $ret{$owners{$name}}; my $o = $owners{$name}; $actions{onChild}-> {$o}-> ($o, $instances{$o}, $ret{$o}, $name) if $actions{onChild}-> {$o}; for ( @{$dep{$name}-> {siblings}}) { if ( exists $dep{$name}-> {profile}-> {$_}) { if ( exists $ret{$dep{$name}-> {profile}-> {$_}}) { $dep{$name}-> {profile}-> {$_} = $ret{$dep{$name}-> {profile}-> {$_}} } else { $siblings{$name}-> {$_} = $dep{$name}-> {profile}-> {$_}; delete $dep{$name}-> {profile}-> {$_}; } } if ( exists $parms-> {$name}-> {$_}) { if ( exists $ret{$parms-> {$name}-> {$_}}) { $parms-> {$name}-> {$_} = $ret{$parms-> {$name}-> {$_}} } else { $siblings{$name}-> {$_} = $parms-> {$name}-> {$_}; delete $parms-> {$name}-> {$_}; } } } $ret{$name} = $ret{$o}-> insert( $dep{$name}-> {class}, %{$dep{$name}-> {profile}}, %{$parms-> {$name}}, ); $actions{onCreate}-> {$name}-> ($name, $instances{$name}, $ret{$name}) if $actions{onCreate}-> {$name}; $actions{onChildCreate}-> {$o}-> ($o, $instances{$o}, $ret{$o}, $ret{$name}) if $actions{onChildCreate}-> {$o}; $do_layer-> ( $name); } }; $do_layer-> ( $main, \%owners); for ( keys %siblings) { my $data = $siblings{$_}; $ret{$_}-> set( map { exists($ret{$data-> {$_}}) ? ( $_ => $ret{$data-> {$_}}) : () } keys %$data ); } $actions{onEnd}-> {$_}-> ($_, $instances{$_}, $ret{$_}) for keys %{$actions{onEnd}}; $ret{$main}-> unlock; return %ret; } sub AUTOFORM_CREATE { my ( $filename, %parms) = @_; my $contents; my @preload_modules; { open F, $filename or die "Cannot open $filename:$!\n"; my $first = ; die "Corrupted file $filename\n" unless $first =~ /^# VBForm/; my @fvc = check_version( $first); die "Incompatible version ($fvc[1]) of file $filename\n" unless $fvc[0]; while () { $contents = $_, last unless /^#/; next unless /^#\s*\[([^\]]+)\](.*)$/; if ( $1 eq 'preload') { push( @preload_modules, split( ' ', $2)); } } local $/; $contents .= ; close F; } for ( @preload_modules) { eval "use $_;"; die "$@\n" if $@; } my $sub = eval( $contents); die "$@\n" if $@; my @dep = $sub-> (); return AUTOFORM_REALIZE( \@dep, \%parms); } package Prima; use strict; sub VBLoad { my ( $filename, %parms) = @_; if ( $filename =~ /.+\:\:([^\:]+)$/ && $filename !~ /^ { centered => 1 }, )-> execute; A more complicated but more proof code can be met in the toolkit: use Prima qw(Application); eval "use Prima::VB::VBLoader"; die "$@\n" if $@; $form = Prima::VBLoad( $fi, 'Form1' => { visible => 0, centered => 1}, ); die "$@\n" unless $form; All form widgets can be supplied with custom parameters, all together combined in a hash of hashes and passed as the second parameter to C function. The example above supplies values for C<::visible> and C<::centered> to C widget, which is default name of a form window created by Visual Builder. All other widgets are accessible by their names in a similar fashion; after the creation, the widget hierarchy can be accessed in the standard way: $form = Prima::VBLoad( $fi, .... 'StartButton' => { onMouseOver => sub { die "No start buttons here\n" }, } ); ... $form-> StartButton-> hide; In case a form is to be included not from a fm file but from other data source, L call can be used to transform perl array into set of widgets: $form = AUTOFORM_REALIZE( [ Form1 => { class => 'Prima::Window', parent => 1, profile => { name => 'Form1', size => [ 330, 421], }], {}); Real-life examples are met across the toolkit; for instance, F dialog is used by C. =head1 API =head2 Methods =over =item check_version HEADER Scans HEADER, - the first line of a .fm file for version info. Returns two scalars - the first is a boolean flag, which is set to 1 if the file can be used and loaded, 0 otherwise. The second scalar is a version string. =item GO_SUB SUB [ @EXTRA_DATA ] Depending on value of boolean flag C performs the following: if it is 1, the SUB text is returned as is. If it is 0, evaluates it in C context and returns the code reference. If evaluation fails, EXTRA_DATA is stored in C array and the exception is re-thrown. C is an internal flag that helps the Visual Builder use the module interface without actual SUB evaluation. =item AUTOFORM_REALIZE WIDGETS, PARAMETERS WIDGETS is an array reference that contains evaluated data of the read content of .fm file ( its data format is preserved). PARAMETERS is a hash reference with custom parameters passed to widgets during creation. The widgets are distinguished by the names. Visual Builder ensures that no widgets have equal names. C creates the tree of widgets and returns the root window, which is usually named C. It automatically resolves parent-child relations, so the order of WIDGETS does not matter. Moreover, if a parent widget is passed as a parameter to a children widget, the parameter is deferred and passed after the creation using C<::set> call. During the parsing and creation process internal notifications can be invoked. These notifications (events) are stored in .fm file and usually provide class-specific loading instructions. See L for details. =item AUTOFORM_CREATE FILENAME, %PARAMETERS Reads FILENAME in .fm file format, checks its version, loads, and creates widget tree. Upon successful load the root widget is returned. The parsing and creation is performed by calling C. If loading fails, C is called. =item Prima::VBLoad FILENAME, %PARAMETERS A wrapper around C, exported in C namespace. FILENAME can be specified either as a file system path name, or as a relative module name. In a way, Prima::VBLoad( 'Module::form.fm' ) and Prima::VBLoad( Prima::Utils::find_image( 'Module' 'form.fm')) are identical. If the procedure finds that FILENAME is a relative module name, it calls C automatically. To tell explicitly that FILENAME is a file system path name, FILENAME must be prefixed with C> symbol ( the syntax is influenced by C ). %PARAMETERS is a hash with custom parameters passed to widgets during creation. The widgets are distinguished by the names. Visual Builder ensures that no widgets have equal names. If the form file loaded successfully, returns the form object reference. Otherwise, C is returned and the error string is stored in C<$@> variable. =back =head2 Events The events, stored in .fm file are called during the loading process. The module provides no functionality for supplying the events during the load. This interface is useful only for developers of Visual Builder - ready classes. The events section is located in C section of widget entry. There can be more than one event of each type, registered to different widgets. NAME parameter is a string with name of the widget; INSTANCE is a hash, created during load for every widget provided to keep internal event-specific or class-specific data there. C section of widget entry is present there as an only predefined key. =over =item Begin NAME, INSTANCE Called upon beginning of widget tree creation. =item FormCreate NAME, INSTANCE, ROOT_WIDGET Called after the creation of a form, which reference is contained in ROOT_WIDGET. =item Create NAME, INSTANCE, WIDGET. Called after the creation of the widget. The newly created widget is passed in WIDGET =item Child NAME, INSTANCE, WIDGET, CHILD_NAME Called before child of WIDGET is created with CHILD_NAME as name. =item ChildCreate NAME, INSTANCE, WIDGET, CHILD_WIDGET. Called after child of WIDGET is created; the newly created widget is passed in CHILD_WIDGET. =item End NAME, INSTANCE, WIDGET Called after the creation of all widgets is finished. =back =head1 FILE FORMAT The idea of format of .fm file is that is should be evaluated by perl C call without special manipulations, and kept as plain text. The file begins with a header, which is a #-prefixed string, and contains a signature, version of file format, and version of the creator of the file: # VBForm version file=1 builder=0.1 The header can also contain additional headers, also prefixed with #. These can be used to tell the loader that another perl module is needed to be loaded before the parsing; this is useful, for example, if a constant is declared in the module. # [preload] Prima::ComboBox The main part of a file is enclosed in C statement. After evaluation, this sub returns array of paired scalars, where each first item is a widget name and second item is hash of its parameters and other associated data: sub { return ( 'Form1' => { class => 'Prima::Window', module => 'Prima::Classes', parent => 1, code => GO_SUB('init()'), profile => { width => 144, name => 'Form1', origin => [ 490, 412], size => [ 144, 100], }}, ); } The hash has several predefined keys: =over =item actions HASH Contains hash of events. The events are evaluated via C mechanism and executed during creation of the widget tree. See L for details. =item code STRING Contains a code, executed before the form is created. This key is present only on the root widget record. =item class STRING Contains name of a class to be instantiated. =item extras HASH Contains a class-specific parameters, used by events. =item module STRING Contains name of perl module that contains the class. The module will be C'd by the loader. =item parent BOOLEAN A boolean flag; set to 1 for the root widget only. =item profile HASH Contains profile hash, passed as parameters to the widget during its creation. If custom parameters were passed to C, these are coupled with C ( the custom parameters take precedence ) before passing to the C call. =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L =cut Prima-1.28/Prima/VB/Config.pm0000644000175100017510000002064711150770061013425 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Config.pm,v 1.16 2005/10/13 17:22:52 dk Exp $ package Prima::VB::Config; sub pages { return qw(General Additional Sliders Abstract); } sub classes { return ( 'Prima::Gauge' => { icon => 'VB::classes.gif:9', page => 'Sliders', class => 'Prima::VB::Gauge', RTModule => 'Prima::Sliders', module => 'Prima::VB::CoreClasses', }, 'Prima::StringOutline' => { icon => 'VB::classes.gif:17', page => 'General', class => 'Prima::VB::StringOutline', RTModule => 'Prima::Outlines', module => 'Prima::VB::CoreClasses', }, 'Prima::ImageViewer' => { icon => 'VB::classes.gif:14', page => 'General', class => 'Prima::VB::ImageViewer', RTModule => 'Prima::ImageViewer', module => 'Prima::VB::CoreClasses', }, 'Prima::Label' => { icon => 'VB::classes.gif:15', page => 'General', class => 'Prima::VB::Label', RTModule => 'Prima::Label', module => 'Prima::VB::CoreClasses', }, 'Prima::GroupBox' => { icon => 'VB::classes.gif:10', page => 'General', class => 'Prima::VB::GroupBox', RTModule => 'Prima::Buttons', module => 'Prima::VB::CoreClasses', }, 'Prima::InputLine' => { icon => 'VB::classes.gif:13', page => 'General', class => 'Prima::VB::InputLine', RTModule => 'Prima::InputLine', module => 'Prima::VB::CoreClasses', }, 'Prima::ScrollWidget' => { icon => 'VB::classes.gif:21', page => 'Abstract', class => 'Prima::VB::ScrollWidget', RTModule => 'Prima::ScrollWidget', module => 'Prima::VB::CoreClasses', }, 'Prima::Widget' => { icon => 'VB::VB.gif:0', page => 'Abstract', class => 'Prima::VB::Widget', RTModule => 'Prima::Classes', module => 'Prima::VB::Classes', }, 'Prima::OutlineViewer' => { icon => 'VB::classes.gif:17', page => 'Abstract', class => 'Prima::VB::OutlineViewer', RTModule => 'Prima::Outlines', module => 'Prima::VB::CoreClasses', }, 'Prima::SpinEdit' => { icon => 'VB::classes.gif:25', page => 'Sliders', class => 'Prima::VB::SpinEdit', RTModule => 'Prima::Sliders', module => 'Prima::VB::CoreClasses', }, 'Prima::Calendar' => { icon => 'VB::classes.gif:32', page => 'Additional', class => 'Prima::VB::Calendar', RTModule => 'Prima::Calendar', module => 'Prima::VB::CoreClasses', }, 'Prima::DirectoryListBox' => { icon => 'VB::classes.gif:6', page => 'Additional', class => 'Prima::VB::DirectoryListBox', RTModule => 'Prima::FileDialog', module => 'Prima::VB::CoreClasses', }, 'Prima::ComboBox' => { icon => 'VB::classes.gif:3', page => 'General', class => 'Prima::VB::ComboBox', RTModule => 'Prima::ComboBox', module => 'Prima::VB::CoreClasses', }, 'Prima::Radio' => { icon => 'VB::classes.gif:18', page => 'General', class => 'Prima::VB::Radio', RTModule => 'Prima::Buttons', module => 'Prima::VB::CoreClasses', }, 'Prima::SpeedButton' => { icon => 'VB::classes.gif:19', page => 'Additional', class => 'Prima::VB::Button', RTModule => 'Prima::Buttons', module => 'Prima::VB::CoreClasses', }, 'Prima::ListBox' => { icon => 'VB::classes.gif:16', page => 'General', class => 'Prima::VB::ListBox', RTModule => 'Prima::Lists', module => 'Prima::VB::CoreClasses', }, 'Prima::CheckBox' => { icon => 'VB::classes.gif:2', page => 'General', class => 'Prima::VB::CheckBox', RTModule => 'Prima::Buttons', module => 'Prima::VB::CoreClasses', }, 'Prima::CircularSlider' => { icon => 'VB::classes.gif:4', page => 'Sliders', class => 'Prima::VB::CircularSlider', RTModule => 'Prima::Sliders', module => 'Prima::VB::CoreClasses', }, 'Prima::DetailedList' => { icon => 'VB::classes.gif:31', page => 'General', class => 'Prima::VB::DetailedList', RTModule => 'Prima::DetailedList', module => 'Prima::VB::CoreClasses', }, 'Prima::Edit' => { icon => 'VB::classes.gif:8', page => 'General', class => 'Prima::VB::Edit', RTModule => 'Prima::Edit', module => 'Prima::VB::CoreClasses', }, 'Prima::ColorComboBox' => { icon => 'VB::classes.gif:1', page => 'Additional', class => 'Prima::VB::ColorComboBox', RTModule => 'Prima::ColorDialog', module => 'Prima::VB::CoreClasses', }, 'Prima::Slider' => { icon => 'VB::classes.gif:22', page => 'Sliders', class => 'Prima::VB::Slider', RTModule => 'Prima::Sliders', module => 'Prima::VB::CoreClasses', }, 'Prima::AltSpinButton' => { icon => 'VB::classes.gif:24', page => 'Sliders', class => 'Prima::VB::AltSpinButton', RTModule => 'Prima::Sliders', module => 'Prima::VB::CoreClasses', }, 'Prima::Header' => { icon => 'VB::classes.gif:30', page => 'Sliders', class => 'Prima::VB::Header', RTModule => 'Prima::Header', module => 'Prima::VB::CoreClasses', }, 'Prima::DirectoryOutline' => { icon => 'VB::classes.gif:7', page => 'Additional', class => 'Prima::VB::DirectoryOutline', RTModule => 'Prima::Outlines', module => 'Prima::VB::CoreClasses', }, 'Prima::Button' => { icon => 'VB::classes.gif:0', page => 'General', class => 'Prima::VB::Button', RTModule => 'Prima::Buttons', module => 'Prima::VB::CoreClasses', }, 'Prima::TabSet' => { icon => 'VB::classes.gif:27', page => 'Additional', class => 'Prima::VB::TabSet', RTModule => 'Prima::Notebooks', module => 'Prima::VB::CoreClasses', }, 'Prima::ScrollBar' => { icon => 'VB::classes.gif:20', page => 'General', class => 'Prima::VB::ScrollBar', RTModule => 'Prima::ScrollBar', module => 'Prima::VB::CoreClasses', }, 'Prima::ListViewer' => { icon => 'VB::classes.gif:16', page => 'Abstract', class => 'Prima::VB::ListViewer', RTModule => 'Prima::Lists', module => 'Prima::VB::CoreClasses', }, 'Prima::TabbedNotebook' => { icon => 'VB::classes.gif:28', page => 'Additional', class => 'Prima::VB::TabbedNotebook', RTModule => 'Prima::Notebooks', module => 'Prima::VB::CoreClasses', }, 'Prima::Notebook' => { icon => 'VB::classes.gif:29', page => 'Abstract', class => 'Prima::VB::Notebook', RTModule => 'Prima::Notebooks', module => 'Prima::VB::CoreClasses', }, 'Prima::DriveComboBox' => { icon => 'VB::classes.gif:5', page => 'Additional', class => 'Prima::VB::DriveComboBox', RTModule => 'Prima::FileDialog', module => 'Prima::VB::CoreClasses', }, 'Prima::SpinButton' => { icon => 'VB::classes.gif:23', page => 'Sliders', class => 'Prima::VB::SpinButton', RTModule => 'Prima::Sliders', module => 'Prima::VB::CoreClasses', }, 'Prima::Grid' => { RTModule => 'Prima::Grids', class => 'Prima::VB::Grid', page => 'General', icon => 'VB::classes.gif:33', module => 'Prima::VB::CoreClasses', }, 'Prima::AbstractGrid' => { RTModule => 'Prima::Grids', class => 'Prima::VB::AbstractGrid', page => 'Abstract', icon => 'VB::classes.gif:33', module => 'Prima::VB::CoreClasses', }, ); } 1; Prima-1.28/Prima/VB/VB.gif0000644000175100017510000000232411150770061012650 0ustar dkdkGIF89a€ÿÿ!ù2, ŒiÀí¾ždq¾jÎ`go“(‘WÀAhJ­¬©*²Q!ù2, ƒ€€€€€€€€€¿¿¿ÿÿÿÿÿÿÿÿÿÿÿÿ†pI%­çάG^Ö^£Çm§Yl[…æ!ËúÔpßìP^‡ÝCfº]t;F 6‡AÉãuBaLd4²ÁäkYô=%QåŽé´U²CKñúÕffd nÉKÙçVN¯G!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ©ðÉI«½8O »æ^H(†€bžŸ¢²^*”p;¯õ¨ÌtnÉ$œïá*ÝD*áCfìQ@JZa’zR¦X2K“Ú¹@_Úu7&³]“Û,,`w¤\´‘˜/W]tJQV‚Il…dx]fu`R‹U•ŠK‚TWAˆuvŒP7hk$†xg™{™…b klr«“’’bY¥C¸]šCqmÁsÄŨÇOÃÊC!ù2, ƒ€€€€€€€€€€€€ÀÀÀÿÿÿÿÿÿÿÿÿÿÿÿ†ðÉI«½5éÍ»ÿšnùŒá9ªÉ©²Ÿˆ¶oˆÊ+W¯°—Ñ3Ül¨{ ŽÈ¤rÉ< ‰DÜꃹ¨ ©Íumm‹\’Øå–Æa´Í[»vÙíuù;'—eö˜ ôa«€E‚CO„‡Y/ftv&ƒ‰Š‘’“ˆ G˜œQ=•} ¢£¤4¨©;Prima-1.28/Prima/VB/examples/0000755000175100017510000000000011150770061013467 5ustar dkdkPrima-1.28/Prima/VB/examples/Sample.fm0000644000175100017510000003664011150770061015245 0ustar dkdk# VBForm version file=1 builder=0.1 sub { return ( 'SampleApplication' => { class => 'Prima::Window', module => 'Prima::Classes', parent => 1, profile => { width => 420, name => 'SampleApplication', bottom => 335, text => 'Sample Application', originDontCare => 0, origin => [ 353, 335], height => 223, left => 353, sizeDontCare => 0, size => [ 420, 223], }}, 'IV' => { class => 'Prima::ImageViewer', module => 'Prima::ImageViewer', profile => { name => 'IV', image => Prima::Image->create( width=>80, height=>76, type => im::bpp8, palette => [ 32,33,33,172,142,93,128,88,54,56,45,106,85,59,48,204,202,176,69,60,111,97,88,113,52,42,70,156,155,160,36,29,151,72,60,79,54,43,90,122,117,116,160,118,62,185,180,160,49,42,126,82,76,81,58,52,71,147,144,131,72,63,145,95,88,88,217,216,220,50,43,146,124,115,150,182,183,200,182,168,134,70,59,93,53,49,47,239,239,239,114,78,53,145,133,119,59,51,127,88,80,106,61,53,109,60,52,88,100,88,138,51,44,80,180,178,182,136,104,85,69,60,65,79,68,78,160,160,194,119,117,132,53,44,164,111,108,112,169,164,162,35,29,165,57,52,80,146,145,146,60,51,136,70,62,127,147,104,55,96,87,97,135,117,95,82,52,43,252,254,254,87,79,94,54,46,70,75,67,66,47,36,150,66,59,161,60,52,96,190,189,187,52,43,115,164,132,88,205,205,205,225,227,227,138,134,144,47,42,56,196,194,196,165,146,111,112,86,72,167,158,128,113,106,137,105,103,102,194,188,161,188,179,150,82,76,127,163,157,150,164,130,78,122,95,82,188,186,222,225,229,241,144,132,164,151,132,103,214,215,212,100,92,127,152,117,79,76,73,141,229,241,251,108,76,66,137,134,134,177,157,110,178,172,147,164,156,178,220,214,234,148,110,70,76,72,160,184,152,98,139,97,48,77,69,109,132,123,118,64,52,146,54,50,59,43,41,40,63,53,160,98,67,47,130,124,132,98,96,97,111,105,124,170,166,172,79,54,58,196,190,214,104,97,143,124,124,160,70,44,89,103,75,75,86,77,116,183,159,127,132,110,102,188,191,173,107,96,114,79,67,93,44,35,169,120,95,71,175,175,174,49,40,136,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128], data => "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "8Z8SS\x16CCC\x1d8888888888". "88888888888888888888". "88888888888888888888". "8888888888888888\x1dCBF". "\x09\\\x0dm5mK\x0d\\\\~C\x1dZ888888". "88888888888888888888". "88888888888888888888". "8888888888\\\x18+++-9\x11hh". "EiEihi\x00\(\x11m-\\~FC\x1d8888". "88888888888888888888". "8888888888888888\x1d8\x1d\x1d". "Z\x1dZ888888ZOW \@\@\x03\x03\>\#0". "0h\x12EE\x00h\x11\x15mm-\\.\?\x16\x1d\x1d88". "88888888888888888888". "888888888\x1d\x16F\&~.1\\1D\x13". "\x13\x131.~FVVCC\x1dZ\?+\>\@\x10\x03\"\"". "\>t:h\x1cih;\x15m\x15m\x0d1.B\x16\x1d88". "88888888888888888888". "8888CV~\x13f\x15\(\x1c\x1ci\x1c\x1ch\(\x1cp". "\(\(\(;;\x11mK\x0df.BC\x1dV+\>\x10 \x06". "+Dn{\x12\x12\(h\x1c;\x11\x15-\x0dl\x09BZ88". "88888888888888888888". "C\&\x136}\'}H\x1e\x1ekkk\x0477i\x1ci\x00". "i\x1c\x1c\x1c\x1c;;;\x11\x15K\\OFC\x1dF\!33". "C888\x09\x0b\x12\x12\);\x11\x15K\x0d\\.\x16888". "888888888888888888V\x13". "\x1fIIGAP\x0e\x0e44dddddd\x02\x1e\x04i". "i\x00i\x00\x00\x1c\x1c\(;;mK\\\x09FV\x1d\x165\x18". "88888D\x120\)\)-f1\&B\x1d8888". "8888888888888Z\x1d\x16V\&KI". "\x1a\^\^wAXa4d\x02\x1e\x02\x02\x02\x02d44dd". "\x1e7\x00\x00\x00ii\(;\x11\x15Kf\\.B\x16\x16BC". "8\x1d8Z~\)\x1b{5.V\x1d88888888". "8888888888\x16\x0f\x1aIG\x01AXX\^". "IIGG\x01PXa4H\x0bt00\x0b0\x0b\)\)[". "\x02\x02\x027\x00\x00i\x11;\x11\x11m\x0d\x0dl\x09FV\x16S". "8\x1d\&z\#\>\x0b9F88888888888". "888888888\x16\x13M\x0fLM\x1ac\x01UO". "\x0fMMM\x1a]\x01AaQp\%\%\%\%\x0c\x0c\x0c\%\x08". "\(\)[\x04\x00ih\x11;\)\x115-\x0dl1\?V\&1". "-\x0b0\#\x1b\x0b9B888888888888". "888888888~1\^\x1a\^wIGcAU". "\x0fL\x05yyM\x1awUu\#\>\#\x0c0\#\%\%\%\x0c". "\%0\x0b\(\x1c\x11\x15---\x0d-\x0d+K\x11\)\(hh". "\x120\x12\x0b9\x09\x1d8888888888888". "888888888V\x1fI\x0f\x0fLMw]\x01P". "\'f.\&y\?.\\u\x1b\#\x1b\#\#\#0\%\%\%:". "\%\%\)\x0d1~\?BB\?l\)hhh\x12\x12\x12\x12\x12". "\x0b-\x09V8888888888888888". "8888888888B.\x13\^\x0fL\x1awUX". "[\x1b{9\x155\x0b\x0bu\x11{\x0b\x0b:\x08:0:\x12[". "\x0b0-\x1dZ\x1dC\x099hh\x08:\x12\x12\(\)\x0d\x09B". "\x1d8888888888888888888". "888888888888\x1d\?1\x1ff\x1ffu". "\x0b{\x07\x07r\x07nv\x1b\x0b;\)\x0b999\x12\x08\x0b\'". "u\x12\?8\x16D\(\x08\x08\x08\%\x12\)-o\x168888". "88888888888888888888". "8888888888888888\x1d\x1d\x1dV". "F\&.\\m{5nJvtp\x0b\x1b0\x1b0\%h5". "u\x0b\x1dD\(\x120\x12:\x125o\x1d8888888". "88888888888888888888". "88888888888888888888". "88888F\(9\x07\x07e:9\!v\#\x08\%\x08h". "\x12\x11\x15hh\%0\x0b\x15\&8888888888". "88888888888888888888". "88888888888888888888". "888888\x15{e\>:E:\#0\x12\x12h\x12\%". "\x12\(E\x12:0\)\&888888888888". "88888888888888888888". "88888888888888888888". "88888V\x0b\x0b\#\x12:Ehh\x12Ehh:h". "\x12\x12h\x12:\x11C8888888888888". "88888888888888888888". "88888888888888888888". "88888F\x11\x12\x12:\x08\x12:h\x12\x08:h\x08E". "\x08h::\(V88888888888888". "88888888888888888888". "88888888888888888888". "88888\x1d9\x1b\>\x03\"\#\%:::\%\x08::". "EE:E\x09888888888888888". "88888888888888888888". "88888888888888888888". "88888n\"2\x7f\x10\x10\x03\x0c0::E\x08EE". "EEh\x11Z888888888888888". "88888888888888888888". "88888888888888888888". "8888\&\>\x17\<\x17\x7f\x03\x03\#:\x08::EEE". "EE\x12\&8888888888888888". "88888888888888888888". "88888888888888888888". "8888n\x7f\<\x17\x7f\"\%\%\x12\x12\x08\x12\x08EEE". "h\x12\x1188888888888888888". "88888888888888888888". "88888888888888888888". "8888e\x0a/\<\x03::hEEEEEEEh". ":\x12l88888888888888888". "88888888888888888888". "88888888888888888888". "8888e\x0a\x7f\x03\x12\x12\x12\x12:EEEEEE:". "E\x12\&88888888888888888". "88888888888888888888". "88888888888888888888". "8888z\x7f\%h\x12\x12:h\x08hEEE\x08\%E". "EhF88888888888888888". "88888888888888888888". "88888888888888888888". "88881\x12\x12\x12\x12\x12:\x08E\x08E::0\%h". ":E.88888888888888888". "88888888888888888888". "88888888888888888888". "8888_\x12\x12\%00\%:\x08\x08E\x08:\%\%:". "\x08:588888888888888888". "88888888888888888888". "88888888888888888888". "888\x1d\)\x08\x0c\x03\x103\"\x0c\x08\x08::E\x12\%\%". "\%\%\(\x1d8888888888888888". "88888888888888888888". "88888888888888888888". "88\x1d~:\%\x7f\x0a\x7f\<\<\x10\x03\x08:\x12\x12\x12:\%". "\%0\x0bC8888888888888888". "88888888888888888888". "88888888888888888888". "F~zh\x12:\%\x0a\x0a\x0a\x0a\x0a\x7f\x03\#0\x0b\x12\x12\%". "\%\%\x0bZ8888888888888888". "88888888888888888888". "8888888888888888888n". "\x06\>\x08::\x08\x08\x0c\x0a\x0a/\x0a\x17 \>0\x12:\%\%". "\%:\x1588888888888888888". "88888888888888888888". "88888888888888888C+\x12". "\x08\x08\x08:\x08EE\%\x17\x17//\x7f\>::\x12:\#\%". "\%:\x0d88888888888888888". "88888888888888888888". "888888888888888889\>\x03". "\%\x08\x08\x080:E\x0c\x17,/\x0a\x0c\%\%\x080\#\"0". "00188888888888888888". "88888888888888888888". "8888888888888888\x1d\#\<\<". "\x10tE\x120\x12h:\>\"\x03\@\x03\"\>\>\>\x03\"\#". "\x12\(F88888888888888888". "88888888888888888888". "88888888888888888{\x17\<". "\x10\x0c:\x12\x12\x12\x12\x0b\>\@\x0a\x7f\x17\x10 \"\x10\x7f 0". "\x12\)\x1d88888888888888888". "88888888888888888888". "888888888888888881\x06\@". "t\x08E\x0b.FBF\x1b \x7f\<\<\x7f \x10\x17\x17 \x12". "\x12\x0d888888888888888888". "88888888888888888888". "888888888888\x1d8888\x1d\x0b\%". "\@\x0c\x08u\x1d888z\>\"\x03\"\>\"\@\x10\x10\>0". "\)\?888888888888888888". "88888888888888888888". "88888888\x1d.\'HQ\x0d\?8Sxp\x0c". "\x0a\x7f\x08;S888z\x0b:\x08E:0\#\#0\%\x12". "\x0bC888888888888888888". "88888888888888888888". "8888888V6fO\^x}Hlup\x15\>". "\x0a\< z88Cl\#\x0ct\x0c\x08:\x12:\x08:\x12\x12". "\x12\?888888888888888888". "88888888888888888888". "888888\x05]U\?888FH\x04;18\x16". "\x07\x06\x18C8\&{\x1200\x12\%t\#\#::\x120:". "\x12\x11B88888888888888888". "88888888888888888888". "88888VLBVC888.[;\(\x1688". "Z\x1d8\x1dl\x12\x0b\>\#\x1b\x1b\x12:\x12\%::\x12\x120". ":0\x0bo8888888888888888". "88888888888888888888". "8888888888ZV1[xBHO88". "88o9\x12\x0c\x06 \" \"t\x12h\x12\x12h:h". "\x08\x08\x08\x12o888888888888888". "88888888888888888888". "8888888888~HQF88ff88". "\&9\x1b0\#\x03 2222\x10\"\"\#\#\#0::". "E\x08\x08\x08\)\?88888888888888". "88888888888888888888". "8888888888IU.888\x0d\\81". "\x1b\>:t 2\<\<\x17\<\x7f\@\x0c\x0c\%\x08". "::\x08\x080\x11\x1d8888888888888". "88888888888888888888". "8888888888C888BBHBo\>". "\@\>\>\"\#t\#\%\% ,,|//|\x0a\@\x0c0". ":h\x08\%\x12018888888888888". "88888888888888888888". "8888888888888\x1dx\x15\\85 ". "22\"\>tt\x08\x08\x08 gj,|||\<\@\x0c0". "\%hh\%\x08\x08\)8888888888888". "88888888888888888888". "8888888888888\x0f\'\x0d8\x1d\>\x17". "\<2\x03\x7f\x17 \x1b::\x06ee\"\x03\@ \x03\x0c\>\x0c". "\x08\x08\x12:\%:\x12V888888888888". "88888888888888888888". "888888888888\x16\^V88\x1d\>|". "\<2\x10\<\x0a\x17\"\x1b\x125\*R\*\x07\x1b3 \x03\"\>". ":\x08:\%\x08\x08\x12F888888888888". "88888888888888888888". "888888888888C88888e\<". "\<2\@\x7f\<\"\x06\x0b\x04;BZZ`ngg\"\"\>". "\x0c\x12h:\x08\x08\x12~888888888888". "88888888888888888888". "8888888888888888881\x7f". ",g t\x1b\"\x06p7kU8ZZy3j \@\>". "\%\%h\x08\%\x08:\&888888888888". "88888888888888888888". "888888888888888888\x1dn". "2g\>hh0\x1bp\x04\x04}Z88\x1dzjg \>". "0\%::\%\%\x12\x09888888888888". "88888888888888888888". "8888888888888888888Z". "9\x06p7\x1c\(07kk}\x1dZZZD,\x17 \"". "\#0\x08:\x08\%\%0\x0dS8888888888". "88888888888888888888". "88888888888888888888". "~\x0b;7\x04mn\(GHXZZZ8\x09,j2\>". "\>\%h\x08\x08\%\%\x08:5B888888888". "88888888888888888888". "88888888888888888888". "Z{\x13X\x1e6\?\x11G6MZ8ZZ\&jj2\>". "\>\%:\x12\x08\%\%\x08\x08\x08\)\&88888888". "88888888888888888888". "88888888888888888888". "8ls\x05\x01\^ZzLVZZZZZF== \x03". "\x0c\#\x08h\x120\%\x08\x08\x08\x12\)o8888888". "88888888888888888888". "88888888888888888888". "8\x09\x07CVZZsoZZZZZZ\x19j\x142\>". "\>\x1b0\x12\x12\x12\x12:\x08\x08\x08ppB888888". "88888888888888888888". "88888888888888888888". "8\&e_ZZS\*\x18\x1dZZZZ8\*jg\"\x03". "\>\>\>\#0\>ttp\x08\x08\x08\x085888888". "88888888888888888888". "88888888888888888888". "8F9\$\x16ZS`\$_ZZZZZTj\x14 \>". "\>\>\>\"\x03\x03t\x03t\x08p\x08\x08p\?88888". "88888888888888888888". "88888888888888888888". "8\x09eNDZZSsrBZZZZ\$\x14\>\#t". "t\x0c\x0c\" 2\x7f \x03t\x08\x08\x08tl88888". "88888888888888888888". "88888888888888888888". "8n=eY_ZS\x19brBZ\x1d\x09\x14 \%\x0ct". "\%\x0ct\>\"g\<\<\x7f\x03\x08\x08\x08\x08u88888". "88888888888888888888". "88888888888888888888". "ZNj3\x06YT\x16qYbNJr\x14\x14\x12\x08\x0ct". "\x0c\%:0\x1be\x06\x7f\<\h:\%\x08". "\x08\x08\x12\x12l8\x16ov 2t:\x12\)88888". "88888888888888888888". "88888888888888888888". "8N,j\x06\x12\x06\x14\x14\" \x06\"\"\>\x12:\%\%\x08". "E:\x12-\x1d8888D tp0\x0d88888". "88888888888888888888". "88888888888888888888". "8\x18jje\x12\x120\x12\x12\>\x06\"\#0\x12\%\x08:\x12". "\x12\x0b\x09888888\?\"\"\x12p\?88888". "88888888888888888888". "88888888888888888888". "8FY=30\x12\(9+\)\x06\x06\x06t\x08\x12\(\)9". "1C8888888F \>\x0bm888888". "88888888888888888888". "88888888888888888888". "88J=30\x12p\&8\x1d\x191ln-l\x09V8". "888888888\x09\x14\x1b;V888888". "88888888888888888888". "88888888888888888888". "88CW\x14\x06\x0b\)\x1688888888888". "888888888J3\x0bO8888888". "88888888888888888888". "88888888888888888888". "888\x16\x073\x1b\(~88888888888". "88888888`eNl88888888". "88888888888888888888". "88888888888888888888". "8888\x16z\x06\x0b9C8888888888". "88888888+N\\888888888". "88888888888888888888". "88888888888888888888". "88888\x1dl\x1b\x0bK\x1d888888888". "88888888D\x198888888888". "88888888888888888888". "88888888888888888888". "8888888F5\x0b\x0d\x1d88888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888\x1d.5188888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". "88888888888888888888". ''), zoom => 2, valignment => ta::Middle, origin => [ 210, 69], size => [ 192, 142], owner => 'SampleApplication', alignment => ta::Center, }}, 'SampleGroup' => { class => 'Prima::GroupBox', module => 'Prima::Buttons', profile => { origin => [ 8, 53], name => 'SampleGroup', onRadioClick => Prima::VB::VBLoader::GO_SUB('$_[0]-> owner-> IV->zoom( 1 << $_[0]-> index );'), owner => 'SampleApplication', size => [ 189, 158], text => 'Sample Group', }}, 'VB::Radio1' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 15, 94], name => 'VB::Radio1', owner => 'SampleGroup', size => [ 157, 36], text => 'First', }}, 'OkBtn' => { class => 'Prima::Button', module => 'Prima::Buttons', profile => { origin => [ 22, 9], name => 'OkBtn', size => [ 96, 36], owner => 'SampleApplication', onClick => Prima::VB::VBLoader::GO_SUB('$_[0]-> owner-> close;'), text => '~Ok', }}, 'VB::Radio2' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 16, 53], name => 'VB::Radio2', owner => 'SampleGroup', size => [ 157, 36], text => 'Second', }}, 'VB::Radio3' => { class => 'Prima::Radio', module => 'Prima::Buttons', profile => { origin => [ 14, 11], name => 'VB::Radio3', owner => 'SampleGroup', size => [ 157, 36], text => 'Third', }}, 'VB::InputLine1' => { class => 'Prima::InputLine', module => 'Prima::InputLine', profile => { origin => [ 215, 9], name => 'VB::InputLine1', owner => 'SampleApplication', size => [ 187, 41], text => 'Enter text here...', alignment => ta::Center, font => {name => 'Times New Roman', size => 12, style => fs::Underlined, pitch => fp::Variable}, }}, ); } Prima-1.28/Prima/VB/examples/Widgety.pm0000644000175100017510000001234211150770061015443 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Widgety.pm,v 1.5 2005/10/13 17:22:53 dk Exp $ # Example of how to implement mirror to VB widget palette. # In fact, you don't need to keep runtime package and VB # implementation in one file. # # Package Prima::VB::examples::Widgety must be presented # first in file, located in Prima/VB/examples/Widgety.pm, # but runtime package could be located somewhere else, like # Prima::VB::CoreClasses.pm is a shell to Prima/*.pm # # Another example here is to introduce custom property editor, # included into Object Inspector. Here's defined 'lineRoundStyle', # property, same as rare-used 'lineEnd'. # ########################## VB mirror package ######################### package Prima::VB::examples::Widgety; sub classes { return ( 'Prima::SampleWidget' => { RTModule => 'Prima::VB::examples::Widgety', class => 'Prima::VB::examples::SampleWidget', page => 'Samples', module => 'Prima::VB::examples::Widgety', icon => 'VB::VB.gif:0', }, ); } use Prima::VB::Classes; package Prima::VB::examples::SampleWidget; use vars qw(@ISA); @ISA = qw( Prima::VB::CommonControl); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( lineRoundStyle => ['lineRoundStyle'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ( $self, $canvas) = @_; my @sz = $self-> size; my $c = $self-> color; $canvas-> color( $self-> backColor); $canvas-> bar( 0, 0, @sz); $canvas-> color( $c); $canvas-> lineWidth( 8); $canvas-> lineEnd( $self-> prf('lineRoundStyle')); $canvas-> line( 20, 20, $sz[0] - 21, $sz[1] - 21); $canvas-> draw_text( $self-> prf('text'), 0, 0, @sz, dt::Center | dt::VCenter); $canvas-> lineWidth( 1); $self-> common_paint($canvas); } sub prf_lineRoundStyle { $_[0]-> repaint; } package Prima::VB::Types::lineRoundStyle; use vars qw(@ISA); @ISA = qw(Prima::VB::Types::radio); sub IDS { qw( Flat Square Round); } sub packID { 'le'; } sub open { my $self = shift; $self-> SUPER::open( @_); $self-> {A}-> set( bottom => $self-> {A}-> bottom + 36, height => $self-> {A}-> height - 36, ); $self-> {B} = $self-> {container}-> insert( Widget => origin => [ 5, 5], size => [ $self-> {A}-> width, 32], growMode => gm::GrowHiX, onPaint => sub { my ( $me, $canvas) = @_; my @sz = $canvas-> size; $canvas-> color( cl::White); $canvas-> bar(0,0,@sz); $canvas-> lineEnd( $self-> get); $canvas-> lineWidth( 14); $canvas-> color( cl::Gray); $canvas-> line( 14, $sz[1]/2, $sz[0]-14, $sz[1]/2); $canvas-> lineWidth( 2); $canvas-> color( cl::Black); $canvas-> lineEnd( le::Round); $canvas-> line( 8, $sz[1]/2, 20, $sz[1]/2); $canvas-> line( $sz[0]-20, $sz[1]/2, $sz[0]-8, $sz[1]/2); $canvas-> line( 14, $sz[1]/2-6, 14, $sz[1]/2+6); $canvas-> line( $sz[0]-14, $sz[1]/2-6, $sz[0]-14, $sz[1]/2+6); }, ); } sub on_change { my $self = $_[0]; $self-> {B}-> repaint; } ############################### runtime package ########################################## use Prima::Classes; package Prima::SampleWidget; use vars qw(@ISA); @ISA = qw( Prima::Widget); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( lineRoundStyle => le::Round, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); $self-> lineRoundStyle( $profile{lineRoundStyle}); return %profile; } sub on_paint { my ( $self, $canvas) = @_; my @sz = $self-> size; my $c = $self-> color; $canvas-> color( $self-> backColor); $canvas-> bar( 0, 0, @sz); $canvas-> color( $c); $canvas-> lineWidth( 8); $canvas-> lineEnd( $self-> lineRoundStyle); $canvas-> line( 20, 20, $sz[0] - 21, $sz[1] - 21); $canvas-> draw_text( $self-> text, 0, 0, @sz, dt::Center | dt::VCenter); } sub lineRoundStyle { return $_[0]-> {lineRoundStyle} unless $#_; $_[0]-> {lineRoundStyle} = $_[1]; $_[0]-> repaint; } 1; Prima-1.28/Prima/VB/cfgmaint.pl0000644000175100017510000002330611150770061014002 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: cfgmaint.pl,v 1.8 2005/10/13 17:22:52 dk Exp $ use Prima::VB::CfgMaint; die < 1 } split( '', $_[0]); return if $h{$cmd[1]}; die "Invalid sub-option: $cmd[1]. Use one of '$_[0]'\n"; } sub assert { die "$_[1]\n" unless $_[0]; } die "Insufficient number of parameters\n" if @cmd < 2; $cmd[$_] = lc $cmd[$_] for 0..1; if ( $cmd[0] eq 'a') { check('pm', 3); } elsif ( $cmd[0] eq 'l') { check('wpm', 2); } elsif( $cmd[0] eq 'd') { check('wpm', 3); } elsif( $cmd[0] eq 'r') { check('wp', 4); } elsif( $cmd[0] eq 'm') { check('wp', 3); die "Insufficient number of parameters\n" if @cmd < 4 && $cmd[1] eq 'w'; } else { die "Unknown action: $cmd[0]\n"; } my @r; if ( $both) { @r = Prima::VB::CfgMaint::read_cfg(); } else { @r = Prima::VB::CfgMaint::open_cfg(); } die "$r[1]\n" unless $r[0]; if ( $cmd[0] eq 'a') { if ( $cmd[1] eq 'm') { my %cs = %Prima::VB::CfgMaint::classes; my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages; assert( Prima::VB::CfgMaint::add_module( $cmd[2])); for ( @Prima::VB::CfgMaint::pages) { next if $pg{$_}; print "page '$_' added\n"; } for ( keys %Prima::VB::CfgMaint::classes) { next if $cs{$_}; print "widget '$_' added\n"; } } elsif ( $cmd[1] eq 'p') { my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages; die "Page '$cmd[2]' already exists\n" if $pg{$cmd[2]}; push @Prima::VB::CfgMaint::pages, $cmd[2]; } } elsif ( $cmd[0] eq 'l') { if ( $cmd[1] eq 'w') { my $ok = defined $cmd[2] ? 0 : 1; for ( keys %Prima::VB::CfgMaint::classes) { next if defined $cmd[2] && $Prima::VB::CfgMaint::classes{$_}-> {page} ne $cmd[2]; print "$_\n"; $ok = 1 } die "Page '$cmd[2]' doesn't exist\n" unless $ok; } elsif ( $cmd[1] eq 'p') { print join( "\n", @Prima::VB::CfgMaint::pages); } elsif ( $cmd[1] eq 'm') { my %pk = (); $pk{$Prima::VB::CfgMaint::classes{$_}-> {module}} = 1 for keys %Prima::VB::CfgMaint::classes; for ( keys %pk) { print "$_\n"; } } exit; } elsif( $cmd[0] eq 'd') { if ( $cmd[1] eq 'w') { die "Widget '$cmd[2]' doesn't exist\n" unless $Prima::VB::CfgMaint::classes{$cmd[2]}; delete $Prima::VB::CfgMaint::classes{$cmd[2]}; } elsif ( $cmd[1] eq 'p') { my @p; for ( @Prima::VB::CfgMaint::pages) { push ( @p, $_) unless $cmd[2] eq $_; } die "Page '$cmd[2]' doesn't exist\n" if scalar @Prima::VB::CfgMaint::pages == scalar @p; @Prima::VB::CfgMaint::pages = @p; for ( keys %Prima::VB::CfgMaint::classes) { next unless $Prima::VB::CfgMaint::classes{$_}-> {page} eq $cmd[2]; delete $Prima::VB::CfgMaint::classes{$_}; print "Widget '$_' deleted\n"; } } elsif ( $cmd[1] eq 'm') { my %dep; my $ok = 0; for ( keys %Prima::VB::CfgMaint::classes) { unless ( $Prima::VB::CfgMaint::classes{$_}-> {module} eq $cmd[2]) { $dep{$Prima::VB::CfgMaint::classes{$_}-> {page}} = 1; next; } delete $Prima::VB::CfgMaint::classes{$_}; $ok = 1; print "widget '$_' removed\n"; } my @newpages; for ( @Prima::VB::CfgMaint::pages) { push ( @newpages, $_) , next if $dep{$_}; print "page '$_' removed\n"; } @Prima::VB::CfgMaint::pages = @newpages; die "Package '$cmd[2]' not found\n" unless $ok; } } elsif( $cmd[0] eq 'r') { if ( $cmd[1] eq 'w') { die "Widget '$cmd[2]' doesn't exist\n" unless $Prima::VB::CfgMaint::classes{$cmd[2]}; die "Widget '$cmd[3]' already exist\n" if $Prima::VB::CfgMaint::classes{$cmd[3]}; $Prima::VB::CfgMaint::classes{$cmd[3]} = $Prima::VB::CfgMaint::classes{$cmd[2]}; delete $Prima::VB::CfgMaint::classes{$cmd[2]}; } elsif ( $cmd[1] eq 'p') { my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages; die "Page '$cmd[2]' doesn't exist\n" unless $pg{$cmd[2]}; die "Page '$cmd[3]' already exist\n" if $pg{$cmd[3]}; for ( @Prima::VB::CfgMaint::pages) { $_ = $cmd[3], last if $_ eq $cmd[2]; } for ( keys %Prima::VB::CfgMaint::classes) { $Prima::VB::CfgMaint::classes{$_}-> {page} = $cmd[3] if $Prima::VB::CfgMaint::classes{$_}-> {page} eq $cmd[2]; } } } elsif( $cmd[0] eq 'm') { if ( $cmd[1] eq 'w') { my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages; die "Page '$cmd[3]' doesn't exist\n" unless $pg{$cmd[3]}; die "Widget '$cmd[2]' doesn't exist\n" unless $Prima::VB::CfgMaint::classes{$cmd[2]}; $Prima::VB::CfgMaint::classes{$cmd[2]}-> {page} = $cmd[3]; } elsif ( $cmd[1] eq 'p') { my %pg = map { $_ => 1} @Prima::VB::CfgMaint::pages; die "Page '$cmd[2]' doesn't exist\n" unless $pg{$cmd[2]}; die "Page '$cmd[3]' doesn't exist\n" if ! exists $pg{$cmd[3]} && defined $cmd[3]; my @p; for ( @Prima::VB::CfgMaint::pages) { push ( @p, $_) unless $cmd[2] eq $_; } @Prima::VB::CfgMaint::pages = @p; @p = (); if ( defined $cmd[3]) { for ( @Prima::VB::CfgMaint::pages) { push ( @p, $cmd[2]) if $_ eq $cmd[3]; push ( @p, $_); } @Prima::VB::CfgMaint::pages = @p; } else { push @Prima::VB::CfgMaint::pages, $cmd[2]; } print join( "\n", @Prima::VB::CfgMaint::pages); } } assert( Prima::VB::CfgMaint::write_cfg) unless $ro; __DATA__ =pod =head1 NAME cfgmaint - configuration tool for Visual Builder =head1 SYNTAX cfgmaint [ -rbxop ] command object [ parameters ] =head1 DESCRIPTION Maintains widget palette configuration for the Visual Builder. It can be stored in the system-wide and the local user config files. C allows adding, renaming, moving, and deleting the classes and pages in the Visual Builder widget palette. =head1 USAGE C is invoked with C and C arguments, where C defines the action to be taken, and C - the object to be handled. =head2 Options =over =item -r Write configuration to the system-wide config file =item -b Read configuration from both system-wide and user config files =item -x Do not write backups =item -o Read-only mode =item -p Execute C code before start. This option might be necessary when adding a module that relies on the toolkit but does not invoke the code itself. =back =head2 Objects =over =item m Selects a module. Valid for add, list, and remove commands. =item p Selects a page. Valid for all commands. =item w Selects a widget. Valid for list, remove, rename, and move commands. =back =head2 Commands =over =item a Adds a new object to the configuration. Can be either a page or a module. =item d Removes an object. =item l Prints object name. In case object is a widget, prints all registered widgets. If the string is specified as an additional parameter, it is treated as a page name and only widgets from the page are printed. =item r Renames an object to a new name, which is passed as additional parameter. Can be either a widget or a page. =item m If C is a widget, relocates one or more widgets to a new page. If C is a page, moves the page before the page specified as an additional parameter, or to the end if no additional page specified. =back =head1 EXAMPLE Add a new module to the system-wide configuration: cfgmaint -r a m CPAN/Prima/VB/New/MyCtrls.pm List widgets, present in both config files: cfgmaint -b l w Rename a page: cfgmaint r p General Basic =head1 FILES F, F<~/.prima/vbconfig> =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L =cut Prima-1.28/Prima/VB/CfgMaint.pm0000644000175100017510000002103711150770061013702 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: CfgMaint.pm,v 1.12 2005/10/13 17:22:52 dk Exp $ package Prima::VB::CfgMaint; use strict; use Prima::Utils; use vars qw(@pages %classes $backup $userCfg $rootCfg $systemWide); @pages = (); %classes = (); $backup = 1; $systemWide = 0; $rootCfg = 'Prima/VB/Config.pm'; $userCfg = 'vbconfig'; my $file; my $pkg; sub reset_cfg { @pages = (); %classes = (); } sub open_cfg { if ( $systemWide) { $file = undef; for (@INC) { $file = "$_/$rootCfg", last if -f "$_/$rootCfg" && -r _; } return (0, "Cannot find $rootCfg") unless $file; $pkg = "Prima::VB::Config"; $file =~ s[\\][/]g; eval "require \"$file\";"; } else { $file = Prima::Utils::path($userCfg); $pkg = "Prima::VB::UserConfig"; return 1 unless -f $file; eval "require \"$file\";"; } return (0, "$@") if $@; @pages = eval "$pkg".'::pages'; my @csa = eval "$pkg".'::classes'; return ( 0, "Invalid package \'$pkg\'") if scalar @csa % 2; %classes = @csa; return 1; } sub read_cfg { my $sw = $systemWide; my ( $f, $p); reset_cfg; $systemWide = 0; my @r = open_cfg; return @r unless $r[0]; ( $f, $p) = ( $file, $pkg) if $sw == 0; my %cs = %classes; my @pg = @pages; $systemWide = 1; @r = open_cfg; return @r unless $r[0]; ( $f, $p) = ( $file, $pkg) if $sw == 1; my %pgref = map { $classes{$_}-> {page} => 1} keys %classes; %classes = ( %classes, %cs); for ( @pg) { next if $pgref{$_}; $pgref{$_} = 1; push( @pages, $_); } ($systemWide, $file, $pkg) = ( $sw, $f, $p); return 1; } sub write_cfg { return ( 0, "Cannot write to $file") if -f $file && ! -w _; unless ( -f $file) { my $x = $file; $x =~ s/[\\\/]?[^\\\/]+$//; unless ( -d $x) { eval "use File::Path"; die "$@\n" if $@; File::Path::mkpath( $x); } } if ( $backup && -f $file) { local $/; open F, "$file" or return ( 0, "Cannot read $file"); my $f = ; close F; open F, ">$file.bak" or return ( 0, "Cannot write backup $file.bak"); print F $f; close F; } open F, ">$file" or return ( 0, "Cannot write to $file"); my $c = < $maxln; } $c .= sprintf( "\t\t%-${maxln}s => \'$dt{$_}\',\n", $_) for keys %dt; $c .= "\t},\n"; } $c .= <) { next if /^#/; next unless /package\s+([^\s;].*)/m; $pkg = $1; $pkg =~ s[[\s;]*$][]; last; } close F; return ( 0, "Cannot locate 'package' section in $file") unless defined $pkg; eval "use $pkg;"; if ( $@) { my $err = "$@"; if ( $err =~ /Can\'t locate\s([^\s]+)\sin/) { $err = "Corrupted module $file - internal and file names doesn't match"; } return ( 0, $err); } my @clsa = eval "$pkg".'::classes'; return ( 0, "$@") if $@; return ( 0, "Invalid package \'$pkg\'") if scalar @clsa % 2; my %cls = @clsa; $cls{$_}-> {module} = $pkg for keys %cls; my %pgref = map { $classes{$_}-> {page} => 1} keys %classes; %classes = ( %classes, %cls); for ( keys %cls) { my $pg = $cls{$_}-> {page}; next if $pgref{$pg}; $pgref{$pg} = 1; push @pages, $pg; } return 1; } 1; __DATA__ =pod =head1 NAME Prima::VB::CfgMaint - maintains visual builder widget palette configuration. =head1 DESCRIPTION The module is used by the Visual Builder and C programs, to maintain the Visual Builder widget palette. The installed widgets are displayed in main panel of the Visual Builder, and can be maintained by C. =head1 USAGE The Visual Builder widget palette configuration is contained in two files - the system-wide C and the user C<~/.prima/vbconfig>. The user config file take the precedence when loaded by the Visual Builder. The module can select either configuration by assigning C<$systemWide> boolean property. The widgets are grouped in pages, which are accessible by names. New widgets can be added to the palette by calling C method, which accepts a perl module file as its first parameter. The module must conform to the VB-loadable format. =head1 FORMAT This section describes format of a module with VB-loadable widgets. The module must define a package with same name as the module. In the package, C sub must be declared, that returns an array or paired scalars, where each first item in a pair corresponds to the widget class and the second to a hash, that contains the class loading information, and must contain the following keys: =over =item class STRING Name of the VB-representation class, which represents the original widget class in the Visual Builder. This is usually a lightweight class, which does not contain all functionality of the original class, but is capable of visually reflecting changes to the class properties. =item icon PATH Sets an image file, where the class icon is contained. PATH provides an extended syntax for indicating a frame index, if the image file is multiframed: the frame index is appended to the path name with C<:> character prefix, for example: C<"NewWidget::icons.gif:2">. =item module STRING Sets the module name, that contains C. =item page STRING Sets the default palette page where the widget is to be put. The current implementation of the Visual Builder provides four pages: C. If the page is not present, new page is automatically created when the widget class is registered. =item RTModule STRING Sets the module name, that contains the original class. =back The reader is urged to explore F file, which contains an example class C, its VB-representation, and a property C definition example. =head1 API =head2 Methods =over =item add_module FILE Reads FILE module and loads all VB-loadable widgets from it. =item classes Returns string declaration of all registered classes in format of C registration procedure ( see L ). =item open_cfg Loads class and pages information from either a system-wide or a user configuration file. If succeeds, the information is stored in C<@pages> and C<%classes> variables ( the old information is lost ) and returns 1. If fails, returns 0 and string with the error explanation; C<@pages> and C<%classes> content is undefined. =item pages Returns array of page names =item read_cfg Reads information from both system-wide and user configuration files, and merges the information. If succeeds, returns 1. If fails, returns 0 and string with the error explanation. =item reset_cfg Erases all information about pages and classes. =item write_cfg Writes either the system-wide or the user configuration file. If C<$backup> flag is set to 1, the old file renamed with C<.bak> extension. If succeeds, returns 1. If fails, returns 0 and string with the error explanation. =back =head1 FILES F, C<~/.prima/vbconfig>. =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, F. =cut Prima-1.28/Prima/VB/CoreClasses.pm0000644000175100017510000015753711150770061014437 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: CoreClasses.pm,v 1.44 2008/04/09 13:17:44 dk Exp $ package Prima::VB::CoreClasses; use strict; sub classes { return ( 'Prima::Button' => { RTModule => 'Prima::Buttons', class => 'Prima::VB::Button', page => 'General', icon => 'VB::classes.gif:0', }, 'Prima::SpeedButton' => { RTModule => 'Prima::Buttons', class => 'Prima::VB::Button', page => 'Additional', icon => 'VB::classes.gif:19', }, 'Prima::Label' => { RTModule => 'Prima::Label', class => 'Prima::VB::Label', page => 'General', icon => 'VB::classes.gif:15', }, 'Prima::InputLine' => { RTModule => 'Prima::InputLine', class => 'Prima::VB::InputLine', page => 'General', icon => 'VB::classes.gif:13', }, 'Prima::ListBox' => { RTModule => 'Prima::Lists', class => 'Prima::VB::ListBox', page => 'General', icon => 'VB::classes.gif:16', }, 'Prima::DirectoryListBox' => { RTModule => 'Prima::FileDialog', class => 'Prima::VB::DirectoryListBox', page => 'Additional', icon => 'VB::classes.gif:6', }, 'Prima::ListViewer' => { RTModule => 'Prima::Lists', class => 'Prima::VB::ListViewer', page => 'Abstract', icon => 'VB::classes.gif:16', }, 'Prima::CheckBox' => { RTModule => 'Prima::Buttons', class => 'Prima::VB::CheckBox', page => 'General', icon => 'VB::classes.gif:2', }, 'Prima::Radio' => { RTModule => 'Prima::Buttons', class => 'Prima::VB::Radio', page => 'General', icon => 'VB::classes.gif:18', }, 'Prima::GroupBox' => { RTModule => 'Prima::Buttons', class => 'Prima::VB::GroupBox', page => 'General', icon => 'VB::classes.gif:10', }, 'Prima::ScrollBar' => { RTModule => 'Prima::ScrollBar', class => 'Prima::VB::ScrollBar', page => 'General', icon => 'VB::classes.gif:20', }, 'Prima::ComboBox' => { RTModule => 'Prima::ComboBox', class => 'Prima::VB::ComboBox', page => 'General', icon => 'VB::classes.gif:3', }, 'Prima::DriveComboBox' => { RTModule => 'Prima::FileDialog', class => 'Prima::VB::DriveComboBox', page => 'Additional', icon => 'VB::classes.gif:5', }, 'Prima::ColorComboBox' => { RTModule => 'Prima::ColorDialog', class => 'Prima::VB::ColorComboBox', page => 'Additional', icon => 'VB::classes.gif:1', }, 'Prima::Edit' => { RTModule => 'Prima::Edit', class => 'Prima::VB::Edit', page => 'General', icon => 'VB::classes.gif:8', }, 'Prima::ImageViewer' => { RTModule => 'Prima::ImageViewer', class => 'Prima::VB::ImageViewer', page => 'General', icon => 'VB::classes.gif:14', }, 'Prima::ScrollWidget' => { RTModule => 'Prima::ScrollWidget', class => 'Prima::VB::ScrollWidget', page => 'Abstract', icon => 'VB::classes.gif:21', }, 'Prima::SpinButton' => { RTModule => 'Prima::Sliders', class => 'Prima::VB::SpinButton', page => 'Sliders', icon => 'VB::classes.gif:23', }, 'Prima::AltSpinButton' => { RTModule => 'Prima::Sliders', class => 'Prima::VB::AltSpinButton', page => 'Sliders', icon => 'VB::classes.gif:24', }, 'Prima::SpinEdit' => { RTModule => 'Prima::Sliders', class => 'Prima::VB::SpinEdit', page => 'Sliders', icon => 'VB::classes.gif:25', }, 'Prima::Gauge' => { RTModule => 'Prima::Sliders', class => 'Prima::VB::Gauge', page => 'Sliders', icon => 'VB::classes.gif:9', }, 'Prima::Slider' => { RTModule => 'Prima::Sliders', class => 'Prima::VB::Slider', page => 'Sliders', icon => 'VB::classes.gif:22', }, 'Prima::CircularSlider' => { RTModule => 'Prima::Sliders', class => 'Prima::VB::CircularSlider', page => 'Sliders', icon => 'VB::classes.gif:4', }, 'Prima::StringOutline' => { RTModule => 'Prima::Outlines', class => 'Prima::VB::StringOutline', page => 'General', icon => 'VB::classes.gif:17', }, 'Prima::OutlineViewer' => { RTModule => 'Prima::Outlines', class => 'Prima::VB::OutlineViewer', page => 'Abstract', icon => 'VB::classes.gif:17', }, 'Prima::DirectoryOutline' => { RTModule => 'Prima::Outlines', class => 'Prima::VB::DirectoryOutline', page => 'Additional', icon => 'VB::classes.gif:7', }, 'Prima::Notebook' => { RTModule => 'Prima::Notebooks', class => 'Prima::VB::Notebook', page => 'Abstract', icon => 'VB::classes.gif:29', }, 'Prima::TabSet' => { RTModule => 'Prima::Notebooks', class => 'Prima::VB::TabSet', page => 'Additional', icon => 'VB::classes.gif:27', }, 'Prima::TabbedNotebook' => { RTModule => 'Prima::Notebooks', class => 'Prima::VB::TabbedNotebook', page => 'Additional', icon => 'VB::classes.gif:28', }, 'Prima::Header' => { icon => 'VB::classes.gif:30', RTModule => 'Prima::Header', page => 'Sliders', module => 'Prima::VB::CoreClasses', class => 'Prima::VB::Header', }, 'Prima::DetailedList' => { icon => 'VB::classes.gif:31', RTModule => 'Prima::DetailedList', page => 'General', module => 'Prima::VB::CoreClasses', class => 'Prima::VB::DetailedList', }, 'Prima::Calendar' => { icon => 'VB::classes.gif:32', RTModule => 'Prima::Calendar', page => 'Additional', module => 'Prima::VB::CoreClasses', class => 'Prima::VB::Calendar', }, 'Prima::Grid' => { RTModule => 'Prima::Grids', class => 'Prima::VB::Grid', page => 'General', icon => 'VB::classes.gif:33', }, ); } use Prima::Classes; use Prima::StdBitmap; package Prima::VB::CommonControl; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::Control); sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( firstClick palette sizeMax sizeMin ownerColor ownerFont ownerHint ownerBackColor ownerShowHint ownerPalette ); } package Prima::VB::Button; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(flat vertical default checkable checked autoRepeat autoHeight autoWidth)], uiv => [qw(glyphs borderWidth defaultGlyph hiliteGlyph disabledGlyph pressedGlyph holdGlyph imageScale )], modalResult => ['modalResult'], icon => ['image',], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onClick', ); @$def{keys %prf} = values %prf; return $def; } sub caption_box { my ($self,$canvas) = @_; my $cap = $self-> text; $cap =~ s/~//; return $canvas-> get_text_width( $cap), $canvas-> font-> height; } sub on_paint { my ( $self, $canvas) = @_; my @size = $canvas-> size; my $cl = $self-> color; if ( $self-> prf('flat')) { $canvas-> rect3d( 0,0,$size[0]-1,$size[1]-1,1, cl::Gray,cl::Gray,$self-> backColor); } else { $canvas-> rect3d( 0,0,$size[0]-1,$size[1]-1,$self-> prf('borderWidth'), $self-> light3DColor,$self-> dark3DColor,$self-> backColor); } my $i = $self-> prf('image'); my $capOk = length($self-> text) > 0; my ( $fw, $fh) = $capOk ? $self-> caption_box($canvas) : ( 0, 0); my ( $textAtX, $textAtY) = ( 2, $size[1]-3); if ( defined $i) { my $gy = $self-> prf('glyphs'); $gy = 1 unless $gy; my $pw = $i-> width / $gy; my $ph = $i-> height; my $sw = $pw * $self-> prf('imageScale'); my $sh = $ph * $self-> prf('imageScale'); my ( $imAtX, $imAtY); if ( $capOk) { if ( $self-> prf('vertical')) { $imAtX = ( $size[ 0] - $sw) / 2; $imAtY = ( $size[ 1] - $fh - $sh) / 3; $textAtY = $imAtY; $imAtY = $size[ 1] - $imAtY - $sh; } else { $imAtX = ( $size[ 0] - $fw - $sw) / 3; $imAtY = ( $size[ 1] - $sh) / 2; $textAtX = 2 * $imAtX + $sw; } } else { $imAtX = ( $size[0] - $sw) / 2; $imAtY = ( $size[1] - $sh) / 2; } $canvas-> put_image_indirect( $i, $imAtX, $imAtY, 0, 0, $sw, $sh,$pw, $ph,rop::CopyPut); } $canvas-> color( $cl); if ( $capOk) { $canvas-> draw_text($self-> text, $textAtX,2,$size[0]-3,$textAtY, dt::DrawMnemonic|dt::Center|dt::VCenter|dt::UseClip); } $self-> common_paint($canvas); } sub prf_flat { $_[0]-> repaint; } sub prf_borderWidth { $_[0]-> repaint; } sub prf_glyphs { $_[0]-> repaint; } sub prf_vertical { $_[0]-> repaint; } sub prf_image { $_[0]-> repaint; } sub prf_imageScale { $_[0]-> repaint; } package Prima::VB::Label; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( align => ['alignment',], valign => ['valignment',], bool => [qw(autoWidth autoHeight showAccelChar showPartial wordWrap)], Handle => ['focusLink',], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ( $self, $canvas) = @_; my @sz = $canvas-> size; my $cl = $self-> color; $canvas-> color( $self-> backColor); $canvas-> bar( 1,1,$sz[0]-2,$sz[1]-2); $canvas-> color( cl::Gray); $canvas-> rectangle( 0,0,$sz[0]-1,$sz[1]-1); $canvas-> color( $cl); my ( $a, $va, $sp, $ww, $sac) = $self-> prf(qw( alignment valignment showPartial wordWrap showAccelChar)); my $flags = dt::NewLineBreak | dt::WordBreak | dt::ExpandTabs | (($a == ta::Left) ? dt::Left : (( $a == ta::Center) ? dt::Center : dt::Right)) | (ta::Top == $va ? dt::Top : (( $va == ta::Middle) ? dt::VCenter : dt::Bottom)) | ($sp ? dt::DrawPartial : 0) | ($ww ? 0 : dt::NoWordWrap) | ($sac ? 0 : dt::DrawMnemonic); $canvas-> draw_text( $self-> text,0,0,$sz[0]-1,$sz[1]-1,$flags); $self-> common_paint($canvas); } sub prf_alignment { $_[0]-> repaint; } sub prf_valignment { $_[0]-> repaint; } sub prf_showPartial { $_[0]-> repaint; } sub prf_wordWrap { $_[0]-> repaint; } sub prf_showAccelChar { $_[0]-> repaint; } package Prima::VB::InputLine; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( align => ['alignment',], bool => [qw(writeOnly readOnly insertMode autoSelect autoHeight autoTab firstChar charOffset)], upoint => ['selection',], uiv => ['selStart','selEnd','maxLen','borderWidth'], char => ['passwordChar',], string => ['wordDelimiters',], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( selection selEnd selStart charOffset firstChar ); } sub on_paint { my ( $self, $canvas) = @_; my @sz = $canvas-> size; my $cl = $self-> color; my ( $a, $bw, $wo, $pc) = $self-> prf(qw( alignment borderWidth writeOnly passwordChar)); $canvas-> rect3d( 0,0,$sz[0]-1,$sz[1]-1,$bw,$self-> dark3DColor,$self-> light3DColor,$self-> backColor); $canvas-> color( $cl); $a = (ta::Left == $a ? dt::Left : (ta::Center == $a ? dt::Center : dt::Right)); my $c = $self-> text; $c =~ s/./$pc/g if $wo; $canvas-> draw_text($c,2,2,$sz[0]-3,$sz[1]-3, $a|dt::VCenter|dt::UseClip|dt::ExpandTabs|dt::NoWordWrap); $self-> common_paint($canvas); } sub prf_alignment { $_[0]-> repaint; } sub prf_writeOnly { $_[0]-> repaint; } sub prf_borderWidth { $_[0]-> repaint; } sub prf_passwordChar { $_[0]-> repaint; } package Prima::VB::Cluster; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onCheck', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(auto checked pressed autoHeight autoWidth)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_checked { $_[0]-> repaint; } sub paint { my ( $self, $canvas, $i) = @_; my @sz = $canvas-> size; $canvas-> color( $self-> backColor); $canvas-> bar(1,1,$sz[0]-2,$sz[1]-2); $canvas-> color( cl::Gray); $canvas-> rectangle(0,0,$sz[0]-1,$sz[1]-1); $canvas-> put_image( 2, ($sz[1] - $i-> height)/2, $i) if $i; $canvas-> color( cl::Black); my $w = $i ? $i-> width : 0; $canvas-> draw_text($self-> text,2 + $w,2,$sz[0]-1,$sz[1]-1, dt::Center|dt::VCenter|dt::UseClip|dt::DrawMnemonic); $self-> common_paint($canvas); } package Prima::VB::CheckBox; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::Cluster); sub on_paint { my ( $self, $canvas) = @_; $self-> paint( $canvas, Prima::StdBitmap::image( $self-> prf('checked') ? sbmp::CheckBoxChecked : sbmp::CheckBoxUnchecked)); } package Prima::VB::Radio; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::Cluster); sub on_paint { my ( $self, $canvas) = @_; $self-> paint( $canvas, Prima::StdBitmap::icon( $self-> prf('checked') ? sbmp::RadioChecked : sbmp::RadioUnchecked)); } package Prima::VB::GroupBox; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onRadioClick', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( uiv => ['index'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ( $self, $canvas) = @_; my @size = $canvas-> size; my @clr = ( $self-> color, $self-> backColor); $canvas-> color( $clr[1]); $canvas-> bar( 0, 0, @size); my $fh = $canvas-> font-> height; $canvas-> color( $self-> light3DColor); $canvas-> rectangle( 1, 0, $size[0] - 1, $size[1] - $fh / 2 - 2); $canvas-> color( $self-> dark3DColor); $canvas-> rectangle( 0, 1, $size[0] - 2, $size[1] - $fh / 2 - 1); my $c = $self-> text; if ( length( $c) > 0) { $canvas-> color( $clr[1]); $canvas-> bar ( 8, $size[1] - $fh - 1, 16 + $canvas-> get_text_width( $c), $size[1] - 1 ); $canvas-> color( $clr[0]); $canvas-> text_out( $c, 12, $size[1] - $fh - 1); } $self-> common_paint($canvas); } package Prima::VB::BiScroller; use strict; sub paint_exterior { my ( $self, $canvas) = @_; my @sz = $canvas-> size; my $cl = $self-> color; my ( $bw, $hs, $vs, $ahs, $avs) = $self-> prf(qw( borderWidth hScroll vScroll autoHScroll autoVScroll)); $hs ||= $ahs; $vs ||= $avs; $canvas-> rect3d( 0,0,$sz[0]-1,$sz[1]-1,$bw, $self-> dark3DColor,$self-> light3DColor,$self-> backColor); my $sw = 12; my $sl = 16; $hs = $hs ? $sw : 0; $vs = $vs ? $sw : 0; my @r = ( $bw, $bw+$hs, $sz[0]-$bw-1-$vs,$sz[1]-$bw-1); if ( $hs) { $self-> color( $ahs ? cl::Gray : cl::Black); $canvas-> rectangle( $r[0], $bw, $r[2], $r[1]); if ($r[0]+4+$sl < $r[2]-2-$sl) { $canvas-> rectangle( $r[0]+2, $bw+2, $r[0]+2+$sl, $r[1]-2); $canvas-> rectangle( $r[2]-2-$sl, $bw+2, $r[2]-2, $r[1]-2); } } if ( $vs) { $self-> color( $avs ? cl::Gray : cl::Black); $canvas-> rectangle( $sz[0]-$bw-1-$sw,$hs+2,$sz[0]-$bw-1,$r[3]-0); if ( $r[3]-$sl > $hs+2+$sl) { $canvas-> rectangle( $sz[0]-$bw+1-$sw,$hs+4,$sz[0]-$bw-3,$hs+2+$sl); $canvas-> rectangle( $sz[0]-$bw+1-$sw,$r[3]-2-$sl,$sz[0]-$bw-3,$r[3]-2); } } $canvas-> color( $cl); return if ( $r[0] > $r[2]) || ( $r[1] >= $r[3]); return @r; } sub prf_autoHScroll { $_[0]-> repaint; } sub prf_autoVScroll { $_[0]-> repaint; } sub prf_borderWidth { $_[0]-> repaint; } sub prf_hScroll { $_[0]-> repaint; } sub prf_vScroll { $_[0]-> repaint; } package Prima::VB::ListBox; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onClick', ); @$def{keys %prf} = values %prf; return $def; } sub prf_events { return ( $_[0]-> SUPER::prf_events, onSelectItem => 'my ( $self, $index, $selectState) = @_;', ); } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(autoWidth vScroll hScroll multiSelect extendedSelect autoHeight integralWidth integralHeight multiColumn autoHScroll autoVScroll drawGrid vertical)], uiv => [qw(itemHeight itemWidth focusedItem borderWidth offset topItem)], color => [qw(gridColor)], items => [qw(items selectedItems)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw (offset); } sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior( $canvas); $canvas-> draw_text( join("\n", @{$self-> prf('items')}), @r, dt::NoWordWrap | dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | dt::UseClip ) if scalar @r; $self-> common_paint($canvas); } sub prf_items { $_[0]-> repaint; } package Prima::VB::ListViewer; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::ListBox); sub prf_events { return ( $_[0]-> SUPER::prf_events, onDrawItem => 'my ( $self, $canvas, $itemIndex, $x, $y, $x2, $y2, $selected, $focused) = @_;', onStringify => 'my ( $self, $index, $result) = @_;', onMeasureItem => 'my ( $self, $index, $result) = @_;', ); } package Prima::VB::DirectoryListBox; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::ListBox); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( uiv => ['indent'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw (items itemWidth itemHeight); } sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior( $canvas); $canvas-> draw_text( "usr\n\tlocal\n\t\tshare\n\t\t\texamples\n\t\t\t\tetc", @r, dt::NoWordWrap | dt::ExpandTabs | dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | dt::UseClip ) if scalar @r; $self-> common_paint($canvas); } package Prima::VB::ScrollBar; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(autoTrack vertical)], uiv => [qw(minThumbSize pageStep partial step whole)], iv => [qw(min max value)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub on_paint { my ( $self, $canvas) = @_; my @sz = $canvas-> size; my $cl = $self-> color; my ( $v) = $self-> prf(qw( vertical)); $canvas-> color( $self-> backColor); $canvas-> bar(0,0,@sz); $canvas-> color( $cl); $canvas-> rectangle(0,0,$sz[0]-1,$sz[1]-1); my $ws = 18; my $ex = 5; if ( $sz[ $v ? 1 : 0] > $ws * 2) { if ( $v) { $canvas-> rectangle(2,2,$sz[0]-3,2+$ws); $canvas-> ellipse($sz[0]/2-2,$ws/2+2,$ex,$ex); $canvas-> rectangle(2,$sz[1]-3-$ws,$sz[0]-3,$sz[1]-3); $canvas-> ellipse($sz[0]/2-2,$sz[1]-$ws/2-3,$ex,$ex); } else { $canvas-> rectangle(2,2,2+$ws,$sz[1]-3); $canvas-> ellipse($ws/2+2,$sz[1]/2-2,$ex,$ex); $canvas-> rectangle($sz[0]-3-$ws,2,$sz[0]-3,$sz[1]-3); $canvas-> ellipse($sz[0]-$ws/2-3,$sz[1]/2-2,$ex,$ex); } } $self-> common_paint($canvas); } sub prf_vertical { $_[0]-> repaint; } package Prima::VB::ComboBox; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(caseSensitive literal autoSelect autoHeight)], uiv => [qw(editHeight listHeight focusedItem)], comboStyle => ['style'], string => ['text'], items => ['items'], ); $_[0]-> prf_types_delete( $pt, qw(text)); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( writeOnly autoWidth selectedItems selection vScroll borderWidth readOnly hScroll alignment insertMode multiSelect maxLen autoTab extendedSelect buttonClass selection integralHeight buttonProfile selStart multiColumn editClass selEnd itemHeight editProfile firstChar itemWidth listProfile charOffset offset listVisible passwordChar topItem listClass wordDelimiters gridColor autoHScroll autoVScroll ); } sub on_paint { my ( $self, $canvas) = @_; my @sz = $canvas-> size; my $cl = $self-> color; my @c3d = ( $self-> dark3DColor, $self-> light3DColor); my $s = $self-> prf('style') == cs::Simple; my $szy = $s ? ( $sz[1]-$canvas-> font-> height - 5) : 0; $canvas-> rect3d( 0,$szy,$sz[0]-1,$sz[1]-1,1,$c3d[0],$c3d[1],$self-> backColor); unless ( $s) { $canvas-> rect3d( $sz[0]-18,0,$sz[0]-1,$sz[1]-1,2,$c3d[1],$c3d[0],$self-> backColor); $canvas-> color( cl::Black); $canvas-> fillpoly([ $sz[0]-12,$sz[1] * 0.6, $sz[0]-8,$sz[1] * 0.6, $sz[0]-10,$sz[1] * 0.3, ]); } $canvas-> color( $cl); $canvas-> draw_text( $self-> text, 2, $szy + 2, $sz[0] - 3 - ( $s ? 0 : 17), $sz[1] - 3, dt::Left|dt::VCenter|dt::NoWordWrap|dt::UseClip|dt::ExpandTabs); if ( $s) { $canvas-> rect3d( 0,0,$sz[0]-1,$szy-1,2,$c3d[0],$c3d[1],$self-> backColor); my $i = $self-> prf('items'); $canvas-> draw_text( join("\n", @$i),2,2,$sz[0]-3,$szy-3, dt::Left|dt::Top|dt::NoWordWrap|dt::UseClip|dt::NewLineBreak|dt::UseExternalLeading ); } $self-> common_paint($canvas); } sub prf_style { $_[0]-> repaint; } sub prf_items { $_[0]-> repaint; } sub prf_borderWidth { $_[0]-> repaint; } package Prima::VB::DriveComboBox; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::ComboBox); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( char => ['drive'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( items ); } package Prima::VB::ColorComboBox; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::ComboBox); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( color => ['value'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( items ); } package Prima::VB::Edit; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(autoIndent cursorWrap insertMode hScroll vScroll persistentBlock readOnly syntaxHilite wantTabs wantReturns wordWrap autoHScroll autoVScroll )], uiv => [qw(borderWidth tabIndent undoLimit)], editBlockType => ['blockType',], color => [qw(hiliteNumbers hiliteQStrings hiliteQQStrings)], string => ['wordDelimiters',], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( accelItems selection cursorX markers cursorY textRef modified topLine offset selection selEnd selStart ); } sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior( $canvas); $canvas-> draw_text( $self-> text, @r, ( $self-> prf('wordWrap') ? dt::WordWrap : dt::NoWordWrap) | dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | dt::UseClip | dt::ExpandTabs ) if scalar @r; $self-> common_paint($canvas); } sub prf_wordWrap { $_[0]-> repaint; } package Prima::VB::ImageViewer; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(hScroll vScroll quality autoHScroll autoVScroll )], uiv => [qw(borderWidth zoom)], image => ['image'], align => ['alignment',], valign => ['valignment',], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( deltaX imageFile deltaY limitX limitY ); } sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior( $canvas); my $i = $self-> prf('image'); if ( $i) { $canvas-> clipRect( $r[0], $r[1], $r[2] - 1, $r[3] - 1); my ( $a, $v, $z) = $self-> prf(qw(alignment valignment zoom)); my ( $ix, $iy) = $i-> size; my ( $izx, $izy) = ( $ix * $z, $iy * $z); my ( $ax, $ay); $a = ta::Left if $izx >= $r[2] - $r[0]; $v = ta::Top if $izy >= $r[3] - $r[1]; if ( $a == ta::Left) { $ax = $r[0]; } elsif ( $a == ta::Center) { $ax = $r[0] + ( $r[2] - $r[0] - $izx) / 2; } else { $ax = $r[2] - $izx; } if ( $v == ta::Bottom) { $ay = $r[1]; } elsif ( $v == ta::Middle) { $ay = $r[1] + ( $r[3] - $r[1] - $izy) / 2; } else { $ay = $r[3] - $izy; } $canvas-> stretch_image( $ax, $ay, $izx, $izy, $i); } $self-> common_paint($canvas); } sub prf_image { $_[0]-> repaint; } sub prf_alignment { $_[0]-> repaint; } sub prf_valignment { $_[0]-> repaint; } sub prf_zoom { $_[0]-> repaint; } package Prima::VB::ScrollWidget; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(autoHScroll autoVScroll hScroll vScroll)], uiv => [qw(borderWidth deltaX deltaY limitX limitY)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ( $self, $canvas) = @_; $self-> paint_exterior( $canvas); $self-> common_paint( $canvas); } package Prima::VB::SpinButton; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub prf_events { return ( $_[0]-> SUPER::prf_events, onIncrement => 'my ( $self, $increment) = @_;', ); } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub on_paint { my ( $self, $canvas) = @_; my @clr = ( $self-> color, $self-> backColor); my @c3d = ( $self-> light3DColor, $self-> dark3DColor); my @size = $canvas-> size; $canvas-> rect3d( 0, 0, $size[0] - 1, $size[1] * 0.4 - 1, 2, @c3d, $clr[1]); $canvas-> rect3d( 0, $size[1] * 0.4, $size[0] - 1, $size[1] * 0.6 - 1, 2, @c3d, $clr[1]); $canvas-> rect3d( 0, $size[1] * 0.6, $size[0] - 1, $size[1] - 1, 2, @c3d, $clr[1]); $canvas-> color( $clr[0]); $canvas-> fillpoly([ $size[0] * 0.3, $size[1] * 0.73, $size[0] * 0.5, $size[1] * 0.87, $size[0] * 0.7, $size[1] * 0.73 ]); $canvas-> fillpoly([ $size[0] * 0.3, $size[1] * 0.27, $size[0] * 0.5, $size[1] * 0.13, $size[0] * 0.7, $size[1] * 0.27 ]); $self-> common_paint( $canvas); } package Prima::VB::AltSpinButton; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub prf_events { return ( $_[0]-> SUPER::prf_events, onIncrement => 'my ( $self, $increment) = @_;', ); } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub on_paint { my ( $self, $canvas) = @_; my @clr = ( $self-> color, $self-> backColor); my @c3d = ( $self-> light3DColor, $self-> dark3DColor); my @size = $canvas-> size; $canvas-> color( $clr[ 1]); $canvas-> bar( 0, 0, $size[0]-1, $size[1]-1); $canvas-> color( $c3d[ 0]); $canvas-> line( 0, 0, 0, $size[1] - 1); $canvas-> line( 1, 1, 1, $size[1] - 2); $canvas-> line( 2, $size[1] - 2, $size[0] - 3, $size[1] - 2); $canvas-> line( 1, $size[1] - 1, $size[0] - 2, $size[1] - 1); $canvas-> color( $c3d[ 1]); $canvas-> line( 1, 0, $size[0] - 1, 0); $canvas-> line( 2, 1, $size[0] - 1, 1); $canvas-> line( $size[0] - 2, 1, $size[0] - 2, $size[1] - 2); $canvas-> line( $size[0] - 1, 1, $size[0] - 1, $size[1] - 1); $canvas-> color( $c3d[ 1]); $canvas-> line( -1, 0, $size[0] - 2, $size[1] - 1); $canvas-> line( 0, 0, $size[0] - 1, $size[1] - 1); $canvas-> color( $c3d[ 0]); $canvas-> line( 1, 0, $size[0], $size[1] - 1); $canvas-> color( $clr[0]); $canvas-> fillpoly([ $size[0] * 0.2, $size[1] * 0.65, $size[0] * 0.3, $size[1] * 0.77, $size[0] * 0.4, $size[1] * 0.65 ]); $canvas-> fillpoly([ $size[0] * 0.6, $size[1] * 0.35, $size[0] * 0.7, $size[1] * 0.27, $size[0] * 0.8, $size[1] * 0.35 ]); $self-> common_paint( $canvas); } package Prima::VB::SpinEdit; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::InputLine); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( align => ['alignment',], bool => ['writeOnly','readOnly','insertMode','autoSelect', 'autoTab','firstChar','charOffset'], upoint => ['selection',], uiv => [qw(min max step value)], string => [qw(spinClass editClass)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( selection passwordChar selEnd writeOnly selStart charOffset firstChar ); } sub on_paint { my ( $self, $canvas) = @_; my @sz = $canvas-> size; my $cl = $self-> color; my ( $a, $bw) = $self-> prf(qw( alignment borderWidth)); $canvas-> rect3d( 0,0,$sz[0]-1,$sz[1]-1,$bw, $self-> dark3DColor,$self-> light3DColor,$self-> backColor); $canvas-> rect3d( $sz[0]-$sz[1]-$bw,$bw,$sz[0]-1,$sz[1]-1,2, $self-> light3DColor,$self-> dark3DColor); $canvas-> color( $cl); $a = (ta::Left == $a ? dt::Left : (ta::Center == $a ? dt::Center : dt::Right)); my $c = $self-> prf('value'); $canvas-> draw_text($c,2,2,$sz[0]-$sz[1]-$bw*2,$sz[1]-3, $a|dt::VCenter|dt::UseClip|dt::ExpandTabs|dt::NoWordWrap); $self-> common_paint($canvas); } sub prf_alignment { $_[0]-> repaint; } sub prf_borderWidth { $_[0]-> repaint; } package Prima::VB::Gauge; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub prf_events { return ( $_[0]-> SUPER::prf_events, onStringify => 'my ( $self, $index, $result) = @_;', ); } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => ['vertical'], uiv => [qw(min max value threshold indent)], gaugeRelief => ['relief'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ($self,$canvas) = @_; my ($x, $y) = $canvas-> size; my ($i, $relief, $v, $val, $min, $max, $l3, $d3) = $self-> prf(qw(indent relief vertical value min max light3DColor dark3DColor)); my ($clComplete,$clHilite,$clBack,$clFore) = ($self-> prf('hiliteBackColor', 'hiliteColor'), $self-> backColor, $self-> color); my $complete = $v ? $y : $x; my $ediv = $max - $min; $ediv = 1 unless $ediv; $complete = int(($complete - $i*2) * $val / $ediv + 0.5); $canvas-> color( $clComplete); $canvas-> bar ( $v ? ($i, $i, $x-$i-1, $i+$complete) : ( $i, $i, $i + $complete, $y-$i-1) ); $canvas-> color( $clBack); $canvas-> bar ( $v ? ($i, $i+$complete+1, $x-$i-1, $y-$i-1) : ( $i+$complete+1, $i, $x-$i-1, $y-$i-1) ); # draw the border $canvas-> color(( $relief == gr::Sink) ? $d3 : (( $relief == gr::Border) ? cl::Black : $l3)); for ( my $j = 0; $j < $i; $j++) { $canvas-> line( $j, $j, $j, $y - $j - 1); $canvas-> line( $j, $y - $j - 1, $x - $j - 1, $y - $j - 1); } $canvas-> color(( $relief == gr::Sink) ? $l3 : (( $relief == gr::Border) ? cl::Black : $d3)); for ( my $j = 0; $j < $i; $j++) { $canvas-> line( $j + 1, $j, $x - $j - 1, $j); $canvas-> line( $x - $j - 1, $j, $x - $j - 1, $y - $j - 1); } # draw the text, if neccessary my $s = sprintf( "%2d%%", $val * 100.0 / $ediv); my ($fw, $fh) = ( $canvas-> get_text_width( $s), $canvas-> font-> height); my $xBeg = int(( $x - $fw) / 2 + 0.5); my $xEnd = $xBeg + $fw; my $yBeg = int(( $y - $fh) / 2 + 0.5); my $yEnd = $yBeg + $fh; my ( $zBeg, $zEnd) = $v ? ( $yBeg, $yEnd) : ( $xBeg, $xEnd); if ( $zBeg > $i + $complete) { $canvas-> color( $clFore); $canvas-> text_out( $s, $xBeg, $yBeg); } elsif ( $zEnd < $i + $complete + 1) { $canvas-> color( $clHilite); $canvas-> text_out( $s, $xBeg, $yBeg); } else { $canvas-> clipRect( $v ? ( 0, 0, $x, $i + $complete) : ( 0, 0, $i + $complete, $y)); $canvas-> color( $clHilite); $canvas-> text_out( $s, $xBeg, $yBeg); $canvas-> clipRect( $v ? ( 0, $i + $complete + 1, $x, $y) : ( $i + $complete + 1, 0, $x, $y)); $canvas-> color( $clFore); $canvas-> text_out( $s, $xBeg, $yBeg); } $self-> common_paint( $canvas); } sub prf_min { $_[0]-> repaint; } sub prf_max { $_[0]-> repaint; } sub prf_value { $_[0]-> repaint; } sub prf_indent { $_[0]-> repaint; } sub prf_relief { $_[0]-> repaint; } sub prf_vertical { $_[0]-> repaint; } package Prima::VB::AbstractSlider; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(readOnly snap autoTrack)], uiv => [qw(min max value increment step)], sliderScheme => ['scheme'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( ticks); } package Prima::VB::Slider; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::AbstractSlider); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(ribbonStrip vertical)], uiv => [qw(shaftBreadth)], tickAlign => [qw(tickAlign)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ($self,$canvas) = @_; my ($x, $y) = $canvas-> size; my ( $f, $b) = ( $self-> color, $self-> backColor); my @c3d = ( $self-> light3DColor, $self-> dark3DColor); $canvas-> color( $b); $canvas-> bar(0,0,$x,$y); $canvas-> color( $f); if ( $self-> prf('vertical')) { $canvas-> rect3d( $x * 0.4, 0, $x * 0.6, $y - 1, 1, @c3d); $canvas-> rect3d( $x * 0.25, 3, $x * 0.75, 20, 1, @c3d, $b); } else { $canvas-> rect3d( 0, $y * 0.4, $x - 1, $y * 0.6, 1, @c3d); $canvas-> rect3d( 3, $y * 0.25, 20, $y * 0.75, 1, @c3d, $b); } $self-> common_paint( $canvas); } sub prf_vertical { $_[0]-> repaint; } package Prima::VB::CircularSlider; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::AbstractSlider); sub prf_events { return ( $_[0]-> SUPER::prf_events, onStringify => 'my ( $self, $index, $result) = @_;', ); } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw(buttons stdPointer)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ($self,$canvas) = @_; my ($x, $y) = $canvas-> size; my ( $f, $b) = ( $self-> color, $self-> backColor); my @c3d = ( $self-> light3DColor, $self-> dark3DColor); $canvas-> color( $b); $canvas-> bar(0,0,$x,$y); $canvas-> color( $f); my ( $cx, $cy) = ( $x/2, $y/2); my $rad = ($x < $y) ? $cx : $cy; $rad -= 3; $canvas-> lineWidth(2); $canvas-> color( $c3d[0]); $canvas-> arc( $cx, $cy, $rad, $rad, 65, 235); $canvas-> color( $c3d[1]); $canvas-> arc( $cx, $cy, $rad, $rad, 255, 405); $canvas-> lineWidth(1); $self-> common_paint( $canvas); } package Prima::VB::AbstractOutline; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onClick', ); @$def{keys %prf} = values %prf; return $def; } sub prf_events { return ( $_[0]-> SUPER::prf_events, onSelectItem => 'my ( $self, $index) = @_;', onDrawItem => 'my ( $self, $canvas, $node, $left, $bottom, $right, $top, $position, $focused) = @_;', onMeasureItem => 'my ( $self, $node, $result) = @_;', onExpand => 'my ( $self, $node, $action) = @_;', onDragItem => 'my ( $self, $from, $to) = @_;', onStringify => 'my ( $self, $node, $result) = @_;', ); } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [ qw(autoHScroll autoVScroll vScroll hScroll dragable autoHeight showItemHint)], uiv => [ qw(itemHeight itemWidth focusedItem borderWidth offset topItem indent openedGlyphs closedGlyphs)], treeItems => [qw(items)], icon => [qw(closedIcon openedIcon)], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw (offset); } package Prima::VB::OutlineViewer; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::AbstractOutline); sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw (items); } package Prima::VB::StringOutline; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::AbstractOutline); sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior( $canvas); my $c = ''; my $i = $self-> prf('items'); my $traverse; if ( $i && scalar @r) { my $fh = $canvas-> font-> height; my $max = int(($r[3] - $r[1]) / $fh) + 1; $traverse = sub{ my ( $x, $l) = @_; goto ENOUGH unless $max--; $c .= "\t\t" x $l; $c .= $x-> [2] ? '[-] ' : '[+] ' if $x-> [1]; $c .= $x-> [0] . "\n"; $l++; if ( $x-> [1] && $x-> [2]) { $traverse-> ($_, $l) for @{$x-> [1]}; } }; $traverse-> ($_,0) for @$i; ENOUGH: $canvas-> draw_text( $c, @r, dt::NoWordWrap | dt::ExpandTabs | dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | dt::UseClip ); } $self-> common_paint($canvas); } sub prf_items { $_[0]-> repaint; } package Prima::VB::DirectoryOutline; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::AbstractOutline); sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( items dragable ); } sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior( $canvas); $canvas-> draw_text( "usr\n\tlocal\n\t\tshare\n\t\t\texamples\n\t\t\t\tetc", @r, dt::NoWordWrap | dt::ExpandTabs | dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | dt::UseClip ) if scalar @r; $self-> common_paint($canvas); } package Prima::VB::Notebook; use strict; use vars qw(@ISA); @ISA = qw( Prima::VB::CommonControl); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( uiv => ['pageCount', 'pageIndex'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {defaultInsertPage}; } sub init { my $self = shift; my %profile = $self-> SUPER::init( @_); $self-> {list} = {}; $self-> {pageCount} = 0; $self-> {pageIndex} = 0; $self-> insert( Popup => name => 'AltPopup', items => [ ['~Next page' => '+' => '+' => sub { $self-> pg_inc(1); }], ['~Previous page' => '-' => '-' => sub { $self-> pg_inc(-1); }], ['~Move widget to page...' => 'Ctrl+M' => '^M' => sub { $self-> widget_repage } ], ], )-> selected(0); $self-> add_hooks(qw(name owner DESTROY)); return %profile; } sub prf_pageIndex { my ( $self, $pi) = @_; return if $pi == $self-> {pageIndex}; my $l = $self-> {list}; for ( $VB::form-> widgets) { my $n = $_-> name; next unless exists $l-> {$n}; $_-> visible( $pi == $l-> {$n}); } $self-> {pageIndex} = $pi; } sub ext_profile { my $self = $_[0]; my $l = $self-> {list}; return map { $_ => $l-> {$_}} keys %{$l}; } sub act_profile { my $self = $_[0]; return ( onChild => '$_[2]-> defaultInsertPage( $_[1]-> {extras}-> {$_[3]})', ); } sub repage { $_[0]-> {pageIndex} = -1; # force repage $_[0]-> prf_pageIndex($_[0]-> prf('pageIndex')); } sub on_load { my $self = $_[0]; return unless $self-> {extras}; $self-> {list} = $self-> {extras}; delete $self-> {extras}; $self-> repage; } sub on_show { my $self = $_[0]; $self-> insert( Timer => timeout => 1, onTick => sub { $self-> repage; $_[0]-> destroy; })-> start; } sub on_hook { my ( $self, $who, $prop, $old, $new) = @_; if ( $prop eq 'name') { return unless exists $self-> {list}-> {$old}; $self-> {list}-> {$new} = $self-> {list}-> {$old}; delete $self-> {list}-> {$old}; return; } if ( $prop eq 'owner') { my $n = $self-> prf('name'); my $l = $self-> {list}; if (( $n eq $old) || exists $l-> {$old}) { return if exists $l-> {$new} || ( $n eq $new); delete $l-> {$who}; } elsif (( $n eq $new) && exists $l-> {$who}) { return; # notebook itself was renamed } elsif (( $n eq $new) || exists $l-> {$new}) { return if exists $l-> {$old} || ( $n eq $old); $l-> {$who} = $self-> {pageIndex}; } return; } if ( $prop eq 'DESTROY') { delete $self-> {list}-> {$who}; return; } } sub widget_repage { my $self = $_[0]; my @mw = $VB::form-> marked_widgets; my $d = Prima::Dialog-> create( text => 'Move to page', size => [ 217, 63], centered => 1, icon => $VB::ico, visible => 0, designScale => [7, 16], ); $d-> insert( ['Prima::SpinEdit' => origin => [ 3, 8], name => 'Spin', size => [ 100, 20], value => $self-> {pageIndex}, max => 16383, ], [ 'Prima::Button' => origin => [ 109, 8], size => [ 96, 36], text => '~OK', onClick => sub { $d-> ok; }, ], [ 'Prima::Label' => origin => [ 3, 36], size => [ 100, 20], text => 'Move to page', ]); my $ok = $d-> execute == mb::OK; my $pi = $d-> Spin-> value; $d-> destroy; return unless $ok; return if $self-> {pageIndex} == $pi; my $ctrl = 0; for ( @mw) { my $name = $_-> name; next unless exists $self-> {list}-> {$name}; $self-> {list}-> {$name} = $pi; $ctrl++; } return unless $ctrl; $self-> prf_set( pageIndex => $pi); } sub pg_inc { my ( $self, $inc) = @_; my $np = $self-> {pageIndex} + $inc; return if $np < 0 || $np > 16383; $self-> prf_set( pageIndex => $np); } package Prima::VB::TabSet; use strict; use vars qw(@ISA); @ISA = qw( Prima::VB::CommonControl); sub prf_events { return ( $_[0]-> SUPER::prf_events, onDrawTab => 'my ( $self, $canvas, $number, $colorSet, $largePolygon, $smallPolygon) = @_;', onMeasureTab => 'my ( $self, $index, $result) = @_;', ); } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onChange', ); @$def{keys %prf} = values %prf; return $def; } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( uiv => [qw(firstTab focusedTab tabIndex)], bool => [qw(colored topMost)], items => ['tabs'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_tabs { $_[0]-> repaint; } sub prf_topMost { $_[0]-> repaint; } sub on_paint { my ( $self, $canvas) = @_; my @sz = $self-> size; my $c = $self-> color; $canvas-> color( $self-> backColor); $canvas-> bar( 0, 0, @sz); my $y = ( $sz[1] - $canvas-> font-> height) / 2; $canvas-> color( $c); my $x = 0; my @tabs = @{$self-> prf('tabs')}; my $topMost = $self-> prf( 'topMost'); for ( @tabs) { $canvas-> text_out( $_, $x + 5, $y); my $tx = $canvas-> get_text_width( $_); $canvas-> polyline( $topMost ? [ $x, 2, $x + 5, $sz[1] - 2, $x + $tx + 5, $sz[1] - 2, $x + $tx + 10, 2 ] : [ $x, $sz[1] - 2, $x + 5, 2, $x + $tx + 5, 2, $x + $tx + 10, $sz[1] - 2 ]); $x += $tx + 20; last if $x >= $sz[0]; } if ( scalar @tabs) { my $tx = $canvas-> get_text_width( $tabs[0]); $topMost ? $canvas-> line( $tx + 10, 2, $sz[0] - 1, 2) : $canvas-> line( $tx + 10, $sz[1] - 2, $sz[0] - 1, $sz[1] - 2); } $self-> common_paint($canvas); } package Prima::VB::TabbedNotebook; use vars qw(@ISA); @ISA = qw( Prima::VB::Notebook); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( items => ['tabs'], uiv => ['tabIndex'], bool => ['style', 'orientation'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( tabCount pageCount ); } sub act_profile { my $self = $_[0]; return ( $self-> SUPER::act_profile, onChildCreate => '$_[3]-> origin( $_[3]-> left-$_[3]-> owner-> left, $_[3]-> bottom-$_[3]-> owner-> bottom);', ); } sub on_paint { my ( $self, $canvas) = @_; my @sz = $canvas-> size; my $cl = $self-> color; my @c3d = ( $self-> light3DColor, $self-> dark3DColor); $canvas-> color( $self-> backColor); $canvas-> bar( 0, 0, @sz); $canvas-> color( $cl); my $fh = $canvas-> font-> height; my $mh = $fh * 2 + 4; my @tabs = @{$self-> prf('tabs')}; my $earx = 16; my ( $page, $last, $x, $maxx, $ix) = (0,'', $earx * 3, $sz[0] - $earx * 3 - 1, $self-> prf('pageIndex')); my $y = $self-> prf('orientation') ? 0 : $sz[1] - $mh; for ( @tabs) { next unless $page++ >= $ix; next if $_ eq $last; $last = $_; my $w = $canvas-> get_text_width( $last); $canvas-> text_out( $last, $x + $earx + 2, $y + $fh/2 + 2); $canvas-> rectangle( $x+1, $y + $fh/2+1, $x + $earx * 2 + $w + 2, $y + $fh*3/2+2); $canvas-> rectangle( $x, $y + $fh/2, $x + $earx * 2 + $w + 3, $y + $fh*3/2+3) if $page == $ix+1; $x += $w + $earx * 2 + 4; last if $x > $maxx; } $canvas-> rect3d( $earx/2, $y + $fh/2, $earx * 2.5, $y + $fh * 3/2+4, 2, @c3d, $canvas-> backColor); $canvas-> rect3d( $maxx + $earx/2, $y + $fh/2, $maxx + $earx * 2.5, $y + $fh * 3/2+4, 2, @c3d, $canvas-> backColor); $canvas-> fillpoly([ $earx, $y + $fh, $earx*2, $y + $fh*0.5+3, $earx*2, $y + $fh*1.5-1 ]); $canvas-> fillpoly([ $maxx + $earx*2, $y + $fh, $maxx + $earx, $y + $fh*0.5+3, $maxx + $earx, $y + $fh*1.5-1 ]); my @tr = $canvas-> translate; $canvas-> translate( $self-> prf('orientation') ? (0, $mh) : (0,0)); if ( $self-> prf('style')) { $canvas-> rect3d( 10, 10, $sz[0] - 11, $sz[1] - 10 - $mh, 1, reverse @c3d); $canvas-> rect3d( 2, 2, $sz[0] - 3, $sz[1] - $mh, 1, @c3d); } $canvas-> linePattern( lp::Dash); $canvas-> rectangle( 12, 12, $sz[0] - 17, $sz[1] - ($self-> prf('style') ? 48 : -4) - $mh); $canvas-> linePattern( lp::Solid); $canvas-> translate(@tr); $self-> common_paint( $canvas); } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; if ( $btn == mb::Left) { my @sz = $self-> size; my $fh = $self-> font-> height; my $ny = $self-> prf('orientation') ? 0 : $sz[1] - 2 * $fh - 4; my $earx = 16; my $maxx = $sz[0] - $earx; if ( $y > $ny + $fh/2 && $y < $ny + $fh*3/2+4) { if ( $x > $earx/2 && $x < $earx * 2.5) { $self-> prf_set( 'pageIndex' => $self-> prf('pageIndex') - 1); return; } elsif ( $x > $maxx - $earx*1.5 && $x < $maxx + $earx/2) { $self-> prf_set( 'pageIndex' => $self-> prf('pageIndex') + 1); return; } } } $self-> SUPER::on_mousedown( $btn, $mod, $x, $y); } sub prf_tabs { $_[0]-> repaint; } sub prf_orientation { $_[0]-> repaint } sub prf_style { $_[0]-> repaint } sub prf_pageIndex { $_[0]-> SUPER::prf_pageIndex( $_[1]); $_[0]-> repaint; } package Prima::VB::Header; use strict; use vars qw(@ISA); @ISA = qw( Prima::VB::CommonControl); # use Prima::Header; sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( items => ['items', 'widths'], uiv => ['offset', 'minTabWidth'], iv => ['pressed'], bool => ['clickable', 'dragable', 'vertical', 'scalable'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( pressed); } sub on_paint { my ( $self, $canvas) = @_; my @sz = $canvas-> size; $canvas-> clear; my @w = @{$self-> prf('widths')}; my @i = @{$self-> prf('items')}; my $v = $self-> prf('vertical'); my $fh = $canvas-> font-> height; my @c3d = ( $canvas-> light3DColor, $canvas-> dark3DColor); my $x; my $z = 0; for ( $x = 0; $x < @i; $x++) { my $ww = $w[$x]; $ww = $canvas-> get_text_width( $i[$x]) if !(defined($ww)) || !($ww =~ m/^\s*\d+\s*$/); my @rc = $v ? ( 0, $z, $sz[0]-1, $z + $ww) : ( $z, 0, $z + $ww, $sz[1]-1); $canvas-> rect3d( @rc, 1, @c3d); $canvas-> clipRect( $rc[0]+1, $rc[1]+1, $rc[2]-1, $rc[3]-1); $canvas-> text_out( $i[$x], $rc[0] + 1, $rc[1] + ($rc[3] - $rc[1] - $fh) / 2 + 1); $canvas-> clipRect( 0, 0, @sz); $z += $ww + 2; } $self-> common_paint( $canvas); } sub prf_items { $_[0]-> repaint; } sub prf_widths{ $_[0]-> repaint; } package Prima::VB::DetailedList; use strict; use vars qw(@ISA); @ISA = qw( Prima::VB::ListBox); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( items => ['headers', 'widths'], multiItems => ['items'], uiv => ['mainColumn', 'columns', 'minTabWidth', 'offset'], string => ['headerClass'], bool => ['clickable', 'dragable', 'vertical', 'scalable'], ); $_[0]-> prf_types_delete( $pt, qw(items)); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw ( pressed headerProfile headerDelegations multiColumn autoWidth vertical offset pressed gridColor); } sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior($canvas); my @w = @{$self-> prf('widths')}; my @h = @{$self-> prf('headers')}; my @i = @{$self-> prf('items')}; my $c = $self-> prf('columns'); my $f = $canvas-> font-> height; if ( scalar(@r)) { $canvas-> color( cl::Gray); $canvas-> bar( 1, $r[3] - $f, $r[2], $r[3] - 1); $canvas-> color( cl::Fore); if ( $c) { my $z = $r[0]; my $j; for ( $j = 0; $j < $c; $j++) { my $ww = $w[$j]; $ww = $canvas-> get_text_width( $h[$j]) if !(defined($ww)) || !($ww =~ m/^\s*\d+\s*$/); my @z = ( $z, $r[1], ( $z + $ww > $r[2]) ? $r[2] : $z + $ww, $r[3]); $z[2]++; $canvas-> rectangle( @z); $z[2]--; $canvas-> draw_text( join("\n", $h[$j], map { defined($i[$_]-> [$j]) ? $i[$_]-> [$j] : '' } 0..$#i), @z, dt::NoWordWrap | dt::NewLineBreak | dt::Left | dt::Top | dt::UseClip ); $z += $ww + 1; last if $z > $r[2]; } } } $self-> common_paint($canvas); } sub prf_items { my ( $self, $data) = @_; my $c = $self-> prf('columns'); for ( @$data) { next if scalar @$_ >= $c; push( @$_, ('') x ( $c - scalar @$_)); } $self-> repaint; } sub prf_columns { $_[0]-> prf_items( $_[0]-> prf('items')); } sub prf_widths { $_[0]-> repaint; } sub prf_headers { $_[0]-> prf_set( columns => scalar @{$_[0]-> prf('headers')}); } package Prima::VB::Calendar; use strict; use vars qw(@ISA); @ISA = qw( Prima::VB::CommonControl); sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( date => [ 'date' ], bool => ['useLocale'], iv => [ 'day', 'year', 'month' ], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub on_paint { my ( $self, $canvas) = @_; my ( $fh, $fw) = ( $canvas-> font-> height, $canvas-> font-> maximalWidth * 2); my @sz = $canvas-> size; $canvas-> clear; $canvas-> rectangle( 5, 5, $sz[0] - 6, $sz[1] - 17 - $fh * 3); $canvas-> rectangle( 5, $sz[1] - $fh * 2 - 10, $sz[0] - 110, $sz[1] - $fh - 6); $canvas-> rectangle( $sz[0] - 105, $sz[1] - $fh * 2 - 10, $sz[0] - 5, $sz[1] - $fh - 6); $canvas-> clipRect( 6, 6, $sz[0] - 7, $sz[1] - 18 - $fh * 3); my ( $xd, $yd) = ( int(( $sz[0] - 10 ) / 7), int(( $sz[1] - $fh * 4 - 22 ) / 7)); $yd = $fh if $yd < $fh; $xd = $fw if $xd < $fw; my ( $x, $y, $i) = ( 5 + $xd/2, $sz[1] - 17 - $fh * 4, 0); for ( 1 .. 31 ) { $canvas-> text_out( $_, $x, $y); $x += $xd; next unless $i++ == 6; ( $x, $y, $i) = ( 5 + $xd/2, $y - $yd, 0); } $canvas-> clipRect( 0, 0, @sz); $self-> common_paint($canvas); } package Prima::VB::Grid; use strict; use vars qw(@ISA); @ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( mainEvent => 'onClick', ); @$def{keys %prf} = values %prf; return $def; } sub prf_events { return ( $_[0]-> SUPER::prf_events, onSelectCell => 'my ( $self, $column, $row) = @_;', onDrawCell => < 'my ( $self, $axis, $index, $min, $max) = @_;', onMeasure => 'my ( $self, $axis, $index, $breadth) = @_;', onSetExtent => 'my ( $self, $axis, $index, $breadth) = @_;', onStringify => 'my ( $self, $column, $row, $text_ref) = @_;', ); } sub prf_types { my $pt = $_[ 0]-> SUPER::prf_types; my %de = ( bool => [qw( allowChangeCellHeight allowChangeCellWidth autoHScroll autoVScroll clipCells drawHGrid drawVGrid hScroll vScroll multiSelect)], uiv => [qw(borderWidth columns constantCellWidth constantCellHeight gridGravity leftCell topCell rows)], upoint => [qw(focusedCell)], color => [qw(gridColor indentCellBackColor indentCellColor)], urect => [qw(cellIndents)], multiItems => ['cells'], ); $_[0]-> prf_types_add( $pt, \%de); return $pt; } sub prf_adjust_default { my ( $self, $p, $pf) = @_; $self-> SUPER::prf_adjust_default( $p, $pf); delete $pf-> {$_} for qw (offset); } sub on_paint { my ( $self, $canvas) = @_; my @r = $self-> paint_exterior($canvas); my @i = @{$self-> prf('cells')}; my $c = $self-> prf('columns'); my $r = $self-> prf('rows'); my $f = $canvas-> font-> height; if ( scalar(@r) && $c && $r) { my $z = $r[0]; my $j; my @polyline; my $lowline = $r[3] - $r * $f; $lowline = $r[1] if $lowline < $r[1]; for ( $j = 0; $j < $c; $j++) { my $ww = $canvas-> get_text_width( defined($i[0]-> [$j]) ? $i[0]-> [$j] : '' ); my @z = ( $z, $r[1], ( $z + $ww > $r[2]) ? $r[2] : $z + $ww, $r[3]); push @polyline, $z[2]+1, $lowline, $z[2]+1, $r[3]; $canvas-> draw_text( join("\n", map { defined($i[$_]-> [$j]) ? $i[$_]-> [$j] : '' } 0..($r-1)), @z, dt::NoWordWrap | dt::NewLineBreak | dt::Left | dt::Top | dt::UseClip ); $z += $ww + 1; last if $z > $r[2]; } push @polyline, $r[0], $lowline, $r[0], $r[3]; push @polyline, map { $r[0], $r[3] - $_ * $f, $z, $r[3] - $_ * $f } 1 .. $r; $self-> lines(\@polyline); } $self-> common_paint($canvas); } sub prf_cells { my ( $self, $data) = @_; my $c = $self-> prf('columns'); my $r = $self-> prf('rows'); for ( @$data) { next if scalar @$_ >= $c; push( @$_, ('') x ( $c - scalar @$_)); } if ( scalar @$data < $r) { $r -= @$data; push @$data, [('') x $c] while $r--; } $self-> repaint; } sub prf_columns { $_[0]-> prf_cells( $_[0]-> prf('cells')); } sub prf_rows { $_[0]-> prf_cells( $_[0]-> prf('cells')); } 1; Prima-1.28/Prima/VB/VB.pl0000644000175100017510000022305611150770061012525 0ustar dkdk# Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: VB.pl,v 1.93 2009/01/08 08:13:47 dk Exp $ use strict; use Prima qw(StdDlg Notebooks MsgBox ComboBox FontDialog ColorDialog IniFile Utils); use Prima::VB::VBLoader; use Prima::VB::VBControls; use Prima::VB::CfgMaint; ######### built-in setup variables ############### my $lite = 0; # set to 1 to use ::Lite packages. For debug only $Prima::VB::CfgMaint::systemWide = 0; # 0 - user config, 1 - root config to write my $singleConfig = 0; # set 1 to use only either user or root config my $VBVersion = 0.2; ################################################### my $classes = 'Prima::VB::Classes'; if ( $lite) { $classes = 'Prima::VB::Lite::Classes'; $Prima::VB::CfgMaint::systemWide = 1; $Prima::VB::CfgMaint::rootCfg = 'Prima/VB/Lite/Config.pm'; } eval "use $classes;"; die "$@" if $@; use Prima::Application name => 'Form template builder'; package VB; use strict; use vars qw($inspector $main $editor $code $font_dialog $color_dialog $form $fastLoad $writeMode ); $fastLoad = 1; $writeMode = 0; my $openFileDlg; my $saveFileDlg; my $openImageDlg; my $saveImageDlg; my $fontDlg; sub open_dialog { my %profile = @_; $openFileDlg = Prima::OpenDialog-> create( icon => $VB::ico, directory => $VB::main-> {ini}-> {OpenPath}, system => 1, ) unless $openFileDlg; $openFileDlg-> set( %profile); return $openFileDlg; } sub save_dialog { my %profile = @_; $saveFileDlg = Prima::SaveDialog-> create( icon => $VB::ico, directory => $VB::main-> {ini}-> {SavePath}, system => 1, ) unless $saveFileDlg; $saveFileDlg-> set( %profile); return $saveFileDlg; } sub image_open_dialog { my %profile = @_; $openImageDlg = Prima::ImageOpenDialog-> create( icon => $VB::ico, directory => $VB::main-> {ini}-> {OpenPath}, ) unless $openImageDlg; $openImageDlg-> set( %profile); return $openImageDlg; } sub image_save_dialog { my %profile = @_; $saveImageDlg = Prima::ImageSaveDialog-> create( icon => $VB::ico, directory => $VB::main-> {ini}-> {SavePath}, ) unless $saveImageDlg; $saveImageDlg-> set( %profile); return $saveImageDlg; } sub font_dialog { my %profile = @_; $fontDlg = Prima::FontDialog-> create( icon => $VB::ico, name => 'Select font', ) unless $fontDlg; $fontDlg-> set( %profile); return $fontDlg; } sub accelItems { return [ ['openitem' => '~Open' => 'Ctrl+O' => '^O' => sub { $VB::main-> open;}], ['-saveitem1' => '~Save' => 'Ctrl+S' => '^S' => sub {$VB::main-> save;}], ['Exit' => 'Ctrl+Q' => '^Q' => sub{ $VB::main-> close;}], ['Object Inspector' => 'F11' => 'F11' => sub { $VB::main-> bring_inspector; }], ['Code Editor' => 'F12' => 'F12' => sub { $VB::main-> bring_code_editor; }], ['-runitem' => '~Run' => 'Ctrl+F9' => '^F9' => sub { $VB::main-> form_run}, ], ['~Help' => 'F1' => 'F1' => sub { $::application-> open_help('VB/Help')}], ['~Widget property' => 'Shift+F1' => '#F1' => sub { ObjectInspector::help_lookup() }], ]; } package OPropListViewer; use strict; use vars qw(@ISA); @ISA = qw(PropListViewer); sub on_click { my $self = $_[0]; my $index = $self-> focusedItem; my $current = $VB::inspector-> {current}; return if $index < 0; my $id = $self-> {'id'}-> [$index]; return if $id eq 'name' || $id eq 'owner'; $self-> SUPER::on_click; for ( $current, grep { $current != $_ } $VB::form-> marked_widgets) { if ( $self-> {check}-> [$index]) { $_-> prf_set( $id => $_-> {default}-> {$id}); } else { $_-> prf_delete( $id); } } } sub on_selectitem { my ( $self, $lst, $state) = @_; return unless $state; $VB::inspector-> close_item; $VB::inspector-> open_item; } package ObjectInspector; use strict; use vars qw(@ISA); @ISA = qw(Prima::Window); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( text => 'Object Inspector', width => 280, height => 350, left => 6, sizeDontCare => 0, originDontCare => 0, icon => $VB::ico, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $VB::main-> init_position( $self, 'ObjectInspectorRect'); my @sz = $self-> size; my $fh = $self-> font-> height + 6; $self-> insert( ComboBox => origin => [ 0, $sz[1] - $fh], size => [ $sz[0], $fh], growMode => gm::Ceiling, style => cs::DropDown, name => 'Selector', items => [''], delegations => [qw(Change)], ); $self-> {monger} = $self-> insert( Notebook => origin => [ 0, $fh], size => [ 100, $sz[1] - $fh * 2], growMode => gm::Client, pageCount => 2, ); $self-> {mtabs} = $self-> insert( Button => origin => [ 0, 0], size => [ 100, $fh], text => '~Events', growMode => gm::Floor, name => 'MTabs', delegations => [qw(Click)], ); $self-> {mtabs}-> {mode} = 0; $self-> {plist} = $self-> {monger}-> insert_to_page( 0, OPropListViewer => origin => [ 0, 0], size => [ 100, $sz[1] - $fh * 2], name => 'PList', growMode => gm::Client, ); $self-> {elist} = $self-> {monger}-> insert_to_page( 1, OPropListViewer => origin => [ 0, 0], size => [ 100, $sz[1] - $fh * 2], name => 'EList', growMode => gm::Client, ); $self-> {currentList} = $self-> {'plist'}; $self-> insert( Divider => vertical => 1, origin => [ 100, 0], size => [ 6, $sz[1] - $fh], min => 50, max => 50, name => 'Div', delegations => [qw(Change)], ); $self-> {panel} = $self-> insert( Notebook => origin => [ 106, 0], size => [ $sz[0]-106, $sz[1] - $fh], growMode => gm::Right, name => 'Panel', pageCount => 1, ); $self-> {panel}-> {pages} = {}; $self-> {current} = undef; return %profile; } sub on_size { my ( $self, $ox, $oy, $x, $y) = @_; return if $x == $ox; my $d = $self-> bring('Div'); return unless $d; $self-> {div_ratio} = $d-> left / ( $x || 1 ) unless $self-> {div_ratio}; $d-> left( $x * $self-> {div_ratio}); $self-> {lock_div_ratio} = 1; $self-> Div_Change( $d); delete $self-> {lock_div_ratio}; } sub Div_Change { my $self = $_[0]; my ( $left, $right) = ( $self-> Div-> left, $self-> Div-> right); $self-> {monger}-> width( $left); $self-> {mtabs}-> width( $left); $self-> Panel-> set( width => $self-> width - $right, left => $right, ); $self-> {div_ratio} = $left / ( $self-> width || 1 ) unless $self-> {lock_div_ratio}; } sub set_monger_index { my ( $self, $ix) = @_; my $mtabs = $self-> {mtabs}; return if $ix == $mtabs-> {mode}; $mtabs-> {mode} = $ix; $mtabs-> text( $ix ? '~Properties' : '~Events'); $self-> {monger}-> pageIndex( $ix); $self-> {currentList} = $self-> { $ix ? 'elist' : 'plist' }; $self-> close_item; $self-> open_item; } sub MTabs_Click { my ( $self, $mtabs) = @_; $self-> set_monger_index( $mtabs-> {mode} ? 0 : 1); } sub Selector_Change { my $self = $_[0]; return if $self-> {selectorChanging}; return unless $VB::form; my $t = $self-> Selector-> text; return unless length( $t); $self-> {selectorRetrieving} = 1; my $enter; if ( $t eq $VB::form-> text) { $VB::form-> focus; $enter = $VB::form; } else { my @f = $VB::form-> widgets; for ( @f) { $enter = $_, $_-> show, $_-> focus, last if $t eq $_-> name; } } if ( $enter) { $enter-> marked(1,1); ObjectInspector::enter_widget( $enter); } $self-> {selectorRetrieving} = 0; } sub item_changed { my $self = $VB::inspector; return unless $self; return unless $self-> {opened}; return if $self-> {sync}; if ( $self-> {opened}-> valid) { if ( $self-> {opened}-> can( 'get')) { $self-> {sync} = 1; my $data = $self-> {opened}-> get; $self-> {opened}-> {widget}-> prf_set( $self-> {opened}-> {id} => $data); my $list = $self-> {currentList}; my $ix = $list-> {index}-> {$self-> {opened}-> {id}}; unless ( $list-> {check}-> [$ix]) { $list-> {check}-> [$ix] = 1; $list-> redraw_items( $ix); } my @w = $VB::form-> marked_widgets; for my $w ( @w) { next if $w == $self-> {current}; $w-> prf_set($self-> {opened}-> {id} => $data); } $self-> {sync} = undef; } } } sub widget_changed { my ( $how, $id) = @_; my $self = $VB::inspector; return unless $self; return if $self-> {currentList} != $self-> {plist}; if ( $self-> {opened}) { if ( $id eq $self-> {opened}-> {id}) { return if $self-> {sync}; $self-> {sync} = 1; my $data = $self-> {opened}-> {widget}-> prf( $id); $self-> {opened}-> set( $data); $self-> {sync} = undef; } } my $list = $self-> {currentList}; my $ix = $list-> {index}-> {$id}; if ( $list-> {check}-> [$ix] == $how) { $list-> {check}-> [$ix] = $how ? 0 : 1; $list-> redraw_items( $ix); } } sub close_item { my $self = $_[0]; return unless defined $self-> {opened}; $self-> {lastOpenedId} = $self-> {opened}-> {id}; $self-> {opened} = undef; } sub open_item { my $self = $_[0]; return if defined $self-> {opened}; my $list = $self-> {currentList}; my $f = $list-> focusedItem; if ( $f < 0) { $self-> {panel}-> pageIndex(0); return; } my $id = $list-> {id}-> [$f]; my $type = $VB::main-> get_typerec( $self-> {current}-> {types}-> {$id}); my $p = $self-> {panel}; my $pageset; if ( exists $p-> {pages}-> {$type}) { $self-> {opened} = $self-> {typeCache}-> {$type}; $pageset = $p-> {pages}-> {$type}; $self-> {opened}-> renew( $id, $self-> {current}); } else { $p-> pageCount( $p-> pageCount + 1); $p-> pageIndex( $p-> pageCount - 1); $p-> {pages}-> {$type} = $p-> pageIndex; $self-> {opened} = $type-> new( $p, $id, $self-> {current}); $self-> {typeCache}-> {$type} = $self-> {opened}; } my $data = $self-> {current}-> prf( $id); $self-> {sync} = 1; $self-> {opened}-> set( $data); $self-> {sync} = undef; $p-> pageIndex( $pageset) if defined $pageset; $self-> {lastOpenedId} = undef; } sub enter_widget { return unless $VB::inspector; my ( $self, $w) = ( $VB::inspector, $_[0]); if ( defined $w) { return if defined $self-> {current} and $self-> {current} == $w; } else { return unless defined $self-> {current}; } my $oid = $self-> {opened}-> {id} if $self-> {opened}; $oid = $self-> {lastOpenedId} unless defined $oid; $self-> {current} = $w; if ( $self-> {current}) { $self-> close_item; my %df = %{$_[0]-> {default}}; my $pf = $_[0]-> {profile}; my @ef = sort keys %{$self-> {current}-> {events}}; my $ep = $self-> {elist}; my $num = 0; my @check = (); my %ix = (); for ( @ef) { push( @check, exists $pf-> {$_} ? 1 : 0); $ix{$_} = $num++; delete $df{$_}; } $ep-> reset_items( [@ef], [@check], {%ix}); $ep-> focusedItem( $ix{$oid}) if defined $oid and defined $ix{$oid}; my $lp = $self-> {plist}; @ef = sort keys %df; %ix = (); @check = (); $num = 0; for ( @ef) { push( @check, exists $pf-> {$_} ? 1 : 0); $ix{$_} = $num++; } $lp-> reset_items( [@ef], [@check], {%ix}); $lp-> focusedItem( $ix{$oid}) if defined $oid and defined $ix{$oid}; $self-> Selector-> text( $self-> {current}-> name) unless $self-> {selectorRetrieving}; $self-> open_item; } else { $self-> {panel}-> pageIndex(0); for ( qw( plist elist)) { my $p = $self-> {$_}; $p-> {check} = []; $p-> {index} = {}; $p-> set_count(0); } $self-> Selector-> text( ''); } } sub update_markings { return unless $VB::inspector; my @w = $VB::form-> marked_widgets; return enter_widget( $VB::form) if 0 == @w; return enter_widget( $w[0]) if 1 == @w; my $self = $VB::inspector; $self-> close_item; my $n1 = $self-> {current} = shift @w; my %el = %{$n1-> {events}}; my %pl = %{$n1-> {default}}; delete @pl{ keys %el }; delete @pl{ qw(name) }; # won't set these properties for my $w ( @w) { delete @el{ grep { not exists $w->{events}->{$_} } keys %el}; delete @pl{ grep { not exists $w->{default}->{$_} } keys %pl}; } my $oid = $self-> {lastOpenedId}; my @ef = sort keys %el; my $ep = $self-> {elist}; my $num = 0; my @check = (); my %ix = (); for my $e ( @ef) { push( @check, ( grep { $_-> {profile}->{$e} } $n1, @w ) ? 1 : 0); $ix{$e} = $num++; } $ep-> reset_items( [@ef], [@check], {%ix}); $ep-> focusedItem( $ix{$oid}) if defined $oid and defined $ix{$oid}; my $lp = $self-> {plist}; @ef = sort keys %pl; %ix = (); @check = (); $num = 0; for my $e ( @ef) { push( @check, ( grep { $_-> {profile}->{$e} } $n1, @w ) ? 1 : 0); $ix{$e} = $num++; } $lp-> reset_items( [@ef], [@check], {%ix}); $lp-> focusedItem( $ix{$oid}) if defined $oid and defined $ix{$oid}; $self-> Selector-> text( join(',', map { $_-> name } $n1, @w)); $self-> open_item; } sub renew_widgets { return unless $VB::inspector; return if $VB::inspector-> {selectorChanging}; $VB::inspector-> {selectorChanging} = 1; $VB::inspector-> close_item; if ( $VB::form) { my @f = ( $VB::form, $VB::form-> widgets); $_ = $_-> name for @f; $VB::inspector-> Selector-> items( \@f); my $fx = $VB::form-> focused ? $VB::form : $VB::form-> selectedWidget; $fx = $VB::form unless $fx; enter_widget( $fx); } else { $VB::inspector-> Selector-> items( ['']); $VB::inspector-> Selector-> text( ''); enter_widget(undef); } $VB::inspector-> {selectorChanging} = undef; } sub preload { my $self = $VB::inspector; my $l = $self-> {plist}; my $cnt = $l-> count; $self-> {panel}-> hide; $l-> hide; $l-> focusedItem( $cnt) while $cnt-- > 0; $l-> show; $self-> {panel}-> show; } sub on_destroy { $VB::inspector = undef; $VB::main-> {ini}-> {ObjectInspectorRect} = join( ' ', $_[0]-> rect); } sub help_lookup { return unless $VB::inspector; my $self = $VB::inspector; my $list = $self-> {currentList}; my $f = $list-> focusedItem; return if $f < 0; my $event = $self-> {mtabs}-> {mode}; my $id = $list-> {id}-> [$f]; $id =~ s/^on// if $event; $::application-> open_help("Prima::Widget/$id"); } package Form; use strict; use vars qw(@ISA); @ISA = qw( Prima::Window Prima::VB::Window); { my %RNT = ( %{Prima::Window-> notification_types()}, Load => nt::Default, ); sub notification_types { return \%RNT; } } sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( sizeDontCare => 0, originDontCare => 0, width => 300, height => 200, centered => 1, class => 'Prima::Window', module => 'Prima::Classes', selectable => 1, mainEvent => 'onMouseClick', popupItems => $VB::main-> menu-> get_items( 'edit'), ownerIcon => 0, ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); $profile{profile}-> {name} = $self-> name; for ( qw( marked sizeable)) { $self-> {$_}=0; }; $self-> {dragMode} = 3; $self-> init_profiler( \%profile); $self-> {guidelineX} = $self-> width / 2; $self-> {guidelineY} = $self-> height / 2; unless ( $self-> {syncRecting}) { $self-> {syncRecting} = $self; $self-> prf_set( origin => [$self-> origin], size => [$self-> size], originDontCare => 0, sizeDontCare => 0, ); $self-> {syncRecting} = undef; } return %profile; } sub insert_new_control { my ( $self, $x, $y, $where, %profile) = @_; my $class = exists($profile{class}) ? $profile{class} : $VB::main-> {currentClass}; my $xclass = $VB::main-> {classes}-> {$class}-> {class}; return unless defined $xclass; my $creatOrder = 0; my $wn = $where-> name; for ( $self-> widgets) { my $po = $_-> prf('owner'); $po = $VB::form-> name unless length $po; next unless $po eq $wn; my $co = $_-> {creationOrder}; $creatOrder++; next if $co < $creatOrder; $creatOrder = $co + 1; } my $j; my %prf = exists($profile{profile}) ? ( %{$profile{profile}}) : (); eval { eval "use $VB::main->{classes}->{$class}->{RTModule};"; die "$@" if $@; $j = $self-> insert( $xclass, profile => { %prf, owner => $wn, origin => [$x-4,$y-4], }, class => $class, module => $VB::main-> {classes}-> {$class}-> {RTModule}, creationOrder => $creatOrder, ); $j-> {realClass} = $profile{realClass} if exists $profile{realClass}; }; $VB::main-> {currentClass} = undef unless exists $profile{class}; if ( $@) { Prima::MsgBox::message( "Error:$@"); return; } $self-> {modified} = 1; unless ( $profile{manualSelect}) { $j-> select; $j-> marked(1,1); ObjectInspector::enter_widget( $j); } return $j; } sub on_paint { my ( $self, $canvas) = @_; $canvas-> backColor( $self-> backColor); $canvas-> color( cl::Blue); $canvas-> fillPattern([0,0,0,0,4,0,0,0]); my @sz = $canvas-> size; $canvas-> bar(0,0,@sz); $canvas-> fillPattern( fp::Solid); $canvas-> linePattern( lp::Dash); $canvas-> line( $self-> {guidelineX}, 0, $self-> {guidelineX}, $sz[1]); $canvas-> line( 0, $self-> {guidelineY}, $sz[0], $self-> {guidelineY}); } sub on_move { my $self = shift; $self-> SUPER::on_move(@_); $self-> prf_set( originDontCare => 0); } sub on_size { my $self = shift; $self-> SUPER::on_size(@_); $self-> prf_set( sizeDontCare => 0); } sub on_close { my $self = $_[0]; if ( $self-> {modified} || ( $VB::editor && $VB::editor-> {modified})) { my $name = defined ( $VB::main-> {fmName}) ? $VB::main-> {fmName} : 'Untitled'; my $r = Prima::MsgBox::message( "Save changes to $name?", mb::YesNoCancel|mb::Warning ); if ( $r == mb::Yes) { $self-> clear_event, return unless $VB::main-> save; $self-> {modified} = undef; } elsif ( $r == mb::Cancel) { $self-> clear_event; } else { $self-> {modified} = undef; } } } sub on_destroy { if ( $VB::form && ( $VB::form == $_[0])) { $VB::form = undef; if ( defined $VB::main) { $VB::main-> {fmName} = undef; $VB::main-> update_menu(); $VB::main-> update_markings(); } } CodeEditor::flush; ObjectInspector::renew_widgets; } sub veil { my $self = $_[0]; $::application-> begin_paint; my @r = ( @{$self-> {anchor}}, @{$self-> {dim}}); ( $r[0], $r[2]) = ( $r[2], $r[0]) if $r[2] < $r[0]; ( $r[1], $r[3]) = ( $r[3], $r[1]) if $r[3] < $r[1]; @r = $self-> client_to_screen( @r); $::application-> clipRect( $self-> client_to_screen( 0,0,$self-> size)); $::application-> rect_focus( @r, 1); $::application-> end_paint; } sub on_mousedown { my ( $self, $btn, $mod, $x, $y) = @_; return if $self-> {transaction}; if ( $btn == mb::Left) { unless ( $self-> {transaction}) { if ( abs( $self-> {guidelineX} - $x) < 3) { $self-> capture(1, $self); $self-> {saveHdr} = $self-> text; $self-> {transaction} = ( abs( $self-> {guidelineY} - $y) < 3) ? 4 : 2; return; } elsif ( abs( $self-> {guidelineY} - $y) < 3) { $self-> {transaction} = 3; $self-> capture(1, $self); $self-> {saveHdr} = $self-> text; return; } } if ( defined $VB::main-> {currentClass}) { $self-> insert_new_control( $x, $y, $self); } else { $self-> focus; $self-> marked(0,1); $self-> update_view; $self-> {transaction} = 1; $self-> capture(1); $self-> {anchor} = [ $x, $y]; $self-> {dim} = [ $x, $y]; $self-> veil; ObjectInspector::enter_widget( $self); } } } sub on_mousemove { my ( $self, $mod, $x, $y) = @_; unless ( $self-> {transaction}) { if ( abs( $self-> {guidelineX} - $x) < 3) { $self-> pointer(( abs( $self-> {guidelineY} - $y) < 3) ? cr::Move : cr::SizeWE); } elsif ( abs( $self-> {guidelineY} - $y) < 3) { $self-> pointer( cr::SizeNS); } else { $self-> pointer( cr::Arrow); } return; } if ( $self-> {transaction} == 1) { return if $self-> {dim}-> [0] == $x && $self-> {dim}-> [1] == $y; $self-> veil; $self-> {dim} = [ $x, $y]; $self-> veil; return; } if ( $VB::main-> {ini}-> {SnapToGrid}) { $x -= $x % 4; $y -= $y % 4; } if ( $self-> {transaction} == 2) { $self-> {guidelineX} = $x; $self-> text( $x); $_-> repaint for grep { $_-> {locked} } $self-> widgets; $self-> repaint; return; } if ( $self-> {transaction} == 3) { $self-> {guidelineY} = $y; $self-> text( $y); $_-> repaint for grep { $_-> {locked} } $self-> widgets; $self-> repaint; return; } if ( $self-> {transaction} == 4) { $self-> {guidelineY} = $y; $self-> {guidelineX} = $x; $self-> text( "$x:$y"); $_-> repaint for grep { $_-> {locked} } $self-> widgets; $self-> repaint; return; } } sub on_mouseup { my ( $self, $btn, $mod, $x, $y) = @_; return unless $self-> {transaction}; return unless $btn == mb::Left; $self-> capture(0); if ( $self-> {transaction} == 1) { $self-> veil; my @r = ( @{$self-> {anchor}}, @{$self-> {dim}}); ( $r[0], $r[2]) = ( $r[2], $r[0]) if $r[2] < $r[0]; ( $r[1], $r[3]) = ( $r[3], $r[1]) if $r[3] < $r[1]; $self-> {transaction} = $self-> {anchor} = $self-> {dim} = undef; for ( $self-> widgets) { my @x = $_-> rect; next if $x[0] < $r[0] || $x[1] < $r[1] || $x[2] > $r[2] || $x[3] > $r[3]; next if $_-> {locked}; $_-> marked(1); } ObjectInspector::update_markings(); return; } if ( $self-> {transaction} > 1 && $self-> {transaction} < 5) { $self-> {transaction} = undef; $self-> text( $self-> {saveHdr}); return; } } sub on_leave { $_[0]-> notify(q(MouseUp), mb::Left, 0, 0, 0) if $_[0]-> {transaction}; } sub dragMode { if ( $#_) { my ( $self, $dm) = @_; return if $dm == $self-> {dragMode}; $dm = 1 if $dm > 3 || $dm < 1; $self-> {dragMode} = $dm; } else { return $_[0]-> {dragMode}; } } sub dm_init { my ( $self, $widget) = @_; my $cr; if ( $self-> {dragMode} == 1) { $cr = cr::SizeWE; } elsif ( $self-> {dragMode} == 2) { $cr = cr::SizeNS; } else { $cr = cr::Move; } $widget-> pointer( $cr); } sub dm_next { my ( $self, $widget) = @_; $self-> dragMode( $self-> dragMode + 1); $self-> dm_init( $widget); } sub fm_resetguidelines { my $self = $VB::form; return unless $self; $self-> {guidelineX} = $self-> width / 2; $self-> {guidelineY} = $self-> height / 2; $self-> repaint; } sub fm_reclass { my $self = $VB::form; return unless $self; my @wijs = $VB::form-> marked_widgets; return unless scalar @wijs; my $cx = $wijs[0]; $self = $cx if $cx; my $lab_text = 'Class name'; $lab_text = "Temporary class for ".$self-> {realClass} if defined $self-> {realClass}; my $dlg = Prima::Dialog-> create( icon => $VB::ico, size => [ 429, 55], centered => 1, text => 'Change class', ); my ( $i, $b, $l) = $dlg-> insert([ InputLine => origin => [ 5, 5], size => [ 317, 20], text => $self-> {class}, ], [ Button => origin => [ 328, 4], size => [ 96, 36], text => '~Change', onClick => sub { $dlg-> ok }, default => 1, ], [ Label => origin => [ 5, 28], autoWidth => 0, size => [ 317, 20], text => $lab_text, ]); if ( $dlg-> execute == mb::OK) { $self-> {class} = $i-> text; delete $self-> {realClass}; } $dlg-> destroy; } sub marked_widgets { my $self = $_[0]; my @ret = (); for ( $self-> widgets) { push ( @ret, $_) if $_-> marked; } return @ret; } sub fm_subalign { my $self = $VB::form; return unless $self; my ( $forward) = @_; my @marked_widgets = $VB::form-> marked_widgets; return unless scalar @marked_widgets; my @sorted_widgets = sort { $a-> {creationOrder} <=> $b-> {creationOrder}} $VB::form-> widgets; my %marked = map { $_-> {creationOrder} => 1 } @marked_widgets; return if @sorted_widgets == scalar keys %marked; @marked_widgets = grep { exists $marked{$_-> {creationOrder}}} @sorted_widgets; my @new_indexes; push @new_indexes, grep { ! exists $marked{$_}} (0..$#sorted_widgets) if $forward; push @new_indexes, grep { exists $marked{$_}} (0..$#sorted_widgets); push @new_indexes, grep { ! exists $marked{$_}} (0..$#sorted_widgets) unless $forward; for ( my $i = 0; $i < @sorted_widgets; $i++) { $sorted_widgets[$new_indexes[$i]]-> {creationOrder} = $i; $sorted_widgets[$new_indexes[$i]]-> bring_to_front; } } sub fm_stepalign { my $self = $VB::form; return unless $self; my ($forward) = @_; my @marked_widgets = $VB::form-> marked_widgets; return unless scalar @marked_widgets; my @sorted_widgets = sort { $a-> {creationOrder} <=> $b-> {creationOrder}} $VB::form-> widgets; my %marked = map { $_-> {creationOrder} => 1 } @marked_widgets; my @marked_indexes = grep { exists $marked{$_}} (0..$#sorted_widgets); @marked_widgets = grep { exists $marked{$_-> {creationOrder}}} @sorted_widgets; return if @marked_indexes == @sorted_widgets; my @new_indexes; my $anchor; if ( $forward) { push @new_indexes, grep { ! exists $marked{$_}} (0..$marked_indexes[-1]); push @new_indexes, ($marked_indexes[-1]+1) if $marked_indexes[-1] < $#sorted_widgets; push @new_indexes, @marked_indexes; if ( $marked_indexes[-1] < $#sorted_widgets - 1) { push @new_indexes, ($marked_indexes[-1]+2..$#sorted_widgets); } } else { push @new_indexes, (0..$marked_indexes[0]-2) if $marked_indexes[0] > 1; push @new_indexes, @marked_indexes; my $anchor = @new_indexes; push @new_indexes, ($marked_indexes[0]-1) if $marked_indexes[0] > 0; push @new_indexes, grep { ! exists $marked{$_}} ($marked_indexes[0]..$#sorted_widgets); } for ( my $i = 0; $i < @sorted_widgets; $i++) { $sorted_widgets[$new_indexes[$i]]-> {creationOrder} = $i; $sorted_widgets[$new_indexes[$i]]-> bring_to_front; } } sub fm_realign { my $self = $VB::form; return unless $self; $_-> bring_to_front for sort { $a-> {creationOrder} <=> $b-> {creationOrder}} $VB::form-> widgets; } sub fm_duplicate { my $self = $VB::form; return unless $self; my @r = (); my %wjs = map { $_-> prf('name') => $_} ( $self, $self-> widgets); my @marked = $self-> marked_widgets; $self-> marked(0,1); for ( @marked) { my %prf = ( class => $_-> {class}, manualSelect => 1, profile => $_-> {profile}, ); $prf{realClass} = $_-> {realClass} if defined $_-> {realClass}; my $j = $self-> insert_new_control( $_-> left + 14, $_-> bottom + 14, $wjs{$_-> prf('owner')}, %prf); next unless $j; $j-> focus unless scalar @r; push ( @r, $j); $j-> marked(1,0); } ObjectInspector::update_markings(); } sub fm_selectall { return unless $VB::form; $_-> marked(1) for $VB::form-> widgets; ObjectInspector::update_markings(); } sub fm_delete { return unless $VB::form; $_-> destroy for $VB::form-> marked_widgets; ObjectInspector::renew_widgets(); } sub fm_copy { return if !$VB::form || ! scalar $VB::form-> marked_widgets; my $c = $VB::main-> write_form(1); $::application-> Clipboard-> text( $c); } sub fm_paste { return unless $VB::form; my @seq = $VB::main-> inspect_load_data( $::application-> Clipboard-> text, 0); return unless @seq; $VB::main-> wait; my $i; my %names = map { $_-> prf('name') => 1 } ( $VB::form, $VB::form-> widgets); my $main = $VB::form-> prf('name'); my %keymap; my $classes = $VB::main-> {classes}; for ( $i = 0; $i < scalar @seq; $i+= 2) { my ( $key, $hash) = ( $seq[$i], $seq[$i + 1]); # handling name clashes my $j = 0; $key = $seq[$i] . "_$j", $j++ while exists $names{$key}; $keymap{$seq[$i]} = $key; $hash-> {profile}-> {name} = $key; unless ( $classes-> {$hash-> {class}}) { $hash-> {realClass} = $hash-> {class}; $hash-> {class} = 'Prima::Widget'; } my $wclass = $classes-> {$hash-> {class}}-> {class}; my %handleTypes = map { $_ => 1} @{$wclass-> prf_types-> {Handle}}; for ( keys %{$hash-> {profile}}) { next unless exists $handleTypes{ $_}; my $mapv = $keymap{$hash-> {profile}-> {$_}}; $mapv = $main unless defined $mapv; $hash-> {profile}-> {$_} = defined($mapv) ? $mapv : $main; } $seq[$i] = $key; } $VB::form-> marked(0,1); @seq = $VB::main-> push_widgets( @seq); ObjectInspector::renew_widgets; $_-> notify(q(Load)) for @seq; $_-> marked( 1, 0) for @seq; ObjectInspector::update_markings(); } sub fm_creationorder { my $self = $VB::form; return unless $self; my %cos; my @names = (); $cos{$_-> {creationOrder}} = $_-> name for $self-> widgets; push( @names, $cos{$_}) for sort {$a <=> $b} keys %cos; return unless scalar @names; my $d = Prima::Dialog-> create( icon => $VB::ico, origin => [ 358, 396], size => [ 243, 325], text => 'Creation order', ); $d-> insert( [ Button => origin => [ 5, 5], size => [ 96, 36], text => '~OK', default => 1, modalResult => mb::OK, ], [ Button => origin => [ 109, 5], size => [ 96, 36], text => 'Cancel', modalResult => mb::Cancel, ], [ ListBox => origin => [ 5, 48], name => 'Items', size => [ 199, 269], items => \@names, focusedItem => 0, ], [ SpeedButton => origin => [ 209, 188], image => Prima::Icon-> create( width=>13, height=>13, type => im::bpp1, palette => [ 0,0,0,0,0,0], data => "\xff\xf8\x00\x00\x7f\xf0\x00\x00\x7f\xf0\x00\x00\?\xe0\x00\x00\?\xe0\x00\x00". "\x1f\xc0\x00\x00\x1f\xc0\x00\x00\x0f\x80\x00\x00\x0f\x80\x00\x00\x07\x00\x00\x00". "\x07\x00\x00\x00\x02\x00\x00\x00\x02\x00\x00\x00". ''), size => [ 29, 130], onClick => sub { my $i = $d-> Items; my $fi = $i-> focusedItem; return if $fi < 1; my @i = @{$i-> items}; @i[ $fi - 1, $fi] = @i[ $fi, $fi - 1]; $i-> items( \@i); $i-> focusedItem( $fi - 1); }, ], [ SpeedButton => origin => [ 209, 48], image => Prima::Icon-> create( width=>13, height=>13, type => im::bpp1, palette => [ 0,0,0,0,0,0], data => "\x02\x00\x00\x00\x02\x00\x00\x00\x07\x00\x00\x00\x07\x00\x00\x00\x0f\x80\x00\x00". "\x0f\x80\x00\x00\x1f\xc0\x00\x00\x1f\xc0\x00\x00\?\xe0\x00\x00\?\xe0\x00\x00". "\x7f\xf0\x00\x00\x7f\xf0\x00\x00\xff\xf8\x00\x00". ''), size => [ 29, 130], onClick => sub { my $i = $d-> Items; my $fi = $i-> focusedItem; my $c = $i-> count; return if $fi >= $c - 1; my @i = @{$i-> items}; @i[ $fi + 1, $fi] = @i[ $fi, $fi + 1]; $i-> items( \@i); $i-> focusedItem( $fi + 1); }, ]); if ( $d-> execute != mb::Cancel) { my $cord = 1; $self-> bring( $_)-> {creationOrder} = $cord++ for @{$d-> Items-> items}; } $d-> destroy; } sub fm_toggle_lock { my $self = $VB::form; return unless $self; my @w = $self-> marked_widgets; my $unlock = not grep { $_-> {locked} } @w; $_-> {locked} = $unlock for @w; $self-> marked(0,1) if $unlock; $_-> repaint for @w; } sub prf_icon { $_[0]-> icon( $_[1]); } sub prf_menuItems { local $_[0]-> {syncRecting}; $_[0]-> {syncRecting} = 'height'; $_[0]-> menuItems( $_[1]); } package MainPanel; use strict; use vars qw(@ISA *do_layer); @ISA = qw(Prima::Window); sub profile_default { my $def = $_[ 0]-> SUPER::profile_default; my %prf = ( text => $::application-> name, width => $::application-> width - 12, left => 6, bottom => $::application-> height - 106 - $::application-> get_system_value(sv::YTitleBar) - $::application-> get_system_value(sv::YMenu), sizeDontCare => 0, originDontCare => 0, height => 100, icon => $VB::ico, menuItems => [ ['~File' => [ ['newitem' => '~New' => 'Ctrl+N' => '^N' => sub {$_[0]-> new;}], ['openitem' => '~Open' => 'Ctrl+O' => '^O' => sub {$_[0]-> open;}], ['-saveitem1' => '~Save' => 'Ctrl+S' => '^S' => sub {$_[0]-> save;}], ['-saveitem2' =>'Save ~as...' => sub {$_[0]-> saveas;}], ['closeitem' =>'~Close' => 'Ctrl+W' => '^W' => sub { $VB::form-> close if $VB::form}], [], ['E~xit' => 'Ctrl+Q' => '^Q' => sub{$_[0]-> close;}], ]], ['edit' => '~Edit' => [ ['Cop~y' => 'Ctrl+C' => '^C' => sub { Form::fm_copy(); }], ['~Paste' => 'Ctrl+V' => '^V' => sub { Form::fm_paste(); }], ['~Delete' => 'Ctrl-X' => '^X' => sub { Form::fm_delete(); } ], ['~Select all' => 'Ctrl+A' => '^A' => sub { Form::fm_selectall(); }], ['D~uplicate' => 'Ctrl+D' => '^D' => sub { Form::fm_duplicate(); }], [], ['~Align' => [ ['~Bring to front' => 'Shift+PgUp' => km::Shift|kb::PgUp, sub { Form::fm_subalign(1);}], ['~Send to back' => 'Shift+PgDn' => km::Shift|kb::PgDn, sub { Form::fm_subalign(0);}], ['Step ~forward' => 'Ctrl+PgUp' => km::Ctrl|kb::PgUp, sub { Form::fm_stepalign(1);}], ['Step bac~k' => 'Ctrl+PgDn' => km::Ctrl|kb::PgDn, sub { Form::fm_stepalign(0);}], ['~Restore order' => 'Shift+Ctrl+PgDn' => km::Shift|km::Ctrl|kb::PgDn, sub { Form::fm_realign;}], ]], ['~Change class...' => sub { Form::fm_reclass();}], ['Creation ~order' => sub { Form::fm_creationorder(); } ], ['To~ggle lock' => 'Ctrl+G' => '^G' => sub { Form::fm_toggle_lock(); }], ]], ['~View' => [ ['~Object Inspector' => 'F11' => 'F11' => sub { $_[0]-> bring_inspector; }], ['~Code editor' => 'F12' => 'F12' => sub { $_[0]-> bring_code_editor; }], ['Co~lor dialog' => q(bring_color_dialog) ], ['~Font dialog' => q(bring_font_dialog) ], ['~Add widgets...' => q(add_widgets)], [], ['Reset ~guidelines' => sub { Form::fm_resetguidelines(); } ], ['*gsnap' => 'Snap to guid~elines' => sub { $VB::main-> {ini}-> {SnapToGuidelines} = $VB::main-> menu-> toggle( 'gsnap') ? 1 : 0; } ], ['*dsnap' => 'Snap to gri~d' => sub { $VB::main-> {ini}-> {SnapToGrid} = $VB::main-> menu-> toggle( 'dsnap') ? 1 : 0; } ], [], ['-runitem' => '~Run' => 'Ctrl+F9' => '^F9' => \&form_run ], ['-breakitem' => '~Break' => \&form_cancel ], ]], [], ['~Help' => [ ['~About' => sub { Prima::MsgBox::message("Visual Builder for Prima toolkit, version $VBVersion")}], ['~Help' => 'F1' => 'F1' => sub { $::application-> open_help('VB/Help')}], ['~Widget property' => 'Shift+F1' => '#F1' => sub { ObjectInspector::help_lookup() }], ]], ], ); @$def{keys %prf} = values %prf; return $def; } sub init { my $self = shift; my %profile = $self-> SUPER::init(@_); my @r = ( $lite || $singleConfig) ? Prima::VB::CfgMaint::open_cfg : Prima::VB::CfgMaint::read_cfg; die "Error:$r[1]\n" unless $r[0]; my %classes = %Prima::VB::CfgMaint::classes; my @pages = @Prima::VB::CfgMaint::pages; $self-> set( sizeMin => [ 350, $self-> height], sizeMax => [ 16384, $self-> height], ); $self-> {newbutton} = $self-> insert( SpeedButton => origin => [ 4, $self-> height - 30], size => [ 26, 26], hint => 'New', imageFile => Prima::Utils::find_image( 'VB::VB.gif').':1', glyphs => 2, onClick => sub { $VB::main-> new; } , ); $self-> {openbutton} = $self-> insert( SpeedButton => origin => [ 32, $self-> height - 30], size => [ 26, 26], hint => 'Open', imageFile => Prima::Utils::find_image( 'VB::VB.gif').':2', glyphs => 2, onClick => sub { $VB::main-> open; } , ); $self-> {savebutton} = $self-> insert( SpeedButton => origin => [ 60, $self-> height - 30], size => [ 26, 26], hint => 'Save', imageFile => Prima::Utils::find_image( 'VB::VB.gif').':3', glyphs => 2, onClick => sub { $VB::main-> save; } , ); $self-> {runbutton} = $self-> insert( SpeedButton => origin => [ 88, $self-> height - 30], size => [ 26, 26], hint => 'Run', imageFile => Prima::Utils::find_image( 'VB::VB.gif').':4', glyphs => 2, onClick => sub { $VB::main-> form_run} , ); $self-> {tabset} = $self-> insert( TabSet => left => 150, name => 'TabSet', top => $self-> height, width => $self-> width - 150, growMode => gm::Ceiling, topMost => 1, tabs => [ @pages], buffered => 1, delegations => [qw(Change)], ); $self-> {nb} = $self-> insert( Widget => origin => [ 150, 0], size => [$self-> width - 150, $self-> height - $self-> {tabset}-> height], growMode => gm::Client, name => 'TabbedNotebook', onPaint => sub { my ( $self, $canvas) = @_; my @sz = $self-> size; $canvas-> rect3d(0,0,$sz[0]-1,$sz[1],1, $self-> light3DColor,$self-> dark3DColor,$self-> backColor); }, ); $self-> {nbpanel} = $self-> {nb}-> insert( Notebook => origin => [12,1], size => [$self-> {nb}-> width-24,44], growMode => gm::Floor, backColor => cl::Gray, name => 'NBPanel', onPaint => sub { my ( $self, $canvas) = @_; my @sz = $self-> size; $canvas-> rect3d(0,0,$sz[0]-1,$sz[1]-1, 1,cl::Black,cl::Black,$self-> backColor); my $i = 0; $canvas-> rectangle($i-38,2,$i,40) while (($i+=40)<($sz[0]+36)); }, ); $self-> {leftScroll} = $self-> {nb}-> insert( SpeedButton => origin => [1,5], size => [11,36], name => 'LeftScroll', autoRepeat => 1, onPaint => sub { $_[0]-> on_paint( $_[1]); $_[1]-> color( $_[0]-> enabled ? cl::Black : cl::Gray); $_[1]-> fillpoly([7,4,7,32,3,17]); }, delegations => [ $self, qw(Click)], ); $self-> {rightScroll} = $self-> {nb}-> insert( SpeedButton => origin => [$self-> {nb}-> width-11,5], size => [11,36], name => 'RightScroll', growMode => gm::Right, autoRepeat => 1, onPaint => sub { $_[0]-> on_paint( $_[1]); $_[1]-> color( $_[0]-> enabled ? cl::Black : cl::Gray); $_[1]-> fillpoly([3,4,3,32,7,17]); }, delegations => [ $self, qw(Click)], ); $self-> {classes} = \%classes; $self-> {pages} = \@pages; $self-> {gridAlert} = 5; my $font = $self-> font; $self-> {iniFile} = Prima::IniFile-> create( file => Prima::Utils::path('VisualBuilder'), default => [ 'View' => [ 'SnapToGrid' => 1, 'SnapToGuidelines' => 1, 'ObjectInspectorVisible' => 1, 'ObjectInspectorRect' => '-1 -1 -1 -1', 'CodeEditorVisible' => 0, 'CodeEditorRect' => '-1 -1 -1 -1', 'MainPanelRect' => '-1 -1 -1 -1', 'OpenPath' => '.', 'SavePath' => '.', ], 'Editor' => [ 'syntaxHilite' => 1, 'autoIndent' => 1, 'persistentBlock' => 0, 'blockType' => 0, 'FontName' => $font-> name, 'FontSize' => $font-> size, 'FontStyle' => $font-> style, 'FontEncoding' => $font-> encoding, ] ], ); my $i = $self-> {ini} = $self-> {iniFile}-> section( 'View' ); $self-> menu-> dsnap-> checked( $i-> {SnapToGrid}); $self-> menu-> gsnap-> checked( $i-> {SnapToGuidelines}); $self-> init_position( $self, 'MainPanelRect'); return %profile; } sub on_create { $_[0]-> reset_tabs; } sub on_close { return unless $VB::form; $_[0]-> clear_event, return if !$VB::form-> close; } sub on_destroy { $_[0]-> {ini}-> {MainPanelRect} = join( ' ', $_[0]-> rect); my @rx = ( $_[0]-> {ini}-> {ObjectInspectorVisible} = ( $VB::inspector ? 1 : 0)) ? $VB::inspector-> rect : ((-1)x4); $_[0]-> {ini}-> {ObjectInspectorRect} = join( ' ', @rx); @rx = ( $_[0]-> {ini}-> {CodeEditorVisible} = ( $VB::editor ? 1 : 0)) ? $VB::editor-> rect : ((-1)x4); $_[0]-> {ini}-> {CodeEditorRect} = join( ' ', @rx); $_[0]-> {ini}-> {OpenPath} = $openFileDlg-> directory if $openFileDlg; $_[0]-> {ini}-> {SavePath} = $saveFileDlg-> directory if $saveFileDlg; $VB::editor-> close if $VB::editor; $VB::main = undef; $::application-> close; } sub reset_tabs { my $self = $_[0]; my $nb = $self-> {nbpanel}; $nb-> lock; $_-> destroy for $nb-> widgets; $self-> {tabset}-> tabs( $self-> {pages}); $self-> {tabset}-> tabIndex(0); $nb-> pageCount( scalar @{$self-> {pages}}); my %offsets = (); my %pagofs = (); my %modules = (); my $i=0; $pagofs{$_} = $i++ for @{$self-> {pages}}; $modules{$self-> {classes}-> {$_}-> {module}}=1 for keys %{$self-> {classes}}; for ( keys %modules) { my $c = $_; eval("use $c;"); if ( $@) { Prima::MsgBox::message( "Error loading module $_:$@"); $modules{$_} = 0; } } my %iconfails = (); my %icongtx = (); for ( keys %{$self-> {classes}}) { my ( $class, %info) = ( $_, %{$self-> {classes}-> {$_}}); $offsets{$info{page}} = 4 unless exists $offsets{$info{page}}; next unless $modules{$info{module}}; my $i = undef; if ( $info{icon}) { $info{icon} =~ s/\:(\d+)$//; my @parms = ( Prima::Utils::find_image( $info{icon})); push( @parms, 'index', $1) if defined $1; $i = Prima::Icon-> create; unless ( defined $parms[0] && $i-> load( @parms)) { $iconfails{$info{icon}} = 1; $i = undef; } }; my $j = $nb-> insert_to_page( $pagofs{$info{page}}, SpeedButton => hint => $class, name => 'ClassSelector', image => $i, origin => [ $offsets{$info{page}}, 4], size => [ 36, 36], delegations => [$self, qw(Click)], ); $j-> {orgLeft} = $offsets{$info{page}}; $j-> {className} = $class; $offsets{$info{page}} += 40; } $self-> {nbIndex} = 0; $nb-> unlock; $self-> {currentClass} = undef; if ( scalar keys %iconfails) { my @x = keys %iconfails; Prima::MsgBox::message( "Error loading images: @x"); } } sub add_widgets { my $self = $_[0]; my $d = VB::open_dialog( filter => [['Packages' => '*.pm'], [ 'All files' => '*']], ); return unless $d-> execute; my @r = Prima::VB::CfgMaint::add_module( $d-> fileName); Prima::MsgBox::message( "Error:$r[1]"), return unless $r[0]; $self-> {classes} = {%Prima::VB::CfgMaint::classes}; $self-> {pages} = [@Prima::VB::CfgMaint::pages]; $self-> reset_tabs; @r = Prima::VB::CfgMaint::write_cfg; Prima::MsgBox::message( "Error: $r[1]"), return unless $r[0]; } sub get_nbpanel_count { return $_[0]-> {nbpanel}-> widgets_from_page($_[0]-> {nbpanel}-> pageIndex); } sub set_nbpanel_index { my ( $self, $idx) = @_; return if $idx < 0; my $nb = $self-> {nbpanel}; my @wp = $nb-> widgets_from_page( $nb-> pageIndex); return if $idx >= scalar @wp; for ( @wp) { $_-> left( $_-> {orgLeft} - $idx * 40); } $self-> {nbIndex} = $idx; } sub LeftScroll_Click { $_[0]-> set_nbpanel_index( $_[0]-> {nbIndex} - 1); } sub RightScroll_Click { $_[0]-> set_nbpanel_index( $_[0]-> {nbIndex} + 1); } sub ClassSelector_Click { $_[0]-> {currentClass} = $_[1]-> {className}; } sub TabSet_Change { my $self = $_[0]; my $nb = $self-> {nbpanel}; $nb-> pageIndex( $_[1]-> tabIndex); $self-> set_nbpanel_index(0); } sub get_typerec { my ( $self, $type, $valPtr) = @_; unless ( defined $type) { my $rwx = 'fallback'; if ( defined $valPtr && defined $$valPtr) { if ( ref($$valPtr)) { if (( ref($$valPtr) eq 'ARRAY') || ( ref($$valPtr) eq 'HASH')) { } elsif ( $$valPtr-> isa('Prima::Icon')) { $rwx = 'icon'; } elsif ( $$valPtr-> isa('Prima::Image')) { $rwx = 'image'; } } } return "Prima::VB::Types::$rwx"; } $self-> {typerecs} = () unless exists $self-> {typerecs}; my $t = $self-> {typerecs}; return $t-> {$type} if exists $t-> {type}; my $ns = \%Prima::VB::Types::; my $rwx = exists $ns-> {$type.'::'} ? $type : 'fallback'; $rwx = 'Prima::VB::Types::'.$rwx; $t-> {$type} = $rwx; return $rwx; } sub new { my $self = $_[0]; return if $VB::form and !$VB::form-> close; $VB::form = Form-> create; $VB::main-> {fmName} = undef; ObjectInspector::renew_widgets; update_menu(); } sub inspect_load_data { my ($self, $data, $asFile) = @_; my @preload_modules; my $fn = ( $asFile ? $data : "input data"); if ( $asFile) { unless (CORE::open( F, "< $data")) { Prima::MsgBox::message( "Error loading " . $data); return; } local $/; $data = ; close F; } my @d = split( "\n", $data); undef $data; if ( !defined($d[0]) || !($d[0] =~ /^# VBForm/ )) { INV: Prima::MsgBox::message("Invalid format of $fn"); return; } my @fvc = Prima::VB::VBLoader::check_version( $d[0]); Prima::MsgBox::message("Incompatible file format version ($fvc[1]) of $fn.\nBugs possible!", mb::Warning|mb::OK) unless $fvc[0]; shift @d; my $i; for ( $i = 0; $i < scalar @d; $i++) { last unless $d[$i] =~ /^#/; next unless $d[$i] =~ /^#\s*\[([^\]]+)\](.*)$/; if ( $1 eq 'preload') { push( @preload_modules, split( ' ', $2)); } } goto INV if $i >= scalar @d; for ( @preload_modules) { eval "use $_;"; next unless $@; Prima::MsgBox::message( "Error loading module $_:$@"); return; } $Prima::VB::VBLoader::builderActive = 1; my $sub = eval( join( "\n", @d[$i..$#d])); $Prima::VB::VBLoader::builderActive = 0; if ( $@ || ref($sub) ne 'CODE') { Prima::MsgBox::message("Error loading $fn:$@"); return; } $Prima::VB::VBLoader::builderActive = 1; my @ret = $sub-> (); $Prima::VB::VBLoader::builderActive = 0; return @ret; } sub preload_modules { my $self = shift; } sub push_widgets { my $self = shift; my $classes = $self-> {classes}; my $callback = shift if $_[0] && ref($_[0]) eq 'CODE'; my @seq = @_; my $main = $VB::form-> prf('name'); my %owners = ( $main => ''); my %widgets = ( $main => $VB::form); my @return; my %dep; my $i; for ( $i = 0; $i < scalar @seq; $i+= 2) { $dep{$seq[$i]} = $seq[$i + 1]; } for ( keys %dep) { $owners{$_} = exists $dep{$_}-> {profile}-> {owner} ? $dep{$_}-> {profile}-> {owner} : $main; } local *do_layer = sub { my $id = $_[0]; my $i; for ( $i = 0; $i < scalar @seq; $i += 2) { $_ = $seq[$i]; next unless $owners{$_} eq $id; eval "use $dep{$_}->{module};"; Prima::message("Error loading $dep{$_}->{module}:$@"), next if "$@"; my $c = $VB::form-> insert( $classes-> {$dep{$_}-> {class}}-> {class}, realClass => $dep{$_}-> {realClass}, class => $dep{$_}-> {class}, module => $dep{$_}-> {module}, extras => $dep{$_}-> {extras}, creationOrder => $i / 2, ); push ( @return, $c); if ( exists $dep{$_}-> {profile}-> {origin}) { my @norg = @{$dep{$_}-> {profile}-> {origin}}; unless ( exists $widgets{$owners{$_}}) { # validating owner entry $owners{$_} = $main; $dep{$_}-> {profile}-> {owner} = $main; } my @ndelta = $owners{$_} eq $main ? (0,0) : ( $widgets{$owners{$_}}-> left, $widgets{$owners{$_}}-> bottom ); $norg[$_] += $ndelta[$_] for 0..1; $dep{$_}-> {profile}-> {origin} = \@norg; } $c-> prf_set( %{$dep{$_}-> {profile}}); $widgets{$_} = $c; $callback-> ( $self) if $callback; &do_layer( $_); } }; &do_layer( $main, \%owners); return @return; } sub load_file { my ($self,$fileName) = @_; $VB::form-> destroy if $VB::form; $VB::form = undef; update_menu(); my @seq = $self-> inspect_load_data( $fileName, 1); return unless @seq; $self-> {fmName} = $fileName; $VB::main-> wait; my ( $i, $mf, $main, $fmindex); my $classes = $self-> {classes}; for ( $i = 0; $i < scalar @seq; $i+= 2) { my $hash = $seq[$i + 1]; if ( $hash-> {parent}) { $main = $seq[$i]; $mf = $seq[$i+1]; $fmindex = $i; } unless ( $classes-> {$hash-> {class}}) { $hash-> {realClass} = $hash-> {class}; $hash-> {class} = $hash-> {parent} ? 'Prima::Window' : 'Prima::Widget'; } } defined($main) ? splice( @seq, $fmindex, 2) : ( $main = 'Form1', $mf = {}); my $oldtxt = $self-> text; my $maxwij = scalar(@seq) / 2; $self-> text( "Loading..."); $VB::form = Form-> create( realClass => $mf-> {realClass}, class => $mf-> {class}, module => $mf-> {module}, extras => $mf-> {extras}, creationOrder => 0, visible => 0, ); if ( exists $mf-> {code}) { if ( $@) { Prima::MsgBox::message("Error loading $fileName: $@"); } else { $VB::code = $mf-> {code}; if ( $VB::editor) { $VB::editor-> Editor-> textRef( \$VB::code ); $VB::editor-> {modified} = 0; } } } $VB::form-> prf_set( %{$mf-> {profile}}); $VB::inspector-> {selectorChanging} = 1 if $VB::inspector; my $loaded; $self-> push_widgets( sub { $loaded++; $self-> text( sprintf( "Loaded %d%%", ($loaded / $maxwij) * 100)); }, @seq); $VB::form-> show; $VB::inspector-> {selectorChanging}-- if $VB::inspector; ObjectInspector::renew_widgets; update_menu(); $self-> text( $oldtxt); $VB::form-> notify(q(Load)); $_-> notify(q(Load)) for $VB::form-> widgets; } sub open { my $self = $_[0]; return if $VB::form and !$VB::form-> can_close; my $d = VB::open_dialog( filter => [['Form files' => '*.fm'], [ 'All files' => '*']], ); return unless $d-> execute; $self-> load_file( $d-> fileName); } sub write_form { my ( $self, $partialExport) = @_; $VB::writeMode = 0; my @cmp = $partialExport ? $VB::form-> marked_widgets : $VB::form-> widgets; my %preload_modules; my $header = < prf( 'name'); push( @cmp, $VB::form) unless $partialExport; @cmp = sort { $a-> {creationOrder} <=> $b-> {creationOrder}} @cmp; for ( @cmp) { my ( $class, $module) = @{$_}{'class','module'}; $class = $_-> {realClass} if defined $_-> {realClass}; my $types = $_-> {types}; my $name = $_-> prf( 'name'); $Prima::VB::VBLoader::eventContext[0] = $name; $c .= < { \t\tclass => '$class', \t\tmodule => '$module', MEDI if ( $_ == $VB::form) { CodeEditor::sync_code; $c .= "\t\tparent => 1,\n"; $c .= "\t\tcode => Prima::VB::VBLoader::GO_SUB(\'". Prima::VB::Types::generic::quotable($VB::code). "'),\n"; } my %extras = $_-> ext_profile; if ( scalar keys %extras) { $c .= "\t\textras => {\n"; for ( keys %extras) { my $val = $extras{$_}; my $type = $self-> get_typerec( $types-> {$_}, \$val); $val = defined($val) ? $type-> write( $_, $val) : 'undef'; $c .= "\t\t$_ => $val,\n"; } $c .= "\t\t},\n"; } %extras = $_-> act_profile; if ( scalar keys %extras) { $c .= "\t\tactions => {\n"; for ( keys %extras) { my $val = $extras{$_}; my $type = $self-> get_typerec( $types-> {$_}, \$val); $val = defined($val) ? $type-> write( $_, $val) : 'undef'; $c .= "\t\t$_ => $val,\n"; } $c .= "\t\t},\n"; } my %Handle_props = map { $_ => 1 } $_-> {prf_types}-> {Handle} ? @{$_-> {prf_types}-> {Handle}} : (); delete $Handle_props{owner}; if ( scalar keys %Handle_props) { $c .= "\t\tsiblings => [qw(" . join(' ', keys %Handle_props) . ")],\n"; } $c .= "\t\tprofile => {\n"; my ( $x,$prf) = ($_, $_-> {profile}); my @o = $_-> get_o_delta; for( keys %{$prf}) { my $val = $prf-> {$_}; if ( $_ eq 'origin' && defined $val) { my @nval = ( $$val[0] - $o[0], $$val[1] - $o[1], ); $val = \@nval; } my $type = $self-> get_typerec( $types-> {$_}, \$val); $val = defined($val) ? $type-> write( $_, $val) : 'undef'; $preload_modules{$_} = 1 for $type-> preload_modules(); $c .= "\t\t\t$_ => $val,\n"; } $c .= "\t}},\n"; } $c .= < prf( 'name'); my @cmp = $VB::form-> widgets; $VB::writeMode = 1; my $header = < {module} => 1 } @cmp; CodeEditor::sync_code; my $c = < SUPER::profile_default; my \%prf = ( PREHEAD my $prf = $VB::form-> {profile}; my $types = $VB::form-> {types}; for ( keys %$prf) { my $val = $prf-> {$_}; my $type = $self-> get_typerec( $types-> {$_}, \$val); $val = defined($val) ? $type-> write( $_, $val) : 'undef'; $c .= "\t\t$_ => $val,\n"; } # size/origin have lower priority than width/left etc if ( not($prf-> {sizeDontCare}) and exists $prf->{size}) { my @s = @{$prf->{size}}; $c .= "\t\twidth => $s[0],\n\t\theight => $s[1],\n"; } if ( not($prf-> {originDontCare}) and exists $prf->{origin}) { my @o = @{$prf->{origin}}; $c .= "\t\tleft => $o[0],\n\t\tbottom => $o[1],\n"; } my @ds = ( $::application-> font-> width, $::application-> font-> height); $c .= "\t\tdesignScale => [ $ds[0], $ds[1]],\n"; $c .= < {}} @actNames; my @initInstances; for ( @cmp, $VB::form) { my $key = $_-> prf('name'); my %act = $_-> act_profile; next unless scalar keys %act; push ( @initInstances, $key); for ( @actNames) { next unless exists $act{$_}; my $aname = "${_}_$key"; $actions{$_}-> {$key} = $aname; my $asub = join( "\n\t", split( "\n", $act{$_})); $c .= "sub $aname {\n\t$asub\n}\n\n"; } } $c .= < {}} qw(@initInstances); HEAD3 for ( @initInstances) { my $obj = ( $_ eq $main) ? $VB::form : $VB::form-> bring($_); my %extras = $obj-> ext_profile; next unless scalar keys %extras; $c .= "\t\$instances{$_}->{extras} = {\n"; for ( keys %extras) { my $val = $extras{$_}; my $type = $self-> get_typerec( $types-> {$_}, \$val); $val = defined($val) ? $type-> write( $_, $val) : 'undef'; $c .= "\t\t$_ => $val,\n"; } $c .= "\t};\n"; } $c .= "\t".$actions{onBegin}->{$_}."(q($_), \$instances{$_});\n" for keys %{$actions{onBegin}}; $c .= < SUPER::init(\@_); my \%names = ( q($main) => \$self); \$self-> lock; HEAD4 @cmp = sort { $a-> {creationOrder} <=> $b-> {creationOrder}} @cmp; my %names = ( $main => 1 ); my @re_cmp = (); $c .= "\t".$actions{onFormCreate}->{$_}."(q($_), \$instances{$_}, \$self);\n" for keys %{$actions{onFormCreate}}; $c .= "\t".$actions{onCreate}->{$main}."(q($main), \$instances{$main}, \$self);\n" if $actions{onCreate}->{$main}; AGAIN: for ( @cmp) { my $owner = $_-> prf('owner'); unless ( $names{$owner}) { push @re_cmp, $_; next; } my ( $class, $module) = @{$_}{'class','module'}; $class = $_-> {realClass} if defined $_-> {realClass}; my $types = $_-> {types}; my $name = $_-> prf( 'name'); $names{$name} = 1; $c .= "\t".$actions{onChild}-> {$owner}. "(q($owner), \$instances{$owner}, \$names{$owner}, q($name));\n" if $actions{onChild}-> {$owner}; $c .= "\t\$names{$name} = \$names{$owner}-> insert( qq($class) => \n"; my ( $x,$prf) = ($_, $_-> {profile}); my @o = $_-> get_o_delta; for ( keys %{$prf}) { my $val = $prf-> {$_}; if ( $_ eq 'origin' && defined $val) { my @nval = ( $$val[0] - $o[0], $$val[1] - $o[1], ); $val = \@nval; } next if $_ eq 'owner'; my $type = $self-> get_typerec( $types-> {$_}, \$val); $val = defined($val) ? $type-> write( $_, $val) : 'undef'; $modules{$_} = 1 for $type-> preload_modules(); $c .= "\t\t$_ => $val,\n"; } $c .= "\t);\n"; $c .= "\t".$actions{onCreate}-> {$name}. "(q($name), \$instances{$name}, \$names{$name});\n" if $actions{onCreate}-> {$name}; $c .= "\t".$actions{onChildCreate}-> {$owner}. "(q($owner), \$instances{$owner}, \$names{$owner}, \$names{$name});\n" if $actions{onChildCreate}-> {$owner}; } if ( scalar @re_cmp) { @cmp = @re_cmp; @re_cmp = (); goto AGAIN; } $c .= "\t".$actions{onEnd}-> {$_}."(q($_), \$instances{$_}, \$names{$_});\n" for keys %{$actions{onEnd}}; $c .= < unlock; return \%profile; } package ${main}Auto; use Prima::Application; ${main}Window-> create; run Prima; POSTHEAD $header .= "use $_;\n" for sort keys %modules; $VB::writeMode = 0; return $header.$c; } sub save { my ( $self, $asPL) = @_; return 0 unless $VB::form; return $self-> saveas unless defined $self-> {fmName}; if ( CORE::open( F, ">".$self-> {fmName})) { local $/; $VB::main-> wait; my $c = $asPL ? $self-> write_PL : $self-> write_form; print F $c; } else { Prima::MsgBox::message("Error saving ".$self-> {fmName}); return 0; } close F; $VB::form-> {modified} = undef unless $asPL; $VB::editor-> {modified} = 0 if $VB::editor && !$asPL; return 1; } sub saveas { my $self = $_[0]; return 0 unless $VB::form; my $d = VB::save_dialog( filter => [ ['Form files' => '*.fm'], ['Program scratch' => '*.pl'], [ 'All files' => '*'] ], ); $self-> {saveFileDlg} = $d; return 0 unless $d-> execute; my $fn = $d-> fileName; my $asPL = ($d-> filterIndex == 1); my $ofn = $self-> {fmName}; $self-> {fmName} = $fn; $self-> save( $asPL); $self-> {fmName} = $ofn if $asPL; return 1; } sub update_menu { return unless $VB::main; my $m = $VB::main-> menu; my $a = $::application-> accelTable; my $f = (defined $VB::form) ? 1 : 0; my $r = (defined $VB::main-> {running}) ? 1 : 0; $m-> enabled( 'runitem', $f && !$r); $a-> enabled( 'runitem', $f && !$r); $m-> enabled( 'newitem', !$r); $m-> enabled( 'openitem', !$r); $a-> enabled( 'openitem', !$r); $m-> enabled( 'saveitem1', $f); $a-> enabled( 'saveitem1', $f); $m-> enabled( 'saveitem2', $f); $m-> enabled( 'closeitem', $f); $m-> enabled( 'breakitem', $f && $r); $VB::main-> {runbutton}-> enabled( $f && !$r); $VB::main-> {openbutton}-> enabled( !$r); $VB::main-> {newbutton}-> enabled( !$r); $VB::main-> {savebutton}-> enabled( $f); } sub update_markings { } sub form_cancel { if ( $VB::main) { if ( $VB::main-> {topLevel}) { for ( $::application-> get_components) { next if $VB::main-> {topLevel}-> {"$_"}; eval { $_-> destroy; }; } $VB::main-> {topLevel} = undef; } return unless $VB::main-> {running}; $VB::main-> {running}-> destroy; $VB::main-> {running} = undef; update_menu(); } $VB::form-> show if $VB::form; $VB::inspector-> show if $VB::inspector; $VB::editor-> show if $VB::editor; } sub form_run { my $self = $_[0]; return unless $VB::form; if ( $VB::main-> {running}) { $VB::main-> {running}-> destroy; $VB::main-> {running} = undef; } $VB::main-> wait; my $c = $self-> write_form; my $okCreate = 0; $VB::main-> {topLevel} = { map { ("$_" => 1) } $::application-> get_components }; @Prima::VB::VBLoader::eventContext = ('', ''); eval{ local $SIG{__WARN__} = sub { return if $_[0] =~ /^Subroutine.*redefined/; die $_[0] }; my $sub = eval("$c"); die "Error loading module $@" if $@; my @d = $sub-> (); my %r = Prima::VB::VBLoader::AUTOFORM_REALIZE( \@d, {}); my $f = $r{$VB::form-> prf('name')}; $okCreate = 1; if ( $f) { $f-> set( onClose => \&form_cancel ); $VB::main-> {running} = $f; update_menu(); $f-> select; $VB::form-> hide; $VB::inspector-> hide if $VB::inspector; $VB::editor-> hide if $VB::editor; }; }; if ( $@) { my $msg = "$@"; $msg =~ s/ \(eval \d+\)//g; if ( defined( $Prima::VB::VBLoader::eventContext[0]) && length ($Prima::VB::VBLoader::eventContext[0])) { $VB::main-> bring_inspector; $VB::main-> {topLevel}-> { "$VB::inspector" } = 1; $VB::inspector-> Selector-> text( $Prima::VB::VBLoader::eventContext[0]); if ( $Prima::VB::VBLoader::eventContext[0] eq $VB::inspector-> Selector-> text && length($Prima::VB::VBLoader::eventContext[1])) { $VB::inspector-> set_monger_index(1); my $list = $VB::inspector-> {currentList}; my $ix = $list-> {index}-> {$Prima::VB::VBLoader::eventContext[1]}; if ( defined $ix) { $list-> focusedItem( $ix); $VB::inspector-> {panel}-> select; } } } Prima::MsgBox::message( $msg); for ( $::application-> get_components) { next if $VB::main-> {topLevel}-> {"$_"}; eval { $_-> destroy; }; } $VB::main-> {topLevel} = undef; } } sub wait { my $t = $_[0]-> insert( Timer => timeout => 10, onTick => sub { $::application-> pointer( $_[0]-> {savePtr}); $_[0]-> destroy; }); $t-> {savePtr} = $::application-> pointer; $::application-> pointer( cr::Wait); $t-> start; } sub bring_inspector { if ( $VB::inspector) { $VB::inspector-> restore if $VB::inspector-> windowState == ws::Minimized; $VB::inspector-> bring_to_front; $VB::inspector-> select; } else { $VB::inspector = ObjectInspector-> create; ObjectInspector::renew_widgets; } } sub bring_code_editor { if ( $VB::editor) { $VB::editor-> restore if $VB::editor-> windowState == ws::Minimized; $VB::editor-> bring_to_front; $VB::editor-> select; } else { $VB::editor = CodeEditor-> create; } } sub bring_font_dialog { if ( $VB::font_dialog) { $VB::font_dialog-> restore if $VB::font_dialog-> windowState == ws::Minimized; } else { $VB::font_dialog = Prima::FontDialog-> new( borderIcons => bi::All & ~bi::Maximize, taskListed => 1, onDestroy => sub { $VB::font_dialog = undef }, ); my $y; for ( $VB::font_dialog-> widgets) { next unless $_-> isa("Prima::Button") and $_-> text =~ /ok|cancel/i; $y = $_-> right; $_-> set( visible => 0, enabled => 0); } $VB::font_dialog-> Size-> set( left => $VB::font_dialog-> Size-> left, right => $y ); $VB::font_dialog-> visible(1); } $VB::font_dialog-> bring_to_front; $VB::font_dialog-> select; } sub bring_color_dialog { if ( $VB::color_dialog) { $VB::color_dialog-> restore if $VB::color_dialog-> windowState == ws::Minimized; } else { $VB::color_dialog = Prima::ColorDialog-> new( borderIcons => bi::All & ~bi::Maximize, taskListed => 1, onDestroy => sub { $VB::color_dialog = undef }, ); my $y; for ( $VB::color_dialog-> widgets) { next unless $_-> isa("Prima::Button") and $_-> text =~ /ok|cancel/i; $y = $_-> top; $_-> set( visible => 0, enabled => 0); } $_-> bottom( $_-> bottom - $y) for $VB::color_dialog-> widgets; $VB::color_dialog-> height( $VB::color_dialog-> height - $y); $VB::color_dialog-> visible(1); } $VB::color_dialog-> bring_to_front; $VB::color_dialog-> select; } sub init_position { my ( $self, $window, $name) = @_; my @sz = $::application-> size; my @rx = split( ' ', $self-> {ini}-> {$name}); return unless grep { $_ != -1 } @rx; $rx[0] = 0 if $rx[0] < 0 or $rx[0] > $sz[0] + 100; $rx[1] = 0 if $rx[1] < 0 or $rx[1] > $sz[1] + 100; $rx[2] = $sz[0] if $rx[2] > $sz[0]; $rx[3] = $sz[1] if $rx[3] > $sz[1]; $window-> rect( @rx); } package VisualBuilder; use strict; $::application-> icon( Prima::Image-> load( Prima::Utils::find_image( 'VB::VB.gif'), index => 6)); $::application-> accelItems( VB::accelItems); $VB::main = MainPanel-> create; $VB::inspector = ObjectInspector-> create( top => $VB::main-> bottom - 12 - $::application-> get_system_value(sv::YTitleBar) ) if $VB::main-> {ini}-> {ObjectInspectorVisible}; $VB::code = ''; $VB::editor = CodeEditor-> create() if $VB::main-> {ini}-> {CodeEditorVisible}; $VB::form = Form-> create; ObjectInspector::renew_widgets; ObjectInspector::preload() unless $VB::fastLoad; $VB::main-> update_menu(); $VB::main-> load_file( $ARGV[0]) if @ARGV && -f $ARGV[0] && -r _; while ($::application) { eval { run Prima }; Prima::MsgBox::message( "$@") if $::application && $@; } 1; __END__ =pod =head1 NAME VB - Visual Builder for the Prima toolkit =head1 DESCRIPTION Visual Builder is a RAD-style suite for designing forms under the Prima toolkit. It provides rich set of perl-composed widgets, whose can be inserted into a form by simple actions. The form can be stored in a file and loaded by either user program or a simple wrapper, C; the form can be also stored as a valid perl program. A form file typically has I<.fm> extension, an can be loaded by using L module. The following example is the only content of C: use Prima qw(Application VB::VBLoader); my $ret = Prima::VBLoad( $ARGV[0] ); die "$@\n" unless $ret; $ret-> execute; and is usually sufficient for executing a form file. =head1 Help The builder provides three main windows, that are used for designing. These are called I
, I and I
. When the builder is started, the form window is empty. The main panel consists of the menu bar, speed buttons and the widget buttons. If the user presses a widget button, and then clicks the mouse on the form window, the designated widget is inserted into the form and becomes a child of the form window. If the click was made on a visible widget in the form window, the newly inserted widget becomes a children of that widget. After the widget is inserted, its properties are accessible via the object inspector window. The menu bar contains the following commands: =over =item File =over =item New Closes the current form and opens a new, empty form. If the old form was not saved, the user is asked if the changes made have to be saved. This command is an alias to a 'new file' icon on the panel. =item Open Invokes a file open dialog, so a I<.fm> form file can be opened. After the successful file load, all form widgets are visible and available for editing. This command is an alias to an 'open folder' icon on the panel. =item Save Stores the form into a file. The user here can select a type of the file to be saved. If the form is saved as I<.fm> form file, then it can be re-loaded either in the builder or in the user program ( see L for details ). If the form is saved as I<.pl> program, then it can not be loaded; instead, the program can be run immediately without the builder or any supplementary code. Once the user assigned a name and a type for the form, it is never asked when selecting this command. This command is an alias to a 'save on disk' icon on the panel. =item Save as Same as L, except that a new name or type of file are asked every time the command is invoked. =item Close Closes the form and removes the form window. If the form window was changed, the user is asked if the changes made have to be saved. =back =item Edit =over =item Copy Copies the selected widgets into the clipboard, so they can be inserted later by using L command. The form window can not be copied. =item Paste Reads the information, put by the builder L command into the clipboard, and inserts the widgets into the form window. The child-parent relation is kept by names of the widgets; if the widget with the name of the parent of the clipboard-read widgets is not found, the widgets are inserted into the form window. The form window is not affected by this command. =item Delete Deletes the selected widgets. The form window can not be deleted. =item Select all Selects all of the widgets, inserted in the form window, except the form window itself. =item Duplicate Duplicates the selected widgets. The form window is not affected by this command. =item Align This menu item contains z-ordering actions, that are performed on selected widgets. These are: Bring to front Send to back Step forward Step backward Restore order =back =item Change class Changes the class of an inserted widget. This is an advanced option, and can lead to confusions or errors, if the default widget class and the supplied class differ too much. It is used when the widget that has to be inserted is not present in the builder installation. Also, it is called implicitly when a loaded form does not contain a valid widget class; in such case I class is assigned. =item Creation order Opens the dialog, that manages the creation order of the widgets. It is not that important for the widget child-parent relation, since the builder tracks these, and does not allow a child to be created before its parent. However, the explicit order might be helpful in a case, when, for example, C property is left to its default value, so it is assigned according to the order of widget creation. =item Toggle lock Changes the lock status for selected widgets. The lock, if set, prevents a widget from being selected by mouse, to avoid occasional positional changes. This is useful when a widget is used as owner for many sub-widgets. Ctrl+mouse click locks and unlocks a widget. =back =over =item View =over =item Object inspector Brings the object inspector window, if it was hidden or closed. =item Add widgets Opens a file dialog, where the additional VB modules can be located. The modules are used for providing custom widgets and properties for the builder. As an example, the F module is provided with the builder and the toolkit. Look inside this file for the implementation details. =item Reset guidelines Reset the guidelines on the form window into a center position. =item Snap to guidelines Specifies if the moving and resizing widget actions must treat the form window guidelines as snapping areas. =item Snap to grid Specifies if the moving and resizing widget actions must use the form window grid granularity instead of the pixel granularity. =item Run This command hides the form and object inspector windows and 'executes' the form, as if it would be run by C. The execution session ends either by closing the form window or by calling L command. This command is an alias to a 'run' icon on the panel. =item Break Explicitly terminates the execution session, initiated by L command. =back =back =over =item Help =over =item About Displays the information about the visual builder. =item Help Displays the information about the usage of the visual builder. =item Widget property Invokes a help viewer on L manpage and tries to open a topic, corresponding to the current selection of the object inspector property or event list. While this manpage covers far not all ( but still many ) properties and events, it is still a little bit more convenient than nothing. =back =back =head2 Form window The form widget is a common parent for all widgets, created by the builder. The form window provides the following basic navigation functionality. =over =item Guidelines The form window contains two guidelines, the horizontal and the vertical, drawn as blue dashed lines. Dragging with the mouse can move these lines. If menu option L is on, the widgets moving and sizing operations treat the guidelines as the snapping areas. =item Selection A widget can be selected by clicking with the mouse on it. There can be more than one selected widget at a time, or none at all. To explicitly select a widget in addition to the already selected ones, hold the C key while clicking on a widget. This combination also deselects the widget. To select all widgets on the form window, call L, C, C, C =item exposed Returns a boolean value, indicating whether a widget is at least partly visible on the screen. Never returns 1 if a widget has C<::visible> set to 0. See also: C, C, C, C =item fetch_resource CLASS_NAME, NAME, CLASS_RESOURCE, RESOURCE, OWNER, RESOURCE_TYPE = fr::String Returns a system-defined scalar of resource, defined by the widget hierarchy, its class, name and owner. RESOURCE_TYPE can be one of type qualificators: fr::Color - color resource fr::Font - font resource fs::String - text string resource Such a number of the parameters is used because the method can be called before a widget is created. CLASS_NAME is widget class string, NAME is widget name. CLASS_RESOURCE is class of resource, and RESOURCE is the resource name. For example, resources 'color' and 'disabledColor' belong to the resource class 'Foreground'. =item first Returns the first ( from bottom ) sibling widget in Z-order. See also: C, C, C =item focus Alias for C call See also: C, C, C, C =item hide Sets widget C<::visible> to 0. See also: C, C, C, C, C, C =item hide_cursor Hides the cursor. As many times C was called, as many time its counterpart C must be called to reach the cursor's initial state. See also: C, C =item help Starts an interactive help viewer opened on C<::helpContext> string value. The string value is combined from the widget's owner C<::helpContext> strings if the latter is empty or begins with a slash. A special meaning is assigned to an empty string " " - the help() call fails when such value is found to be the section component. This feature can be useful when a window or a dialog presents a standalone functionality in a separate module, and the documentation is related more to the module than to an embedding program. In such case, the grouping widget holds C<::helpContext> as a pod manpage name with a trailing slash, and its children widgets are assigned C<::helpContext> to the topics without the manpage but the leading slash instead. If the grouping widget has an empty string " " as C<::helpContext> then the help is forced to be unavailable for all the children widgets. See also: C =item insert CLASS, %PROFILE [[ CLASS, %PROFILE], ... ] Creates one or more widgets with C property set to the caller widget, and returns the list of references to the newly created widgets. Has two calling formats: =over =item Single widget $parent-> insert( 'Child::Class', name => 'child', .... ); =item Multiple widgets $parent-> insert( [ 'Child::Class1', name => 'child1', .... ], [ 'Child::Class2', name => 'child2', .... ], ); =back =item insert_behind OBJECT Sends a widget behind the OBJECT on Z-axis, given that the OBJECT is a sibling to the widget. See also: C, C, C ,C, C, C, C =item invalidate_rect X_LEFT_OFFSET Y_BOTTOM_OFFSET X_RIGHT_OFFSET Y_TOP_OFFSET Marks the rectangular area of a widget as 'invalid', so re-painting of the area happens. See L<"Graphic content">. See also: C, C, C, C, C, C =item key_down CODE, KEY = kb::NoKey, MOD = 0, REPEAT = 1, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. CODE, KEY, MOD and REPEAT are the parameters to be passed to the notification callbacks. See also: C, C, C =item key_event COMMAND, CODE, KEY = kb::NoKey, MOD = 0, REPEAT = 1, POST = 0 The method sends or posts ( POST flag ) simulated keyboard event to the system. CODE, KEY, MOD and REPEAT are the parameters to be passed to an eventual C or C notifications. COMMAND is allowed to be either C or C. See also: C, C, C, C =item key_up CODE, KEY = kb::NoKey, MOD = 0, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. CODE, KEY and MOD are the parameters to be passed to the notification callbacks. See also: C, C, C =item last Returns the last ( the topmost ) sibling widget in Z-order. See also: C, C, C =item lock Turns off the ability of a widget to re-paint itself. As many times C was called, as may times its counterpart, C must be called to enable re-painting again. Returns a boolean success flag. See also: C, C, C, C =item map_color COLOR Transforms C and C combinations into RGB color representation and returns the result. If COLOR is already in RGB format, no changes are made. See also: C =item mouse_click BUTTON = mb::Left, MOD = 0, X = 0, Y = 0, DBL_CLICK = 0, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. BUTTON, MOD, X, Y, and DBL_CLICK are the parameters to be passed to the notification callbacks. See also: C, C, C, C, C, C =item mouse_down BUTTON = mb::Left, MOD = 0, X = 0, Y = 0, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. BUTTON, MOD, X, and Y are the parameters to be passed to the notification callbacks. See also: C, C, C, C, C, C =item mouse_enter MOD = 0, X = 0, Y = 0, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. MOD, X, and Y are the parameters to be passed to the notification callbacks. See also: C, C, C, C, C, C =item mouse_event COMMAND = cm::MouseDown, BUTTON = mb::Left, MOD = 0, X = 0, Y = 0, DBL_CLICK = 0, POST = 0 The method sends or posts ( POST flag ) simulated mouse event to the system. BUTTON, MOD, X, Y and DBL_CLICK are the parameters to be passed to an eventual mouse notifications. COMMAND is allowed to be one of C, C, C, C, C, C, C constants. See also: C, C, C, C, C, C, C, C, C, C, C, C, C, C =item mouse_leave The method sends or posts ( POST flag ) simulated C event to the system. See also: C, C, C, C, C, C, C =item mouse_move MOD = 0, X = 0, Y = 0, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. MOD, X, and Y are the parameters to be passed to the notification callbacks. See also: C, C, C, C, C, C =item mouse_up BUTTON = mb::Left, MOD = 0, X = 0, Y = 0, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. BUTTON, MOD, X, and Y are the parameters to be passed to the notification callbacks. See also: C, C, C, C, C, C =item mouse_wheel MOD = 0, X = 0, Y = 0, Z = 0, POST = 0 The method sends or posts ( POST flag ) simulated C event to the system. MOD, X, Y and Z are the parameters to be passed to the notification callbacks. See also: C, C, C, C, C, C =item next Returns the neighbor sibling widget, next ( above ) in Z-order. If none found, undef is returned. See also: C, C, C =item next_tab FORWARD = 1 Returns the next widget in the sorted by C<::tabOrder> list of sibling widgets. FORWARD is a boolean lookup direction flag. If none found, the first ( or the last, depending on FORWARD flag ) widget is returned. Only widgets with C<::tabStop> set to 1 participate. Also used by the internal keyboard navigation code. See also: C, C, C, C =item next_positional DELTA_X DELTA_Y Returns a sibling, (grand-)child of a sibling or (grand-)child widget, that matched best the direction specified by DELTA_X and DELTA_Y. At one time, only one of these parameters can be zero; another parameter must be either 1 or -1. Also used by the internal keyboard navigation code. See also: C, C =item pack, packForget, packSlaves See L =item place, placeForget, placeSlaves See L =item prev Returns the neighbor sibling widget, previous ( below ) in Z-order. If none found, undef is returned. See also: C, C, C =item repaint Marks the whole widget area as 'invalid', so re-painting of the area happens. See L<"Graphic content">. See also: C, C, C, C, C, C =item rect_bevel $CANVAS, @RECT, %OPTIONS Draws a rectangular area, similar to produced by C over C<@RECT> that is 4-integer coordinates of the area, but implicitly using widget's C and C properties' values. The following options are recognized: =over =item fill COLOR If set, the area is filled with COLOR, ortherwise is left intact. =item width INTEGER Width of the border in pixels =item concave BOOLEAN If 1, draw a concave area, bulged otherwise =back =item responsive Returns a boolean flag, indicating whether a widget and its owners have all C<::enabled> 1 or not. Useful for fast check if a widget should respond to the user actions. See also: C =item screen_to_client @OFFSETS Maps array of X and Y integer offsets from screen to widget coordinates. Returns the mapped OFFSETS. See also: C =item scroll DELTA_X DELTA_Y %OPTIONS Scrolls the graphic context area by DELTA_X and DELTA_Y pixels. OPTIONS is hash, that contains optional parameters to the scrolling procedure: =over =item clipRect [X1, Y1, X2, Y2] The clipping area is confined by X1, Y1, X2, Y2 rectangular area. If not specified, the clipping area covers the whole widget. Only the bits, covered by clipRect are affected. Bits scrolled from the outside of the rectangle to the inside are painted; bits scrolled from the inside of the rectangle to the outside are not painted. =item confineRect [X1, Y1, X2, Y2] The scrolling area is confined by X1, Y1, X2, Y2 rectangular area. If not specified, the scrolling area covers the whole widget. =item withChildren BOOLEAN If 1, the scrolling performs with the eventual children widgets change their positions to DELTA_X and DELTA_Y as well. =back Cannot be used inside paint state. See also: C, C =item select Alias for C call See also: C, C, C, C =item send_to_back Sends a widget at bottom of all other siblings widgets See also: C, C, C ,C, C, C, C =item show Sets widget C<::visible> to 1. See also: C, C, C, C, C, C =item show_cursor Shows the cursor. As many times C was called, as many time its counterpart C must be called to reach the cursor's initial state. See also: C, C =item showing Returns a boolean value, indicating whether the widget and its owners have all C<::visible> 1 or not. =item unlock Turns on the ability of a widget to re-paint itself. As many times C was called, as may times its counterpart, C must be called to enable re-painting again. When last C is called, an implicit C call is made. Returns a boolean success flag. See also: C, C, C, C =item update_view If any parts of a widget were marked as 'invalid' by either C or C calls or the exposure caused by window movements ( or any other), then C notification is immediately called. If no parts are invalid, no action is performed. If a widget has C<::syncPaint> set to 1, C is always a no-operation call. See also: C, C, C, C, C, C =item validate_rect X_LEFT_OFFSET Y_BOTTOM_OFFSET X_RIGHT_OFFSET Y_TOP_OFFSET Reverses the effect of C, restoring the original, 'valid' state of widget area covered by the rectangular area passed. If a widget with previously invalid areas was wholly validated by this method, no C notifications occur. See also: C, C, C, C, C, C =back =head2 Get-methods =over =item get_default_font Returns the default font for a Prima::Widget class. See also: C =item get_default_popup_font Returns the default font for a Prima::Popup class. See also: C =item get_invalid_rect Returns the result of successive calls C, C and C, as a rectangular area ( four integers ) that cover all invalid regions in a widget. If none found, (0,0,0,0) is returned. See also: C, C, C, C, C, C =item get_handle Returns a system handle for a widget See also: C =item get_locked Returns 1 if a widget is in C - initiated repaint-blocked state. See also: C, C =item get_mouse_state Returns a combination of C constants, reflecting the currently pressed mouse buttons. See also: C, C =item get_parent Returns the owner widget that clips the widget boundaries, or application object if a widget is top-level. See also: C =item get_parent_handle Returns a system handle for a parent of a widget, a window that belongs to another program. Returns 0 if the widget's owner and parent are in the same application and process space. See also: C, C =item get_pointer_size Returns two integers, width and height of a icon, that the system accepts as valid for a pointer. If the icon is supplied that is more or less than these values, it is truncated or padded with transparency bits, but is not stretched. Can be called with class syntax. =item get_shift_state Returns a combination of C constants, reflecting the currently pressed keyboard modificator buttons. See also: C =item get_virtual_size Returns virtual width and height of a widget. See L<"Geometry">, Implicit size regulations. See also: C, C, C C, C, C, C, C =item get_widgets Returns list of children widgets. =back =head2 Events =over =item Change Generic notification, used for Prima::Widget descendants; Prima::Widget itself neither calls not uses the event. Designed to be called when an arbitrary major state of a widget is changed. =item Click Generic notification, used for Prima::Widget descendants; Prima::Widget itself neither calls not uses the event. Designed to be called when an arbitrary major action for a widget is called. =item Close Triggered by C and C functions. If the event flag is cleared during execution, these functions fail. See also: C, C =item ColorChanged INDEX Called when one of widget's color properties is changed, either by direct property change or by the system. INDEX is one of C constants. See also: C =item Disable Triggered by a successive C call See also: C, C, C =item DragDrop X Y I. Supposed to be triggered when a drag-and-drop session started by the widget. X and Y are mouse pointer coordinates on the session start. See also: C, C =item DragOver X Y STATE I. Supposed to be called when a mouse pointer is passed over a widget during a drag-and-drop session. X and Y are mouse pointer coordinates, identical to C X Y parameters. STATE value is undefined. See also: C, C =item Enable Triggered by a successive C call See also: C, C, C =item EndDrag X Y I. Supposed to be called when a drag-and-drop session is finished successfully over a widget. X and Y are mouse pointer coordinates on the session end. See also: C, C =item Enter Called when a widget receives the input focus. See also: C, C, C =item FontChanged Called when a widget font is changed either by direct property change or by the system. See also: C, C =item Hide Triggered by a successive C call See also: C, C, C, C =item Hint SHOW_FLAG Called when the hint label is about to show or hide, depending on SHOW_FLAG. The hint show or hide action fails, if the event flag is cleared during execution. See also: C, C, C, C =item KeyDown CODE, KEY, MOD, REPEAT Sent to the focused widget when the user presses a key. CODE contains an eventual character code, KEY is one of C constants, MOD is a combination of the modificator keys pressed when the event occurred ( C ). REPEAT is how many times the key was pressed; usually it is 1. ( see C<::briefKeys> ). The valid C constants are: km::Shift km::Ctrl km::Alt km::KeyPad km::DeadKey The valid C constants are grouped in several sets. Some codes are aliased, like, C and C. =over =item Modificator keys kb::ShiftL kb::ShiftR kb::CtrlL kb::CtrlR kb::AltL kb::AltR kb::MetaL kb::MetaR kb::SuperL kb::SuperR kb::HyperL kb::HyperR kb::CapsLock kb::NumLock kb::ScrollLock kb::ShiftLock =item Keys with character code defined kb::Backspace kb::Tab kb::Linefeed kb::Enter kb::Return kb::Escape kb::Esc kb::Space =item Function keys kb::F1 .. kb::F30 kb::L1 .. kb::L10 kb::R1 .. kb::R10 =item Other kb::Clear kb::Pause kb::SysRq kb::SysReq kb::Delete kb::Home kb::Left kb::Up kb::Right kb::Down kb::PgUp kb::Prior kb::PageUp kb::PgDn kb::Next kb::PageDown kb::End kb::Begin kb::Select kb::Print kb::PrintScr kb::Execute kb::Insert kb::Undo kb::Redo kb::Menu kb::Find kb::Cancel kb::Help kb::Break kb::BackTab =back See also: C, C, C, C, C, C, C, C =item KeyUp CODE, KEY, MOD Sent to the focused widget when the user releases a key. CODE contains an eventual character code, KEY is one of C constants, MOD is a combination of the modificator keys pressed when the event occurred ( C ). See also: C, C =item Leave Called when the input focus is removed from a widget See also: C, C, C =item Menu MENU VAR_NAME Called before the user-navigated menu ( pop-up or pull-down ) is about to show another level of submenu on the screen. MENU is Prima::AbstractMenu descendant, that children to a widget, and VAR_NAME is the name of the menu item that is about to be shown. Used for making changes in the menu structures dynamically. See also: C =item MouseClick BUTTON, MOD, X, Y, DOUBLE_CLICK Called when a mouse click ( button is pressed, and then released within system-defined interval of time ) is happened in the widget area. BUTTON is one of C constants, MOD is a combination of C constants, reflecting pressed modificator keys during the event, X and Y are the mouse pointer coordinates. DOUBLE_CLICK is a boolean flag, set to 1 if it was a double click, 0 if a single. C constants are: mb::b1 or mb::Left mb::b2 or mb::Middle mb::b3 or mb::Right mb::b4 mb::b5 mb::b6 mb::b7 mb::b8 See also: C, C, C, C, C, C =item MouseDown BUTTON, MOD, X, Y Occurs when the user presses mouse button on a widget. BUTTON is one of C constants, MOD is a combination of C constants, reflecting the pressed modificator keys during the event, X and Y are the mouse pointer coordinates. See also: C, C, C, C, C, C =item MouseEnter MOD, X, Y Occurs when the mouse pointer is entered the area occupied by a widget ( without mouse button pressed ). MOD is a combination of C constants, reflecting the pressed modificator keys during the event, X and Y are the mouse pointer coordinates. See also: C, C, C, C, C, C =item MouseLeave Occurs when the mouse pointer is driven off the area occupied by a widget ( without mouse button pressed ). See also: C, C, C, C, C, C =item MouseMove MOD, X, Y Occurs when the mouse pointer is transported over a widget. MOD is a combination of C constants, reflecting the pressed modificator keys during the event, X and Y are the mouse pointer coordinates. See also: C, C, C, C, C, C =item MouseUp BUTTON, MOD, X, Y Occurs when the user depresses mouse button on a widget. BUTTON is one of C constants, MOD is a combination of C constants, reflecting the pressed modificator keys during the event, X and Y are the mouse pointer coordinates. See also: C, C, C, C, C, C =item MouseWheel MOD, X, Y, Z Occurs when the user rotates mouse wheel on a widget. MOD is a combination of C constants, reflecting the pressed modificator keys during the event, X and Y are the mouse pointer coordinates. Z is the virtual coordinate of a wheel. Typical ( 2001 A.D. ) mouse produces Z 120-fold values. See also: C, C, C, C, C, C =item Move OLD_X, OLD_Y, NEW_X, NEW_Y Triggered when widget changes its position relative to its parent, either by Prima::Widget methods or by the user. OLD_X and OLD_Y are the old coordinates of a widget, NEW_X and NEW_Y are the new ones. See also: C, C, C, C, C =item Paint CANVAS Caused when the system calls for the refresh of a graphic context, associated with a widget. CANVAS is the widget itself, however its usage instead of widget is recommended ( see L<"Graphic content"> ). See also: C, C, C, C, C, C =item Popup BY_MOUSE, X, Y Called by the system when the user presses a key or mouse combination defined for a context pop-up menu execution. By default executes the associated Prima::Popup object, if it is present. If the event flag is cleared during the execution of callbacks, the pop-up menu is not shown. See also: C =item Setup This message is posted right after C notification, and comes first from the event loop. Prima::Widget does not use it. =item Show Triggered by a successive C call See also: C, C, C, C =item Size OLD_WIDTH, OLD_HEIGHT, NEW_WIDTH, NEW_HEIGHT Triggered when widget changes its size, either by Prima::Widget methods or by the user. OLD_WIDTH and OLD_HEIGHT are the old extensions of a widget, NEW_WIDTH and NEW_HEIGHT are the new ones. See also: C, C, C, C, C, C, C, C =item TranslateAccel CODE, KEY, MOD A distributed C event. Traverses all the object tree that the widget which received original C event belongs to. Once the event flag is cleared, the iteration stops. Used for tracking keyboard events by out-of-focus widgets. See also: C =item ZOrderChanged Triggered when a widget changes its stacking order, or Z-order among its siblings, either by Prima::Widget methods or by the user. See also: C, C, C =back =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L, L, L. Prima-1.28/pod/Prima/fontabc.gif0000644000175100017510000001214711150770061014234 0ustar dkdkGIF89að”÷  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~€€€‚‚‚ƒƒƒ„„„………†††‡‡‡ˆˆˆ‰‰‰ŠŠŠ‹‹‹ŒŒŒŽŽŽ‘‘‘’’’“““”””•••–––———˜˜˜™™™ššš›››œœœžžžŸŸŸ   ¡¡¡¢¢¢£££¤¤¤¥¥¥¦¦¦§§§¨¨¨©©©ªªª«««¬¬¬­­­®®®¯¯¯°°°±±±²²²³³³´´´µµµ¶¶¶···¸¸¸¹¹¹ººº»»»¼¼¼½½½¾¾¾¿¿¿ÀÀÀÁÁÁÂÂÂÃÃÃÄÄÄÅÅÅÆÆÆÇÇÇÈÈÈÉÉÉÊÊÊËËËÌÌÌÍÍÍÎÎÎÏÏÏÐÐÐÑÑÑÒÒÒÓÓÓÔÔÔÕÕÕÖÖÖ×××ØØØÙÙÙÚÚÚÛÛÛÜÜÜÝÝÝÞÞÞßßßàààáááâââãããäääåååæææçççèèèéééêêêëëëìììíííîîîïïïðððñññòòòóóóôôôõõõööö÷÷÷øøøùùùúúúûûûüüüýýýþþþÿÿÿ,ð”þñÝûG° Áƒÿ½KÈ°¡¾z º‹H±¢Å‚Ö¤]$¸ªßÆÃûè/È“ÿbuBIðÞ–{A¹O Ì›W‰úhe N˜Â} ÇægE•0]þ”IÓ¦Qœ:yú| 2èТT"e©'Ó5³ÂŒº±§ØV7=‹p+Ê®7¿Œ— N‘ x§ø¡V0,[d/šý[1mH¬„S®äúÒëÌÔÄàLyƒ“~[ lq°f††-®Õìö$\˜2ÇI®Ìï¸ÌŸ#r®è9öÁÐG'. ò4Ë^U*û1fò_¼F”‹À¶p6ÅÚÌ â¦¨›0ï¾OÆB¹ÃÊ™œþFo¾³ìÔñÿ¦G¬þ÷úÆìÇUæ›ÐXe"âÑtztõ ±Ç–{Áw‘|“MQ\Bp°–Ÿ~•'ØyãÈ€gh‘!ˆ µö „ü5äs&„¡XVÄaDâ%Hˆ•ñ1¢~%2t¢m)"´bV-RôbCSPFÉc !GY;7¢—cB;ÆÖãA?RdDC2Hr%‰—¯59Þ“EùÙ”UùÔ• ey}”ýÓ¥EË‘(agþ'”ZˆY·Ø[mT.r"yQ8ÞI[ž(îyØgl2äfA~$GÐœ!ꤢÏ1Ê££¢õÙÞŸ¦Z5•¥r©¡tŠ™ÿ™©š©iT¤ MúÏj“„)EšŽÉižJ jn¢Hjo¦FçdpøÊj¦®2ÇJ(RA˜Þ±Ô%›á²Ø5ÛÐ]”ºjSÚtm¶ÒJP•ò„Ëd„⊛óVÓ´ÀVkÛºæiëî?U¦²¹‚:¯bI‰›¹Ðî‹.Cñ‚”ïÁ<¡ÀÜ®çmApàRÄÃŒ“СlïAY^L¯Ä`‰i0Âa¼ðEãÉñU¡¼BtMQDÉ¡LÊà¾çðA÷ óFÁ†}h“bSCvÑEÐ}6Ö8o½q×<3}¸øÁtâñtÃɚɒ·ÊÐàxn7Þz«î7×€{}áÇã\ýÏ°WdóêŒÙšðçÆ,:é¦'d÷æ}wþ7z{‹ªe±½æ ]\oÒ:Lë¬E;µÒ O|Í ó]Q΋îÌ'¤äo(5ÔlÂkkÆ@ÜR§í¹íÞCÄ·»Ïõ.t»ÉŸ‹RК Z üŠ›¿bC¿NÙïQ¤‘ ,HBÖ("ƒÜàg:H¬† 0áF gˆ—Y !ÁŠ MT¬3ùNE`þ˘äG2Ž À a ‹0@ªP3;ÔQgõC}l^„Š‡Ùà÷…ñz^ÒÄ„äÐZžÓèîw2„¡êtÅ£òÅïQ怼¡›$ÄŠU„ TãÙˆ"ípC‹£î¾h ôAŽŒzD¢°hœ-/~‰"”¦˜˜ì}ç@–¬^ßbÁ ÖŒ5…“ÖÄRçFC†ÍjrÌdë·F’"AKd,Iiʃ¸ /Ì[_¿N#«á.–¤å mÉÊ‚œŽÄ\\)“‡UÆ;\%õN–¹hŠÒ"š,' #ŒE@ЗC•r¼”L“Ž…dM³é¼[R͘yCÿ¦õx‡=s!€¼ˆßY*„lO_ )£$o„1‚<!ÓSÜ7ç7K¶ËŸÌlA™…%m)" =È$Óù=.ÞlŸìç95ÚË‚4 /4Ë£6 Ð?¾,™F_Hš†ë ñh EBj3þ«¢-¼èJäS¥„v j$EúÄÄ„3VãüK9—š¡¦–ï Ö¤Ì&¤:S]Õ ²êäN‘)¯ê/u¯#k=Óõ³$­ä\k·ÚÚÒgM&˜2kºìJ¼jU¯ã+5 R)áT„¨}©*aûòe«ÿdébÿñÒ Ì¤S-ªdÿBYËž³ej/ÅèÊÀBm´l)mVþ/‹Ø¯)žÿ€*^.Ú²êG¶«íïn[P‚ü/‘“ëkéJà*U-k .G†J‹@– Få RyÜ¡D·§¦üå¦p‘ëþ#»+Ü®» ]éþôíNyCYæÖU½›doH¾»·º¨1­YgBÌ‹^(âWœ¡‹Ž;8l"Ž…®Šøkÿ é%¬Ýa{çVäp4,ÂX-‚ZÑPX³tôèdÔ÷Xúb—ÃbñpCì¨D¼Œ8"%Î͉U›/Œ³"cˆúxÃ)H™«»”5ÄGþÚùnˆþ Á Î<ôA/}JUðË9²Ïµ¿÷_įÎçůÁ5ß ?¾’ÕßÛO˜¯•}Á+ppòwÏWÑ'H A ´'¸° Æ0o͆cJG0¸¤´z ak`t€0‘€)d¡—ÔGC`BþWi2&÷0Õ÷árÚuqP´×?aŠ7 2ð‚áQ#f€3wãÑ  `ƒ`FoÆQ: &› ؃bmè„êC„óGƒŸ„J_7%+èkÂŽw1,¦…H#È\^X‚ŒÅ„´E…,¢Ga…kj‚lèDöõ†å†À”Wt$tPóD ÿæx{È"è‡n˜„%ioGcHnmEqɱNv\¨€È€ÿÐejUˆÀ¶+T•Ø èˆ}¸G(‰Ò„§uá,Ár¸VbÐR¨6­è‰F¡¨L¢çX‡eŠæ–ÁØpŸ˜ŘSÃvX‹Ê˜pÌX„®!јTÔUBbŽâ(¶ æxŽüÃ?ýg‹¸ˆº×Íøx¿§-ÝÈ])hrÖ‹qt‰)§yX¾'véRëe~øhªÈ~™Ç}Ø€ü±|šx$tü¸tþØ&k¯ˆ9‘%XvIB®ÀŽ))i˜!‰68p%iAÿ„p+§p,³’Ñ’ )‘0 ‡Æ5“Jä6Ùt8 ŒÚx/IW™_ ‘/pÆ?¸pŽ 6Ž98CÖ‡‰ ù:IÉÇ€™[ø‡©ÅèGV˜Oñ,õ%~t‹Ÿ™Ó{28™xi˜i˜>É”v93Ùgƒø·˜YdI¢©¤™°©’ÚHIZäJ•‰Å(5±IÎö_ÒLÂ׺˜Æ雨éqoÔ“"™5;Øf¨H8Ÿ ÿ’Ö{¹ù—97Ò¹†Ãy„cY9hFst‡ÑX…žíx»yìYž|xž ‘žÄ8–P•J=Á{¦ùÒöôÏ9;”ñd茜CþÉ¡8:eés=1oœi®3…äF_ž„qŸa¡]´~úxÔÙ—¬yÁcïj´—•,œŠð™„¢NÎ)ží£_–¢­GI*¿JI¿–™˜ÞˆøKú{¥üÛ¿×{—Ñ1ÀQÀÇzÀxê¿Ä Àö¨ Ü ™Nzwa˜¼û¾«ü¥ qÁ ‘Ág¿8a4'åÁ¬žöËNxÉ&œ(,*|ºsÌ!j,±Ã'QÃqÃY‘Ã0ÁÂÊ=|?¬lA<Ã(AÄaÄTÄAœ 4 ‘/üŸq°[4Z<ÅÇ›¿ïkXŒ|ÓÂOÑÄbñÄÆQ,Å%\Æ|Æ‘ÆO·MmÜÅJÁ !ÇjÌÇâkÇÿ ŒÇ¡Ç7§™K|nœpü‚üß ‚ÂÈ‘ Ð`¼aÅO±›ÑÐ[Œuåb³ÀÏûL‘,ÈéÖ¥VÊq`ð@Tlžl‘ù d ¤üŽ€yP«ü­|¢0Yy0…°¹ŒÈ! g0°xñª°ÍÜœ ÞìͨÎâ<Ψp æ|Îè| ¦°Îë\ îüΤÏñ< ô\Ï;qàÇz È q•‘NÐíMPÐ}ÐÐ ý•‘˱Ë?! a”õ\ÏòÏïüÎì¼ÎéüÑäÒßìÍÜÌÍ.8{ ÏàÊÏÆ“ÀÌSÎ<9êФKÍ ! +Q \€Õ ÁüƒÐü@öõ #±› §ú` Ûšj°‹@Á ºÐÉm0ÇÐ=}À¹©Á õª  _m;Prima-1.28/pod/Prima/gp-problems.pod0000644000175100017510000002561411150770061015067 0ustar dkdk=for rcs $Id: gp-problems.pod,v 1.8 2007/09/13 15:12:25 dk Exp $ =head1 NAME Prima::gp-problems - Problems, questionable or intricate topics in 2-D Graphics =head1 Introduction One of the most important goals of the Prima project is portability between different operating systems. Independently to efforts in keeping Prima internal code that it behaves more or less identically on different platforms, it is always possible to write non-portable and platform-dependent code. Here are some guidelines and suggestions for 2-D graphics programming. =head1 Minimal display capabilities A compliant display is expected to have minimal set of capabilities, that programmer can rely upon. Following items are guaranteedly supported by Prima: =over =item Minimal capabilities Distinct black and white colors Line widths 0 and 1 One monospaced font Solid fill rop::Copy and rop::NoOper =item Plotting primitives SetPixel,GetPixel Line,PolyLine,PolyLines Ellipse,Arc,Chord,Sector Rectangle FillPoly FillEllipse,FillChord,FillSector TextOut PutImage,GetImage =item Information services GetTextWidth,GetFontMetrics,GetCharacterABCWidths GetImageBitsLayout =item Properties color backColor rop backRop lineWidth lineJoin lineStyle fillPattern fillPolyWinding textOpaque clipRect All these properties must be present, however it is not required for them to be changeable. Even if an underlying platform-specific code can only support one mode for a property, it have to follow all obligations for the mode. For example, if platform supports full functionality for black color but limited functionality for the other colors, the wrapping code should not allow color property to be writable then. =back =head1 Inevident issues =head2 Colors =over =item Black and white colors on paletted displays Due the fact that paletted displays employ indexed color representation, 'black' and 'white' indices are not always 0 and 2^n-1, so result of raster image operations may look garbled (X). Win32 and OS/2 protect themselves from this condition by forcing white to be the last color in the system palette. Example: if white color on 8-bit display occupies palette index 15 then desired masking effect wouldn't work for xoring transparent areas with cl::White. Workaround: Use two special color constants cl::Clear and cl::Set, that represent all zeros and all ones values for bit-sensitive raster operations. =item Black might be not 0, and white not 0xffffff This inevident issue happens mostly on 15- and 16-bits pixel displays. Internal color representation for the white color on a 15-color display ( assuming R,G and B are 5-bits fields) is 11111000 11111000 11111000 --R----- --G----- --B----- that equals to 0xf8f8f8. (All) Advise: do not check for 'blackness' and 'whiteness' merely by comparing a pixel value. =item Pixel value coding Status: internal It is not checked how does Prima behave when a pixel value and a platform integer use different bit and/or byte priority (X). =back =head2 Filled shapes =over =item Dithering If a non-solid pattern is selected and a background and/or a foreground color cannot be drawn as a solid, the correct rendering requires correspondingly 3 or 4 colors. Some rendering engines (Win9X) fail to produce correct results. =item Overfill effect In complex shapes ( FillPoly, for example) the platform renderer can fill certain areas two or more times. Whereas the effect is not noticeable with rop::CopyPut, the other raster operations (like rop::Xor) produce incorrect picture. (OS/2) NB - has nothing in common with the fill winding rule. Workaround: Do not use raster operations with complex filled shapes =item Pattern offset For a widget that contains a pattern-filled shape, its picture will be always garbled after scrolling, because it is impossible to provide an algorithm for a correct rendering without a prior knowledge of the widget nature. (All) Workaround: Do not use patterned backgrounds. Since the same effect is visible on dithered backgrounds, routine check for pure color might be applied. =back =head2 Lines =over =item Line caps over patterned styles It is not clear, whether gaps between dashes should be a multiple to a line width or not. For example, lp::DotDot looks almost as a solid line when lineWidth is over 10 if the first (non-multiple) tactic is chosen. From the other hand it is hardly possible to predict the plotting strategy from a high-level code. The problem is related more to Prima design rather than to a platform-specific code. (All) Workaround: use predefined patterns (lp::XXX) =item Line joins Joint areas may be drawn two (or more) times - the problem emerges if logical ROP (rop::Xor) is chosen.(OS/2) =item Dithering Dithering might be not used for line plotting. (Win9X) =back =head2 Fonts =over =item Font metric inconsistency A font is loaded by request with one size, but claims another afterwards.(OS/2, X). Impact: system-dependent font description may not match to Prima's. Advise: do not try to deduce Prima font metrics from system-dependent ones and vice versa. =item Transparent plotting No internal function for drawing transparent bitmaps (like fonts). Therefore, if a font emulation is desired, special ROPs cannot be reproduced. (OS/2, Win9X, WinNT) Impact: font emulation is laborsome, primarily because the glyphs have to be plotted by consequential anding and xoring a bitmap. Full spectrum of the raster operations cannot be achieved with this approach. =item Kerning Prima do not use text kernings, nor encourages underlying platform-specific code to use it - primarily because of its complexity. From the other hand, sometimes glyph position cannot be determined correctly if no information for the text kerning is provided. (Win9X) =item Fractional text position If the font glyphs have fractional widths, it might be observed that letters may change their position in a string. Example: A set of glyphs has width of 8.6 pixels for each symbol. If the string "abcd" is drawn at position 0, then black part of "d" starts at 25th pixel, but if "cd" is drawn at 17th, as it supposed to be if the integer arithmetics is used, it starts at 24th pixel. (OS/2) Solution: Do not rely to Drawable::get_text_width information, because it always returns integer value, but to Drawable::get_font_abc, which returns real values. =item Text background If a text is drawn with non-CopyPut raster operation, text background is not expected to be mixed with symbols - however this is hardly reachable, so results differs for different platforms. Text background may be only drawn with pure ( non-dithered ) color (Win9X,WinNT) - but this is (arguably) a more correct behavior. Advise: Do not use ::rop2 and text background for special effects =item Internal platform features Font change notification is not provided. (X, OS/2) Raster fonts cannot be synthesized (OS/2, partly X) =back =head2 Raster operations ( ROPs) Background raster operations are not supported (X,Win9X,WinNT) and foreground ROPs have limited number of modes (OS/2,X). Not all ROPs can be emulated for certain primitives, like fonts, complex shapes, and patterned shapes. It is yet unclear which primitives have to support ROPs, - like FloodFill and SetPixel. Behavior of the current implementation is that they do not. =head2 Arcs Platforms tend to produce different results for angles outside 0 and 2pi. Although Prima assures that correct plotting would be performed for any angle, minor inconsistencies may be noticed. If emulating, note that 2 and 4-pi arcs are not the same - for example, they look differently with rop::Xor. =head2 Palettes =over =item Static palettes Some displays are unable to change their hardware palette, so detecting 8- or 4- bits display doesn't automatically mean that palette is writable.(X) =item Widget::palette Widget::palette property is used for explicit declaration of extra color needs for a widget. The request might be satisfacted in different ways, or might not at all. It is advisable not to rely onto platform behavior for the palette operations. =item Dynamic palette change It is possible (usually on 8-bits displays) for a display to change asynchronously its hardware palette in order to process different color requests. All platforms behave differently. Win9X/WinNT - only one top-level window at a time and its direct children ( not ::clipOwner(0)) can benefit from using Widget::palette. System palette is switched every time as different windows moved to the front. OS/2 - not implemented, but in principle the same as under win32. X - Any application can easily ruin system color table. Since this behavior is such by design, no workaround can be applied here. =back =head2 Bitmaps =over =item Invalid scaling Scaling is invalid (Win9X) or not supported (X). Common mistake is to not take into an account the fractional pixels that appear when the scaling factor is more than 1. This mistake can be observed in Win9X. Workaround: none =item Large scale factors Request for drawing a bitmap might fail if large scaling factor is selected. (OS/2,Win9X,WinNT). This effect is obviously due that fact that these platforms scale the bitmap into a memory before the plotting takes place. =back =head1 Platform-specific peculiarities =head2 OS/2 Some ROPs are ambiguous - SRCTRANSPARENT, for example. Some times they work, some times they don't. The particular behavior depends on a video driver. Circles cannot be drawn using an even diameter. Fast GDI operations on HWND_DESKTOP may be delayed, thus GetPixel may return invalid pixel values. =head2 Windows 9X Amount of GDI objects can not exceed some unknown threshold - experiments show that 128 objects is safe enough. No transformations. Color cursor creation routine is broken. Filled shapes are broken. =head2 X No transformations No bitmap scaling No font rotation No GetPixel, FloodFill ( along with some other primitives) White is not 2^n-1 on n-bit paletted displays (tested on XFree86). Filled shapes are broken. Color bitmaps cannot be drawn onto mono bitmaps. =head1 Implementation notes =head2 OS/2 Palettes are not implemented =head2 Win32 Plotting speed of DeviceBitmaps is somewhat less on 8-bit displays than Images and Icons. It is because DeviceBitmaps are bound to their original palette, so putting a DeviceBitmap onto different palette drawable employs inefficient algorithms in order to provide correct results. =head2 X Image that was first drawn on a paletted Drawable always seen in 8 colors if drawn afterwards on a Drawable with the different palette. That is because the image has special cache in display pixel format, but cache refresh on every PutImage call is absolutely inappropriate (although technically possible). It is planned to fix the problem by checking the palette difference for every PutImage invocation. NB - the effect is seen on dynamic color displays only. =head1 AUTHOR Dmitry Karasik, Edmitry@karasik.eu.orgE. =head1 SEE ALSO L Prima-1.28/ms_install.pl0000644000175100017510000001534111150770061013000 0ustar dkdk#! /usr/bin/perl -w # # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: ms_install.pl,v 1.9 2005/10/13 17:22:50 dk Exp $ # BEGIN { die <$dst" or abort "Cannot create $dst: $!"; print DSTPL <) { next if $filestart && /^\#\!/; $filestart = 0; print DSTPL; } close SRCPL; close DSTPL; } elsif ( $mswin32) { print "Installing $dst ...\n"; $dst =~ s/bat$/pl/; abort "Error:$!\n" unless copy $src, $dst; my $i = system("pl2bat $dst"); $src = $dst; $dst =~ s/pl$/bat/; abort "Error: pl2bat $dst failed\n" unless -f $dst; unlink $src; } else { open SRCPL, "<$src" or abort "Cannot open $src: $!"; open DSTPL, ">$dst" or abort "Cannot create $dst: $!"; print DSTPL <) { next if $filestart && /^\#\!/; $filestart = 0; print DSTPL; } close SRCPL; close DSTPL; } } if ( open F, "> install.log") { print F "f:$_\n" for @instfiles; print F "d:$_\n" for @instdir; close F; } else { print "(!) Unable to write 'install.log' ($!), uninstall will be unavailable\n"; } print <) { chomp; next unless m/^(.)\:(.*)$/; print "Deleting $2...\n"; if ( $1 eq 'f') { unlink $2; } elsif ( $1 eq 'd') { rmdir $2; push @dirs, $2; } } close F; rmdir $_ for @dirs; rmdir $_ for @dirs; print "Done.\n"; } Prima-1.28/DeviceBitmap.c0000644000175100017510000000673711150770061013007 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: DeviceBitmap.c,v 1.15 2007/08/09 13:03:06 dk Exp $ */ #include "apricot.h" #include "DeviceBitmap.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CDrawable-> #define my ((( PDeviceBitmap) self)-> self) #define var (( PDeviceBitmap) self) void DeviceBitmap_init( Handle self, HV * profile) { dPROFILE; inherited init( self, profile); var-> w = pget_i( width); var-> h = pget_i( height); var-> monochrome = pget_B( monochrome); if ( !apc_dbm_create( self, var-> monochrome)) croak("RTC0110: Cannot create device bitmap"); inherited begin_paint( self); opt_set( optInDraw); CORE_INIT_TRANSIENT(DeviceBitmap); } void DeviceBitmap_done( Handle self) { apc_dbm_destroy( self); inherited done( self); } Bool DeviceBitmap_begin_paint ( Handle self) { return true;} Bool DeviceBitmap_begin_paint_info ( Handle self) { return true;} void DeviceBitmap_end_paint ( Handle self) { return;} Bool DeviceBitmap_monochrome( Handle self, Bool set, Bool monochrome) { if ( set) croak("Attempt to write read-only property %s", "DeviceBitmap::monochrome"); return var-> monochrome; } static Handle xdup( Handle self, char * className) { Handle h; PDrawable i; HV * profile = newHV(); Point s; pset_H( owner, var-> owner); pset_i( width, var-> w); pset_i( height, var-> h); pset_i( type, var-> monochrome ? imMono : imRGB); h = Object_create( className, profile); sv_free(( SV *) profile); i = ( PDrawable) h; s = i-> self-> get_size( h); i-> self-> begin_paint( h); i-> self-> put_image_indirect( h, self, 0, 0, 0, 0, s.x, s.y, s.x, s.y, ropCopyPut); i-> self-> end_paint( h); --SvREFCNT( SvRV( i-> mate)); return h; } Handle DeviceBitmap_image( Handle self) { return xdup( self, "Prima::Image"); } Handle DeviceBitmap_icon( Handle self) { return xdup( self, "Prima::Icon"); } SV * DeviceBitmap_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", apc_dbm_get_handle( self)); return newSVpv( buf, 0); } #ifdef __cplusplus } #endif Prima-1.28/Printer.c0000644000175100017510000001560011150770061012063 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: Printer.c,v 1.27 2008/04/24 21:30:14 dk Exp $ */ #include "apricot.h" #include "Printer.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CDrawable-> #define my ((( PPrinter) self)-> self) #define var (( PPrinter) self) void Printer_init( Handle self, HV * profile) { dPROFILE; char * prn; inherited init( self, profile); if ( !apc_prn_create( self)) croak("RTC0070: Cannot create printer"); prn = pget_c( printer); if ( strlen( prn) == 0) prn = my-> get_default_printer( self); my-> set_printer( self, prn); CORE_INIT_TRANSIENT(Printer); } void Printer_done( Handle self) { apc_prn_destroy( self); inherited done( self); } Bool Printer_validate_owner( Handle self, Handle * owner, HV * profile) { dPROFILE; if ( pget_H( owner) != application || application == nilHandle) return false; *owner = application; return true; } Bool Printer_begin_doc( Handle self, char * docName) { Bool ok; char buf[ 256]; if ( is_opt( optInDraw)) return false; if ( !docName || *docName == '\0') { snprintf( buf, 256, "APC: %s", (( PComponent) application)-> name); docName = buf; } if ( is_opt( optInDrawInfo)) my-> end_paint_info( self); if ( !inherited begin_paint( self)) return false; if ( !( ok = apc_prn_begin_doc( self, docName))) { inherited end_paint( self); perl_error(); } return ok; } Bool Printer_new_page( Handle self) { Bool ok; if ( !is_opt( optInDraw)) return false; ok = apc_prn_new_page( self); if ( !ok) perl_error(); return ok; } Bool Printer_end_doc( Handle self) { Bool ret; if ( !is_opt( optInDraw)) return false; ret = apc_prn_end_doc( self); inherited end_paint( self); if ( !ret) perl_error(); return ret; } void Printer_abort_doc( Handle self) { if ( !is_opt( optInDraw)) return; inherited end_paint( self); apc_prn_abort_doc( self); } char * Printer_printer( Handle self, Bool set, char * printerName) { if ( !set) return apc_prn_get_selected( self); if ( is_opt( optInDraw)) my-> end_paint( self); if ( is_opt( optInDrawInfo)) my-> end_paint_info( self); return apc_prn_select( self, printerName) ? "1" : ""; } Bool Printer_begin_paint( Handle self) { return my-> begin_doc( self, ""); } void Printer_end_paint( Handle self) { my-> abort_doc( self); } Bool Printer_begin_paint_info( Handle self) { Bool ok; if ( is_opt( optInDraw)) return true; if ( !inherited begin_paint_info( self)) return false; if ( !( ok = apc_prn_begin_paint_info( self))) { inherited end_paint_info( self); if ( !ok) perl_error(); } return ok; } void Printer_end_paint_info( Handle self) { if ( !is_opt( optInDrawInfo)) return; apc_prn_end_paint_info( self); inherited end_paint_info( self); } extern SV * Application_fonts( Handle self, char * name, char * encoding); SV * Printer_fonts( Handle self, char * name, char * encoding) { return Application_fonts( self, name, encoding); } extern SV* Application_font_encodings( Handle self, char * encoding); SV* Printer_font_encodings( Handle self, char * encoding) { return Application_font_encodings( self, encoding); } SV * Printer_printers( Handle self) { int count, i; AV * glo = newAV(); PPrinterInfo info = apc_prn_enumerate( self, &count); for ( i = 0; i < count; i++) av_push( glo, sv_PrinterInfo2HV( &info[ i])); free( info); return newRV_noinc(( SV *) glo); } Point Printer_size( Handle self, Bool set, Point size) { if ( !set) return apc_prn_get_size( self); return inherited size( self, set, size); } SV * Printer_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", apc_prn_get_handle( self)); return newSVpv( buf, 0); } Point Printer_resolution( Handle self, Bool set, Point resolution) { if ( set) croak("Attempt to write read-only property %s", "Printer::resolution"); return apc_prn_get_resolution( self); } XS( Printer_options_FROMPERL) { dXSARGS; Handle self; if ( items == 0) croak ("Invalid usage of Printer.options"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Printer.options"); switch ( items) { case 1: { int i, argc = 0; char ** argv; if ( apc_prn_enum_options( self, &argc, &argv)) { EXTEND( sp, argc); for ( i = 0; i < argc; i++) PUSHs( sv_2mortal( newSVpv( argv[i], 0))); free( argv); } PUTBACK; return; } case 2: { char *option, *value; option = ( char*) SvPV_nolen( ST(1)); if ( apc_prn_get_option( self, option, &value)) { SPAGAIN; XPUSHs( sv_2mortal( newSVpv( value, 0))); free( value); } else { SPAGAIN; XPUSHs( nilSV); } PUTBACK; return; } default: { int i, success = 0; char *option, *value; for ( i = 1; i < items; i+=2) { option = ( char*) SvPV_nolen( ST(i)); value = (SvOK( ST(i+1)) ? ( char*) SvPV_nolen( ST(i+1)) : nil); if ( !value) continue; if ( !apc_prn_set_option( self, option, value)) continue; success++; } SPAGAIN; XPUSHs( sv_2mortal( newSViv( success))); PUTBACK; return; }} return; } void Printer_options ( Handle self) { warn("Invalid call of Printer::options"); } void Printer_options_REDEFINED( Handle self) { warn("Invalid call of Printer::options"); } #ifdef __cplusplus } #endif Prima-1.28/File.cls0000644000175100017510000000401711150770061011656 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: File.cls,v 1.8 2002/05/14 13:22:16 dk Exp $ object Prima::File( Prima::Component) { int eventMask; int eventMask2; int userMask; int fd; SV * file; property SV * file; property int mask; method long add_notification( char * name, SV * subroutine, Handle referer = nilHandle, int index = -1); method void init( HV * profile); method void cleanup(); method SV * get_handle(); c_only void handle_event( PEvent event); method Bool is_active( Bool autoDetach = false); import SV * notification_types(); method void remove_notification( long id); } Prima-1.28/Clipboard.c0000644000175100017510000003337711150770061012352 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: Clipboard.c,v 1.44 2007/10/11 11:34:25 dk Exp $ */ #include "apricot.h" #include "Application.h" #include "Image.h" #include "Clipboard.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CComponent-> #define my ((( PClipboard) self)-> self) #define var (( PClipboard) self) #define cefInit 0 #define cefDone 1 #define cefStore 2 #define cefFetch 3 struct _ClipboardFormatReg; typedef SV* ClipboardExchangeFunc( Handle self, struct _ClipboardFormatReg * instance, int function, SV * data); typedef ClipboardExchangeFunc *PClipboardExchangeFunc; typedef struct _ClipboardFormatReg { char *id; long sysId; ClipboardExchangeFunc *server; void *data; Bool written; } ClipboardFormatReg, *PClipboardFormatReg; static SV * text_server ( Handle self, PClipboardFormatReg, int, SV *); static SV * utf8_server ( Handle self, PClipboardFormatReg, int, SV *); static SV * image_server ( Handle self, PClipboardFormatReg, int, SV *); static SV * binary_server( Handle self, PClipboardFormatReg, int, SV *); static int clipboards = 0; static int formatCount = 0; static Bool protect_formats = false; static PClipboardFormatReg formats = nil; void * Clipboard_register_format_proc( Handle self, char * format, void * serverProc); void Clipboard_init( Handle self, HV * profile) { inherited init( self, profile); if ( !apc_clipboard_create(self)) croak( "RTC0022: Cannot create clipboard"); if (clipboards == 0) { Clipboard_register_format_proc( self, "Text", (void*)text_server); Clipboard_register_format_proc( self, "Image", (void*)image_server); Clipboard_register_format_proc( self, "UTF8", (void*)utf8_server); protect_formats = 1; } clipboards++; CORE_INIT_TRANSIENT(Clipboard); } void Clipboard_done( Handle self) { clipboards--; if ( clipboards == 0) { protect_formats = 0; while( formatCount) my-> deregister_format( self, formats-> id); } apc_clipboard_destroy(self); inherited done( self); } Bool Clipboard_validate_owner( Handle self, Handle * owner, HV * profile) { dPROFILE; if ( pget_H( owner) != application || application == nilHandle) return false; *owner = application; return true; } typedef Bool ActionProc ( Handle self, PClipboardFormatReg item, void * params); typedef ActionProc *PActionProc; static PClipboardFormatReg first_that( Handle self, void * actionProc, void * params) { int i; PClipboardFormatReg list = formats; if ( actionProc == nil) return nil; for ( i = 0; i < formatCount; i++) { if ((( PActionProc) actionProc)( self, list+i, params)) return list+i; } return nil; } static Bool find_format( Handle self, PClipboardFormatReg item, char *format) { return strcmp( item-> id, format) == 0; } static Bool reset_written( Handle self, PClipboardFormatReg item, char *format) { item-> written = false; return false; } void * Clipboard_register_format_proc( Handle self, char * format, void * serverProc) { PClipboardFormatReg list = first_that( self, (void*)find_format, format); if ( list) { my-> deregister_format( self, format); } if (!( list = allocn( ClipboardFormatReg, formatCount + 1))) return nil; if ( formats != nil) { memcpy( list, formats, sizeof( ClipboardFormatReg) * formatCount); free( formats); } formats = list; list += formatCount++; list-> id = duplicate_string( format); list-> server = ( ClipboardExchangeFunc *) serverProc; list-> sysId = ( long) list-> server( self, list, cefInit, nilSV); return list; } void Clipboard_deregister_format( Handle self, char * format) { PClipboardFormatReg fr, list; if ( protect_formats && ( ( strlen( format) == 0) || ( strcmp( format, "Text") == 0) || ( strcmp( format, "UTF8") == 0) || ( strcmp( format, "Image") == 0))) return; fr = first_that( self, (void*)find_format, format); if ( fr == nil) return; list = formats; fr-> server( self, fr, cefDone, nilSV); free( fr-> id); formatCount--; memmove( fr, fr + 1, sizeof( ClipboardFormatReg) * ( formatCount - ( fr - list))); if ( formatCount > 0) { if (( fr = allocn( ClipboardFormatReg, formatCount))) memcpy( fr, list, sizeof( ClipboardFormatReg) * formatCount); } else fr = nil; free( formats); formats = fr; } Bool Clipboard_open( Handle self) { var-> openCount++; if ( var-> openCount > 1) return true; first_that( self, (void*) reset_written, nil); return apc_clipboard_open( self); } void Clipboard_close( Handle self) { if ( var-> openCount > 0) { PClipboardFormatReg text, utf8; var-> openCount--; if ( var-> openCount > 0) return; text = formats + cfText; utf8 = formats + cfUTF8; /* automatically downgrade UTF8 to TEXT */ if ( utf8-> written && !text-> written) { SV *utf8_sv, *text_sv; if (( utf8_sv = utf8-> server( self, utf8, cefFetch, nilSV))) { STRLEN l, charlen; U8 * src; src = ( U8 *) SvPV( utf8_sv, l); text_sv = newSVpvn("", 0); while ( l--) { register UV u = utf8_to_uvchr( src, &charlen); char c = ( u < 0x7f) ? u : '?'; src += charlen; sv_catpvn( text_sv, &c, 1); } text-> server( self, text, cefFetch, text_sv); sv_free( text_sv); } } apc_clipboard_close( self); } else var-> openCount = 0; } Bool Clipboard_format_exists( Handle self, char * format) { Bool ret; PClipboardFormatReg fr = first_that( self, (void*)find_format, format); if ( !fr) return false; my-> open( self); ret = apc_clipboard_has_format( self, fr-> sysId); my-> close( self); return ret; } SV * Clipboard_fetch( Handle self, char * format) { SV * ret; PClipboardFormatReg fr = first_that( self, (void*)find_format, format); my-> open( self); if ( !fr || !my-> format_exists( self, format)) ret = newSVsv( nilSV); else ret = fr-> server( self, fr, cefFetch, nilSV); my-> close( self); return ret; } void Clipboard_store( Handle self, char * format, SV * data) { PClipboardFormatReg fr = first_that( self, (void*)find_format, format); if ( !fr) return; my-> open( self); if ( var-> openCount == 1) { first_that( self, (void*) reset_written, nil); apc_clipboard_clear( self); } fr-> server( self, fr, cefStore, data); my-> close( self); } void Clipboard_clear( Handle self) { my-> open( self); first_that( self, (void*) reset_written, nil); apc_clipboard_clear( self); my-> close( self); } SV * Clipboard_get_handle( Handle self) { char buf[ 256]; snprintf( buf, 256, "0x%08lx", apc_clipboard_get_handle( self)); return newSVpv( buf, 0); } Bool Clipboard_register_format( Handle self, char * format) { void * proc; if (( strlen( format) == 0) || ( strcmp( format, "Text") == 0) || ( strcmp( format, "UTF8") == 0) || ( strcmp( format, "Image") == 0)) return false; proc = Clipboard_register_format_proc( self, format, (void*)binary_server); return proc != nil; } XS( Clipboard_get_formats_FROMPERL) { dXSARGS; Handle self; int i; PClipboardFormatReg list; if ( items != 1) croak ("Invalid usage of Clipboard.get_formats"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Clipboard.get_formats"); my-> open( self); list = formats; for ( i = 0; i < formatCount; i++) { if ( !apc_clipboard_has_format( self, list[ i]. sysId)) continue; XPUSHs( sv_2mortal( newSVpv( list[ i]. id, 0))); } my-> close( self); PUTBACK; } XS( Clipboard_get_registered_formats_FROMPERL) { dXSARGS; Handle self; int i; PClipboardFormatReg list; if ( items < 1) croak ("Invalid usage of Clipboard.get_registered_formats"); SP -= items; self = gimme_the_mate( ST( 0)); if ( self == nilHandle) croak( "Illegal object reference passed to Clipboard.get_registered_formats"); list = formats; EXTEND( sp, formatCount); for ( i = 0; i < formatCount; i++) PUSHs( sv_2mortal( newSVpv( list[ i]. id, 0))); PUTBACK; } XS( Clipboard_get_standard_clipboards_FROMPERL) { dXSARGS; int i; PList l; (void)ax; SP -= items; l = apc_get_standard_clipboards(); if ( l && l-> count > 0) { EXTEND( sp, l-> count); for ( i = 0; i < l-> count; i++) { char *cc = (char *)list_at( l, i); PUSHs( sv_2mortal( newSVpv(cc, 0))); } } if (l) { list_delete_all( l, true); plist_destroy( l); } PUTBACK; } void Clipboard_get_formats ( Handle self) { warn("Invalid call of Clipboard::get_formats"); } void Clipboard_get_formats_REDEFINED ( Handle self) { warn("Invalid call of Clipboard::get_formats"); } void Clipboard_get_registered_formats ( Handle self) { warn("Invalid call of Clipboard::get_registered_formats"); } void Clipboard_get_registered_formats_REDEFINED ( Handle self) { warn("Invalid call of Clipboard::get_registered_formats"); } void Clipboard_get_standard_clipboards ( Handle self) { warn("Invalid call of Clipboard::get_standard_clipboards"); } void Clipboard_get_standard_clipboards_REDEFINED ( Handle self) { warn("Invalid call of Clipboard::get_standard_clipboards"); } static SV * text_server( Handle self, PClipboardFormatReg instance, int function, SV * data) { ClipboardDataRec c; switch( function) { case cefInit: return ( SV *) cfText; case cefFetch: if ( apc_clipboard_get_data( self, cfText, &c)) { data = newSVpv(( char*) c. data, c. length); free( c. data); return data; } break; case cefStore: if ( SvUTF8( data)) { /* jump to UTF8. close() will later downgrade data to ascii, if any */ instance = formats + cfUTF8; return instance-> server( self, instance, cefStore, data); } else { c. data = ( Byte*) SvPV( data, c. length); instance-> written = apc_clipboard_set_data( self, cfText, &c); } break; } return nilSV; } static SV * utf8_server( Handle self, PClipboardFormatReg instance, int function, SV * data) { ClipboardDataRec c; switch( function) { case cefInit: return ( SV *) cfUTF8; case cefFetch: if ( apc_clipboard_get_data( self, cfUTF8, &c)) { data = newSVpv(( char*) c. data, c. length); SvUTF8_on( data); free( c. data); return data; } break; case cefStore: c. data = ( Byte*) SvPV( data, c. length); instance-> written = apc_clipboard_set_data( self, cfUTF8, &c); break; } return nilSV; } static SV * image_server( Handle self, PClipboardFormatReg instance, int function, SV * data) { ClipboardDataRec c; switch( function) { case cefInit: return ( SV *) cfBitmap; case cefFetch: { HV * profile = newHV(); c. image = Object_create( "Prima::Image", profile); sv_free(( SV *) profile); if ( apc_clipboard_get_data( self, cfBitmap, &c)) { --SvREFCNT( SvRV( PImage(c. image)-> mate)); return newSVsv( PImage(c. image)-> mate); } Object_destroy( c. image); } break; case cefStore: c. image = gimme_the_mate( data); if ( !kind_of( c. image, CImage)) { warn("RTC0023: Not an image passed to clipboard"); return nilSV; } instance-> written = apc_clipboard_set_data( self, cfBitmap, &c); break; } return nilSV; } static SV * binary_server( Handle self, PClipboardFormatReg instance, int function, SV * data) { ClipboardDataRec c; switch( function) { case cefInit: return ( SV*) apc_clipboard_register_format( self, instance-> id); case cefDone: apc_clipboard_deregister_format( self, instance-> sysId); break; case cefFetch: if ( apc_clipboard_get_data( self, instance-> sysId, &c)) { SV * ret = newSVpv((char*) c. data, c. length); free( c. data); return ret; } break; case cefStore: c. data = (Byte*) SvPV( data, c. length); instance-> written = apc_clipboard_set_data( self, instance-> sysId, &c); break; } return nilSV; } #ifdef __cplusplus } #endif Prima-1.28/Icon.cls0000644000175100017510000000420211150770061011663 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Icon.cls,v 1.13 2008/04/20 07:56:33 dk Exp $ local @IconHandle { Handle xorMask; Handle andMask; } object Prima::Icon( Prima::Image) { unsigned char* mask; int maskLine; int maskSize; Color maskColor; int maskIndex; int autoMasking; property SV * mask; property Color maskColor; property int maskIndex; property int autoMasking; method void init( HV * profile); method Handle dup(); method IconHandle split(); method void combine( Handle xorMask, Handle andMask); c_only void create_empty( int width, int height, int type); c_only void update_change(); c_only void stretch( int width, int height); } Prima-1.28/Prima.pm0000644000175100017510000003172011150770061011703 0ustar dkdk# # Copyright (c) 1997-2003 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Anton Berezin # # $Id: Prima.pm,v 1.89 2008/10/29 10:54:42 dk Exp $ package Prima; use strict; require DynaLoader; use vars qw($VERSION @ISA $__import @preload); @ISA = qw(DynaLoader); sub dl_load_flags { 0x00 } $VERSION = '1.28'; bootstrap Prima $VERSION; unless ( UNIVERSAL::can('Prima', 'init')) { $::application = 0; return 0; } $::application = undef; require Prima::Const; require Prima::Classes; sub parse_argv { my %options = Prima::options(); my @ret; for ( my $i = 0; $i < @_; $i++) { if ( $_[$i] =~ m/^--(?:([^\=]+)\=)?(.*)$/) { my ( $option, $value) = ( defined( $1) ? ( $1, $2) : ( $2, undef)); last unless defined($option); if ( $option eq 'help') { my @options = Prima::options(); printf " --%-10s - %s\n", shift @options, shift @options while @options; exit(0); } next unless exists $options{$option}; Prima::options( $option, $value); } else { push @ret, $_[$i]; } } return @ret; } { my ( $i, $skip_argv, @argv); for ( $i = 0; $i < @preload; $i++) { if ( $preload[$i] eq 'argv') { push @argv, $preload[++$i]; } elsif ( $preload[$i] eq 'noargv') { $skip_argv++; } } parse_argv( @argv) if @argv; @ARGV = parse_argv( @ARGV) if @ARGV and not $skip_argv; } Prima::init($VERSION); sub END { &Prima::cleanup() if UNIVERSAL::can('Prima', 'cleanup'); } sub run { die "Prima was not properly initialized\n" unless $::application; $::application-> go if $::application-> alive; $::application = undef if $::application and not $::application->alive; } sub import { my @module = @_; while (@module) { my $module = shift @module; my %parameters = (); %parameters = %{shift @module} if @module && ref($module[0]) eq 'HASH'; next if $module eq 'Prima' || $module eq ''; $module = "Prima::$module" unless $module =~ /^Prima::/; $__import = caller; if ( $module) { eval "use $module \%parameters;"; die $@ if $@; } $__import = 0; } } 1; __END__ =pod =head1 NAME Prima - a perl graphic toolkit =head1 SYNOPSIS use Prima qw(Application Buttons); new Prima::MainWindow( text => 'Hello world!', size => [ 200, 200], )-> insert( Button => centered => 1, text => 'Hello world!', onClick => sub { $::application-> close }, ); run Prima; =head1 DESCRIPTION The toolkit is combined from two basic set of classes - core and external. The core classes are coded in C and form a base line for every Prima object written in perl. The usage of C is possible together with the toolkit; however, its full power is revealed in the perl domain. The external classes present easily expandable set of widgets, written completely in perl and communicating with the system using Prima library calls. The core classes form an hierarchy, which is displayed below: Prima::Object Prima::Component Prima::AbstractMenu Prima::AccelTable Prima::Menu Prima::Popup Prima::Clipboard Prima::Drawable Prima::DeviceBitmap Prima::Printer Prima::Image Prima::Icon Prima::File Prima::Timer Prima::Widget Prima::Application Prima::Window The external classes are derived from these; the list of widget classes can be found below in L. =head1 BASIC PROGRAM The very basic code shown in L<"SYNOPSIS"> is explained here. The code creates a window with 'Hello, world' title and a centered button with the same text. The program terminates after the button is pressed. A basic construct for a program written with Prima obviously requires use Prima; code; however, the effective programming requires usage of the other modules, for example, C, which contains set of button widgets. C module can be invoked with a list of such modules, which makes the construction use Prima; use Prima::Application; use Prima::Buttons; shorter by using the following scheme: use Prima qw(Application Buttons); Another basic issue is the event loop, which is called by run Prima; sentence and requires a C object to be created beforehand. Invoking C standard module is one of the possible ways to create an application object. The program usually terminates after the event loop is finished. The window is created by invoking new Prima::Window(); or Prima::Window-> create() code with the additional parameters. Actually, all Prima objects are created by such a scheme. The class name is passed as the first parameter, and a custom set of parameters is passed afterwards. These parameters are usually represented in a hash syntax, although actually passed as an array. The hash syntax is preferred for the code readability: $new_object = new Class( parameter => value, parameter => value, ... ); Here, parameters are the class properties names, and differ from class to class. Classes often have common properties, primarily due to the object inheritance. In the example, the following properties are set : Window::text Window::size Button::text Button::centered Button::onClick Property values can be of any type, given that they are scalar. As depicted here, C<::text> property accepts a string, C<::size> - an anonymous array of two integers and C - a sub. onXxxx are special properties that form a class of I, which share the C/C syntax, and are additive when the regular properties are substitutive (read more in L). Events are called in the object context when a specific condition occurs. The C event here, for example, is called when the user presses (or otherwise activates) the button. =head1 API This section describes miscellaneous methods, registered in C namespace. =over =item message TEXT Displays a system message box with TEXT. =item run Enters the program event loop. The loop is ended when C's C or C method is called. =item parse_argv @ARGS Parses prima options from @ARGS, returns unparsed arguments. =back =head1 OPTIONS Prima applications do not have a portable set of arguments; it depends on the particular platform. Run perl -e '$ARGV[0]=q(--help); require Prima' or any Prima program with C<--help> argument to get the list of supported arguments. Programmaticaly, setting and obtaining these options can be done by using C routine. In cases where Prima argument parsing conflicts with application options, use L to disable automatic parsing; also see L. Alternatively, the construct BEGIN { local @ARGV; require Prima; } will also do. =head1 SEE ALSO The toolkit documentation is divided by several subjects, and the information can be found in the following files: =over =item Tutorials L - introductory tutorial =item Core toolkit classes L - basic object concepts, properties, events L - binder module for the core classes L - 2-D graphic interface L - bitmap routines L - image subsystem and file operations L - window management =over 2 =item * L - Tk::pack geometry manager =item * L - Tk::place geometry manager =back L - top-level window management L - GUI interprocess data exchange L - pull-down and pop-up menu objects L - programmable periodical events L - root of widget objects hierarchy L - system printing services L - asynchronous stream I/O =item Widget library L - buttons and button grouping widgets L - calendar widget L - combo box widget L - multi-column list viewer with controlling header widget L - a multi-column outline viewer with controlling header widget L - advanced dockable widgets L - dockable widgets L - text editor widget L - listbox with checkboxes L - frameset widget class L - grid widgets L - a multi-tabbed header widget L - the built-in POD file browser L - standard dialog for transparent color index selection L - bitmap viewer L - input line widget L - key combination widget and routines L - static text widget L - user-selectable item list widgets L - top-level windows emulation classes L - multipage widgets L - tree view widgets L - POD browser widget L - scroll bars L - scrollable generic document widget L - sliding bars, spin buttons and input lines, dial widget etc. L - a simplistic startup banner window L - rich text browser widget L - widget themes manager =item Standard dialogs L - color selection facilities L - find and replace dialogs L - file system related widgets and dialogs L - font dialog L - image file open and save dialogs L - message and input dialog boxes L - standard printer setup dialog L - wrapper module to the toolkit standard dialogs =item Visual Builder L - Visual Builder for the Prima toolkit L - Visual Builder file loader L - configuration tool for Visual Builder L - maintains visual builder widget palette configuration =item PostScript printer interface L - PostScript interface to C L - latin-based encodings L - PostScript device fonts metrics L - PostScript interface to C =item C interface to the toolkit L - Internal architecture L - Step-by-step image codec creation L - C, a class compiler tool. =item Miscellaneous L - frequently asked questions L - predefined toolkit constants L - event filtering L - animate gif files L - support of Windows-like initialization files L - internal functions L - shared access to the standard toolkit bitmaps L - stress test module L - tie widget properties to scalars or arrays L - miscellaneous routines L - miscellaneous widget classes L - Graphic subsystem portability issues L - usage guide for X11 environment =item Class information The Prima manual pages often provide information for more than one Prima class. To quickly find out the manual page of a desired class, as well as display the inheritance information, use C command. The command can produce output in text and pod formats; the latter feature is used by the standard Prima documentation viewer C ( see File/Run/p-class ). =back =head1 COPYRIGHT Copyright 1997, 2003 The Protein Laboratory, University of Copenhagen. All rights reserved. Copyright 2004 Dmitry Karasik. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Dmitry Karasik Edmitry@karasik.eu.orgE, Anton Berezin Etobez@tobez.orgE, Vadim Belman Evoland@lflat.orgE, =cut Prima-1.28/Types.cls0000644000175100017510000000501211150770061012077 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Types.cls,v 1.11 2007/10/25 11:24:27 dk Exp $ global @Point { int x; int y; } global @Rect { int left; int bottom; int right; int top; } global %Font { int height ; int width ; int style ; int pitch ; double direction ; long resolution ; string name ; int size ; string encoding ; string family ; int vector ; int ascent ; int descent ; int weight ; int maximalWidth ; int internalLeading ; int externalLeading ; int xDeviceRes ; int yDeviceRes ; int firstChar ; int lastChar ; int breakChar ; int defaultChar ; U8 utf8_flags ; } global @FillPattern U8[8]; global @NPoint { double x; double y; } global %PrinterInfo { string name; string device; Bool defaultPrinter; } Prima-1.28/Component.cls0000644000175100017510000000705611150770061012747 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Component.cls,v 1.18 2004/03/26 13:34:07 dk Exp $ object Prima::Component( Prima::Object) { void *sysData; # system-dependent data, defined by apc char *name; ApiHandle handle; # apc handle property Bool eventFlag; property SV * delegations; property SV * name; property Handle owner; method long add_notification( char * name, SV * subroutine, Handle referer = nilHandle, int index = -1); method void attach( Handle objectHandle); method Handle bring( char * componentName); method Bool can_event(); method void cleanup(); method void clear_event(); method void done(); method void detach( Handle objectHandle, Bool kill); method void event_error(); c_only Handle first_that_component( void * actionProc, void * params); public void get_components(); method SV * get_handle(); public void get_notification( char * name, int index); c_only void handle_event ( PEvent event); method void init( HV * profile); method int is_owner( Handle objectHandle); c_only Bool message( PEvent event); c_only Bool migrate( Handle attachTo); import SV * notification_types(); public Bool notify( char * format, ...); method Bool pop_event(); method void post_message( SV * info1, SV * info2); import SV * profile_default(); method void push_event(); c_only void recreate(); method void remove_notification( long id); method void set( HV * profile); method void setup(); public void set_notification( char * name, SV * subroutine); method void unlink_notifier( Handle referer); c_only void update_sys_handle( HV * profile); c_only Bool validate_owner( Handle * newOwner, HV * profile); # internal variables char * evStack; int evPtr; int evLimit; PList postList; PList components; PList evQueue; PList refs; PList events; PHash eventIDs; int eventIDCount; } Prima-1.28/README0000644000175100017510000001112711150770061011154 0ustar dkdkDESCRIPTION =========== PRIMA is a general purpose extensible graphical user interface toolkit with a rich set of standard widgets and an emphasis on 2D image processing tasks. A Perl program using PRIMA looks and behaves identically on X, Win32 and OS/2 PM. PREREQUISITES ============= Prima can use several graphic libraries to handle image files. Compiling Prima with at least one library, preferably for GIF files is strongly recommended, because internal library images are stored in GIFs. Support for the following libraries can be compiled in on all platforms: - libXpm - libpng - libjpeg - libungif - libtiff - libX11 - support for native X11 bitmap files For Win32 and OS/2 platforms, libprigraph library can be used instead. The library supports most of the popular image file formats, including BMP, PCX, GIF, JPEG, TIFF, PNG, and is distributed in binary form for these platforms: - Win32, native : http://www.prima.eu.org/download/gbm-bin-win32.zip. - Win32, cygwin : http://www.prima.eu.org/download/gbm-bin-cygwin.zip. - OS/2 : http://www.prima.eu.org/download/gbm-bin-os2.zip. The zip files contain prigraph.dll and other DLL files if needed. The files are to be put in PATH. The library files, .LIB or .A, are used when compiling Prima from source and to be put in LIBPATH. SOURCE DISTRIBUTION INSTALLATION ================================ Create a makefile by running Makefile.PL using perl and then run make ( or gmake, or nmake for Win32 and OS/2): perl Makefile.PL make make test make install If 'perl Makefile.PL' fails, the compilation history along with errors can be found in makefile.log. If make fails with message ** No image codecs found that means you don't have image libraries that Prima supports in your path. See PREREQUISITES section. If some of the required libraries or include files can not be found, INCPATH+=/some/include and LIBPATH+=/some/lib semantics should be used to tell Makefile.PL about these. To install Prima into a non-default directory, for example your home directory: perl Makefile.PL PREFIX=$HOME/lib/perl If compilation process fails because Makefile contains invalid switches for your compiler or linker, try changing these by specifying arguments to Makefile.PL, where the most useful are: COMPILER - type of compiler ( gcc, emx, mscv32, bcc32, irixcc) CC - compiler command CFLAGS - compiler arguments LD - linked command LDFLAGS - linker arguments Look in Makefile.PL for details. GTK2 ---- Prima can be compiled width GTK2 on unix systems. To do so run perl Makefile.PL WITH_GTK2=1 If successful, Prima will display GTK file dialogs. BINARY DISTRIBUTION INSTALLATION ================================ Available only for MSWin32 and OS/2. Please use installation from source for the other platforms. To install the toolkit from the binary distribution run perl ms_install.pl You have to patch Prima::Config.pm manually if you need to compile prima-dependent modules. USAGE EXAMPLES ============== Try running the toolkit examples, by default installed in INSTALLSITEARCH/Prima/examples directory ( find it by running perl -V:installsitearch ). All examples and programs included into the distribution can be run either by their name or with perl as argument - for example, ..../generic or perl ..../generic . ( perl ..../generic.bat for win32 ) Typical code starts with use Prima qw(Application); and ends with run Prima; which is an event loop call. Start from the following code: use Prima qw(Application Buttons); new Prima::MainWindow( text => 'Hello world!', size => [ 200, 200], )-> insert( Button => centered => 1, text => 'Hello world!', onClick => sub { $::application-> close }, ); run Prima; Or, alternatively, start the VB program, which is the toolkit visual builder. MORE INFORMATION ================ The toolkit contains set of POD files describing its features, and the programming interfaces. Run 'podview Prima' or 'perldoc Prima' command to start with the main manual page. Visit http://www.prima.eu.org/ for the recent versions of the toolkit. You can use cvs update feature to keep in touch. The mailing list on the toolkit is available, you can ask questions there. See the Prima homepage for details. COPYRIGHT ========= (c) 1997-2003 The Protein Laboratory, University of Copenhagen AUTHORS ======= Dmitry Karasik Anton Berezin Vadim Belman CREDITS ======= David Scott Teo Sankaro Prima-1.28/Object.cls0000644000175100017510000000366111150770061012211 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Object.cls,v 1.9 2003/06/05 18:47:00 dk Exp $ object Prima::Object { int stage; int protectCount; int destroyRefCount; Handle owner; void * transient_class; ObjectOptions options; method SV* can( char *name, Bool cacheIt = 1); method void cleanup(); method void done(); method void init( HV * profile); import void profile_add ( SV * profile); import void profile_check_in ( SV * profile, SV * default_profile); import SV * profile_default (); import void set( HV * profile); method void setup(); } Prima-1.28/Utils.c0000644000175100017510000000560611150770061011545 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: Utils.c,v 1.12 2007/05/23 17:50:57 dk Exp $ */ #include "apricot.h" #include "Utils.h" #include #ifdef __cplusplus extern "C" { #endif SV *Utils_query_drives_map( char *firstDrive) { char map[ 256]; apc_query_drives_map( firstDrive, map, sizeof( map)); return newSVpv( map, 0); } int Utils_get_os() { return apc_application_get_os_info( nil, 0, nil, 0, nil, 0, nil, 0); } int Utils_get_gui() { return apc_application_get_gui_info( nil, 0); } long Utils_ceil( double x) { return ceil( x); } long Utils_floor( double x) { return floor( x); } XS(Utils_getdir_FROMPERL) { dXSARGS; Bool wantarray = ( GIMME_V == G_ARRAY); char *dirname; PList dirlist; int i; if ( items >= 2) { croak( "invalid usage of Prima::Utils::getdir"); } dirname = SvPV_nolen( ST( 0)); dirlist = apc_getdir( dirname); SPAGAIN; SP -= items; if ( wantarray) { if ( dirlist) { EXTEND( sp, dirlist-> count); for ( i = 0; i < dirlist-> count; i++) { PUSHs( sv_2mortal(newSVpv(( char *)dirlist-> items[i], 0))); free(( char *)dirlist-> items[i]); } plist_destroy( dirlist); } } else { if ( dirlist) { XPUSHs( sv_2mortal( newSViv( dirlist-> count / 2))); for ( i = 0; i < dirlist-> count; i++) { free(( char *)dirlist-> items[i]); } plist_destroy( dirlist); } else { XPUSHs( &sv_undef); } } PUTBACK; return; } #ifdef __cplusplus } #endif Prima-1.28/Utils.cls0000644000175100017510000000344211150770061012100 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Utils.cls,v 1.6 2002/05/14 13:22:18 dk Exp $ package Prima::Utils { SV * query_drives_map( char *firstDrive = "A:"); int query_drive_type( char *drive) => apc_query_drive_type; int get_os(); int get_gui(); void beep( int flags = mbError) => apc_beep; long ceil( double x); long floor( double x); void sound( int freq = 2000, int dur = 100) => apc_beep_tone; char *username() => apc_get_user_name; } Prima-1.28/Printer.cls0000644000175100017510000000443311150770061012424 0ustar dkdk# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: Printer.cls,v 1.18 2006/01/06 19:13:29 dk Exp $ object Prima::Printer( Prima::Drawable) { property char * printer; property Point resolution; property Point size; method void abort_doc(); method Bool begin_doc( char * docName = ""); method Bool begin_paint(); method Bool begin_paint_info(); method void done(); method Bool end_doc(); method void end_paint(); method void end_paint_info(); method SV* fonts( char * name = "", char * encoding = ""); method SV* font_encodings( char * encoding = ""); method void init( HV * profile); method Bool new_page(); public void options(); method SV * printers(); method Bool setup_dialog() => apc_prn_setup; c_only Bool validate_owner( Handle * newOwner, HV * profile); method char * get_default_printer() => apc_prn_get_default; method SV * get_handle(); } Prima-1.28/Application.c0000644000175100017510000007037111150770061012711 0ustar dkdk/*- * Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * $Id: Application.c,v 1.79 2008/04/28 09:58:27 dk Exp $ */ #include "apricot.h" #include "Timer.h" #include "Window.h" #include "Image.h" #include "Application.h" #include #ifdef __cplusplus extern "C" { #endif #undef my #define inherited CWidget-> #define my ((( PApplication) self)-> self) #define var (( PApplication) self) static void Application_HintTimer_handle_event( Handle, PEvent); void Application_init( Handle self, HV * profile) { dPROFILE; int hintPause = pget_i( hintPause); Color hintColor = pget_i( hintColor), hintBackColor = pget_i( hintBackColor); SV * hintFont = pget_sv( hintFont); SV * sv; char * hintClass = pget_c( hintClass); if ( application != nilHandle) croak( "RTC0010: Attempt to create more than one application instance"); CDrawable-> init( self, profile); list_create( &var-> widgets, 16, 16); list_create( &var-> modalHorizons, 0, 8); application = self; if ( !apc_application_create( self)) croak( "RTC0011: Error creating application"); /* Widget init */ SvHV_Font( pget_sv( font), &Font_buffer, "Application::init"); my-> set_font( self, Font_buffer); SvHV_Font( pget_sv( popupFont), &Font_buffer, "Application::init"); my-> set_popup_font( self, Font_buffer); { AV * av = ( AV *) SvRV( pget_sv( designScale)); SV ** holder = av_fetch( av, 0, 0); if ( holder) var-> designScale. x = SvNV( *holder); else warn("RTC0012: Array panic on 'designScale'"); holder = av_fetch( av, 1, 0); if ( holder) var-> designScale. y = SvNV( *holder); else warn("RTC0012: Array panic on 'designScale'"); pdelete( designScale); } var-> text = duplicate_string(""); opt_set( optModalHorizon); /* store extra info */ { HV * hv = ( HV *) SvRV( var-> mate); (void) hv_store( hv, "PrinterClass", 12, newSVpv( pget_c( printerClass), 0), 0); (void) hv_store( hv, "PrinterModule", 13, newSVpv( pget_c( printerModule), 0), 0); (void) hv_store( hv, "HelpClass", 9, newSVpv( pget_c( helpClass), 0), 0); (void) hv_store( hv, "HelpModule", 10, newSVpv( pget_c( helpModule), 0), 0); } { HV * profile = newHV(); static Timer_vmt HintTimerVmt; pset_H( owner, self); pset_i( timeout, hintPause); pset_c( name, "HintTimer"); var-> hintTimer = create_instance( "Prima::Timer"); protect_object( var-> hintTimer); hv_clear( profile); memcpy( &HintTimerVmt, CTimer, sizeof( HintTimerVmt)); HintTimerVmt. handle_event = Application_HintTimer_handle_event; (( PTimer) var-> hintTimer)-> self = &HintTimerVmt; pset_H( owner, self); pset_i( color, hintColor); pset_i( backColor, hintBackColor); pset_i( visible, 0); pset_i( selectable, 0); pset_i( showHint, 0); pset_c( name, "HintWidget"); pset_sv( font, hintFont); var-> hintWidget = create_instance( hintClass); protect_object( var-> hintWidget); sv_free(( SV *) profile); } if ( SvTYPE( sv = pget_sv( accelItems)) != SVt_NULL) my-> set_accelItems( self, sv); if ( SvTYPE( sv = pget_sv( popupItems)) != SVt_NULL) my-> set_popupItems( self, sv); pdelete( accelTable); pdelete( accelItems); pdelete( popupItems); my-> set( self, profile); CORE_INIT_TRANSIENT(Application); } void Application_done( Handle self) { if ( self != application) return; unprotect_object( var-> hintTimer); unprotect_object( var-> hintWidget); list_destroy( &var-> modalHorizons); list_destroy( &var-> widgets); free( var-> text); free( var-> hint); free( var-> helpContext); var-> accelTable = var-> hintWidget = var-> hintTimer = nilHandle; var-> text = var-> hint = var-> helpContext = nil; apc_application_destroy( self); CDrawable-> done( self); application = nilHandle; } void Application_cleanup( Handle self) { int i; for ( i = 0; i < var-> widgets. count; i++) Object_destroy( var-> widgets. items[i]); if ( var-> icon) my-> detach( self, var-> icon, true); var-> icon = nilHandle; my-> first_that_component( self, (void*)kill_all, nil); CDrawable-> cleanup( self); } void Application_set( Handle self, HV * profile) { pdelete( bottom); pdelete( buffered); pdelete( capture); pdelete( centered); pdelete( clipOwner); pdelete( enabled); pdelete( focused); pdelete( geometry); pdelete( geomHeight); pdelete( geomSize); pdelete( geomWidth); pdelete( growMode); pdelete( height); pdelete( hintClass); pdelete( hintVisible); pdelete( left); pdelete( modalHorizon); pdelete( origin); pdelete( owner); pdelete( ownerBackColor); pdelete( ownerColor); pdelete( ownerFont); pdelete( ownerPalette); pdelete( ownerShowHint); pdelete( palette); pdelete( pack); pdelete( place); pdelete( printerClass); pdelete( printerModule); pdelete( helpClass); pdelete( helpModule); pdelete( rect); pdelete( rigth); pdelete( selectable); pdelete( shape); pdelete( size); pdelete( syncPaint); pdelete( tabOrder); pdelete( tabStop); pdelete( transparent); pdelete( text); pdelete( top); pdelete( visible); pdelete( width); inherited set( self, profile); } void Application_handle_event( Handle self, PEvent event) { switch ( event-> cmd) { case cmPost: if ( event-> gen. H != self) { ((( PComponent) event-> gen. H)-> self)-> message( event-> gen. H, event); event-> cmd = 0; if ( var-> stage > csNormal) return; } break; } inherited handle_event ( self, event); } void Application_sync( char * dummy) { apc_application_sync(); } void Application_yield( char * dummy) { apc_application_yield(); } Bool Application_begin_paint( Handle self) { Bool ok; if ( !CDrawable-> begin_paint( self)) return false; if ( !( ok = apc_application_begin_paint( self))) { CDrawable-> end_paint( self); perl_error(); } return ok; } Bool Application_begin_paint_info( Handle self) { Bool ok; if ( is_opt( optInDraw)) return true; if ( !CDrawable-> begin_paint_info( self)) return false; if ( !( ok = apc_application_begin_paint_info( self))) { CDrawable-> end_paint_info( self); perl_error(); } return ok; } void Application_detach( Handle self, Handle objectHandle, Bool kill) { inherited detach( self, objectHandle, kill); if ( var-> autoClose && ( var-> widgets. count == 1) && kind_of( objectHandle, CWidget) && ( objectHandle != var-> hintWidget) ) my-> close( self); } void Application_end_paint( Handle self) { if ( !is_opt( optInDraw)) return; apc_application_end_paint( self); CDrawable-> end_paint( self); } void Application_end_paint_info( Handle self) { if ( !is_opt( optInDrawInfo)) return; apc_application_end_paint_info( self); CDrawable-> end_paint_info( self); } Bool Application_focused( Handle self, Bool set, Bool focused) { if ( set) return false; return inherited focused( self, set, focused); } void Application_bring_to_front( Handle self) {} void Application_show( Handle self) {} void Application_hide( Handle self) {} void Application_insert_behind( Handle self, Handle view) {} void Application_send_to_back( Handle self) {} SV* Application_fonts( Handle self, char * name, char * encoding) { int count, i; AV * glo = newAV(); PFont fmtx = apc_fonts( self, name[0] ? name : nil, encoding[0] ? encoding : nil, &count); for ( i = 0; i < count; i++) { SV * sv = sv_Font2HV( &fmtx[ i]); HV * profile = ( HV*) SvRV( sv); if ( fmtx[i]. utf8_flags & FONT_UTF8_NAME) { SV ** entry = hv_fetch(( HV*) SvRV( sv), "name", 4, 0); if ( entry && SvOK( *entry)) SvUTF8_on( *entry); } if ( fmtx[i]. utf8_flags & FONT_UTF8_FAMILY) { SV ** entry = hv_fetch(( HV*) SvRV( sv), "family", 6, 0); if ( name && SvOK( *entry)) SvUTF8_on( *entry); } if ( fmtx[i]. utf8_flags & FONT_UTF8_ENCODING) { SV ** entry = hv_fetch(( HV*) SvRV( sv), "encoding", 8, 0); if ( name && SvOK( *entry)) SvUTF8_on( *entry); } if ( name[0] == 0 && encoding[0] == 0) { /* Read specially-coded (const char*) encodings[] vector, stored in fmtx[i].encoding. First pointer is filled with 0s, except the last byte which is a counter. Such scheme allows max 31 encodings per entry to be coded with sizeof(char*)==8. The interface must be re-implemented, but this requires either change in gencls syntax so arrays can be members of hashes, or passing of a dynamic-allocated pointer vector here. */ char ** enc = (char**) fmtx[i].encoding; unsigned char * shift = (unsigned char*) enc + sizeof(char *) - 1, j = *shift; AV * loc = newAV(); pset_sv_noinc( encoding, newSVpv(( j > 0) ? *(++enc) : "", 0)); while ( j--) av_push( loc, newSVpv(*(enc++),0)); pset_sv_noinc( encodings, newRV_noinc(( SV*) loc)); } pdelete( resolution); pdelete( codepage); av_push( glo, sv); } free( fmtx); return newRV_noinc(( SV *) glo); } SV* Application_font_encodings( Handle self, char * encoding) { AV * glo = newAV(); HE *he; PHash h = apc_font_encodings( self); if ( !h) return newRV_noinc(( SV *) glo); hv_iterinit(( HV*) h); for (;;) { void *value, *key; STRLEN keyLen; if (( he = hv_iternext( h)) == nil) break; value = HeVAL( he); key = HeKEY( he); keyLen = HeKLEN( he); av_push( glo, newSVpvn(( char*) key, keyLen)); } return newRV_noinc(( SV *) glo); } Font Application_get_default_font( char * dummy) { Font font; apc_font_default( &font); return font; } Font Application_get_message_font( char * dummy) { Font font; apc_sys_get_msg_font( &font); return font; } Font Application_get_caption_font( char * dummy) { Font font; apc_sys_get_caption_font( &font); return font; } int Application_get_default_cursor_width( char * dummy) { return apc_sys_get_value( svXCursor); } Point Application_get_default_scrollbar_metrics( char * dummy) { Point ret; ret. x = apc_sys_get_value( svXScrollbar); ret. y = apc_sys_get_value( svYScrollbar); return ret; } Point Application_get_default_window_borders( char * dummy, int borderStyle) { Point ret = { 0,0}; switch ( borderStyle) { case bsNone: ret.x = svXbsNone; ret.y = svYbsNone; break; case bsSizeable: ret.x = svXbsSizeable; ret.y = svYbsSizeable; break; case bsSingle: ret.x = svXbsSingle; ret.y = svYbsSingle; break; case bsDialog: ret.x = svXbsDialog; ret.y = svYbsDialog; break; default: return ret; } ret. x = apc_sys_get_value( ret. x); ret. y = apc_sys_get_value( ret. y); return ret; } int Application_get_system_value( char * dummy, int sysValue) { return apc_sys_get_value( sysValue); } SV * Application_get_system_info( char * dummy) { HV * profile = newHV(); char system [ 1024]; char release [ 1024]; char vendor [ 1024]; char arch [ 1024]; char gui_desc [ 1024]; int os, gui; os = apc_application_get_os_info( system, sizeof( system), release, sizeof( release), vendor, sizeof( vendor), arch, sizeof( arch)); gui = apc_application_get_gui_info( gui_desc, sizeof( gui_desc)); pset_i( apc, os); pset_i( gui, gui); pset_c( system, system); pset_c( release, release); pset_c( vendor, vendor); pset_c( architecture, arch); pset_c( guiDescription, gui_desc); return newRV_noinc(( SV *) profile); } Handle Application_get_widget_from_handle( Handle self, SV * handle) { ApiHandle apiHandle; if ( SvIOK( handle)) apiHandle = SvUVX( handle); else apiHandle = sv_2uv( handle); return apc_application_get_handle( self, apiHandle); } Handle Application_get_hint_widget( Handle self) { return var-> hintWidget; } static Bool icon_notify ( Handle self, Handle child, Handle icon) { if ( kind_of( child, CWindow) && (( PWidget) child)-> options. optOwnerIcon) { CWindow( child)-> set_icon( child, icon); PWindow( child)-> options. optOwnerIcon = 1; } return false; } Handle Application_icon( Handle self, Bool set, Handle icon) { if ( var-> stage > csFrozen) return nilHandle; if ( !set) return var-> icon; if ( icon && !kind_of( icon, CImage)) { warn("RTC0013: Illegal object reference passed to Application::icon"); return nilHandle; } if ( icon) { icon = ((( PImage) icon)-> self)-> dup( icon); ++SvREFCNT( SvRV((( PAnyObject) icon)-> mate)); } my-> first_that( self, (void*)icon_notify, (void*)icon); if ( var-> icon) my-> detach( self, var-> icon, true); var-> icon = icon; if ( icon && ( list_index_of( var-> components, icon) < 0)) my-> attach( self, icon); return nilHandle; } Handle Application_get_focused_widget( Handle self) { return apc_widget_get_focused(); } Handle Application_get_active_window( Handle self) { return apc_window_get_active(); } Bool Application_autoClose( Handle self, Bool set, Bool autoClose) { if ( !set) return var-> autoClose; return var-> autoClose = autoClose; } SV * Application_sys_action( char * dummy, char * params) { char * i = apc_system_action( params); SV * ret = i ? newSVpv( i, 0) : nilSV; free( i); return ret; } typedef struct _SingleColor { Color color; int index; } SingleColor, *PSingleColor; Color Application_colorIndex( Handle self, Bool set, int index, Color color) { if ( var-> stage > csFrozen) return clInvalid; if (( index < 0) || ( index > ciMaxId)) return clInvalid; if ( !set) { switch ( index) { case ciFore: return opt_InPaint ? CDrawable-> get_color ( self) : var-> colors[ index]; case ciBack: return opt_InPaint ? CDrawable-> get_backColor ( self) : var-> colors[ index]; default: return var-> colors[ index]; } } else { SingleColor s; s. color = color; s. index = index; if ( !opt_InPaint) my-> first_that( self, (void*)single_color_notify, &s); if ( opt_InPaint) switch ( index) { case ciFore: CDrawable-> set_color ( self, color); break; case ciBack: CDrawable-> set_backColor ( self, color); break; } var-> colors[ index] = color; } return clInvalid; } void Application_set_font( Handle self, Font font) { if ( !opt_InPaint) my-> first_that( self, (void*)font_notify, &font); apc_font_pick( self, &font, & var-> font); if ( opt_InPaint) apc_gp_set_font ( self, &var-> font); } Bool Application_close( Handle self) { if ( var-> stage > csNormal) return true; return my-> can_close( self) ? ( apc_application_close( self), true) : false; } Bool Application_insertMode( Handle self, Bool set, Bool insMode) { if ( !set) return apc_sys_get_insert_mode(); return apc_sys_set_insert_mode( insMode); } Handle Application_get_modal_window( Handle self, int modalFlag, Bool topMost) { if ( modalFlag == mtExclusive) { return topMost ? var-> topExclModal : var-> exclModal; } else if ( modalFlag == mtShared) { return topMost ? var-> topSharedModal : var-> sharedModal; } return nilHandle; } Handle Application_get_parent( Handle self) { return nilHandle; } Point Application_get_scroll_rate( Handle self) { Point ret; ret. x = apc_sys_get_value( svAutoScrollFirst); ret. y = apc_sys_get_value( svAutoScrollNext); return ret; } static void hshow( Handle self) { PWidget_vmt hintUnder = CWidget( var-> hintUnder); SV * text = hintUnder-> get_hint( var-> hintUnder); Point size = hintUnder-> get_size( var-> hintUnder); Point s = my-> get_size( self); Point fin = {0,0}; Point pos = fin; Point mouse = my-> get_pointerPos( self); Point hintSize; PWidget_vmt hintWidget = CWidget( var-> hintWidget); apc_widget_map_points( var-> hintUnder, true, 1, &pos); hintWidget-> set_text( var-> hintWidget, text); sv_free( text); hintSize = hintWidget-> get_size( var-> hintWidget); fin. x = mouse. x - 16; fin. y = pos. y - hintSize. y - 1; if ( fin. y > mouse. y - hintSize. y - 32) fin. y = mouse. y - hintSize. y - 32; if ( fin. x + hintSize. x >= s. x) fin. x = pos. x - hintSize. x; if ( fin. x < 0) fin. x = 0; if ( fin. y + hintSize. y >= s. y) fin. y = pos. y - hintSize. y; if ( fin. y < 0) fin. y = pos. y + size. y + 1; if ( fin. y < 0) fin. y = 0; hintWidget-> set_origin( var-> hintWidget, fin); hintWidget-> show( var-> hintWidget); hintWidget-> bring_to_front( var-> hintWidget); } void Application_HintTimer_handle_event( Handle timer, PEvent event) { CComponent-> handle_event( timer, event); if ( event-> cmd == cmTimer) { Handle self = application; CTimer(timer)-> stop( timer); if ( var-> hintActive == 1) { Event ev = {cmHint}; if ( !var->hintUnder || apc_application_get_widget_from_point( self, my-> get_pointerPos(self)) != var->hintUnder || PObject( var-> hintUnder)-> stage != csNormal) return; ev. gen. B = true; ev. gen. H = var-> hintUnder; var-> hintVisible = 1; if (( PWidget( var-> hintUnder)-> stage == csNormal) && ( CWidget( var-> hintUnder)-> message( var-> hintUnder, &ev))) hshow( self); } else if ( var-> hintActive == -1) var-> hintActive = 0; } } void Application_set_hint_action( Handle self, Handle view, Bool show, Bool byMouse) { if ( show && !is_opt( optShowHint)) return; if ( show) { var-> hintUnder = view; if ( var-> hintActive == -1) { Event ev = {cmHint}; ev. gen. B = true; ev. gen. H = view; ((( PTimer) var-> hintTimer)-> self)-> stop( var-> hintTimer); var-> hintVisible = 1; if (( PWidget( view)-> stage == csNormal) && ( CWidget( view)-> message( view, &ev))) hshow( self); } else { if ( !byMouse && var-> hintActive == 1) return; CTimer( var-> hintTimer)-> start( var-> hintTimer); } var-> hintActive = 1; } else { int oldHA = var-> hintActive; int oldHV = var-> hintVisible; if ( oldHA != -1) ((( PTimer) var-> hintTimer)-> self)-> stop( var-> hintTimer); if ( var-> hintVisible) { Event ev = {cmHint}; ev. gen. B = false; ev. gen. H = view; var-> hintVisible = 0; if (( PWidget( view)-> stage != csNormal) || ( CWidget( view)-> message( view, &ev))) CWidget( var-> hintWidget)-> hide( var-> hintWidget); } if ( oldHA != -1) var-> hintActive = 0; if ( byMouse && oldHV) { var-> hintActive = -1; CTimer( var-> hintTimer)-> start( var-> hintTimer); } } } Color Application_hintColor( Handle self, Bool set, Color hintColor) { if ( !set) return CWidget( var-> hintWidget)-> get_color( var-> hintWidget); return CWidget( var-> hintWidget)-> set_color( var-> hintWidget, hintColor); } Color Application_hintBackColor( Handle self, Bool set, Color hintBackColor) { if ( !set) return CWidget( var-> hintWidget)-> get_backColor( var-> hintWidget); return CWidget( var-> hintWidget)-> set_backColor( var-> hintWidget, hintBackColor); } int Application_hintPause( Handle self, Bool set, int hintPause) { if ( !set) return CTimer( var-> hintTimer)-> get_timeout( var-> hintTimer); return CTimer( var-> hintTimer)-> set_timeout( var-> hintTimer, hintPause); } void Application_set_hint_font( Handle self, Font hintFont) { CWidget( var-> hintWidget)-> set_font( var-> hintWidget, hintFont); } Font Application_get_hint_font( Handle self) { return CWidget( var-> hintWidget)-> get_font( var-> hintWidget); } Bool Application_showHint( Handle self, Bool set, Bool showHint) { if ( !set) return inherited showHint( self, set, showHint); opt_assign( optShowHint, showHint); return false; } Handle Application_next( Handle self) { return self;} Handle Application_prev( Handle self) { return self;} SV * Application_palette( Handle self, Bool set, SV * palette) { return CDrawable-> palette( self, set, palette); } Handle Application_top_frame( Handle self, Handle from) { while ( from) { if ( kind_of( from, CWindow) && (( PWidget( from)-> owner == application) || !CWidget( from)-> get_clipOwner(from)) ) return from; from = PWidget( from)-> owner; } return application; } Handle Application_get_image( Handle self, int x, int y, int xLen, int yLen) { HV * profile; Handle i; Bool ret; Point sz; if ( var-> stage > csFrozen) return nilHandle; if ( x < 0 || y < 0 || xLen <= 0 || yLen <= 0) return nilHandle; sz = apc_application_get_size( self); if ( x + xLen > sz. x) xLen = sz. x - x; if ( y + yLen > sz. y) yLen = sz. y - y; if ( x >= sz. x || y >= sz. y || xLen <= 0 || yLen <= 0) return nilHandle; profile = newHV(); i = Object_create( "Prima::Image", profile); sv_free(( SV *) profile); ret = apc_application_get_bitmap( self, i, x, y, xLen, yLen); --SvREFCNT( SvRV((( PAnyObject) i)-> mate)); return ret ? i : nilHandle; } /* * Cannot return nilHandle. */ Handle Application_map_focus( Handle self, Handle from) { Handle topFrame = my-> top_frame( self, from); Handle topShared; if ( var-> topExclModal) return ( topFrame == var-> topExclModal) ? from : var-> topExclModal; if ( !var-> topSharedModal && var-> modalHorizons. count == 0) return from; /* return from if no shared modals active */ if ( topFrame == self) { if ( !var-> topSharedModal) return from; topShared = var-> topSharedModal; } else { Handle horizon = ( !CWindow( topFrame)-> get_modalHorizon( topFrame)) ? CWindow( topFrame)-> get_horizon( topFrame) : topFrame; if ( horizon == self) topShared = var-> topSharedModal; else topShared = PWindow( horizon)-> topSharedModal; } return ( !topShared || ( topShared == topFrame)) ? from : topShared; } static Handle popup_win( Handle xTop) { PWindow_vmt top = CWindow( xTop); if ( !top-> get_visible( xTop)) top-> set_visible( xTop, 1); if ( top-> get_windowState( xTop) == wsMinimized) top-> set_windowState( xTop, wsNormal); top-> set_selected( xTop, 1); return xTop; } Handle Application_popup_modal( Handle self) { Handle ha = apc_window_get_active(); Handle xTop; if ( var-> topExclModal) { /* checking exclusive modal chain */ xTop = ( !ha || ( PWindow(ha)->modal == 0)) ? var-> exclModal : ha; while ( xTop) { if ( PWindow(xTop)-> nextExclModal) { CWindow(xTop)-> bring_to_front( xTop); xTop = PWindow(xTop)-> nextExclModal; } else { return popup_win( xTop); } } } else { if ( !var-> topSharedModal && var-> modalHorizons. count == 0) return nilHandle; /* return from if no shared modals active */ /* checking shared modal chains */ if ( ha) { xTop = ( PWindow(ha)->modal == 0) ? CWindow(ha)->get_horizon(ha) : ha; if ( xTop == application) xTop = var-> sharedModal; } else xTop = var-> sharedModal ? var-> sharedModal : var-> modalHorizons. items[ 0]; while ( xTop) { if ( PWindow(xTop)-> nextSharedModal) { CWindow(xTop)-> bring_to_front( xTop); xTop = PWindow(xTop)-> nextSharedModal; } else { return popup_win( xTop); } } } return nilHandle; } Bool Application_pointerVisible( Handle self, Bool set, Bool pointerVisible) { if ( !set) return apc_pointer_get_visible( self); return apc_pointer_set_visible( self, pointerVisible); } Point Application_size( Handle self, Bool set, Point size) { if ( set) return size; return apc_application_get_size( self); } Point Application_origin( Handle self, Bool set, Point origin) { Point p = { 0, 0}; return p; } Bool Application_modalHorizon( Handle self, Bool set, Bool modalHorizon) { return true; } Bool Application_wantUnicodeInput( Handle self, Bool set, Bool want_ui) { if ( !set) return var-> wantUnicodeInput; #ifdef PERL_SUPPORTS_UTF8 if ( apc_sys_get_value( svCanUTF8_Input)) var-> wantUnicodeInput = want_ui; #endif return 0; } void Application_update_sys_handle( Handle self, HV * profile) {} Bool Application_get_capture( Handle self) { return false; } void Application_set_capture( Handle self, Bool capture, Handle confineTo) {} void Application_set_centered( Handle self, Bool x, Bool y) {} Bool Application_tabStop( Handle self, Bool set, Bool tabStop) { return false; } Bool Application_selectable( Handle self, Bool set, Bool selectable) { return false; } Handle Application_shape( Handle self, Bool set, Handle mask) { return nilHandle; } Bool Application_syncPaint( Handle self, Bool set, Bool syncPaint) { return false; } Bool Application_visible( Handle self, Bool set, Bool visible) { return true; } Bool Application_buffered( Handle self, Bool set, Bool buffered) { return false; } Bool Application_enabled( Handle self, Bool set, Bool enable) { return true;} int Application_growMode( Handle self, Bool set, int flags) { return 0; } Bool Application_hintVisible( Handle self, Bool set, Bool visible) { return false; } Handle Application_owner( Handle self, Bool set, Handle owner) { return nilHandle; } Bool Application_ownerColor( Handle self, Bool set, Bool ownerColor) { return false; } Bool Application_ownerBackColor( Handle self, Bool set, Bool ownerBackColor) { return false; } Bool Application_ownerFont( Handle self, Bool set, Bool ownerFont) { return false; } Bool Application_ownerShowHint( Handle self, Bool set, Bool ownerShowHint) { return false; } Bool Application_ownerPalette( Handle self, Bool set, Bool ownerPalette) { return false; } Bool Application_clipOwner( Handle self, Bool set, Bool clipOwner) { return true; } int Application_tabOrder( Handle self, Bool set, int tabOrder) { return 0; } SV * Application_text ( Handle self, Bool set, SV * text) { return nilSV; } Bool Application_transparent( Handle self, Bool set, Bool transparent) { return false; } Bool Application_validate_owner( Handle self, Handle * owner, HV * profile) { *owner = nilHandle; return true; } #ifdef __cplusplus } #endif