pkg://ikit-0.4-1.sparc.rpm:138064/
usr/
local/
lib/
ikit/ikit_func.tcl
info downloads
#
# Copyright (c) 1997 Picture Elements, Inc.
# Stephen Williams (steve@picturel.com)
#
# This source code is free software; you can redistribute it
# and/or modify it in source code form under the terms of the GNU
# Library General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option)
# any later version. In order to redistribute the software in
# binary form, you will need a Picture Elements Binary Software
# License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc.,
# 59 Temple Place - Suite 330
# Boston, MA 02111-1307, USA
#
# You should also have recieved a copy of the Picture Elements
# Binary Software License offer along with the source. This offer
# allows you to obtain the right to redistribute the software in
# binary (compiled) form. If you have not received it, contact
# Picture Elements, Inc.,
# 777 Panoramic Way
# Berkeley, CA 94704.
#
#ident "$Id: ikit_func.tcl,v 1.16 1997/07/08 22:23:38 steve Exp $"
#
# $Log: ikit_func.tcl,v $
# Revision 1.16 1997/07/08 22:23:38 steve
# name change.
#
# Revision 1.15 1997/07/07 22:50:42 steve
# Add the 1d median color quantization
#
# Revision 1.14 1997/07/07 03:29:27 steve
# Add the red332 color map reduction.
#
# Revision 1.13 1997/04/22 16:32:12 steve
# Add halftone.
#
# Revision 1.12 1997/02/14 20:54:37 steve
# Add the rgbmatch function.
#
# Revision 1.11 1997/02/03 07:50:10 steve
# Missing a newline
#
# Revision 1.10 1997/02/01 07:27:26 steve
# Add pixel replicate function.
#
# Revision 1.9 1997/02/01 02:11:44 steve
# Add planing to cut planes out of images.
#
# Revision 1.8 1997/02/01 01:08:32 steve
# Cascading function menu, and better dicumentation.
#
# Revision 1.7 1997/01/31 02:03:49 steve
# Add the square-error comparison.
#
# Revision 1.6 1997/01/29 02:06:11 steve
# Add the threshold algorithm.
#
# Revision 1.5 1997/01/28 19:55:38 steve
# Add support for diffusion filters.
#
# Revision 1.4 1997/01/28 06:10:21 steve
# hi-pass filter function
#
# Revision 1.3 1997/01/28 04:43:59 steve
# Add the round function.
#
# Revision 1.2 1997/01/28 04:06:20 steve
# Add the compare operation.
#
# Revision 1.1 1997/01/27 23:11:52 steve
# Create the diffuse function, move all the processing
# functions into the ikit_func.tcl file, and add the
# wishikit program to get static linking to work.
#
# --
# This file adds a bunch of function selections to the ikit
# program. This package uses core capabilities to implement the
# various functions described herin.
#
ik_add_function "Laplacian" \
laplacian
ik_add_function "Global Threshold" \
func_threshold
ik_add_function "Classical Screen~M = 3" {func_halftone fh_M3}
ik_add_function "Replicate~2 x 2" {func_replicate 2 2}
ik_add_function "Replicate~2 x 1" {func_replicate 2 1}
ik_add_function "Replicate~1 x 2" {func_replicate 1 2}
ik_add_function "Filter~Smooth" \
smooth
ik_add_function "Filter~High-pass" \
func_hi_filter
ik_add_function "Error Diffusion~Floyd-Steinberg" \
{func_diffuse floyd-steinberg}
ik_add_function "Error Diffusion~Jarvis, Judice and Ninke" \
{func_diffuse jjn}
ik_add_function "Error Diffusion~Stucki" \
{func_diffuse stucki}
ik_add_function "Compare Images~|a - b|" \
func_compare
ik_add_function "Compare Images~(a - b)^2" \
func_sqe
ik_add_function "Compare Colors~Projection" \
func_rgbproj
ik_add_function "Compare Colors~Match" \
func_rgbmatch
ik_add_function "Compare Colors~Project on white" \
func_rgbproj_white
ik_add_function "Plane~red" \
{func_plane 0}
ik_add_function "Plane~green" \
{func_plane 1}
ik_add_function "Plane~blue" \
{func_plane 2}
ik_add_function "Round to 8bits" \
func_round
ik_add_function "Quantize~1d Median" \
func_red1dmed
ik_add_function "Quantize~332" \
func_red332
# --
# The laplacian looks at an image on the top of the stack, calculates
# the laplacian of it, and pushes the result.
set laplacian_gain 10
proc laplacian {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
global laplacian_gain
ik_get_values "{laplacian_gain {Output gain:} integer}"
set image [image create ik_image -laplace $source -out-gain $laplacian_gain]
ik_stack_push $image "$image <-- Laplace($source, $laplacian_gain)\n"
}
proc smooth {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set m(x) 3
set m(y) 3
set m(0,0) 1 ; set m(1,0) 1 ; set m(2,0) 1
set m(0,1) 1 ; set m(1,1) 1 ; set m(2,1) 1
set m(0,2) 1 ; set m(1,2) 1 ; set m(2,2) 1
set image [image create ik_image -convolute $source -matrix m -gain 1/9]
.body.console insert end "$image <-- smooth($source)\n"
.body.stack.list insert 0 $image
}
proc func_compare {} {
set src1 [ik_stack_peek 0]
if {[llength $src1] == 0} { return }
set src2 [ik_stack_peek 1]
if {[llength $src2] == 0} { return }
set image [image create ik_image -compare $src1 $src2]
ik_stack_push $image "$image <-- compare($src1, $src2)\n"
}
proc func_diffuse {filter} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set image [image create ik_image -diffuse $source -filter $filter]
ik_stack_push $image "$image <-- Diffuse($source, $filter)\n"
}
proc func_hi_filter {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set m(x) 3
set m(y) 3
set m(0,0) -1 ; set m(1,0) -1 ; set m(2,0) -1
set m(0,1) -1 ; set m(1,1) 8 ; set m(2,1) -1
set m(0,2) -1 ; set m(1,2) -1 ; set m(2,2) -1
set image [image create ik_image -convolute $source -matrix m -gain 1/1]
.body.console insert end "$image <-- hi_filter($source)\n"
.body.stack.list insert 0 $image
}
# The M3 classical halftone mask is below. 19 shades of gray are
# supported in this mask, so the numbers are X13 and rearranged into a
# matrix.
# . . . 10 . . .
# . . 2 13 18 . .
# . 4 3 14 15 16 .
# 10 12 11 9 7 8 10
# . 18 17 6 1 2 .
# . . 16 5 4 . .
# . . . 10 . . .
set fh_M3(x) 6
set fh_M3(y) 6
set fh_M3(0,0) 0x7575
set fh_M3(1,0) 0x5b5b
set fh_M3(2,0) 0x6868
set fh_M3(3,0) 0x8282
set fh_M3(4,0) 0x9c9c
set fh_M3(5,0) 0x8f8f
set fh_M3(0,1) 0x4e4e
set fh_M3(1,1) 0x0d0d
set fh_M3(2,1) 0x1a1a
set fh_M3(3,1) 0xa9a9
set fh_M3(4,1) 0xeaea
set fh_M3(5,1) 0xdddd
set fh_M3(0,2) 0x4141
set fh_M3(1,2) 0x3434
set fh_M3(2,2) 0x2727
set fh_M3(3,2) 0xb6b6
set fh_M3(4,2) 0xc3c3
set fh_M3(5,2) 0xd0d0
set fh_M3(0,3) 0x8282
set fh_M3(1,3) 0x9c9c
set fh_M3(2,3) 0x8f8f
set fh_M3(3,3) 0x7575
set fh_M3(4,3) 0x5b5b
set fh_M3(5,3) 0x6868
set fh_M3(0,4) 0xa9a9
set fh_M3(1,4) 0xeaea
set fh_M3(2,4) 0xdddd
set fh_M3(3,4) 0x4e4e
set fh_M3(4,4) 0x0d0d
set fh_M3(5,4) 0x1a1a
set fh_M3(0,5) 0xb6b6
set fh_M3(1,5) 0xc3c3
set fh_M3(2,5) 0xd0d0
set fh_M3(3,5) 0x4141
set fh_M3(4,5) 0x3434
set fh_M3(5,5) 0x2727
proc func_halftone {matrix} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
global $matrix
set image [image create ik_image -halftone $source -matrix $matrix]
ik_stack_push $image "$image <-- Halftone($source, $matrix)\n"
}
proc func_plane {plane} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set image [ik_unique_image_name "$source\[$plane]"]
image create ik_image $image -crop $source -plane $plane
ik_stack_push $image "$image <-- Plane($source, $plane)\n"
}
proc func_replicate {x y} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set image [image create ik_image -replicate $source -xrep $x -yrep $y]
ik_stack_push $image "$image <-- Repl($source, $x x $y)\n"
}
proc func_round {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set image [image create ik_image -round $source]
ik_stack_push $image "$image <-- Round($source)\n"
}
proc func_red332 {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set image [image create ik_image -red332 $source]
ik_stack_push $image "$image <-- Reduce332($source)\n"
}
proc func_red1dmed {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set image [image create ik_image -red1dmed $source]
ik_stack_push $image "$image <-- Reduce 1d Median($source)\n"
}
proc func_sqe {} {
set src1 [ik_stack_peek 0]
if {[llength $src1] == 0} { return }
set src2 [ik_stack_peek 1]
if {[llength $src2] == 0} { return }
set image [image create ik_image -square-error $src1 $src2]
ik_stack_push $image "$image <-- square-error($src1, $src2)\n"
}
set func_thresh_value 32767
proc func_threshold {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
global func_thresh_value
ik_get_values "{func_thresh_value {Threshold:} integer}"
set image [image create ik_image \
-threshold $source \
-thresh $func_thresh_value]
ik_stack_push $image "$image <-- Threshold($source, $func_thresh_value)\n"
}
set func_rgb_red 0xffff
set func_rgb_green 0
set func_rgb_blue 0
proc func_rgbproj {} {
global func_rgb_red func_rgb_green func_rgb_blue
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
ik_get_values {
{func_rgb_red {Red:} integer}
{func_rgb_green {Green:} integer}
{func_rgb_blue {Blue:} integer}
}
set elaps [time {
set image [image create ik_image -rgbmatch $source \
-proj \
-red $func_rgb_red \
-green $func_rgb_green \
-blue $func_rgb_blue]
}]
ik_stack_push $image "$image <-- rgbproj($source, red)\n" "$elaps\n"
}
proc func_rgbproj_white {} {
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
set elaps [time {
set image [image create ik_image -rgbmatch $source \
-proj \
-red 0xffff \
-green 0xffff \
-blue 0xffff]
}]
ik_stack_push $image "$image <-- rgbproj($source, white)\n" "$elaps\n"
}
proc func_rgbmatch {} {
global func_rgb_red func_rgb_green func_rgb_blue
set source [ik_stack_peek]
if {[llength $source] == 0} { return }
ik_get_values {
{func_rgb_red {Red:} integer}
{func_rgb_green {Green:} integer}
{func_rgb_blue {Blue:} integer}
}
set elaps [time {
set image [image create ik_image -rgbmatch $source \
-match \
-red $func_rgb_red \
-green $func_rgb_green \
-blue $func_rgb_blue]
}]
ik_stack_push $image "$image <-- rgbmatch($source, red)\n" "$elaps\n"
}
