a small Tk extension -- adding a command to define bitmap 
Author Message
 a small Tk extension -- adding a command to define bitmap

Here is a small Tk extension to add a command called 'defbitmap',
which I found very convenient.  It allows you to define bitmaps in
your scripts.

Wish scripts often require special bitmaps for labels, buttons etc.
When you want to distribute such a script, you also have to distribute
those bitmap files with the script.  But with this 'defbitmap'
command, you don't have to, because you can define bitmaps in your
script.

For example, a bitmap can be defined like this:

        # define 'question-mark' bitmap (data taken from tk3.3beta)
        defbitmap question 17 27 {
            f00f00581500ac2a005655002ba8001550010ba000056001
            0ba0000560010bb00000580100af00805500c02a00401500
            c00200400100c00200400100c00200000000800100c00200
            400100c00200000100
        }

and it can be used like this:

        label .question -bitmap question

See the comments at the begnning of the attached file "defbitmap.c"
for details.

I also wrote a wish script to convert X11 bitmap file to defbitmap
command script for convenience.

I attach the shar file here since it's short.  You can also find
it at:
        srawgw.sra.co.jp:/pub/lang/tcl/contrib/defbitmap.shar.Z

                                                Makoto Ishisone

#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#

# Source directory /mnt/home/mmb/ishisone/src/tcl
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   5124 -r--r--r-- defbitmap.c
#   1088 -r-xr-xr-x xbmtotk
#
# ============= defbitmap.c ==============
if test -f 'defbitmap.c' -a X"$1" != X"-c"; then
        echo 'x - skipping defbitmap.c (File already exists)'
else
echo 'x - extracting defbitmap.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'defbitmap.c' &&
/*
X * defbitmap.c --
X *
X *     This file implements "defbitmap" command, which enables
X *     you to define bitmap in your scripts.
X */
X
#ifndef lint
static char rcsid[] = "$Id: defbitmap.c,v 1.4 1993/08/25 02:25:17 ishisone Exp $";
#endif
X
#include <stdlib.h>
#include "tk.h"
X
/*
X * NAME
X *     defbitmap - Define a bitmap
X *
X * SYNOPSIS
X *     defbitmap name width height hexstring
X *
X * DESCRIPTION
X *     'defbitmap' command is a Tcl command interface to
X *     Tk_DefineBitmap().  It allows you to include bitmap data in
X *     your scripts.
X *
X *     Name is the name of the bitmap, which can be used with
X *     standard '-bitmap' option on many widgets.  Width and height
X *     specify the dimensions of the bitmap.  Hexstring is the bitmap
X *     data, represented as a hexadecimal string.  The data format is
X *     similar to the one for Tk_DefineBitmap():
X *
X *             bitmap unit:            8
X *             bitmap pad:             8
X *             bitmap bit order:       LSB-first
X *             (Note: this is also same as what X11 'bitmap' command produces)
X *
X *     All the non-hexadecimal characters in hexstring are ignored.
X *     So the following two examples are equivalent.
X *
X *             defbitmap check 8 8 3333cccc3333cccc
X *
X *             defbitmap check 8 8 {
X *                 33, 33, cc, cc,
X *                 33, 33, cc, cc,
X *             }
X *
X *     defbitmap returns the name of the bitmap.
X *
X * ADDING TO YOUR APPLICATION
X *     To use this command in your application, call Tcl_CreateCommand()
X *     for each interpreter as below:
X *
X *     extern int DefBitmapCmd();
X *     ...
X *     Tcl_CreateCommand(interp, "defbitmap", DefBitmapCmd,
X *                       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
X */
X
static char *           getHex _ANSI_ARGS_((char *s, int *valp));
static char *           convHexToBin _ANSI_ARGS_((Tcl_Interp *interp,
X                                                 int n, char *s));
X
/*
X *----------------------------------------------------------------------
X *
X * getHex --
X *
X *     This procedure looks for the first hexadecimal character in
X *     the specified string.
X *
X * Results:
X *     *valp is set to the binary value of the hexadecimal character.
X *     The return value is an address of the next character.  If the
X *     string does not have any hexadecimal character, the return
X *     value is NULL.
X *
X * Side effects:
X *     None.
X *
X *----------------------------------------------------------------------
X */
X
static char *
getHex(s, valp)
char *s;
int *valp;
{
X    int val = -1;
X
X    while (val < 0) {
X       int c = *s++;
X
X       if ('0' <= c && c <= '9') {
X           val = c - '0';
X       } if ('a' <= c && c <= 'f') {
X           val = c - 'a' + 10;
X       } else if ('A' <= c && c <= 'F') {
X           val = c - 'A' + 10;
X       } else if (c == '\0') {
X           return NULL;
X       }
X    }
X    *valp = val;
X    return s;

Quote:
}

X
/*
X *----------------------------------------------------------------------
X *
X * convHexToBin --
X *
X *     This procedure converts the specified hexadecimal string
X *     to binary.
X *
X * Results:
X *     N specifies the number of bytes to be converted. If the
X *     given string does not contain enough hexadecimal characters,
X *     the return value is NULL and an error messages is set to
X *     the interpreter.  Otherwise, the return value is a pointer
X *     to the area where binary data is stored.
X *
X * Side effects:
X *     The area for the binary data is malloc'ed.  It is the caller's
X *     responsibility to free the area.
X *
X *----------------------------------------------------------------------
X */
X
static char *
convHexToBin(interp, n, s)
Tcl_Interp *interp;
int n;
char *s;
{
X    unsigned char *bits, *p;
X
X    p = bits = (unsigned char *)ckalloc((unsigned int)n);
X
X    while (n-- > 0) {
X       int h1, h2;
X
X       if ((s = getHex(s, &h1)) == NULL || (s = getHex(s, &h2)) == NULL) {
X           Tcl_AppendResult(interp, "bit data too short", NULL);
X           ckfree((char *)bits);
X           return NULL;
X       }
X       *p++ = h1 * 16 + h2;
X    }
X    return (char *)bits;
Quote:
}

