From aebe147ae46e27127faa5c9d777de6b9ab822cc9 Mon Sep 17 00:00:00 2001 From: "N.N." Date: Mon, 30 May 2005 09:29:26 +0000 Subject: toxy alpha18 and pddp alpha2 (see notes.txt for toxy, pddp and shared) svn path=/trunk/externals/miXed/; revision=3094 --- Makefile.common | 15 +- bin/pddp/pddpboot.tcl | 32 +++ bin/pddp/pddpclient.tcl | 82 +++++++ bin/pddp/pddpserver.tcl | 490 ++++++++++++++++++++++++++++++++++++++++++ bin/pddp/pkgIndex.tcl | 10 + pddp/Makefile | 8 - pddp/build_counter | 4 +- pddp/notes.txt | 17 +- pddp/pddpboot.tcl | 32 --- pddp/pddpclient.tcl | 82 ------- pddp/pddplink.c | 304 ++++++++++++++++++++++++-- pddp/pddpserver.tcl | 490 ------------------------------------------ shared/notes.txt | 3 + shared/toxy/plusbob.c | 75 ++++--- shared/toxy/plusbob.h | 15 +- test/pddp/pddplink-test-01.pd | 25 ++- test/pddp/pddplink-test-02.pd | 25 ++- toxy/Makefile.objects | 3 +- toxy/build_counter | 4 +- toxy/notes.txt | 18 ++ toxy/plustot.c | 180 +++++++++++++--- toxy/plustot.env.c | 10 +- toxy/plustot.h | 24 ++- toxy/plustot.in.c | 12 +- toxy/plustot.out.c | 13 +- toxy/plustot.print.c | 13 +- toxy/plustot.qlist.c | 12 +- toxy/plustot.var.c | 12 +- toxy/pluswidget.c | 249 +++++++++++++++++++++ 29 files changed, 1506 insertions(+), 753 deletions(-) create mode 100755 bin/pddp/pddpboot.tcl create mode 100644 bin/pddp/pddpclient.tcl create mode 100644 bin/pddp/pddpserver.tcl create mode 100644 bin/pddp/pkgIndex.tcl delete mode 100755 pddp/pddpboot.tcl delete mode 100644 pddp/pddpclient.tcl delete mode 100644 pddp/pddpserver.tcl create mode 100644 toxy/pluswidget.c diff --git a/Makefile.common b/Makefile.common index 4dd5f25..6b33c72 100644 --- a/Makefile.common +++ b/Makefile.common @@ -74,6 +74,12 @@ OUT_DIR = $(ROOT_DIR)/bin BASE_DIR = $(shell basename `pwd`) BASE_NAME = $(shell basename `pwd` | awk -F - '{print $$1}') +INCLUDES = -I . -I $(PD_DIR) -I $(SHARED_DIR) + +ifdef CAML_TYPES +include $(ROOT_DIR)/Makefile.caml +endif + # CX: control external's main file # AX: audio (tilde) external's main file # LX: alias external's main file @@ -99,8 +105,6 @@ SOURCES = $(CX_SOURCES) $(AX_SOURCES) $(LX_SOURCES) $(OTHER_SOURCES) \ $(foreach type,$(TYPES),$($(type)_SOURCES)) \ $(foreach type,$(TYPES),$($(type)_PRIVATEOBJECTS:.o=.c)) -INCLUDES = -I. -I$(PD_DIR) -I$(SHARED_DIR) - ifeq ($(MY_NAME),krzYszcz) WARN_CFLAGS = -Wall -W -Wstrict-prototypes -Werror \ -Wno-unused -Wno-parentheses -Wno-switch @@ -123,9 +127,10 @@ EXTERNS = $(foreach fn,$(CX_NAMES:.c=.$(X_SUFFIX)),$(OUT_DIR)/$(fn)) \ TYPES_RULE = $(foreach fn,$(call TYPES_EXTERNS,$1),$(OUT_DIR)/$(fn)): \ $(OUT_DIR)/%$($1_TILDE).$(X_SUFFIX) \ - : $(call TYPES_DIR,$1)%.o $($1_PRIVATEOBJECTS) \ + : $(call TYPES_DIR,$1)%.o \ + $($1_PRIVATEOBJECTS) $($1_FOREIGNOBJECTS) \ $(foreach obj,$($1_OBJECTS),$(SHARED_DIR)/$(obj)) \ - ; $(CC) -o $$@ $(CFLAGS) $(LFLAGS) $($1_LIBS) $$+ + ; $(CC) -o $$@ $(CFLAGS) $(LFLAGS) $$+ $($1_LIBS) # LATER find a better way... $(if $(word 1,$(TYPES)),$(call TYPES_RULE,$(word 1,$(TYPES)))) @@ -240,7 +245,7 @@ all$(BASE_NAME)s.c: Makefile.sources all: $(EXTERNS) $(SUBDIRS_DEFAULT) -clean: emptydeps +clean:: emptydeps # remove all objects and externs that are contained in current directory -rm -f *.o *.$(X_SUFFIX) $(SUBDIRS) diff --git a/bin/pddp/pddpboot.tcl b/bin/pddp/pddpboot.tcl new file mode 100755 index 0000000..429ff8a --- /dev/null +++ b/bin/pddp/pddpboot.tcl @@ -0,0 +1,32 @@ +#!/bin/sh +# \ +exec tclsh "$0" -- "$@" + +# Synopsis +# test run: +# ./pddpboot.tcl [root [port [path]]] +# from Pd: +# source pddpboot.tcl +# ::pddp::srvUse root (or ::pddp::srvStart root [port]) +# ::pddp::cliOpen path +# ... (more "::pddp::cliOpen" calls) ... +# ::pddp::srvStop + +if {[namespace exists ::pddp]} { ;# created by pddplink's setup + puts stderr "Booting pddp" + set ::pddp::testrun 0 +} else { + puts stderr "Booting pddp, test run..." + namespace eval ::pddp { variable testrun 1 } +} + +if {[info exists ::pddp::theDir]} { + source [file join $::pddp::theDir pddpclient.tcl] + source [file join $::pddp::theDir pddpserver.tcl] + if {[info exists ::pddp::theVersion]} { + package provide pddp $::pddp::theVersion + } +} else { + source pddpclient.tcl] + source pddpserver.tcl] +} diff --git a/bin/pddp/pddpclient.tcl b/bin/pddp/pddpclient.tcl new file mode 100644 index 0000000..998c55a --- /dev/null +++ b/bin/pddp/pddpclient.tcl @@ -0,0 +1,82 @@ +# pddpclient.tcl + +# Synopsis +# not to be run by itself (see pddpboot.tcl) + +if {![namespace exists ::pddp]} { + puts stderr "Error: invalid invocation of pddpclient (boot pddp first)" + puts stderr "exiting..." + exit 1 +} + +if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl" + puts stderr "Loading pddpclient, test run..." + if {$argc > 3} { + set path [lindex $argv 3] + if {[string length $path]} { + puts stderr "Scheduling \"$path\" for opening" + after idle ::pddp::cliOpen $path + } + unset path + } +} else { + puts stderr "Loading pddpclient" +} + +namespace eval ::pddp { + variable theBrowserCommand + + switch -- $::tcl_platform(platform) { + unix { + switch -- $tcl_platform(os) { + Darwin { + set theBrowserCommand "sh -c \"open %s\"" + } + Linux { + foreach candidate \ + {firefox mozilla galeon konqueror netscape lynx} { + set browser [lindex [auto_execok $candidate] 0] + if {[string length $browser]} { + set theBrowserCommand "$browser %s &" + break + } + } + } + } + } + windows { + # should not this be just: [auto_execok start]? + set theBrowserCommand \ + "rundll32 url.dll,FileProtocolHandler file:%s &" + } + } +} + +proc ::pddp::cliError {err} { + puts stderr "Error in pddpclient: $err" +} + +proc ::pddp::cliOpen {path} { + if {[string first "://" $path] < 1} { + if {[info exists ::pddp::thePort]} { + set path "http://localhost:$::pddp::thePort/$path" + } else { + cliError "pddpserver not running" + return + } + } + variable theBrowserCommand + if {[string length $theBrowserCommand]} { + set command [format $theBrowserCommand $path] + puts stderr "pddpclient: exec $command" + if {[catch {eval [list exec] $command} err]} { + if {[lindex $::errorCode 0] eq "CHILDSTATUS"} { + cliError "$err (child status [lindex $::errorCode 2])" + } else { + cliError $err + } + } + } else { + cliError "browser unavailable" + } +} diff --git a/bin/pddp/pddpserver.tcl b/bin/pddp/pddpserver.tcl new file mode 100644 index 0000000..4b96be2 --- /dev/null +++ b/bin/pddp/pddpserver.tcl @@ -0,0 +1,490 @@ +# pddpserver.tcl + +# Synopsis +# not to be run by itself (see pddpboot.tcl) + +# based on: + +# Simple Sample httpd/1.[01] server +# Stephen Uhler (c) 1996-1997 Sun Microsystems + +# http://cvs.sourceforge.net/viewcvs.py/tclhttpd/tclhttpd/bin/mini/mini1.1.tcl + +# modified by krzYszcz (2005): +# putting per-server data and all commands in a namespace "::pddp" +# supporting sourcing from within Pd, through the "pddpboot.tcl" wrapper +# inserting the .pd handler +# lots of other changes, too many to list here (run "diff" if curious...) + +if {![namespace exists ::pddp]} { + puts stderr "Error: invalid invocation of pddpserver (boot pddp first)" + puts stderr "exiting..." + exit 1 +} + +if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl" + puts stderr "Loading pddpserver, test run..." + proc bgerror {msg} { + global errorInfo + puts stderr "bgerror: $msg\n$errorInfo" + } +} else { + puts stderr "Loading pddpserver" + catch {console show} +} + +namespace eval ::pddp { + variable thePort 0 + variable theState + variable theMimeTypes + variable theErrors + variable theErrorFormat + + # "theState" contains the server state: + # root: the root of the document directory + # default: default document name + # listen: the main listening socket id + # naccepts: a count of accepted connections so far + # maxtime: the max time (msec) allowed to complete an http request + # maxused: the max # of requests for a socket + array set theState { + root "" + default index.html + listen "" + naccepts 0 + nrequests 0 + nerrors 0 + maxtime 600000 + maxused 25 + bufsize 32768 + } + + set theState(root) $env(HOME) + + array set theMimeTypes { + {} text/plain + .txt text/plain + .html text/html + .gif image/gif + .jpg image/jpeg + .pd text/html + } + + # HTTP/1.[01] error codes (the ones we use) + array set theErrors { + 204 {No Content} + 400 {Bad Request} + 404 {Not Found} + 405 {Method Not Allowed} + 408 {Request Timeout} + 411 {Length Required} + 419 {Expectation Failed} + 500 {Internal Server Error} + 503 {Service Unavailable} + 504 {Service Temporarily Unavailable} + 505 {HTTP Version Not Supported} + } + + # Generic error response + set theErrorFormat { + Error: %1$s + Got the error: %2$s
+ while trying to obtain %3$s + } +} + +proc ::pddp::srvUse {{root {}} {port 0}} { + variable theState + if {[string length $theState(listen)]} { + if {[string length $root] && ![string equal $root $theState(root)]} { + srvLog $theState(listen) Warning "Redirection attempt for $root" + } + } else { + srvStart $root $port + } +} + +# Start the server by listening for connections on the desired port. + +proc ::pddp::srvStart {{root {}} {port 0}} { + variable thePort + variable theState + + puts stderr "Starting pddp server on [info hostname]" + if {[string length $root]} { + set theState(root) $root + } + # we do not handle multiple pddpservers, LATER rethink + srvStop + array set theState [list naccepts 0 nrequests 0 nerrors 0] + + for { set thePort $port } {$thePort < 65535 } {incr thePort } { + if {[catch {set theState(listen) \ + [socket -server ::pddp::srvAccept $thePort]} res]} { + if {$thePort == 0} { + # FIXME this is a critical error + set thePort 32768 + } + } else { break } + } + if {$thePort == 65535} { + srvLog none Error "Could not find port available for listening" + } else { + if {$thePort == 0} { + set thePort [lindex [fconfigure $theState(listen) -sockname] 2] + } + srvLog $theState(listen) Port $thePort + srvLog $theState(listen) Root directory \"$root\" + } + after 120 update ;# FIXME might be needed on windows they say, test there + return $thePort +} + +proc ::pddp::srvStop {} { + variable thePort + variable theState + if {[string length $theState(listen)]} { + if {[catch {close $theState(listen)} res]} { + srvLog $theState(listen) Warning [list $res while closing socket] + } else { + srvLog $theState(listen) Closed. + } + set theState(listen) "" + update + } +} + +# Accept a new connection from the server and set up a handler +# to read the request from the client. + +proc ::pddp::srvAccept {sock ipaddr port} { + variable theState + variable theSockData$sock + # reject remote requests, LATER revisit + if {[string equal $ipaddr "127.0.0.1"]} { + incr theState(naccepts) + srvReset $sock $theState(maxused) + srvLog $sock Connect $ipaddr $port + } else { + srvLog $sock Warning "rejecting remote connection request from $ipaddr" + srvSockDone $sock 1 + } +} + +# Initialize or reset the socket state + +proc ::pddp::srvReset {sock nlft} { + variable theState + upvar 0 ::pddp::theSockData$sock sockData + array set sockData [list state start linemode 1 version 0 nleft $nlft] + set sockData(cancel) \ + [after $theState(maxtime) [list srvTimeout $sock]] + fconfigure $sock -blocking 0 -buffersize $theState(bufsize) \ + -translation {auto crlf} + fileevent $sock readable [list ::pddp::srvRead $sock] +} + +# Read data from a client request +# 1) read the request line +# 2) read the mime headers +# 3) read the additional data (if post && content-length not satisfied) + +proc ::pddp::srvRead {sock} { + variable theState + upvar 0 ::pddp::theSockData$sock sockData + + # Use line mode to read the request and the mime headers + + if {$sockData(linemode)} { + set readCount [gets $sock line] + set state [string compare $readCount 0],$sockData(state) + switch -glob -- $state { + 1,start { + if {[regexp {(HEAD|POST|GET) ([^?]+)\??([^ ]*) HTTP/1.([01])} \ + $line x sockData(proto) sockData(url) \ + sockData(query) sockData(version)]} { + set sockData(state) mime + incr theState(nrequests) + srvLog $sock Request $sockData(nleft) $line + } else { + srvError $sock 400 $line + } + } + 0,start { + srvLog $sock Warning "Initial blank line fetching request" + } + 1,mime { + if {[regexp {([^:]+):[ ]*(.*)} $line {} key value]} { + set key [string tolower $key] + set sockData(key) $key + if {[info exists sockData(mime,$key)]} { + append sockData(mime,$key) ", $value" + } else { + set sockData(mime,$key) $value + } + } elseif {[regexp {^[ ]+(.+)} $line {} value] && \ + [info exists sockData(key)]} { + append sockData(mime,$sockData($key)) " " $value + } else { + srvError $sock 400 $line + } + } + 0,mime { + if {$sockData(proto) == "POST" && \ + [info exists sockData(mime,content-length)]} { + set sockData(linemode) 0 + set sockData(count) $sockData(mime,content-length) + if {$sockData(version) && \ + [info exists sockData(mime,expect)]} { + if {$sockData(mime,expect) == "100-continue"} { + puts $sock "100 Continue HTTP/1.1\n" + flush $sock + } else { + srvError $sock 419 $sockData(mime,expect) + } + } + fconfigure $sock -translation {binary crlf} + } elseif {$sockData(proto) != "POST"} { + srvRespond $sock + } else { + srvError $sock 411 "Confusing mime headers" + } + } + -1,* { + if {[eof $sock]} { + srvLog $sock Error "Broken connection fetching request" + srvSockDone $sock 1 + } else { + puts stderr "Partial read, retrying" + } + } + default { + srvError $sock 404 "Invalid http state: $state,[eof $sock]" + } + } + + # Use counted mode to get the post data + + } elseif {![eof $sock]} { + append sockData(postdata) [read $sock $sockData(count)] + set sockData(count) [expr {$sockData(mime,content-length) - \ + [string length $sockData(postdata)]}] + if {$sockData(count) == 0} { + srvRespond $sock + } + } else { + srvLog $sock Error "Broken connection reading POST data" + srvSockDone $sock 1 + } +} + +# Done with the socket, either close it, or set up for next fetch +# sock: The socket I'm done with +# doclose: If true, close the socket, otherwise set up for reuse + +proc ::pddp::srvSockDone {sock doclose} { + variable theState + upvar 0 ::pddp::theSockData$sock sockData + + after cancel $sockData(cancel) + set nleft [incr sockData(nleft) -1] + unset sockData + if {$doclose} { + close $sock + } else { + srvReset $sock $nleft + } + return "" +} + +# A timeout happened + +proc ::pddp::srvTimeout {sock} { + srvError $sock 408 +} + +# FIXME test if "path" has its patch window already open... +proc ::pddp::srvPdHandler {sock path} { + set dir [file dirname $path] + set tail [file tail $path] + if {[catch {pd [concat pd open $tail $dir \;]}]} { + srvError $sock 504 + } else { + srvError $sock 204 + # FIXME raise; focus (test on windows) + } +} + +# Handle file system queries. This is a place holder for a more +# generic dispatch mechanism. + +proc ::pddp::srvRespond {sock} { + variable theState + variable theUrlCache + upvar 0 ::pddp::theSockData$sock sockData + + regsub {(^http://[^/]+)?} $sockData(url) {} url + if {[info exists theUrlCache($url)]} { + set mypath $theUrlCache($url) + } else { + set mypath [srvUrl2File $theState(root) $url] + if {[file isdirectory $mypath]} { + append mypath / $theState(default) + } + set theUrlCache($url) $mypath + } + if {[string length $mypath] == 0} { + srvError $sock 400 + } elseif {![file readable $mypath]} { + if {[string equal [file tail $mypath] "favicon.ico"]} { + srvError $sock 204 ;# FIXME design something + } else { + srvError $sock 404 $mypath + } + } else { + set ext [file extension $mypath] + + if {[string equal $ext ".pd"]} { + srvPdHandler $sock $mypath + return + } + + puts $sock "HTTP/1.$sockData(version) 200 Data follows" + puts $sock "Date: [srvGetDate [clock seconds]]" + puts $sock "Last-Modified: [srvGetDate [file mtime $mypath]]" + puts $sock "Content-Type: [srvContentType $ext]" + puts $sock "Content-Length: [file size $mypath]" + + ## Should also close socket if recvd connection close header + set doclose [expr {$sockData(nleft) == 0}] + + if {$doclose} { + puts $sock "Connection close:" + } elseif {$sockData(version) == 0 && \ + [info exists sockData(mime,connection)]} { + if {$sockData(mime,connection) == "Keep-Alive"} { + set doclose 0 + puts $sock "Connection: Keep-Alive" + } + } + puts $sock "" + flush $sock + + if {$sockData(proto) != "HEAD"} { + set in [open $mypath] + fconfigure $sock -translation binary + fconfigure $in -translation binary + fcopy $in $sock -command \ + [list ::pddp::srvCopyDone $in $sock $doclose] + } else { + srvSockDone $sock $doclose + } + } +} + +# Callback when file is done being output to client +# in: The fd for the file being copied +# sock: The client socket +# doclose: close the socket if true +# bytes: The # of bytes copied +# error: The error message (if any) + +proc ::pddp::srvCopyDone {in sock doclose bytes {error {}}} { + close $in + srvLog $sock Done $bytes bytes + srvSockDone $sock $doclose +} + +# Convert the file suffix into a mime type. + +proc ::pddp::srvContentType {ext} { + variable theMimeTypes + set type text/plain + catch {set type $theMimeTypes($ext)} + return $type +} + +# Respond with an error reply +# sock: The socket handle to the client +# code: The httpd error code +# args: Additional information for error logging + +proc ::pddp::srvError {sock code args} { + variable theState + variable theErrors + variable theErrorFormat + upvar 0 ::pddp::theSockData$sock sockData + + append sockData(url) "" + incr theState(nerrors) + set message [format $theErrorFormat $code $theErrors($code) $sockData(url)] + append head "HTTP/1.$sockData(version) $code $theErrors($code)" \n + append head "Date: [srvGetDate [clock seconds]]" \n + append head "Connection: close" \n + append head "Content-Length: [string length $message]" \n + + # Because there is an error condition, the socket may be "dead" + + catch { + fconfigure $sock -translation crlf + puts -nonewline $sock $head\n$message + flush $sock + } reason + srvSockDone $sock 1 + if {$code < 300} {set status Status} else {set status Error} + srvLog $sock $status $code $theErrors($code) $args $reason +} + +# Generate a date string in HTTP format. + +proc ::pddp::srvGetDate {seconds} { + return [clock format $seconds -format {%a, %d %b %Y %T %Z}] +} + +# Log an Httpd transaction. +# This should be replaced as needed. + +proc ::pddp::srvLog {sock args} { + puts stderr "pddp log ($sock): $args" +} + +# Convert a url into a pathname. (UNIX version only) +# This is probably not right, and belongs somewhere else. +# - Remove leading http://... if any +# - Collapse all /./ and /../ constructs +# - expand %xx sequences -> disallow "/"'s and "."'s due to expansions + +proc ::pddp::srvUrl2File {root url} { + regsub -all {//+} $url / url ;# collapse multiple /'s + while {[regsub -all {/\./} $url / url]} {} ;# collapse /./ + while {[regsub -all {/\.\.(/|$)} $url /\x81\\1 url]} {} ;# mark /../ + while {[regsub "/\[^/\x81]+/\x81/" $url / url]} {} ;# collapse /../ + if {![regexp "\x81|%2\[eEfF]" $url]} { ;# invalid /../, / or . ? + return $root[srvCgiMap $url] + } else { + return "" + } +} + +# Decode url-encoded strings. + +proc ::pddp::srvCgiMap {data} { + regsub -all {([][$\\])} $data {\\\1} data + regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data + return [subst $data] +} + +if {$::pddp::testrun} { ;# true if tested as a standalone script + if {$argc > 1} { + set root [lindex $argv 1] + set port [lindex $argv 2] + if {![string is integer -strict $port]} { + set port 32768 + } + } else { + set root $env(HOME) + set port 32768 + } + ::pddp::srvStart $root $port + vwait forever +} diff --git a/bin/pddp/pkgIndex.tcl b/bin/pddp/pkgIndex.tcl new file mode 100644 index 0000000..a3abe3d --- /dev/null +++ b/bin/pddp/pkgIndex.tcl @@ -0,0 +1,10 @@ +proc LoadPddp { version dir } { + namespace eval ::pddp {} + set ::pddp::theVersion $version + set ::pddp::theDir $dir + source [file join $dir pddpboot.tcl] +} + +set version "0.1.0.2" + +package ifneeded pddp $version [list LoadPddp $version $dir] diff --git a/pddp/Makefile b/pddp/Makefile index b65c310..fc022be 100644 --- a/pddp/Makefile +++ b/pddp/Makefile @@ -1,10 +1,2 @@ ROOT_DIR = .. -redefault: pddpboot default - -pddpboot: $(ROOT_DIR)/bin/pddpboot.tcl \ - $(ROOT_DIR)/bin/pddpclient.tcl $(ROOT_DIR)/bin/pddpserver.tcl - -$(ROOT_DIR)/bin/%.tcl: %.tcl - cp $< $@ - include $(ROOT_DIR)/Makefile.common diff --git a/pddp/build_counter b/pddp/build_counter index ddd868f..627f0ec 100644 --- a/pddp/build_counter +++ b/pddp/build_counter @@ -1,7 +1,7 @@ #define PDDP_VERSION "0.1" #define PDDP_RELEASE "alpha" -#define PDDP_BUILD 1 +#define PDDP_BUILD 2 #if 0 -PDDP_SNAPSHOT = 0.1-alpha1 +PDDP_SNAPSHOT = 0.1-alpha2 #endif diff --git a/pddp/notes.txt b/pddp/notes.txt index e156fe1..168f51e 100644 --- a/pddp/notes.txt +++ b/pddp/notes.txt @@ -1,10 +1,25 @@ TODO for pddp * pddplink: . standardize server's root directory (use $help_directory from pd.tk?) - . nonboxed version DONE for pddp +alpha2 + * loading tcl scripts through "package require pddp": + . storing them in an immediate subdirectory of the path of pddplink's binary + . storing a hand-crafted pkgIndex.tcl there + . pddplink's setup appends the path of its binary to tcl's "auto_path" + * pddpserver asks for auto-assigning its port first, then starts + incrementing from 32768 + * pddplink's appearance controlled with creation options (an option switch + is any symbol starting from '-' followed by a letter) + * options currently recognized: + . "-box" (standard object box) + . "-text" followed by any number of non-option atoms (body text) + * nonboxed version (default) has a custom widgetbehavior, which is a thin + layer on top of the standard text widgetbehavior (using all rtext routines), + so that merging into core Pd, as a new object type, T_LINK, would be easy. + alpha1 * prototype versions of the external "pddplink" and two pd-gui extensions "pddpserver.tcl", "pddpclient.tcl" diff --git a/pddp/pddpboot.tcl b/pddp/pddpboot.tcl deleted file mode 100755 index 3cec684..0000000 --- a/pddp/pddpboot.tcl +++ /dev/null @@ -1,32 +0,0 @@ -#!/bin/sh -# \ -exec tclsh "$0" -- "$@" - -# Synopsis -# test run: -# ./pddpboot.tcl [root [port [path]]] -# from Pd: -# source pddpboot.tcl -# ::pddp::srvUse root (or ::pddp::srvStart root [port]) -# ::pddp::cliOpen path -# ... (more "::pddp::cliOpen" calls) ... -# ::pddp::srvStop - -if {[namespace exists ::pddp]} { ;# created by pddplink's setup - puts stderr "Booting pddp" - set ::pddp::testrun 0 -} else { - puts stderr "Booting pddp, test run..." - namespace eval ::pddp { variable testrun 1 } -} - -puts stderr "current directory: [pwd]" - -source pddpclient.tcl -source pddpserver.tcl - -if {[info exists ::pddp::theDir]} { - puts stderr "restoring directory: $::pddp::theDir" - cd $::pddp::theDir - unset ::pddp::theDir -} diff --git a/pddp/pddpclient.tcl b/pddp/pddpclient.tcl deleted file mode 100644 index 7633394..0000000 --- a/pddp/pddpclient.tcl +++ /dev/null @@ -1,82 +0,0 @@ -# pddpclient.tcl - -# Synopsis -# not to be run by itself (see pddpboot.tcl) - -if {![namespace exists ::pddp]} { - puts stderr "Error: invalid invocation of pddpclient (boot pddp first)" - puts stderr "exiting..." - exit 1 -} - -if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl" - puts stderr "Loading pddpclient, test run..." - if {$argc > 3} { - set path [lindex $argv 3] - if {[string length $path]} { - puts stderr "Scheduling \"$path\" for opening" - after idle ::pddp::cliOpen $path - } - unset path - } -} else { - puts stderr "Loading pddpclient" -} - -namespace eval ::pddp { - variable theBrowserCommand - - switch -- $::tcl_platform(platform) { - unix { - switch -- $tcl_platform(os) { - Darwin { - set theBrowserCommand "sh -c open %s" - } - Linux { - foreach candidate \ - {firefox mozilla galeon konqueror netscape lynx} { - set browser [lindex [auto_execok $candidate] 0] - if {[string length $browser]} { - set theBrowserCommand "$browser %s &" - break - } - } - } - } - } - windows { - # should not this be just: [auto_execok start]? - set theBrowserCommand \ - "rundll32 url.dll,FileProtocolHandler file:%s &" - } - } -} - -proc ::pddp::cliError {err} { - puts stderr "Error in pddpclient: $err" -} - -proc ::pddp::cliOpen {path} { - if {[string first "://" $path] < 1} { - if {[info exists ::pddp::thePort]} { - set path "http://localhost:$::pddp::thePort/$path" - } else { - cliError "pddpserver not running" - return - } - } - variable theBrowserCommand - if {[string length $theBrowserCommand]} { - set command [format $theBrowserCommand $path] - puts stderr "pddpclient: open $command" - if {[catch {eval [list exec] $command} err]} { - if {[lindex $::errorCode 0] eq "CHILDSTATUS"} { - cliError "$err (child status [lindex $::errorCode 2])" - } else { - cliError $err - } - } - } else { - cliError "browser unavailable" - } -} diff --git a/pddp/pddplink.c b/pddp/pddplink.c index d60a90a..d746bbd 100644 --- a/pddp/pddplink.c +++ b/pddp/pddplink.c @@ -2,6 +2,10 @@ * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ +/* This is a prototype of an active comment. It might be replaced with + a new core object type, T_LINK (te_type bitfield would have to be + extended then). */ + #include #include #include "m_pd.h" @@ -21,6 +25,10 @@ typedef struct _pddplink t_object x_ob; t_glist *x_glist; int x_isboxed; + char *x_vistext; + int x_vissize; + int x_vislength; + int x_rtextactive; t_symbol *x_dirsym; t_symbol *x_ulink; t_atom x_openargs[2]; @@ -29,6 +37,117 @@ typedef struct _pddplink } t_pddplink; static t_class *pddplink_class; +static t_class *pddplinkbox_class; + +/* Code that might be merged back to g_text.c starts here: */ + +static void pddplink_getrect(t_gobj *z, t_glist *glist, + int *xp1, int *yp1, int *xp2, int *yp2) +{ + t_pddplink *x = (t_pddplink *)z; + int width, height; + float x1, y1, x2, y2; + if (glist->gl_editor && glist->gl_editor->e_rtext) + { + if (x->x_rtextactive) + { + t_rtext *y = glist_findrtext(glist, (t_text *)x); + width = rtext_width(y); + height = rtext_height(y) - 2; + } + else + { + int font = glist_getfont(glist); + width = x->x_vislength * sys_fontwidth(font) + 2; + height = sys_fontheight(font) + 2; + } + } + else width = height = 10; + x1 = text_xpix((t_text *)x, glist); + y1 = text_ypix((t_text *)x, glist); + x2 = x1 + width; + y2 = y1 + height; + y1 += 1; + *xp1 = x1; + *yp1 = y1; + *xp2 = x2; + *yp2 = y2; +} + +static void pddplink_displace(t_gobj *z, t_glist *glist, int dx, int dy) +{ + t_text *t = (t_text *)z; + t->te_xpix += dx; + t->te_ypix += dy; + if (glist_isvisible(glist)) + { + t_rtext *y = glist_findrtext(glist, t); + rtext_displace(y, dx, dy); + } +} + +static void pddplink_select(t_gobj *z, t_glist *glist, int state) +{ + t_pddplink *x = (t_pddplink *)z; + t_rtext *y = glist_findrtext(glist, (t_text *)x); + rtext_select(y, state); + if (glist_isvisible(glist) && glist->gl_havewindow) + { + if (state) + sys_vgui(".x%lx.c itemconfigure %s -fill blue\n", + glist, rtext_gettag(y)); + else + sys_vgui(".x%lx.c itemconfigure %s -text {%s} -fill magenta\n", + glist, rtext_gettag(y), x->x_vistext); + } +} + +static void pddplink_activate(t_gobj *z, t_glist *glist, int state) +{ + t_pddplink *x = (t_pddplink *)z; + t_rtext *y = glist_findrtext(glist, (t_text *)x); + rtext_activate(y, state); + x->x_rtextactive = state; +} + +static void pddplink_vis(t_gobj *z, t_glist *glist, int vis) +{ + t_pddplink *x = (t_pddplink *)z; + if (vis) + { + if (glist->gl_havewindow) + { + t_rtext *y = glist_findrtext(glist, (t_text *)x); + rtext_draw(y); + sys_vgui(".x%lx.c itemconfigure %s -text {%s} -fill magenta\n", + glist, rtext_gettag(y), x->x_vistext); + } + } + else + { + if (glist->gl_havewindow) + { + t_rtext *y = glist_findrtext(glist, (t_text *)x); + rtext_erase(y); + } + } +} + +static int pddplink_wbclick(t_gobj *z, t_glist *glist, int xpix, int ypix, + int shift, int alt, int dbl, int doit); + +static t_widgetbehavior pddplink_widgetbehavior = +{ + pddplink_getrect, + pddplink_displace, + pddplink_select, + pddplink_activate, + 0, + pddplink_vis, + pddplink_wbclick, +}; + +/* Code that might be merged back to g_text.c ends here. */ /* FIXME need access to glob_pdobject... */ static t_pd *pddplink_pdtarget(t_pddplink *x) @@ -66,6 +185,98 @@ static void pddplink_click(t_pddplink *x, t_floatarg xpos, t_floatarg ypos, x->x_ishit = 0; } +static int pddplink_wbclick(t_gobj *z, t_glist *glist, int xpix, int ypix, + int shift, int alt, int dbl, int doit) +{ + if (doit) + pddplink_click((t_pddplink *)z, (t_floatarg)xpix, (t_floatarg)ypix, + (t_floatarg)shift, 0, (t_floatarg)alt); + return (1); +} + +static int pddplink_isoption(char *name) +{ + if (*name == '-') + { + char c = name[1]; + return ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')); + } + else return (0); +} + +static t_symbol *pddplink_nextsymbol(int ac, t_atom *av, int opt, int *skipp) +{ + int ndx; + for (ndx = 0; ndx < ac; ndx++, av++) + { + if (av->a_type == A_SYMBOL && + (!opt || pddplink_isoption(av->a_w.w_symbol->s_name))) + { + *skipp = ++ndx; + return (av->a_w.w_symbol); + } + } + return (0); +} + +static int pddplink_dooptext(char *dst, int maxsize, int ac, t_atom *av) +{ + int i, sz, sep, len; + char buf[32], *src; + for (i = 0, sz = 0, sep = 0; i < ac; i++, av++) + { + if (sep) + { + sz++; + if (sz >= maxsize) + break; + else if (dst) + { + *dst++ = ' '; + *dst = 0; + } + } + else sep = 1; + if (av->a_type == A_SYMBOL) + src = av->a_w.w_symbol->s_name; + else if (av->a_type == A_FLOAT) + { + src = buf; + sprintf(src, "%g", av->a_w.w_float); + } + else + { + sep = 0; + continue; + } + len = strlen(src); + sz += len; + if (sz >= maxsize) + break; + else if (dst) + { + strcpy(dst, src); + dst += len; + } + } + return (sz); +} + +static char *pddplink_optext(int *sizep, int ac, t_atom *av) +{ + char *result; + int sz = pddplink_dooptext(0, MAXPDSTRING, ac, av); + *sizep = sz + (sz >= MAXPDSTRING ? 4 : 1); + result = getbytes(*sizep); + pddplink_dooptext(result, sz + 1, ac, av); + if (sz >= MAXPDSTRING) + { + sz = strlen(result); + strcpy(result + sz, "..."); + } + return (result); +} + #ifdef PDDPLINK_DEBUG static void pddplink_debug(t_pddplink *x) { @@ -74,36 +285,77 @@ static void pddplink_debug(t_pddplink *x) static void pddplink_free(t_pddplink *x) { + if (x->x_vistext) + freebytes(x->x_vistext, x->x_vissize); } -static void *pddplink_new(t_symbol *s1, t_symbol *s2) +static void *pddplink_new(t_symbol *s, int ac, t_atom *av) { - t_pddplink *x = (t_pddplink *)pd_new(pddplink_class); - t_symbol *dirsym; - x->x_glist = canvas_getcurrent(); - x->x_isboxed = (s2 == gensym("box")); - x->x_dirsym = canvas_getdir(x->x_glist); /* FIXME */ - if (!s1 || s1 == &s_) + t_pddplink xgen, *x; + int skip; + xgen.x_isboxed = 0; + xgen.x_vistext = 0; + xgen.x_vissize = 0; + if (xgen.x_ulink = pddplink_nextsymbol(ac, av, 0, &skip)) { - x->x_linktype = PDDPLINK_HTML; - x->x_ulink = gensym("index.html"); + t_symbol *opt; + ac -= skip; + av += skip; + while (opt = pddplink_nextsymbol(ac, av, 1, &skip)) + { + ac -= skip; + av += skip; + if (opt == gensym("-box")) + xgen.x_isboxed = 1; + else if (opt == gensym("-text")) + { + t_symbol *nextsym = pddplink_nextsymbol(ac, av, 1, &skip); + int natoms = (nextsym ? skip - 1 : ac); + if (natoms) + xgen.x_vistext = + pddplink_optext(&xgen.x_vissize, natoms, av); + } + } } - else + x = (t_pddplink *) + pd_new(xgen.x_isboxed ? pddplinkbox_class : pddplink_class); + x->x_glist = canvas_getcurrent(); + x->x_dirsym = canvas_getdir(x->x_glist); /* FIXME */ + + x->x_isboxed = xgen.x_isboxed; + x->x_vistext = xgen.x_vistext; + x->x_vissize = xgen.x_vissize; + x->x_vislength = (x->x_vistext ? strlen(x->x_vistext) : 0); + x->x_rtextactive = 0; + if (xgen.x_ulink) { - int len = strlen(s1->s_name); - if (len > 3 && !strcmp(s1->s_name + len - 3, ".pd")) + int len = strlen(xgen.x_ulink->s_name); + if (len > 3 && !strcmp(xgen.x_ulink->s_name + len - 3, ".pd")) x->x_linktype = PDDPLINK_PD; else x->x_linktype = PDDPLINK_HTML; - x->x_ulink = s1; + x->x_ulink = xgen.x_ulink; + } + else + { + x->x_linktype = PDDPLINK_HTML; + x->x_ulink = gensym("index.html"); } SETSYMBOL(&x->x_openargs[0], x->x_ulink); SETSYMBOL(&x->x_openargs[1], x->x_dirsym); x->x_ishit = 0; if (x->x_isboxed) - { - inlet_new((t_object *)x, (t_pd *)x, 0, 0); outlet_new((t_object *)x, &s_anything); + else + { + /* do we need to set ((t_text *)x)->te_type = T_TEXT; ? */ + if (!x->x_vistext) + { + x->x_vislength = strlen(x->x_ulink->s_name); + x->x_vissize = x->x_vislength + 1; + x->x_vistext = getbytes(x->x_vissize); + strcpy(x->x_vistext, x->x_ulink->s_name); + } } if (x->x_linktype == PDDPLINK_HTML) sys_vgui("after 0 {::pddp::srvUse %s}\n", x->x_dirsym->s_name); @@ -115,22 +367,34 @@ void pddplink_setup(void) t_symbol *dirsym; post("this is pddplink %s, %s %s build...", PDDP_VERSION, loud_ordinal(PDDP_BUILD), PDDP_RELEASE); + pddplink_class = class_new(gensym("pddplink"), (t_newmethod)pddplink_new, (t_method)pddplink_free, sizeof(t_pddplink), CLASS_NOINLET | CLASS_PATCHABLE, - A_DEFSYM, A_DEFSYM, 0); + A_GIMME, 0); class_addanything(pddplink_class, pddplink_anything); - class_addmethod(pddplink_class, (t_method)pddplink_click, + class_setwidget(pddplink_class, &pddplink_widgetbehavior); + + pddplinkbox_class = class_new(gensym("pddplink"), 0, + (t_method)pddplink_free, + sizeof(t_pddplink), 0, A_GIMME, 0); + class_addanything(pddplinkbox_class, pddplink_anything); + class_addmethod(pddplinkbox_class, (t_method)pddplink_click, gensym("click"), A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, 0); + #ifdef PDDPLINK_DEBUG class_addmethod(pddplink_class, (t_method)pddplink_debug, gensym("debug"), 0); + class_addmethod(pddplinkbox_class, (t_method)pddplink_debug, + gensym("debug"), 0); #endif + dirsym = pddplink_class->c_externdir; /* FIXME */ - sys_vgui("namespace eval ::pddp {variable theDir [pwd]}; cd %s\n", - dirsym->s_name); - sys_gui("after 0 {source pddpboot.tcl}\n"); + sys_vgui( + "if {[lsearch $auto_path \"%s\"] < 0} {lappend auto_path \"%s\"}\n", + dirsym->s_name, dirsym->s_name); + sys_gui("after 0 {package require pddp}\n"); } diff --git a/pddp/pddpserver.tcl b/pddp/pddpserver.tcl deleted file mode 100644 index fe17948..0000000 --- a/pddp/pddpserver.tcl +++ /dev/null @@ -1,490 +0,0 @@ -# pddpserver.tcl - -# Synopsis -# not to be run by itself (see pddpboot.tcl) - -# based on: - -# Simple Sample httpd/1.[01] server -# Stephen Uhler (c) 1996-1997 Sun Microsystems - -# http://cvs.sourceforge.net/viewcvs.py/tclhttpd/tclhttpd/bin/mini/mini1.1.tcl - -# modified by krzYszcz (2005): -# putting per-server data and all commands in a namespace "::pddp" -# supporting sourcing from within Pd, through the "pddpboot.tcl" wrapper -# inserting the .pd handler -# lots of other changes, too many to list here (run "diff" if curious...) - -if {![namespace exists ::pddp]} { - puts stderr "Error: invalid invocation of pddpserver (boot pddp first)" - puts stderr "exiting..." - exit 1 -} - -if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl" - puts stderr "Loading pddpserver, test run..." - proc bgerror {msg} { - global errorInfo - puts stderr "bgerror: $msg\n$errorInfo" - } -} else { - puts stderr "Loading pddpserver" - catch {console show} -} - -namespace eval ::pddp { - variable thePort 8080 - variable theState - variable theMimeTypes - variable theErrors - variable theErrorFormat - - # "theState" contains the server state: - # root: the root of the document directory - # default: default document name - # listen: the main listening socket id - # naccepts: a count of accepted connections so far - # maxtime: the max time (msec) allowed to complete an http request - # maxused: the max # of requests for a socket - array set theState { - root "" - default index.html - listen "" - naccepts 0 - nrequests 0 - nerrors 0 - maxtime 600000 - maxused 25 - bufsize 32768 - } - - set theState(root) $env(HOME) - - array set theMimeTypes { - {} text/plain - .txt text/plain - .html text/html - .gif image/gif - .jpg image/jpeg - .pd text/html - } - - # HTTP/1.[01] error codes (the ones we use) - array set theErrors { - 204 {No Content} - 400 {Bad Request} - 404 {Not Found} - 405 {Method Not Allowed} - 408 {Request Timeout} - 411 {Length Required} - 419 {Expectation Failed} - 500 {Internal Server Error} - 503 {Service Unavailable} - 504 {Service Temporarily Unavailable} - 505 {HTTP Version Not Supported} - } - - # Generic error response - set theErrorFormat { - Error: %1$s - Got the error: %2$s
- while trying to obtain %3$s - } -} - -proc ::pddp::srvUse {{root {}} {port 8080}} { - variable theState - if {[string length $theState(listen)]} { - if {[string length $root] && ![string equal $root $theState(root)]} { - srvLog $theState(listen) Warning "Redirection attempt for $root" - } - } else { - srvStart $root $port - } -} - -# Start the server by listening for connections on the desired port. - -proc ::pddp::srvStart {{root {}} {port 8080}} { - variable thePort - variable theState - - puts stderr "Starting pddp server on [info hostname]" - if {[string length $root]} { - set theState(root) $root - } - # we do not handle multiple pddpservers, LATER rethink - srvStop - array set theState [list naccepts 0 nrequests 0 nerrors 0] - - for { set thePort $port } {$thePort < 32767 } {incr thePort } { - if {[catch {set theState(listen) \ - [socket -server ::pddp::srvAccept $thePort]} res]} { - if {$thePort == 0} { - # FIXME this is a critical error - set thePort 8080 - } - } else { break } - } - if {$thePort == 32767} { - srvLog none Error "Could not find port available for listening" - } else { - if {$thePort == 0} { - set thePort [lindex [fconfigure $theState(listen) -sockname] 2] - } - srvLog $theState(listen) Port $thePort - srvLog $theState(listen) Root directory \"$root\" - } - after 120 update ;# FIXME might be needed on windows they say, test there - return $thePort -} - -proc ::pddp::srvStop {} { - variable thePort - variable theState - if {[string length $theState(listen)]} { - if {[catch {close $theState(listen)} res]} { - srvLog $theState(listen) Warning [list $res while closing socket] - } else { - srvLog $theState(listen) Closed. - } - set theState(listen) "" - update - } -} - -# Accept a new connection from the server and set up a handler -# to read the request from the client. - -proc ::pddp::srvAccept {sock ipaddr port} { - variable theState - variable theSockData$sock - # reject remote requests, LATER revisit - if {[string equal $ipaddr "127.0.0.1"]} { - incr theState(naccepts) - srvReset $sock $theState(maxused) - srvLog $sock Connect $ipaddr $port - } else { - srvLog $sock Warning "rejecting remote connection request from $ipaddr" - srvSockDone $sock 1 - } -} - -# Initialize or reset the socket state - -proc ::pddp::srvReset {sock nlft} { - variable theState - upvar 0 ::pddp::theSockData$sock sockData - array set sockData [list state start linemode 1 version 0 nleft $nlft] - set sockData(cancel) \ - [after $theState(maxtime) [list srvTimeout $sock]] - fconfigure $sock -blocking 0 -buffersize $theState(bufsize) \ - -translation {auto crlf} - fileevent $sock readable [list ::pddp::srvRead $sock] -} - -# Read data from a client request -# 1) read the request line -# 2) read the mime headers -# 3) read the additional data (if post && content-length not satisfied) - -proc ::pddp::srvRead {sock} { - variable theState - upvar 0 ::pddp::theSockData$sock sockData - - # Use line mode to read the request and the mime headers - - if {$sockData(linemode)} { - set readCount [gets $sock line] - set state [string compare $readCount 0],$sockData(state) - switch -glob -- $state { - 1,start { - if {[regexp {(HEAD|POST|GET) ([^?]+)\??([^ ]*) HTTP/1.([01])} \ - $line x sockData(proto) sockData(url) \ - sockData(query) sockData(version)]} { - set sockData(state) mime - incr theState(nrequests) - srvLog $sock Request $sockData(nleft) $line - } else { - srvError $sock 400 $line - } - } - 0,start { - srvLog $sock Warning "Initial blank line fetching request" - } - 1,mime { - if {[regexp {([^:]+):[ ]*(.*)} $line {} key value]} { - set key [string tolower $key] - set sockData(key) $key - if {[info exists sockData(mime,$key)]} { - append sockData(mime,$key) ", $value" - } else { - set sockData(mime,$key) $value - } - } elseif {[regexp {^[ ]+(.+)} $line {} value] && \ - [info exists sockData(key)]} { - append sockData(mime,$sockData($key)) " " $value - } else { - srvError $sock 400 $line - } - } - 0,mime { - if {$sockData(proto) == "POST" && \ - [info exists sockData(mime,content-length)]} { - set sockData(linemode) 0 - set sockData(count) $sockData(mime,content-length) - if {$sockData(version) && \ - [info exists sockData(mime,expect)]} { - if {$sockData(mime,expect) == "100-continue"} { - puts $sock "100 Continue HTTP/1.1\n" - flush $sock - } else { - srvError $sock 419 $sockData(mime,expect) - } - } - fconfigure $sock -translation {binary crlf} - } elseif {$sockData(proto) != "POST"} { - srvRespond $sock - } else { - srvError $sock 411 "Confusing mime headers" - } - } - -1,* { - if {[eof $sock]} { - srvLog $sock Error "Broken connection fetching request" - srvSockDone $sock 1 - } else { - puts stderr "Partial read, retrying" - } - } - default { - srvError $sock 404 "Invalid http state: $state,[eof $sock]" - } - } - - # Use counted mode to get the post data - - } elseif {![eof $sock]} { - append sockData(postdata) [read $sock $sockData(count)] - set sockData(count) [expr {$sockData(mime,content-length) - \ - [string length $sockData(postdata)]}] - if {$sockData(count) == 0} { - srvRespond $sock - } - } else { - srvLog $sock Error "Broken connection reading POST data" - srvSockDone $sock 1 - } -} - -# Done with the socket, either close it, or set up for next fetch -# sock: The socket I'm done with -# doclose: If true, close the socket, otherwise set up for reuse - -proc ::pddp::srvSockDone {sock doclose} { - variable theState - upvar 0 ::pddp::theSockData$sock sockData - - after cancel $sockData(cancel) - set nleft [incr sockData(nleft) -1] - unset sockData - if {$doclose} { - close $sock - } else { - srvReset $sock $nleft - } - return "" -} - -# A timeout happened - -proc ::pddp::srvTimeout {sock} { - srvError $sock 408 -} - -# FIXME test if "path" has its patch window already open... -proc ::pddp::srvPdHandler {sock path} { - set dir [file dirname $path] - set tail [file tail $path] - if {[catch {pd [concat pd open $tail $dir \;]}]} { - srvError $sock 504 - } else { - srvError $sock 204 - # FIXME raise; focus (test on windows) - } -} - -# Handle file system queries. This is a place holder for a more -# generic dispatch mechanism. - -proc ::pddp::srvRespond {sock} { - variable theState - variable theUrlCache - upvar 0 ::pddp::theSockData$sock sockData - - regsub {(^http://[^/]+)?} $sockData(url) {} url - if {[info exists theUrlCache($url)]} { - set mypath $theUrlCache($url) - } else { - set mypath [srvUrl2File $theState(root) $url] - if {[file isdirectory $mypath]} { - append mypath / $theState(default) - } - set theUrlCache($url) $mypath - } - if {[string length $mypath] == 0} { - srvError $sock 400 - } elseif {![file readable $mypath]} { - if {[string equal [file tail $mypath] "favicon.ico"]} { - srvError $sock 204 ;# FIXME design something - } else { - srvError $sock 404 $mypath - } - } else { - set ext [file extension $mypath] - - if {[string equal $ext ".pd"]} { - srvPdHandler $sock $mypath - return - } - - puts $sock "HTTP/1.$sockData(version) 200 Data follows" - puts $sock "Date: [srvGetDate [clock seconds]]" - puts $sock "Last-Modified: [srvGetDate [file mtime $mypath]]" - puts $sock "Content-Type: [srvContentType $ext]" - puts $sock "Content-Length: [file size $mypath]" - - ## Should also close socket if recvd connection close header - set doclose [expr {$sockData(nleft) == 0}] - - if {$doclose} { - puts $sock "Connection close:" - } elseif {$sockData(version) == 0 && \ - [info exists sockData(mime,connection)]} { - if {$sockData(mime,connection) == "Keep-Alive"} { - set doclose 0 - puts $sock "Connection: Keep-Alive" - } - } - puts $sock "" - flush $sock - - if {$sockData(proto) != "HEAD"} { - set in [open $mypath] - fconfigure $sock -translation binary - fconfigure $in -translation binary - fcopy $in $sock -command \ - [list ::pddp::srvCopyDone $in $sock $doclose] - } else { - srvSockDone $sock $doclose - } - } -} - -# Callback when file is done being output to client -# in: The fd for the file being copied -# sock: The client socket -# doclose: close the socket if true -# bytes: The # of bytes copied -# error: The error message (if any) - -proc ::pddp::srvCopyDone {in sock doclose bytes {error {}}} { - close $in - srvLog $sock Done $bytes bytes - srvSockDone $sock $doclose -} - -# Convert the file suffix into a mime type. - -proc ::pddp::srvContentType {ext} { - variable theMimeTypes - set type text/plain - catch {set type $theMimeTypes($ext)} - return $type -} - -# Respond with an error reply -# sock: The socket handle to the client -# code: The httpd error code -# args: Additional information for error logging - -proc ::pddp::srvError {sock code args} { - variable theState - variable theErrors - variable theErrorFormat - upvar 0 ::pddp::theSockData$sock sockData - - append sockData(url) "" - incr theState(nerrors) - set message [format $theErrorFormat $code $theErrors($code) $sockData(url)] - append head "HTTP/1.$sockData(version) $code $theErrors($code)" \n - append head "Date: [srvGetDate [clock seconds]]" \n - append head "Connection: close" \n - append head "Content-Length: [string length $message]" \n - - # Because there is an error condition, the socket may be "dead" - - catch { - fconfigure $sock -translation crlf - puts -nonewline $sock $head\n$message - flush $sock - } reason - srvSockDone $sock 1 - if {$code < 300} {set status Status} else {set status Error} - srvLog $sock $status $code $theErrors($code) $args $reason -} - -# Generate a date string in HTTP format. - -proc ::pddp::srvGetDate {seconds} { - return [clock format $seconds -format {%a, %d %b %Y %T %Z}] -} - -# Log an Httpd transaction. -# This should be replaced as needed. - -proc ::pddp::srvLog {sock args} { - puts stderr "pddp log ($sock): $args" -} - -# Convert a url into a pathname. (UNIX version only) -# This is probably not right, and belongs somewhere else. -# - Remove leading http://... if any -# - Collapse all /./ and /../ constructs -# - expand %xx sequences -> disallow "/"'s and "."'s due to expansions - -proc ::pddp::srvUrl2File {root url} { - regsub -all {//+} $url / url ;# collapse multiple /'s - while {[regsub -all {/\./} $url / url]} {} ;# collapse /./ - while {[regsub -all {/\.\.(/|$)} $url /\x81\\1 url]} {} ;# mark /../ - while {[regsub "/\[^/\x81]+/\x81/" $url / url]} {} ;# collapse /../ - if {![regexp "\x81|%2\[eEfF]" $url]} { ;# invalid /../, / or . ? - return $root[srvCgiMap $url] - } else { - return "" - } -} - -# Decode url-encoded strings. - -proc ::pddp::srvCgiMap {data} { - regsub -all {([][$\\])} $data {\\\1} data - regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data - return [subst $data] -} - -if {$::pddp::testrun} { ;# true if tested as a standalone script - if {$argc > 1} { - set root [lindex $argv 1] - set port [lindex $argv 2] - if {![string is integer -strict $port]} { - set port 8080 - } - } else { - set root $env(HOME) - set port 8080 - } - ::pddp::srvStart $root $port - vwait forever -} diff --git a/shared/notes.txt b/shared/notes.txt index 3f35ae2..a823fad 100644 --- a/shared/notes.txt +++ b/shared/notes.txt @@ -5,6 +5,9 @@ TODO for root and shared DONE for root and shared +with toxy alpha18 + * plusbob: stubifying t_plusbob, in order to minimize memory leak to 4 words + with rafts prealpha1 * new module: patchvalue diff --git a/shared/toxy/plusbob.c b/shared/toxy/plusbob.c index 9dae191..350b3c8 100644 --- a/shared/toxy/plusbob.c +++ b/shared/toxy/plusbob.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -11,12 +11,30 @@ //#define PLUSBOB_DEBUG #endif -/* LATER let there be a choice of using either fake-symbols, or gpointers. +/* The main failure of the current implementation is when a foreign object + stores a faked symbol beyond lifetime of a wrappee. There is no obvious + way of protecting against stale pointers, other than leaking small + portions of memory (four words) with every new faked symbol. In case of + plustot, this is not a very big deal, since for each [+tot] object the + number of wrapped tcl objects is small and constant. + + Another failure is when a foreign object binds something to a faked + symbol (for example, when a faked symbol is passed to an array's rename + method). This should not happen in usual contexts, and even if it does, + it will unlikely cause any real harm. + + LATER let there be a choice of using either fake-symbols, or gpointers. The gpointer layout would be such: gs_un points to a plusbob-like - structure (without the bob_tag field), a unique integer code has to be + structure (without the bob_stub field), a unique integer code has to be reserved for gs_which, the fields gp_un and gp_valid are ignored. Using bob_refcount instead of gs_refcount is likely to simplify code. */ +typedef struct _plusstub +{ + t_symbol sb_tag; /* common value for all bob types */ + t_plusbob *sb_bob; +} t_plusstub; + /* Currently, objects of all +bob types are tagged with the same name: */ static char plustag_name[] = "+bob"; @@ -27,11 +45,11 @@ static void plustag_init(t_symbol *tag) tag->s_next = 0; } -/* silent if caller is empty */ -int plustag_isvalid(t_symbol *tag, t_pd *caller) +/* returns tagged +bob if valid, null otherwise (silent if caller is empty) */ +t_plusbob *plustag_isvalid(t_symbol *tag, t_pd *caller) { if (tag->s_name == plustag_name) - return (1); + return (((t_plusstub *)tag)->sb_bob); else if (caller) { if (strcmp(tag->s_name, plustag_name)) @@ -43,6 +61,14 @@ int plustag_isvalid(t_symbol *tag, t_pd *caller) return (0); } +static t_plusstub *plusstub_create(t_plusbob *bob) +{ + t_plusstub *stub = getbytes(sizeof(*stub)); + plustag_init(&stub->sb_tag); + stub->sb_bob = bob; + return (stub); +} + /* +bob is an object tossed around, a bobbing object. Currently, this is a wrapping for Tcl_Interp, Tcl_Obj, or a tcl variable, but the +bob interface is abstract enough to be suitable for other types of objects. @@ -128,7 +154,7 @@ t_plusbob *plusbob_create(t_plustype *tp, t_plusbob *parent) } if (bob = getbytes(tp->tp_size)) { - plustag_init(&bob->bob_tag); + bob->bob_stub = (t_symbol *)plusstub_create(bob); bob->bob_type = tp; while (tp->tp_base) tp = tp->tp_base; bob->bob_root = tp; @@ -154,6 +180,7 @@ static void plusbob_free(t_plusbob *bob) for (tp = bob->bob_type; tp; tp = tp->tp_base) if (tp->tp_deletefn) (*tp->tp_deletefn)(bob); freebytes(bob, (bob->bob_type ? bob->bob_type->tp_size : sizeof(*bob))); + /* the stub remains... */ } void plusbob_preserve(t_plusbob *bob) @@ -251,21 +278,21 @@ t_pd *plusbob_getowner(t_plusbob *bob) void outlet_plusbob(t_outlet *o, t_plusbob *bob) { - outlet_symbol(o, (t_symbol *)bob); + outlet_symbol(o, bob->bob_stub); } -/* silent if caller is empty */ -int plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller) +/* returns tagged +bob if valid, null otherwise (silent if caller is empty) */ +t_plusbob *plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller) { if (tag->s_name == plustag_name) { - if (((t_plusbob *)tag)->bob_type->tp_name == tname) - return (1); + t_plusbob *bob = ((t_plusstub *)tag)->sb_bob; + if (bob->bob_type->tp_name == tname) + return (bob); else if (caller) { - t_symbol *s = ((t_plusbob *)tag)->bob_type->tp_name; - loud_error((caller == PLUSBOB_OWNER ? - ((t_plusbob *)tag)->bob_owner : caller), + t_symbol *s = bob->bob_type->tp_name; + loud_error((caller == PLUSBOB_OWNER ? bob->bob_owner : caller), "invalid type '%s' ('%s' expected)", (s ? s->s_name : ""), (tname ? tname->s_name : "")); @@ -276,18 +303,18 @@ int plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller) return (0); } -/* silent if caller is empty */ -int plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller) +/* returns tagged +bob if valid, null otherwise (silent if caller is empty) */ +t_plusbob *plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller) { if (tag->s_name == plustag_name) { - if (((t_plusbob *)tag)->bob_root->tp_name == rname) - return (1); + t_plusbob *bob = ((t_plusstub *)tag)->sb_bob; + if (bob->bob_root->tp_name == rname) + return (bob); else if (caller) { - t_symbol *s = ((t_plusbob *)tag)->bob_root->tp_name; - loud_error((caller == PLUSBOB_OWNER ? - ((t_plusbob *)tag)->bob_owner : caller), + t_symbol *s = bob->bob_root->tp_name; + loud_error((caller == PLUSBOB_OWNER ? bob->bob_owner : caller), "invalid base type '%s' ('%s' expected)", (s ? s->s_name : ""), (rname ? rname->s_name : "")); @@ -301,7 +328,7 @@ int plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller) t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller) { if (!validate || tag->s_name == plustag_name) - return (((t_plusbob *)tag)->bob_type->tp_name); + return (((t_plusstub *)tag)->sb_bob->bob_type->tp_name); else if (plustag_isvalid(tag, caller)) /* print the error there */ loudbug_bug("plustag_typename"); return (0); @@ -310,7 +337,7 @@ t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller) t_symbol *plustag_rootname(t_symbol *tag, int validate, t_pd *caller) { if (!validate || tag->s_name == plustag_name) - return (((t_plusbob *)tag)->bob_root->tp_name); + return (((t_plusstub *)tag)->sb_bob->bob_root->tp_name); else if (plustag_isvalid(tag, caller)) /* print the error there */ loudbug_bug("plustag_rootname"); return (0); diff --git a/shared/toxy/plusbob.h b/shared/toxy/plusbob.h index bdfe356..391e5c1 100644 --- a/shared/toxy/plusbob.h +++ b/shared/toxy/plusbob.h @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -12,9 +12,10 @@ EXTERN_STRUCT _plusbob; EXTERN_STRUCT _plusenv; #define t_plusenv struct _plusenv +/* LATER move to plusbob.c */ struct _plusbob { - t_symbol bob_tag; /* common value for all bob types */ + t_symbol *bob_stub; /* points back to stub = symbol, pointer-to-here */ t_plustype *bob_type; /* our type */ t_plustype *bob_root; /* our base type directly derived from t_plusbob */ t_pd *bob_owner; @@ -37,7 +38,11 @@ struct _plusenv typedef void (*t_plustypefn)(void *); -int plustag_isvalid(t_symbol *s, t_pd *caller); +t_plusbob *plustag_isvalid(t_symbol *tag, t_pd *caller); +t_plusbob *plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller); +t_plusbob *plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller); +t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller); +t_symbol *plustag_rootname(t_symbol *tag, int validate, t_pd *caller); t_plustype *plustype_new(t_plustype *base, t_symbol *name, size_t sz, t_plustypefn deletefn, @@ -57,10 +62,6 @@ void plusbob_detachownedchildren(t_plusbob *bob, t_plusbob *newparent, void plusbob_setowner(t_plusbob *bob, t_pd *owner); t_pd *plusbob_getowner(t_plusbob *bob); void outlet_plusbob(t_outlet *o, t_plusbob *bob); -int plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller); -int plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller); -t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller); -t_symbol *plustag_rootname(t_symbol *tag, int validate, t_pd *caller); t_plusenv *plusenv_create(t_plustype *tp, t_plusbob *parent, t_symbol *id); t_plusenv *plusenv_find(t_symbol *id, t_plusenv *defenv); diff --git a/test/pddp/pddplink-test-01.pd b/test/pddp/pddplink-test-01.pd index f5f1403..e7ca4b0 100644 --- a/test/pddp/pddplink-test-01.pd +++ b/test/pddp/pddplink-test-01.pd @@ -1,8 +1,17 @@ -#N canvas 232 221 450 300 12; -#X obj 61 83 pddplink pddplink-test-01.html; -#X text 21 12 first entry; -#X text 59 47 linking to a local html page:; -#X text 58 130 linking to a remote html page:; -#X obj 60 166 pddplink http://puredata.info; -#X obj 59 254 pddplink pddplink-test-02.pd; -#X text 57 218 linking to another local patch:; +#N canvas 421 92 475 404 12; +#X text 20 10 first entry; +#X text 50 50 three ways of linking to a; +#X obj 270 50 pddplink pddplink-test-01.html -text local html page +; +#X obj 50 75 pddplink pddplink-test-01.html; +#X obj 50 110 pddplink pddplink-test-01.html -box; +#X text 50 170 three ways of linking to a; +#X obj 270 170 pddplink http://puredata.info -text remote html page +; +#X obj 50 195 pddplink http://puredata.info; +#X obj 50 230 pddplink http://puredata.info -box; +#X text 50 290 three ways of linking to; +#X obj 260 290 pddplink pddplink-test-02.pd -text another local patch +; +#X obj 50 315 pddplink pddplink-test-02.pd; +#X obj 50 350 pddplink pddplink-test-02.pd -box; diff --git a/test/pddp/pddplink-test-02.pd b/test/pddp/pddplink-test-02.pd index eb67411..839c0b6 100644 --- a/test/pddp/pddplink-test-02.pd +++ b/test/pddp/pddplink-test-02.pd @@ -1,8 +1,17 @@ -#N canvas 332 321 450 300 12; -#X obj 61 83 pddplink pddplink-test-02.html; -#X text 21 12 second entry; -#X text 59 47 linking to a local html page:; -#X text 58 130 linking to a remote html page:; -#X obj 60 166 pddplink http://puredata.info; -#X obj 59 254 pddplink pddplink-test-01.pd; -#X text 57 218 linking to another local patch:; +#N canvas 321 192 475 404 12; +#X text 20 10 first entry; +#X text 50 50 three ways of linking to a; +#X obj 270 50 pddplink pddplink-test-02.html -text local html page +; +#X obj 50 75 pddplink pddplink-test-02.html; +#X obj 50 110 pddplink pddplink-test-02.html -box; +#X text 50 170 three ways of linking to a; +#X obj 270 170 pddplink http://puredata.info -text remote html page +; +#X obj 50 195 pddplink http://puredata.info; +#X obj 50 230 pddplink http://puredata.info -box; +#X text 50 290 three ways of linking to; +#X obj 260 290 pddplink pddplink-test-01.pd -text another local patch +; +#X obj 50 315 pddplink pddplink-test-01.pd; +#X obj 50 350 pddplink pddplink-test-01.pd -box; diff --git a/toxy/Makefile.objects b/toxy/Makefile.objects index 8139856..b0300f0 100644 --- a/toxy/Makefile.objects +++ b/toxy/Makefile.objects @@ -25,7 +25,8 @@ plustot.in.o \ plustot.var.o \ plustot.out.o \ plustot.qlist.o \ -plustot.print.o +plustot.print.o \ +pluswidget.o PLUSTOT_LIBS = $(TCL_LIB) diff --git a/toxy/build_counter b/toxy/build_counter index 53f4151..5b97c5e 100644 --- a/toxy/build_counter +++ b/toxy/build_counter @@ -1,7 +1,7 @@ #define TOXY_VERSION "0.1" #define TOXY_RELEASE "alpha" -#define TOXY_BUILD 17 +#define TOXY_BUILD 18 #if 0 -TOXY_SNAPSHOT = 0.1-alpha17 +TOXY_SNAPSHOT = 0.1-alpha18 #endif diff --git a/toxy/notes.txt b/toxy/notes.txt index 120f0db..10401a5 100644 --- a/toxy/notes.txt +++ b/toxy/notes.txt @@ -7,9 +7,27 @@ TODO for toxy . editor: break editorhook into separate properties, add them in single mode . find a way for "package require" to work out-of-the-box on windows * tow: canvas-wide and type-on-canvas-wide broadcasting + * plustot: + . do not evaluate if fresh, unless explicitly forced to (are side-effects + to be modal, requested with a flag, or triggered with a message?) + . creation time evaluation DONE for toxy +alpha18 + * plustot: + . adjusted to the new, stubified +bob handling + . +selectors registered as creation selectors, so that, e.g. "+in" is + a valid input form for "plustot +in" ("+tot +in" remains valid too) + . "save" callback changes every "+tot" selector to "plustot", + and every "+selector" to "plustot +selector" + . customized appearance: + - creation selector omitted if equals "plustot" or "+tot" + - text, border and i/o outline is brown, border is thicker, + inlets and outlets are lightgrey inside and taller + . mouse click interpreted as the message 'bang' + . accepting commands without arguments (beware: this is yet to be debugged) + alpha17 * widget: . first sketch of an editor widget (bpf), introducing a basic set of rules: diff --git a/toxy/plustot.c b/toxy/plustot.c index 1a738ef..31c2b0b 100644 --- a/toxy/plustot.c +++ b/toxy/plustot.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003-2004 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -7,6 +7,7 @@ #include "g_canvas.h" #include "common/loud.h" #include "common/grow.h" +#include "unstable/forky.h" #include "hammer/file.h" #include "common/props.h" #include "toxy/scriptlet.h" @@ -33,7 +34,6 @@ # define PLUSDEBUG_DECRREFCOUNT(ob, fn) Tcl_DecrRefCount(ob) #endif -static t_symbol *plusps_tot; static t_symbol *plusps_env; static t_symbol *plusps_in; static t_symbol *plusps_var; @@ -42,6 +42,25 @@ static t_symbol *plusps_qlist; static t_symbol *plusps_print; static t_symbol *totps_query; +static void plussymbols_create(void) +{ + /* public */ + totps_plustot = gensym("plustot"); + plusps_tot = gensym("+tot"); + plusps_Ti = gensym("+Ti"); + plusps_To = gensym("+To"); + plusps_Tv = gensym("+Tv"); + + /* private */ + plusps_env = gensym("+env"); + plusps_in = gensym("+in"); + plusps_var = gensym("+var"); + plusps_out = gensym("+out"); + plusps_qlist = gensym("+qlist"); + plusps_print = gensym("+print"); + totps_query = gensym("query"); +} + static void plusloud_tcldirty(t_pd *caller, char *fnname) { loud_warning((caller == PLUSBOB_OWNER ? 0 : caller), "+tot", @@ -91,6 +110,28 @@ static t_plustype *plustin_basetype; static t_plustype *plustin_type; static t_plustin *plustin_default = 0; +static int plustin_testCmd(ClientData cd, Tcl_Interp *interp, + int objc, Tcl_Obj **objv) +{ + Tcl_Obj *result; + post("this is a test"); + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "anyValue"); + return (TCL_ERROR); + } + + post("in refcount: %d", objv[1]->refCount); + result = Tcl_DuplicateObj(objv[1]); + post("out refcount: %d", result->refCount); + + if (result == NULL) + return (TCL_ERROR); + Tcl_SetObjResult(interp, result); + post("exit refcount: %d", result->refCount); + return (TCL_OK); +} + /* To be called from derived constructors or plustin's provider. */ t_plustin *plustin_create(t_plustype *tp, t_plusbob *parent, t_symbol *id) { @@ -106,6 +147,12 @@ t_plustin *plustin_create(t_plustype *tp, t_plusbob *parent, t_symbol *id) Tcl_Preserve(interp); if (Tcl_Init(interp) == TCL_ERROR) plusloud_tclerror(0, interp, "interpreter initialization failed"); + else + { + Tcl_CreateObjCommand(interp, "test::test", + (Tcl_ObjCmdProc*)plustin_testCmd, + (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); + } Tcl_Release(interp); } else loud_error(0, "failed attempt to create an interpreter"); @@ -318,15 +365,15 @@ Tcl_Obj *plustob_getvalue(t_plustob *tob) /* silent, if caller is empty */ t_plustin *plustag_tobtin(t_symbol *tag, t_pd *caller) { - return (plustag_validroot(tag, plusps_To, caller) - ? ((t_plustob *)tag)->tob_tin : 0); + t_plusbob *bob = plustag_validroot(tag, plusps_To, caller); + return (bob ? ((t_plustob *)bob)->tob_tin : 0); } /* silent, if caller is empty */ Tcl_Obj *plustag_tobvalue(t_symbol *tag, t_pd *caller) { - return (plustag_validroot(tag, plusps_To, caller) - ? ((t_plustob *)tag)->tob_value : 0); + t_plusbob *bob = plustag_validroot(tag, plusps_To, caller); + return (bob ? ((t_plustob *)bob)->tob_value : 0); } /* silent, if caller is empty */ @@ -408,9 +455,10 @@ Tcl_Obj *plustob_setsymbol(t_plustob *tob, t_symbol *s) { if (plustag_isvalid(s, 0)) { - if (plustag_validroot(s, plusps_To, PLUSBOB_OWNER)) + t_plusbob *bob; + if (bob = plustag_validroot(s, plusps_To, PLUSBOB_OWNER)) { - t_plustob *from = (t_plustob *)s; + t_plustob *from = (t_plustob *)bob; return (plustob_set(tob, from->tob_tin, from->tob_value)); } else return (0); @@ -962,7 +1010,7 @@ typedef struct _plusproxy typedef struct _plustot { - t_object x_ob; + t_plusobject x_plusobject; t_glist *x_glist; t_plustob *x_tob; /* interpreter's result (after invocation) */ t_scriptlet *x_script; @@ -1343,7 +1391,8 @@ static int plustot_makeproxies(t_plustot *x) x->x_proxies[i] = plusproxy_new((t_pd *)x, i, x->x_tob->tob_tin); for (i = 1; i < x->x_nproxies; i++) - inlet_new((t_object *)x, (t_pd *)x->x_proxies[i], 0, 0); + plusinlet_new(&x->x_plusobject, + (t_pd *)x->x_proxies[i], 0, 0); x->x_mainproxy = x->x_proxies[0]; /* second pass: traverse non-empty slots, create variables */ plustot_parsevariables(x, interp, @@ -1780,6 +1829,36 @@ static void plustot_tot(t_plustot *x, t_symbol *s, int ac, t_atom *av) } } +static void plustot_save(t_gobj *z, t_binbuf *bb) +{ + t_text *t = (t_text *)z; + t_binbuf *inbb = t->te_binbuf; + int ac = binbuf_getnatom(inbb); + t_atom *av = binbuf_getvec(inbb); + binbuf_addv(bb, "ssii", gensym("#X"), gensym("obj"), + (int)t->te_xpix, (int)t->te_ypix); + if (ac && av->a_type == A_SYMBOL) + { + t_symbol *s = av->a_w.w_symbol; + if (s != totps_plustot) + { + t_atom at; + SETSYMBOL(&at, totps_plustot); + binbuf_add(bb, 1, &at); + if (s == plusps_tot && ac > 1) + { + inbb = binbuf_new(); + binbuf_add(inbb, ac - 1, av + 1); + } + } + } + else loudbug_bug("plustot_save"); + binbuf_addbinbuf(bb, inbb); + binbuf_addsemi(bb); + if (inbb != t->te_binbuf) + binbuf_free(inbb); +} + #ifdef PLUSTOT_DEBUG static void plustot_debug(t_plustot *x) { @@ -1821,6 +1900,7 @@ static void plustot_free(t_plustot *x) freebytes(x->x_proxies, x->x_nproxies * sizeof(*x->x_proxies)); } if (x->x_script) scriptlet_free(x->x_script); + plusobject_free(&x->x_plusobject); } static void *plustot_new(t_symbol *s, int ac, t_atom *av) @@ -1832,10 +1912,15 @@ static void *plustot_new(t_symbol *s, int ac, t_atom *av) t_plustin *tin = 0; t_plustob *tob = 0; t_scriptlet *script = scriptlet_new(0, 0, 0, 0, glist, 0); - if (ac && av->a_type == A_SYMBOL) + if (s != plusps_tot && s != totps_plustot && s != &s_) + cmdname = s; + else if (ac && av->a_type == A_SYMBOL) { cmdname = av->a_w.w_symbol; ac--; av++; + } + if (cmdname) + { if (*cmdname->s_name == '+') { if (cmdname == plusps_env) @@ -1856,7 +1941,10 @@ static void *plustot_new(t_symbol *s, int ac, t_atom *av) return (0); } } +#if 0 + /* FIXME forgot where this constraint came from, debug carefully... */ if (ac) +#endif { ctail = plusstring_fromatoms(ac, av, script); plusstring_preserve(ctail); @@ -1865,7 +1953,7 @@ static void *plustot_new(t_symbol *s, int ac, t_atom *av) if ((tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && (tob = plustob_new(tin, 0))) { - x = (t_plustot *)pd_new(plustot_class); + x = (t_plustot *)plusobject_new(plustot_class, cmdname, ac, av); /* tin already preserved (plustob_new() did it) */ plusbob_preserve((t_plusbob *)tob); plusbob_setowner((t_plusbob *)tob, (t_pd *)x); @@ -1933,7 +2021,7 @@ static void *plustot_new(t_symbol *s, int ac, t_atom *av) } } } - outlet_new((t_object *)x, &s_symbol); + plusoutlet_new(&x->x_plusobject, &s_symbol); } else { @@ -1950,16 +2038,56 @@ static void *plustot_new(t_symbol *s, int ac, t_atom *av) return (x); } +void plusobject_widgetfree(t_plusobject *po); +void plusobject_widgetcreate(t_plusobject *po, t_symbol *s, int ac, t_atom *av); +void plusclass_widgetsetup(t_class *c); + +void plusobject_free(t_plusobject *po) +{ + plusobject_widgetfree(po); +} + +t_plusobject *plusobject_new(t_class *c, t_symbol *s, int ac, t_atom *av) +{ + t_plusobject *po = (t_plusobject *)pd_new(c); + po->po_ninlets = 1; + po->po_noutlets = 0; + plusobject_widgetcreate(po, s, ac, av); + return (po); +} + +t_inlet *plusinlet_new(t_plusobject *po, t_pd *dest, + t_symbol *s1, t_symbol *s2) +{ + po->po_ninlets++; + return (inlet_new((t_object *)po, dest, s1, s2)); +} + +t_outlet *plusoutlet_new(t_plusobject *po, t_symbol *s) +{ + po->po_noutlets++; + return (outlet_new((t_object *)po, s)); +} + +void plusclass_inherit(t_class *c, t_symbol *s) +{ + class_addcreator((t_newmethod)plustot_new, s, A_GIMME, 0); + forky_setsavefn(c, plustot_save); + plusclass_widgetsetup(c); +} + void plustot_setup(void) { post("beware! this is plustot %s, %s %s build...", TOXY_VERSION, loud_ordinal(TOXY_BUILD), TOXY_RELEASE); - plustot_class = class_new(gensym("+tot"), + plussymbols_create(); + + plustot_class = class_new(totps_plustot, (t_newmethod)plustot_new, (t_method)plustot_free, sizeof(t_plustot), 0, A_GIMME, 0); - class_addcreator((t_newmethod)plustot_new, - gensym("plustot"), A_GIMME, 0); + plusclass_inherit(plustot_class, plusps_tot); + class_addbang(plustot_class, plustot_bang); class_addfloat(plustot_class, plustot_float); class_addsymbol(plustot_class, plustot_symbol); @@ -1974,10 +2102,6 @@ void plustot_setup(void) gensym("tot"), A_GIMME, 0); class_addmethod(plustot_class, (t_method)plustot_tot, gensym("query"), A_GIMME, 0); -#ifdef PLUSTOT_DEBUG - class_addmethod(plustot_class, (t_method)plustot_debug, - gensym("debug"), 0); -#endif plusproxy_class = class_new(gensym("+tot proxy"), 0, (t_method)plusproxy_free, @@ -1985,23 +2109,14 @@ void plustot_setup(void) class_addfloat(plusproxy_class, plusproxy_float); class_addsymbol(plusproxy_class, plusproxy_symbol); class_addlist(plusproxy_class, plusproxy_list); + #ifdef PLUSTOT_DEBUG + class_addmethod(plustot_class, (t_method)plustot_debug, + gensym("debug"), 0); class_addmethod(plusproxy_class, (t_method)plusproxy_debug, gensym("debug"), 0); #endif - plusps_tot = gensym("+tot"); - plusps_env = gensym("+env"); - plusps_in = gensym("+in"); - plusps_var = gensym("+var"); - plusps_out = gensym("+out"); - plusps_qlist = gensym("+qlist"); - plusps_print = gensym("+print"); - plusps_Ti = gensym("+Ti"); - plusps_To = gensym("+To"); - plusps_Tv = gensym("+Tv"); - totps_query = gensym("query"); - plustin_basetype = plusenv_setup(); plustin_type = plustype_new(plustin_basetype, plusps_Ti, sizeof(t_plustin), @@ -2013,7 +2128,6 @@ void plustot_setup(void) plusvar_type = plustype_new(plustob_type, plusps_Tv, sizeof(t_plusvar), (t_plustypefn)plusvar_delete, 0, 0, 0); - plustot_env_setup(); plustot_in_setup(); plustot_var_setup(); diff --git a/toxy/plustot.env.c b/toxy/plustot.env.c index e0e08f3..23ec82f 100644 --- a/toxy/plustot.env.c +++ b/toxy/plustot.env.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -19,7 +19,7 @@ typedef struct _plustot_env { - t_object x_ob; + t_plusobject x_plusobject; t_plustin *x_tin; t_glist *x_glist; t_hammerfile *x_filehandle; @@ -97,6 +97,7 @@ static void plustot_env_free(t_plustot_env *x) plusbob_detachchildren((t_plusbob *)x->x_tin, (t_plusbob *)tin); plusbob_release((t_plusbob *)x->x_tin); hammerfile_free(x->x_filehandle); + plusobject_free(&x->x_plusobject); } void *plustot_env_new(t_symbol *s, int ac, t_atom *av) @@ -110,11 +111,11 @@ void *plustot_env_new(t_symbol *s, int ac, t_atom *av) || (tin = plustin_glistprovide(gl, PLUSTIN_GLIST_THIS, 1))) { int warned = 0; - x = (t_plustot_env *)pd_new(plustot_env_class); + x = (t_plustot_env *)plusobject_new(plustot_env_class, s, ac, av); x->x_tin = tin; plusbob_preserve((t_plusbob *)tin); x->x_glist = gl; - outlet_new((t_object *)x, &s_symbol); + plusoutlet_new(&x->x_plusobject, &s_symbol); if (deftin) /* true if both oldtin == 0 (we are first in this glist) and plustin_default != 0 (bobs exist already) */ @@ -143,6 +144,7 @@ void plustot_env_setup(void) plustot_env_class = class_new(gensym("+env"), 0, (t_method)plustot_env_free, sizeof(t_plustot_env), 0, 0); + plusclass_inherit(plustot_env_class, gensym("+env")); class_addbang(plustot_env_class, plustot_env_bang); class_addmethod(plustot_env_class, (t_method)plustot_env_source, gensym("source"), A_DEFSYM, 0); diff --git a/toxy/plustot.h b/toxy/plustot.h index ad72d29..509e100 100644 --- a/toxy/plustot.h +++ b/toxy/plustot.h @@ -1,4 +1,4 @@ -/* Copyright (c) 2003-2004 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -23,6 +23,19 @@ EXTERN_STRUCT _plustob; EXTERN_STRUCT _plusvar; #define t_plusvar struct _plusvar +EXTERN_STRUCT _pluswidget; +#define t_pluswidget struct _pluswidget + +typedef struct _plusobject +{ + t_object po_ob; + t_pluswidget *po_widget; + int po_ninlets; + int po_noutlets; +} t_plusobject; + +t_symbol *totps_plustot; +t_symbol *plusps_tot; t_symbol *plusps_Ti; t_symbol *plusps_To; t_symbol *plusps_Tv; @@ -47,9 +60,11 @@ t_plustob *plustob_new(t_plustin *tin, Tcl_Obj *ob); void plustob_setifshared(t_plustob *tob, t_plusifsharedfn ifsharedfn); int plustob_isshared(t_plustob *tob); Tcl_Obj *plustob_getvalue(t_plustob *tob); + t_plustin *plustag_tobtin(t_symbol *s, t_pd *caller); Tcl_Obj *plustag_tobvalue(t_symbol *s, t_pd *caller); Tcl_Obj *plusatom_tobvalue(t_atom *ap, t_pd *caller); + Tcl_Obj *plustob_set(t_plustob *tob, t_plustin *tin, Tcl_Obj *ob); Tcl_Obj *plustob_setfloat(t_plustob *tob, t_float f); Tcl_Obj *plustob_setsymbol(t_plustob *tob, t_symbol *s); @@ -68,6 +83,13 @@ Tcl_Obj *plusvar_setfloat(t_plusvar *var, t_float f, int doit); Tcl_Obj *plusvar_setsymbol(t_plusvar *var, t_symbol *s, int doit); Tcl_Obj *plusvar_setlist(t_plusvar *var, int ac, t_atom *av, int doit); +void plusobject_free(t_plusobject *po); +t_plusobject *plusobject_new(t_class *c, t_symbol *s, int ac, t_atom *av); +t_inlet *plusinlet_new(t_plusobject *po, t_pd *dest, + t_symbol *s1, t_symbol *s2); +t_outlet *plusoutlet_new(t_plusobject *po, t_symbol *s); +void plusclass_inherit(t_class *c, t_symbol *s); + void plustot_env_setup(void); void plustot_in_setup(void); void plustot_var_setup(void); diff --git a/toxy/plustot.in.c b/toxy/plustot.in.c index 206b8b0..3cb3b6c 100644 --- a/toxy/plustot.in.c +++ b/toxy/plustot.in.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -15,7 +15,7 @@ typedef struct _plusproxy_in typedef struct _plustot_in { - t_object x_ob; + t_plusobject x_plusobject; t_glist *x_glist; t_plustob *x_tob; t_plusproxy_in *x_proxy; @@ -75,6 +75,7 @@ static void plustot_in_free(t_plustot_in *x) { plusbob_release((t_plusbob *)x->x_tob); if (x->x_proxy) pd_free((t_pd *)x->x_proxy); + plusobject_free(&x->x_plusobject); } void *plustot_in_new(t_symbol *s, int ac, t_atom *av) @@ -86,15 +87,15 @@ void *plustot_in_new(t_symbol *s, int ac, t_atom *av) if ((tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && (tob = plustob_new(tin, 0))) { - x = (t_plustot_in *)pd_new(plustot_in_class); + x = (t_plustot_in *)plusobject_new(plustot_in_class, s, ac, av); plusbob_preserve((t_plusbob *)tob); plusbob_setowner((t_plusbob *)tob, (t_pd *)x); plustob_setlist(tob, ac, av); x->x_glist = glist; x->x_tob = tob; x->x_proxy = plusproxy_in_new((t_pd *)x); - inlet_new((t_object *)x, (t_pd *)x->x_proxy, 0, 0); - outlet_new((t_object *)x, &s_symbol); + plusinlet_new(&x->x_plusobject, (t_pd *)x->x_proxy, 0, 0); + plusoutlet_new(&x->x_plusobject, &s_symbol); } else { @@ -113,6 +114,7 @@ void plustot_in_setup(void) plustot_in_class = class_new(gensym("+in"), 0, (t_method)plustot_in_free, sizeof(t_plustot_in), 0, 0); + plusclass_inherit(plustot_in_class, gensym("+in")); class_addbang(plustot_in_class, plustot_in_bang); class_addfloat(plustot_in_class, plustot_in_float); class_addsymbol(plustot_in_class, plustot_in_symbol); diff --git a/toxy/plustot.out.c b/toxy/plustot.out.c index 9b70d55..564e907 100644 --- a/toxy/plustot.out.c +++ b/toxy/plustot.out.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -9,8 +9,8 @@ typedef struct _plustot_out { - t_object x_ob; - t_binbuf *x_bb; + t_plusobject x_plusobject; + t_binbuf *x_bb; } t_plustot_out; static t_class *plustot_out_class; @@ -52,13 +52,15 @@ static void plustot_out_symbol(t_plustot_out *x, t_symbol *s) static void plustot_out_free(t_plustot_out *x) { binbuf_free(x->x_bb); + plusobject_free(&x->x_plusobject); } void *plustot_out_new(t_symbol *s, int ac, t_atom *av) { - t_plustot_out *x = (t_plustot_out *)pd_new(plustot_out_class); + t_plustot_out *x = + (t_plustot_out *)plusobject_new(plustot_out_class, s, ac, av); x->x_bb = binbuf_new(); - outlet_new((t_object *)x, &s_anything); + plusoutlet_new(&x->x_plusobject, &s_anything); return (x); } @@ -67,5 +69,6 @@ void plustot_out_setup(void) plustot_out_class = class_new(gensym("+out"), 0, (t_method)plustot_out_free, sizeof(t_plustot_out), 0, 0); + plusclass_inherit(plustot_out_class, gensym("+out")); class_addsymbol(plustot_out_class, plustot_out_symbol); } diff --git a/toxy/plustot.print.c b/toxy/plustot.print.c index 0bd6357..889ded3 100644 --- a/toxy/plustot.print.c +++ b/toxy/plustot.print.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -9,9 +9,9 @@ typedef struct _plustot_print { - t_object x_ob; - t_symbol *x_label; - t_binbuf *x_bb; + t_plusobject x_plusobject; + t_symbol *x_label; + t_binbuf *x_bb; } t_plustot_print; static t_class *plustot_print_class; @@ -75,11 +75,13 @@ static void plustot_print_symbol(t_plustot_print *x, t_symbol *s) static void plustot_print_free(t_plustot_print *x) { binbuf_free(x->x_bb); + plusobject_free(&x->x_plusobject); } void *plustot_print_new(t_symbol *s, int ac, t_atom *av) { - t_plustot_print *x = (t_plustot_print *)pd_new(plustot_print_class); + t_plustot_print *x = + (t_plustot_print *)plusobject_new(plustot_print_class, s, ac, av); x->x_label = (ac && av->a_type == A_SYMBOL ? av->a_w.w_symbol : 0); x->x_bb = binbuf_new(); return (x); @@ -90,5 +92,6 @@ void plustot_print_setup(void) plustot_print_class = class_new(gensym("+print"), 0, (t_method)plustot_print_free, sizeof(t_plustot_print), 0, 0); + plusclass_inherit(plustot_print_class, gensym("+print")); class_addsymbol(plustot_print_class, plustot_print_symbol); } diff --git a/toxy/plustot.qlist.c b/toxy/plustot.qlist.c index e4787fd..4be5430 100644 --- a/toxy/plustot.qlist.c +++ b/toxy/plustot.qlist.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -29,7 +29,7 @@ typedef struct _plusproxy_qlist typedef struct _plustot_qlist { - t_object x_ob; + t_plusobject x_plusobject; t_glist *x_glist; t_plustob *x_tob; t_outlet *x_rightout; @@ -168,6 +168,7 @@ static void plustot_qlist_free(t_plustot_qlist *x) { plusbob_release((t_plusbob *)x->x_tob); if (x->x_proxy) pd_free((t_pd *)x->x_proxy); + plusobject_free(&x->x_plusobject); } void *plustot_qlist_new(t_symbol *s, int ac, t_atom *av) @@ -179,15 +180,15 @@ void *plustot_qlist_new(t_symbol *s, int ac, t_atom *av) if ((tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && (tob = plustob_new(tin, 0))) { - x = (t_plustot_qlist *)pd_new(plustot_qlist_class); + x = (t_plustot_qlist *)plusobject_new(plustot_qlist_class, s, ac, av); plusbob_preserve((t_plusbob *)tob); plusbob_setowner((t_plusbob *)tob, (t_pd *)x); plustob_setlist(tob, ac, av); x->x_glist = glist; x->x_tob = tob; x->x_proxy = plusproxy_qlist_new(x); - inlet_new((t_object *)x, (t_pd *)x->x_proxy, 0, 0); - outlet_new((t_object *)x, &s_anything); + plusinlet_new(&x->x_plusobject, (t_pd *)x->x_proxy, 0, 0); + plusoutlet_new(&x->x_plusobject, &s_anything); x->x_rightout = outlet_new((t_object *)x, &s_symbol); } else @@ -207,6 +208,7 @@ void plustot_qlist_setup(void) plustot_qlist_class = class_new(gensym("+qlist"), 0, (t_method)plustot_qlist_free, sizeof(t_plustot_qlist), 0, 0); + plusclass_inherit(plustot_qlist_class, gensym("+qlist")); class_addbang(plustot_qlist_class, plustot_qlist_bang); plusproxy_qlist_class = class_new(gensym("+qlist proxy"), 0, 0, diff --git a/toxy/plustot.var.c b/toxy/plustot.var.c index a5f36a7..9cb2453 100644 --- a/toxy/plustot.var.c +++ b/toxy/plustot.var.c @@ -1,4 +1,4 @@ -/* Copyright (c) 2003 krzYszcz and others. +/* Copyright (c) 2003-2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ @@ -15,7 +15,7 @@ typedef struct _plusproxy_var typedef struct _plustot_var { - t_object x_ob; + t_plusobject x_plusobject; t_glist *x_glist; t_plusvar *x_var; t_plusproxy_var *x_proxy; @@ -75,6 +75,7 @@ static void plustot_var_free(t_plustot_var *x) { plusbob_release((t_plusbob *)x->x_var); if (x->x_proxy) pd_free((t_pd *)x->x_proxy); + plusobject_free(&x->x_plusobject); } void *plustot_var_new(t_symbol *s, int ac, t_atom *av) @@ -87,15 +88,15 @@ void *plustot_var_new(t_symbol *s, int ac, t_atom *av) (tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && (var = plusvar_new(av->a_w.w_symbol->s_name, 0, tin))) { - x = (t_plustot_var *)pd_new(plustot_var_class); + x = (t_plustot_var *)plusobject_new(plustot_var_class, s, ac, av); plusbob_preserve((t_plusbob *)var); plusbob_setowner((t_plusbob *)var, (t_pd *)x); plusvar_setlist(var, ac - 1, av + 1, 1); x->x_glist = glist; x->x_var = var; x->x_proxy = plusproxy_var_new((t_pd *)x); - inlet_new((t_object *)x, (t_pd *)x->x_proxy, 0, 0); - outlet_new((t_object *)x, &s_symbol); + plusinlet_new(&x->x_plusobject, (t_pd *)x->x_proxy, 0, 0); + plusoutlet_new(&x->x_plusobject, &s_symbol); } else { @@ -117,6 +118,7 @@ void plustot_var_setup(void) plustot_var_class = class_new(gensym("+var"), 0, (t_method)plustot_var_free, sizeof(t_plustot_var), 0, 0); + plusclass_inherit(plustot_var_class, gensym("+var")); class_addbang(plustot_var_class, plustot_var_bang); class_addfloat(plustot_var_class, plustot_var_float); class_addsymbol(plustot_var_class, plustot_var_symbol); diff --git a/toxy/pluswidget.c b/toxy/pluswidget.c new file mode 100644 index 0000000..050b2a1 --- /dev/null +++ b/toxy/pluswidget.c @@ -0,0 +1,249 @@ +/* Copyright (c) 2005 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +/* This is a prototype of a custom object box. It might be replaced with + a new core object type, T_CUSTOM (te_type bitfield would have to be + extended then). */ + +#include +#include +#include "m_pd.h" +#include "g_canvas.h" +#include "common/loud.h" +#include "toxy/plusbob.h" +#include "plustot.h" + +#ifdef KRZYSZCZ +//#define PLUSWIDGET_DEBUG +#endif + +struct _pluswidget +{ + char *pw_vistext; /* binbuf_gettext()-style (no null termination) */ + int pw_vissize; + int pw_rtextactive; + int pw_ishit; +}; + +/* Code that might be merged back to g_text.c starts here: */ + +static void pluswidget_getrect(t_gobj *z, t_glist *glist, + int *xp1, int *yp1, int *xp2, int *yp2) +{ + t_pluswidget *pw = ((t_plusobject *)z)->po_widget; + int width, height; + float x1, y1, x2, y2; + if (glist->gl_editor && glist->gl_editor->e_rtext) + { + if (pw->pw_rtextactive) + { + t_rtext *y = glist_findrtext(glist, (t_text *)z); + width = rtext_width(y); + height = rtext_height(y); + } + else + { + int font = glist_getfont(glist); + width = pw->pw_vissize * sys_fontwidth(font) + 2; + height = sys_fontheight(font) + 4; /* 2-pixel top/bottom margins */ + } + } + else width = height = 10; + x1 = text_xpix((t_text *)z, glist); + y1 = text_ypix((t_text *)z, glist); + x2 = x1 + width; + y2 = y1 + height; + y1 += 1; + *xp1 = x1; + *yp1 = y1; + *xp2 = x2; + *yp2 = y2; +} + +static void pluswidget_drawiofor(t_glist *glist, t_plusobject *po, + int firsttime, + char *tag, int x1, int y1, int x2, int y2) +{ + int n, nplus, i, width = x2 - x1; + for (n = po->po_noutlets, nplus = (n == 1 ? 1 : n-1), i = 0; i < n; i++) + { + int onset = x1 + (width - IOWIDTH) * i / nplus; + if (firsttime) + sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %so%d\ + -outline brown -fill lightgrey\n", + glist_getcanvas(glist), + onset, y2 - 3, + onset + IOWIDTH, y2 + 2, + tag, i); + else + sys_vgui(".x%lx.c coords %so%d %d %d %d %d\n", + glist_getcanvas(glist), tag, i, + onset, y2 - 3, + onset + IOWIDTH, y2 + 2); + } + for (n = po->po_ninlets, nplus = (n == 1 ? 1 : n-1), i = 0; i < n; i++) + { + int onset = x1 + (width - IOWIDTH) * i / nplus; + if (firsttime) + sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %si%d\ + -outline brown -fill lightgrey\n", + glist_getcanvas(glist), + onset, y1 - 3, + onset + IOWIDTH, y1 + 2, + tag, i); + else + sys_vgui(".x%lx.c coords %si%d %d %d %d %d\n", + glist_getcanvas(glist), tag, i, + onset, y1 - 3, + onset + IOWIDTH, y1 + 2); + } +} + +static void pluswidget_drawborder(t_text *t, t_glist *glist, + char *tag, int firsttime) +{ + int x1, y1, x2, y2; + pluswidget_getrect(&t->te_g, glist, &x1, &y1, &x2, &y2); + if (firsttime) + sys_vgui(".x%lx.c create line\ + %d %d %d %d %d %d %d %d %d %d -width 2 -fill brown -tags %sR\n", + glist_getcanvas(glist), + x1, y1, x2, y1, x2, y2, x1, y2, x1, y1, tag); + else + sys_vgui(".x%lx.c coords %sR\ + %d %d %d %d %d %d %d %d %d %d\n", + glist_getcanvas(glist), tag, + x1, y1, x2, y1, x2, y2, x1, y2, x1, y1); + pluswidget_drawiofor(glist, (t_plusobject *)t, firsttime, + tag, x1, y1, x2, y2); +} + +static void pluswidget_displace(t_gobj *z, t_glist *glist, int dx, int dy) +{ + t_text *t = (t_text *)z; + t->te_xpix += dx; + t->te_ypix += dy; + if (glist_isvisible(glist)) + { + t_rtext *y = glist_findrtext(glist, t); + rtext_displace(y, dx, dy); + pluswidget_drawborder(t, glist, rtext_gettag(y), 0); + canvas_fixlinesfor(glist_getcanvas(glist), t); + } +} + +static void pluswidget_select(t_gobj *z, t_glist *glist, int state) +{ + t_pluswidget *pw = ((t_plusobject *)z)->po_widget; + t_rtext *y = glist_findrtext(glist, (t_text *)z); + rtext_select(y, state); + if (glist_isvisible(glist) && glist->gl_havewindow) + { + if (state) + sys_vgui(".x%lx.c itemconfigure %s -fill blue\n", + glist, rtext_gettag(y)); + else + sys_vgui(".x%lx.c itemconfigure %s -text {%.*s} -fill brown\n", + glist, rtext_gettag(y), pw->pw_vissize, pw->pw_vistext); + } +} + +static void pluswidget_activate(t_gobj *z, t_glist *glist, int state) +{ + t_pluswidget *pw = ((t_plusobject *)z)->po_widget; + t_rtext *y = glist_findrtext(glist, (t_text *)z); + rtext_activate(y, state); + pw->pw_rtextactive = state; + pluswidget_drawborder((t_text *)z, glist, rtext_gettag(y), 0); +} + +static void pluswidget_delete(t_gobj *z, t_glist *glist) +{ + canvas_deletelinesfor(glist, (t_text *)z); +} + +static void pluswidget_vis(t_gobj *z, t_glist *glist, int vis) +{ + t_pluswidget *pw = ((t_plusobject *)z)->po_widget; + if (vis) + { + if (glist->gl_havewindow) + { + t_rtext *y = glist_findrtext(glist, (t_text *)z); + pluswidget_drawborder((t_text *)z, glist, rtext_gettag(y), 1); + rtext_draw(y); + sys_vgui(".x%lx.c itemconfigure %s -text {%.*s} -fill brown\n", + glist, rtext_gettag(y), pw->pw_vissize, pw->pw_vistext); + } + } + else + { + if (glist->gl_havewindow) + { + t_rtext *y = glist_findrtext(glist, (t_text *)z); + text_eraseborder((t_text *)z, glist, rtext_gettag(y)); + rtext_erase(y); + } + } +} + +static int pluswidget_click(t_gobj *z, t_glist *glist, int xpix, int ypix, + int shift, int alt, int dbl, int doit) +{ + if (doit) + pd_bang((t_pd *)z); + return (1); +} + +static t_widgetbehavior pluswidget_widgetbehavior = +{ + pluswidget_getrect, + pluswidget_displace, + pluswidget_select, + pluswidget_activate, + pluswidget_delete, + pluswidget_vis, + pluswidget_click, +}; + +/* Code that might be merged back to g_text.c ends here. */ + +void plusobject_widgetfree(t_plusobject *po) +{ + t_pluswidget *pw = po->po_widget; + if (pw) + { + if (pw->pw_vistext) + freebytes(pw->pw_vistext, pw->pw_vissize); + freebytes(pw, sizeof(*pw)); + } +} + +void plusobject_widgetcreate(t_plusobject *po, t_symbol *s, int ac, t_atom *av) +{ + t_pluswidget *pw = getbytes(sizeof(*pw)); + t_binbuf *inbb = binbuf_new(); + if (!s || s == &s_) + s = plusps_tot; + po->po_widget = pw; + if ((s != totps_plustot && s != plusps_tot) || ac == 0) + { + t_atom at; + if (s == totps_plustot) + s = plusps_tot; + SETSYMBOL (&at, s); + binbuf_add(inbb, 1, &at); + } + if (ac > 0) + binbuf_add(inbb, ac, av); + binbuf_gettext(inbb, &pw->pw_vistext, &pw->pw_vissize); + binbuf_free(inbb); + pw->pw_rtextactive = 0; + pw->pw_ishit = 0; +} + +void plusclass_widgetsetup(t_class *c) +{ + class_setwidget(c, &pluswidget_widgetbehavior); +} -- cgit v1.2.1