ftp.nice.ch/pub/next/graphics/vector/PencilTWO.s.tar.gz#/PencilTWO/Source/PencilLibrary/Attributes.tcl

This is Attributes.tcl in view mode; [Download] [Up]

# The attributes palette

proc ATrefresh {} {
global ATwin ATnum .curwin ATview ATimg ATsc ATname

$ATwin hideDisplay {
set .curwin $ATwin
set ATview [new view 0 0 80 [expr $ATnum*80] {} -nowindow]
set ATsc [new scrollview 0 20 100 100 $ATview]
$ATsc autosize w h
for {set i 0} {$i<$ATnum} {incr i} {
	[new button 0 [expr $i*80] 80 80 $ATname($i) "ATdo $i" -window $ATview] setImage $ATimg($i) -above
}
}
$ATwin display
}

proc ATaddAtt {} {
	global ATaddWin .curwin ATpath

	set l [P_selection]
	if ([llength $l]==0)||([llength $l]>1) {alertPanel "Add attribute" "Please select exactly one object before trying to add it to the attribute list." OK} {
	if ![info exists ATaddWin] {
		new fromNIB $ATpath/../AddAttributes.nib
		set ATaddWin ${.curwin}
	} {
		$ATaddWin orderFront
	}
	}
}

proc ATdoAddObj {} {
	global ATtf ATaddWin

	$ATaddWin close
	addAttr [$ATtf value]
}

proc addAttr {name} {
global ATpath n

P_selToTIFF $ATpath/$name.tiff 75.0 75.0
set f [open $ATpath/$name.att w]
puts $f [P_getobject $n]
close $f
ATadd $name
}

proc ATadd {n} {
	global ATsc ATimg ATpath ATnum ATdorefresh ATatt ATname

	set ATimg($ATnum) [new image -load $ATpath/$n.tiff]
	set f [open $ATpath/$n.att]
	set ATatt($ATnum) [read $f]
	set ATname($ATnum) $n
	close $f
	incr ATnum
	
	if $ATdorefresh {
		if [info exists ATsc] {$ATsc free}
		ATrefresh
	}
}

catch {
set ATnum 0
set ATwin [new window 123 21 100 120 "Attribute"]
new button 0 0 100 20 "Add attr..." ATaddAtt
set ATpath [P_find Attributes]
catch {
set ATdorefresh 0
catch {
foreach f [glob $ATpath/*.att] {
catch {ATadd [file tail [file root $f]]}
}
}
set ATdorefresh 1
ATrefresh
}
}

proc ATdo {i} {
	global ATatt curL curBr
	
	set o $ATatt($i)
	P_setCurLayer [set ly [lindex $o 17]]
	P_setAttributes [lindex $o 1] [lindex $o 2] [lindex $o 4] [lindex $o 3] [lindex $o 5] [lindex $o 16] [lindex $o 10] [lindex $o 11] [lindex $o 12] [lindex $o 13] [lindex $o 14] [lindex $o 15]
	$curBr select $ly
	set curL $ly
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.