X
/*
X *----------------------------------------------------------------------
X *
X * DefBitmapCmd --
X *
X *     This procedure implements the "defbitmap" command.
X *     See the documentation at the top of this file for details.
X *
X * Results:
X *     A standard Tcl result.
X *
X * Side effects:
X *     See the documentation.
X *
X *----------------------------------------------------------------------
X */
X
/* ARGSUSED */
int
DefBitmapCmd(cldata, interp, argc, argv)
ClientData cldata;
Tcl_Interp *interp;
int argc;
char **argv;
{
X    int width, height;
X    int nbytes;
X    char *bits;
X    int ret;
X
X    /*
X     * defbitmap name width height hex-string
X     */
X    if (argc != 5) {
X       Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                        " name width height hex-string\"", NULL);
X       return TCL_ERROR;
X    }
X    if ((width = strtol(argv[2], (char **)NULL, 0)) <= 0) {
X       Tcl_AppendResult(interp, "invalid width", NULL);
X       return TCL_ERROR;
X    }
X    if ((height = strtol(argv[3], (char **)NULL, 0)) <= 0) {
X       Tcl_AppendResult(interp, "invalid height", NULL);
X       return TCL_ERROR;
X    }
X
X    nbytes = ((width + 7) / 8) * height;
X    if ((bits = convHexToBin(interp, nbytes, argv[4])) == NULL) {
X       return TCL_ERROR;
X    }
X    ret = Tk_DefineBitmap(interp, Tk_GetUid(argv[1]), bits,
X                         (unsigned int)width, (unsigned int)height);
X    if (ret != TCL_OK) {
X       ckfree(bits);
X    } else {
X       Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
X    }
X
X    return ret;
Quote:
}

SHAR_EOF
chmod 0444 defbitmap.c ||
echo 'restore of defbitmap.c failed'
Wc_c="`wc -c < 'defbitmap.c'`"
test 5124 -eq "$Wc_c" ||
        echo 'defbitmap.c: original size 5124, current size' "$Wc_c"
fi
# ============= xbmtotk ==============
if test -f 'xbmtotk' -a X"$1" != X"-c"; then
        echo 'x - skipping xbmtotk (File already exists)'
else
echo 'x - extracting xbmtotk (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'xbmtotk' &&
#! /usr/local/bin/wish -f
# $Id: xbmtotk,v 1.3 1993/08/25 01:19:21 ishisone Exp $
#
# xbmtotk -- X bitmapfile -> defbitmap converter
#       usage: xbmtotk [bitmap-file...]
X
proc convert {file {bitmap_name {}}} {
X    set width 0
X    set height 0
X
X    while {[gets $file line] >= 0} {
X       if {[regexp "#define.*_width" $line]} {
X           set width [lindex $line 2]
X       } elseif {[regexp "#define.*_height" $line]} {
X           set height [lindex $line 2]
X       } elseif {[regexp "char (.*)_bits" $line junk name]} {
X           if {"$bitmap_name" == ""} {set bitmap_name $name}
X           break
X       }
X    }
X
X    if {!$width || !$height} {
X       puts stderr "no width/height line"
X       exit 1
X    } elseif {"$bitmap_name" == ""} {
X       puts stderr "cannot get bitmap name"
X       exit 1
X    }
X
X    puts stdout "defbitmap $bitmap_name $width $height \{"
X    while {[gets $file line] >= 0} {
X       regsub -all {0x| |,|;} $line {} s
X       puts stdout "    $s"
X       if {[string first \} $line] >= 0} break;
X    }
Quote:
}

X
if {[llength $argv] < 1} then {
X    convert stdin
Quote:
} else {

X    foreach arg $argv {
X       set file [open $arg r]
X       convert $file
X       close $file
X    }
Quote:
}

X
destroy .
SHAR_EOF
chmod 0555 xbmtotk ||
echo 'restore of xbmtotk failed'
Wc_c="`wc -c < 'xbmtotk'`"
test 1088 -eq "$Wc_c" ||
        echo 'xbmtotk: original size 1088, current size' "$Wc_c"
fi
exit 0


Sun, 11 Feb 1996 10:56:52 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. ANNOUNCE: Tk extension for adding canvas commands (on items)

2. Info commands does not show extension added commands?

3. Converting Windows Bitmap to X bitmap format so that Tk can display it

4. TIP #96: Add [tk caret] Command and Tk_SetCaretPos API

5. How to add Tk commands

6. Problem adding commands to a Tk interpreter.

7. Problems with adding my C commands to Tk...

8. Command Table Help - trying to define alternate command for SCRNAME

9. bitmap on smaller screen

10. Small animated icon or bitmap somewhere?

11. Converting a pre-defined bitmap to an image?

12. Creating an image from a pre-defined bitmap

 

 
Powered by phpBB® Forum Software