#!/usr/bin/wish # portray - corpus display script # Copyright (C) 2004-2007 Richard Moot (Richard.Moot@labri.fr) # Copyright (C) 2004-2007 CNRS (http://www.cnrs.fr) # Copyright (C) 2004-2007 INRIA (http://www.inria.fr) # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # This library 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 # Lesser General Public License for more details. # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # This program portrays a corpus file as output by the annotate # tools and displays it as a graph on a TclTk canvas. # 20050203 Removed dependencies on other files (README, hands.gif # and taglist.tcl) # 20010420 Added a preliminary solution to the secondary edges # where a leaf is a parent by virtue of a secondary edge # connection. Only one problematic case remains. # 20010411 Removed -filetypes option in postscript save procedure # due to incompatibility with TclTk 8.3.2 on Macintosh # 20010411 Change sentence number display into entry widget. You can # now enter a sentence number directly. # 20010411 Only one problem with secondary edges remains: when a # word is the parent of some expression (which is only # possible via some secondary edge) one connecting line # is missing. # 20010410 Some more secondary edge connections. Works in most cases # now. The only problematic case is when the child is higher # in the tree than its secondary parent. Secondary edges are # now also unlimited in number. # 20010410 Added support for file selection. # 20010410 Secondary edges are now connected to both child and parent, # some problems still remain when the child is complex or # when there are multiple secondary edges. # 20010405 Added zoom in/out and font selection feature. # 20010405 Added preliminary support for secondary edges, but # secondary edges are still only connected to the parent. # 20010404 First version. Still needs some cleaning up. Secondary # edges are not supported yet. # global display variables set fontsize 12 set fontsizes {6 8 10 12 14 17 18 20 24 34} set fontfamily helvetica set fontfamilies [font families] set font -*-$fontfamily-medium-r-*-*-$fontsize-*-*-*-*-*-*-* set xskip [expr $fontsize*2] set yskip [expr $fontsize*2] set yskipsmall [expr $fontsize*1] set displaymorph 1 set debug 0 if {$debug == 1} { set secolor red set spcolor blue } else { set secolor black set spcolor black } set syndir [pwd] set edgelevel {} # Automatically generated from file "/users.sfinx/heleen/CGN/REL3/tags3a" # Format: 3 #%% 0 sentences (0 tokens, 0 phrases) set vertex(WHSUB) {constituentvraag: bijzin} set vertex(MWU) {merged-word-unit ('drie en twintig', 'Jan van den Berg')} set vertex(--) set vertex(LIST) {asyndetische conjunctie} set vertex(WW1) WW(pv,ev) set vertex(WW2) WW(pv,mv) set vertex(WW3) WW(pv,met-t) set vertex(WW4) WW(inf) set vertex(WW5) WW(vd) set vertex(WW6) WW(od) set vertex(LET) LET set vertex(NP) {nominale groep} set vertex(CONJ) conjunctie set vertex(PPRES) tegenwoordig-deelwoordgroep set vertex(TW1) TW(hoofd) set vertex(VNW1) VNW(pers,pron) set vertex(TW2) TW(rang) set vertex(VNW2) VNW(pr,pron) set vertex(TSW) TSW set vertex(VNW3) VNW(refl,pron) set vertex(COMPP) {zinsdeel met 'meer' of 'even' als hoofd en CP als complement} set vertex(VNW4) VNW(recip,pron) set vertex(ADJ10) ADJ(vrij,comp) set vertex(VNW5) VNW(bez,det) set vertex(AP) {adjectiefgroep (ook voor adverbiaal gebruikte adjectieven)} set vertex(ADJ11) ADJ(vrij,sup) set vertex(VNW6) VNW(vrag,pron) set vertex(ADJ12) ADJ(vrij,dim) set vertex(VNW7) VNW(betr,pron) set vertex(SPEC) SPEC set vertex(VNW8) VNW(vb,pron) set vertex(VNW9) VNW(vb,adv-pron) set vertex(INF) kale-infinitiefgroep set vertex(SSUB) {bijzin (V-finaal)} set vertex(WHQ) {constituentvraag: hoofdzin} set vertex(PP) prepositiegroep set vertex(VZ1) VZ(init) set vertex(VZ2) VZ(fin) set vertex(VZ3) VZ(versm) set vertex(LID) LID set vertex(AHI) aan-het-infinitiefgroep set vertex(VNW10) VNW(excl,pron) set vertex(VNW11) VNW(vb,det) set vertex(VNW12) VNW(excl,det) set vertex(VG1) VG(neven) set vertex(PPART) voltooid/passief-deelwoordgroep set vertex(VG2) VG(onder) set vertex(VNW13) VNW(aanw,pron) set vertex(SVAN) {van-zin (complement in directe rede)} set vertex(SMAIN) {declaratieve zin (V2)} set vertex(ADJ1) ADJ(prenom,basis) set vertex(UNKNOWN) set vertex(VNW14) VNW(aanw,adv-pron) set vertex(BW) BW set vertex(ADJ2) ADJ(prenom,comp) set vertex(VNW15) VNW(aanw,det) set vertex(WHREL) {hoofdloze relatiefzin} set vertex(ADJ3) ADJ(prenom,sup) set vertex(VNW16) VNW(onbep,pron) set vertex(REL) relatiefzin set vertex(CP) {zinsdeel ingeleid door onderschikkend vw. of vw./vz. v. verg.} set vertex(ADJ4) ADJ(nom,basis) set vertex(VNW17) VNW(onbep,adv-pron) set vertex(ADJ5) ADJ(nom,comp) set vertex(VNW18) VNW(onbep,det) set vertex(ADJ6) ADJ(nom,sup) set vertex(VNW19) VNW(onbep,grad) set vertex(ADJ7) ADJ(postnom,basis) set vertex(N1) N(soort,ev) set vertex(ADJ8) ADJ(postnom,comp) set vertex(N2) N(soort,mv) set vertex(ADJ9) ADJ(vrij,basis) set vertex(N3) N(eigen,ev) set vertex(N4) N(eigen,mv) set vertex(ADVP) {bijwoordgroep (alleen voor echte bijwoorden)} set vertex(DU) {discourse-unit (asyndetische constructie)} set vertex(SV1) {zin met V op de eerste plaats} set vertex(OTI) om-te-infinitiefgroep set vertex(DETP) {determinatorgroep ('bijna alle' in 'bijna alle boeken')} set vertex(TI) te-infinitiefgroep set edge(sat) {satelliet: aan- of uitloop (in DU) met binding in NUCL} set edge(ld) {locatief of directioneel complement} set edge(su) {subject, onderwerp} set edge(sup) {voorlopig subject} set edge(se) {verplicht reflexief object} set edge(dlink) {'en', 'maar', 'want' o.i.d. aan het begin van een uiting} set edge(--) set edge(hdf) {staart (scheidbaar deel) van circumpositie} set edge(whd) {complementeerder/hoofd van WHQ of WHSUB} set edge(pc) voorzetselvoorwerp set edge(dp) {elk der delen van een DU} set edge(tag) {aanhangsel, voor- of tussenvoegsel} set edge(obj1) {direct object van V, (eerste) complement van P, A, N} set edge(pobj1) {voorlopig OBJ1} set edge(det) determinator set edge(obj2) {secundair object (IO, EO, BO)} set edge(prt) {elk der delen van een partikelgroep} set edge(part) partitief set edge(obcomp) {vergelijkingscomplement (compl. van 'meer'/'even')} set edge(mod) {algemeen label voor bepaling/modificeerder} set edge(predm) {bepaling v. gesteldheid 'tijdens de handeling'} set edge(cmp) {complementeerder/hoofd van CP, SVAN, TI, OTI of AHI} set edge(unknown) set edge(crd) nevenschikker set edge(vc) {verbaal complement, beknopte bijzin} set edge(svp) {scheidbaar deel van werkwoord} set edge(nucl) {kernzin (in DU)} set edge(me) maat(/duur/gewicht)-complement set edge(appos) bijstelling set edge(cnj) {lid van nevenschikking} set edge(mwp) {elk der delen van een MWU} set edge(lp) {elk der delen van een LIST} set edge(hd) hoofd set edge(body) {romp van CP, SVAN, TI, OTI, AHI, REL, WHQ of WHSUB} set edge(rhd) {complementeerder/hoofd van (hoofdloze) relatiefzin} set edge(predc) {predicatief complement} set morph(T228) ADJ(vrij,comp,zonder) set morph(U509m) VNW(bez,det,stan,vol,3v,ev,prenom,met-e,rest) set morph(U510m) VNW(bez,det,gen,vol,3p,mv,prenom,met-e,rest3) set morph(T229) ADJ(vrij,sup,zonder) set morph(T230) ADJ(vrij,dim,zonder) set morph(U509n) VNW(bez,det,stan,red,3,ev,prenom,zonder,agr) set morph(U511e) VNW(bez,det,dat,vol,2,getal,prenom,met-e,evmo) set morph(U543a) VNW(onbep,det,stan,nom,met-e,mv-n) set morph(U509o) VNW(bez,det,stan,vol,3,mv,prenom,zonder,agr) set morph(U511f) VNW(bez,det,dat,vol,2,getal,prenom,met-e,evf) set morph(U543b) VNW(onbep,det,stan,nom,met-e,ev-n) set morph(U509p) VNW(bez,det,stan,vol,3p,mv,prenom,met-e,rest) set morph(U509q) VNW(bez,det,stan,red,3,getal,prenom,zonder,agr) set morph(U511h) VNW(bez,det,dat,vol,3,ev,prenom,met-e,evmo) set morph(U509r) VNW(bez,det,stan,red,1,ev,prenom,met-e,agr) set morph(U511i) VNW(bez,det,dat,vol,3,ev,prenom,met-e,evf) set morph(U512a) VNW(bez,det,stan,vol,1,ev,nom,met-e,getal-n) set morph(U509s) VNW(bez,det,stan,red,3,ev,prenom,met-e,agr) set morph(U604) LID(bep,gen,rest3) set morph(T532a) VNW(aanw,det,gen,nom,met-e,ev-n) set morph(U512b) VNW(bez,det,stan,vol,1,mv,nom,met-e,getal-n) set morph(U512c) VNW(bez,det,stan,vol,2,getal,nom,met-e,getal-n) set morph(U511l) VNW(bez,det,dat,vol,3p,mv,prenom,met-e,evmo) set morph(U512d) VNW(bez,det,stan,vol,2v,ev,nom,met-e,getal-n) set morph(U511m) VNW(bez,det,dat,vol,3p,mv,prenom,met-e,evf) set morph(U512e) VNW(bez,det,stan,vol,3m,ev,nom,met-e,getal-n) set morph(U608) LID(onbep,stan,agr) set morph(U512f) VNW(bez,det,stan,vol,3v,ev,nom,met-e,getal-n) set morph(T501a) VNW(pers,pron,nomin,vol,1,ev) set morph(U610) LID(onbep,stan,evz) set morph(U512g) VNW(bez,det,stan,vol,3p,mv,nom,met-e,getal-n) set morph(T501b) VNW(pers,pron,nomin,nadr,1,ev) set morph(U512h) VNW(bez,det,stan,vol,1,ev,nom,met-e,ev-n) set morph(T501c) VNW(pers,pron,nomin,red,1,ev) set morph(U512i) VNW(bez,det,stan,vol,1,mv,nom,met-e,ev-n) set morph(T501d) VNW(pers,pron,nomin,vol,1,mv) set morph(U512j) VNW(bez,det,stan,vol,2,getal,nom,met-e,ev-n) set morph(T501e) VNW(pers,pron,nomin,nadr,1,mv) set morph(T533a) VNW(aanw,det,dat,nom,met-e,ev-n) set morph(U512k) VNW(bez,det,stan,vol,2v,ev,nom,met-e,ev-n) set morph(T501f) VNW(pers,pron,nomin,red,1,mv) set morph(U513c) VNW(bez,det,dat,vol,2,getal,nom,met-e,ev-n) set morph(U512l) VNW(bez,det,stan,vol,3m,ev,nom,met-e,ev-n) set morph(T501g) VNW(pers,pron,nomin,vol,2v,ev) set morph(U512m) VNW(bez,det,stan,vol,3v,ev,nom,met-e,ev-n) set morph(T501h) VNW(pers,pron,nomin,nadr,2v,ev) set morph(U512n) VNW(bez,det,stan,vol,3p,mv,nom,met-e,ev-n) set morph(T501i) VNW(pers,pron,nomin,red,2v,ev) set morph(U545a) VNW(onbep,grad,stan,nom,met-e,ev-n,basis) set morph(U513f) VNW(bez,det,dat,vol,3p,mv,nom,met-e,ev-n) set morph(U512o) VNW(bez,det,stan,vol,1,ev,nom,met-e,mv-n) set morph(T502a) VNW(pers,pron,obl,vol,2v,ev) set morph(U545b) VNW(onbep,grad,stan,nom,met-e,mv-n,basis) set morph(U512p) VNW(bez,det,stan,vol,1,mv,nom,met-e,mv-n) set morph(U545c) VNW(onbep,grad,stan,nom,met-e,getal-n,sup) set morph(U512q) VNW(bez,det,stan,vol,2,getal,nom,met-e,mv-n) set morph(T502c) VNW(pers,pron,obl,nadr,3m,ev,masc) set morph(U545d) VNW(onbep,grad,stan,nom,met-e,ev-n,sup) set morph(U512r) VNW(bez,det,stan,vol,2v,ev,nom,met-e,mv-n) set morph(U545e) VNW(onbep,grad,stan,nom,met-e,mv-n,sup) set morph(U514a) VNW(vrag,pron,stan,nadr,3o,ev) set morph(U512s) VNW(bez,det,stan,vol,3m,ev,nom,met-e,mv-n) set morph(U545f) VNW(onbep,grad,stan,nom,zonder,mv-n,dim) set morph(U512t) VNW(bez,det,stan,vol,3v,ev,nom,met-e,mv-n) set morph(U512u) VNW(bez,det,stan,vol,3p,mv,nom,met-e,mv-n) set morph(T501p) VNW(pers,pron,nomin,nadr,3m,ev,masc) set morph(T501s) VNW(pers,pron,nomin,vol,3v,ev,fem) set morph(T901) BW() set morph(T501t) VNW(pers,pron,nomin,nadr,3v,ev,fem) set morph(U515a) VNW(betr,pron,stan,vol,persoon,getal) set morph(U515b) VNW(betr,pron,stan,vol,3,ev) set morph(U515c) VNW(betr,pron,stan,vol,3o,ev) set morph(U547a) VNW(onbep,det,stan,vrij,zonder) set morph(T504a) VNW(pers,pron,gen,vol,1,ev) set morph(T504b) VNW(pers,pron,gen,vol,1,mv) set morph(UNKNOWN) set morph(U327) WW(vd,nom,met-e,getal-n) set morph(T504d) VNW(pers,pron,gen,vol,3m,ev) set morph(U328) WW(od,nom,met-e,getal-n) set morph(T601) LID(bep,stan,evon) set morph(U516b) VNW(betr,pron,gen,vol,3o,getal) set morph(T602) LID(bep,stan,rest) set morph(T603) LID(bep,gen,evmo) set morph(T605) LID(bep,dat,evmo) set morph(U548a) VNW(onbep,grad,stan,vrij,zonder,basis) set morph(T606) LID(bep,dat,evf) set morph(U548b) VNW(onbep,grad,stan,vrij,zonder,sup) set morph(T607) LID(bep,dat,mv) set morph(U548c) VNW(onbep,grad,stan,vrij,zonder,comp) set morph(T609) LID(onbep,gen,evf) set morph(U517a) VNW(vb,pron,stan,vol,3p,getal) set morph(U517b) VNW(vb,pron,stan,vol,3o,ev) set morph(T301) WW(pv,tgw,ev) set morph(T302) WW(pv,tgw,mv) set morph(T303) WW(pv,tgw,met-t) set morph(T304) WW(pv,verl,ev) set morph(U518a) VNW(vb,pron,gen,vol,3m,ev) set morph(T305) WW(pv,verl,mv) set morph(U518b) VNW(vb,pron,gen,vol,3v,ev) set morph(T306) WW(pv,verl,met-t) set morph(U518c) VNW(vb,pron,gen,vol,3p,mv) set morph(T307) WW(pv,imp,ev) set morph(T308) WW(pv,imp,met-t) set morph(T309) WW(pv,conj,ev) set morph(T310) WW(inf,prenom,zonder) set morph(T311) WW(inf,prenom,met-e) set morph(T312) WW(inf,nom,zonder,ev-n) set morph(T313) WW(inf,postnom,zonder) set morph(T314) WW(inf,vrij,zonder) set morph(T001) TSW() set morph(U520a) VNW(excl,pron,stan,vol,3,getal) set morph(U519a) VNW(vb,adv-pron,obl,vol,3o,getal) set morph(T315) WW(vd,prenom,zonder) set morph(T002) SPEC(afgebr) set morph(T540a) VNW(onbep,det,gen,prenom,met-e,mv) set morph(T316) WW(vd,prenom,met-e) set morph(T003) SPEC(onverst) set morph(T317) WW(vd,nom,met-e,ev-n) set morph(T004) SPEC(vreemd) set morph(T318) WW(vd,nom,met-e,mv-n) set morph(T005) SPEC(deeleigen) set morph(T319) WW(vd,postnom,zonder) set morph(T320) WW(vd,vrij,zonder) set morph(T006) SPEC(meta) set morph(T321) WW(od,prenom,zonder) set morph(T007) LET() set morph(T322) WW(od,prenom,met-e) set morph(T323) WW(od,nom,met-e,ev-n) set morph(T324) WW(od,nom,met-e,mv-n) set morph(U521a) VNW(vb,det,stan,prenom,zonder,evon) set morph(T325) WW(od,postnom,zonder) set morph(T541a) VNW(onbep,det,dat,prenom,met-e,evmo) set morph(U521b) VNW(vb,det,stan,prenom,met-e,rest) set morph(T326) WW(od,vrij,zonder) set morph(T541b) VNW(onbep,det,dat,prenom,met-e,evf set morph(T510a) VNW(bez,det,gen,vol,1,ev,prenom,zonder,evmo) set morph(T510c) VNW(bez,det,gen,vol,1,mv,prenom,met-e,evmo) set morph(U522a) VNW(vb,det,stan,nom,met-e,getal-n) set morph(T510j) VNW(bez,det,gen,vol,3v,ev,prenom,zonder,evmo) set morph(T511a) VNW(bez,det,dat,vol,1,ev,prenom,met-e,evmo) set morph(T511b) VNW(bez,det,dat,vol,1,ev,prenom,met-e,evf) set morph(T511c) VNW(bez,det,dat,vol,1,mv,prenom,met-e,evmo) set morph(T511d) VNW(bez,det,dat,vol,1,mv,prenom,met-e,evf) set morph(U523a) VNW(excl,det,stan,vrij,zonder) set morph(T511g) VNW(bez,det,dat,vol,2v,ev,prenom,met-e,evf) set morph(T511j) VNW(bez,det,dat,vol,3v,ev,prenom,met-e,evmo) set morph(T511k) VNW(bez,det,dat,vol,3v,ev,prenom,met-e,evf) set morph(U524a) VNW(aanw,pron,stan,vol,3o,ev) set morph(T544a) VNW(onbep,det,gen,nom,met-e,mv-n) set morph(U524b) VNW(aanw,pron,stan,nadr,3o,ev) set morph(U524c) VNW(aanw,pron,stan,vol,3,getal) set morph(T513a) VNW(bez,det,dat,vol,1,ev,nom,met-e,ev-n) set morph(T513b) VNW(bez,det,dat,vol,1,mv,nom,met-e,ev-n) set morph(T513d) VNW(bez,det,dat,vol,3m,ev,nom,met-e,ev-n) set morph(T513e) VNW(bez,det,dat,vol,3v,ev,nom,met-e,ev-n) set morph(U526a) VNW(aanw,adv-pron,obl,vol,3o,getal) set morph(T701) VZ(init) set morph(T546a) VNW(onbep,grad,gen,nom,met-e,mv-n,basis) set morph(T702) VZ(fin) set morph(T703) VZ(versm) set morph(U117) N(soort,ev,basis,genus,stan) set morph(U118) N(eigen,ev,basis,genus,stan) set morph(U527a) VNW(aanw,adv-pron,stan,red,3,getal) set morph(T516a) VNW(betr,pron,gen,vol,3o,ev) set morph(T401) TW(hoofd,prenom,stan) set morph(T402) TW(hoofd,prenom,bijz) set morph(T403) TW(hoofd,nom,ev-n,basis) set morph(T404) TW(hoofd,nom,mv-n,basis) set morph(U528a) VNW(aanw,det,stan,prenom,zonder,evon) set morph(T405) TW(hoofd,nom,ev-n,dim) set morph(U528b) VNW(aanw,det,stan,prenom,zonder,rest) set morph(T406) TW(hoofd,nom,mv-n,dim) set morph(U528c) VNW(aanw,det,stan,prenom,zonder,agr) set morph(T407) TW(hoofd,postnom) set morph(U528d) VNW(aanw,det,stan,prenom,met-e,rest) set morph(T408) TW(hoofd,vrij) set morph(T409) TW(rang,prenom,stan) set morph(T410) TW(rang,prenom,bijz) set morph(T411) TW(rang,nom,ev-n) set morph(T412) TW(rang,nom,mv-n) set morph(T413) TW(rang,vrij) set morph(U529a) VNW(aanw,det,gen,prenom,met-e,rest3) set morph(T101) N(soort,ev,basis,zijd,stan) set morph(T102) N(soort,ev,basis,onz,stan) set morph(T103) N(soort,ev,dim,onz,stan) set morph(T104) N(soort,ev,basis,gen) set morph(T105) N(soort,ev,dim,gen) set morph(T106) N(soort,ev,basis,dat) set morph(T107) N(soort,mv,basis) set morph(T108) N(soort,mv,dim) set morph(T109) N(eigen,ev,basis,zijd,stan) set morph(T110) N(eigen,ev,basis,onz,stan) set morph(U531a) VNW(aanw,det,stan,nom,met-e,getal-n) set morph(T111) N(eigen,ev,dim,onz,stan) set morph(U531b) VNW(aanw,det,stan,nom,met-e,ev-n) set morph(T112) N(eigen,ev,basis,gen) set morph(U531c) VNW(aanw,det,stan,nom,met-e,mv-n) set morph(T113) N(eigen,ev,dim,gen) set morph(T114) N(eigen,ev,basis,dat) set morph(T115) N(eigen,mv,basis) set morph(T116) N(eigen,mv,dim) set morph(U532b) VNW(aanw,det,gen,nom,met-e,getal-n) set morph(U501j) VNW(pers,pron,nomin,vol,2b,getal) set morph(U501k) VNW(pers,pron,nomin,nadr,2b,getal) set morph(U502b) VNW(pers,pron,obl,vol,3,ev,masc) set morph(U501l) VNW(pers,pron,nomin,vol,2,getal) set morph(U501m) VNW(pers,pron,nomin,nadr,2,getal) set morph(U502d) VNW(pers,pron,obl,red,3,ev,masc) set morph(U501n) VNW(pers,pron,nomin,red,2,getal) set morph(U502e) VNW(pers,pron,obl,vol,3,getal,fem) set morph(U534a) VNW(aanw,det,stan,vrij,zonder) set morph(U501o) VNW(pers,pron,nomin,vol,3,ev,masc) set morph(U502f) VNW(pers,pron,obl,nadr,3v,getal,fem) set morph(U502g) VNW(pers,pron,obl,red,3v,getal,fem) set morph(U501q) VNW(pers,pron,nomin,red,3,ev,masc) set morph(U502h) VNW(pers,pron,obl,vol,3p,mv) set morph(U501r) VNW(pers,pron,nomin,red,3p,ev,masc) set morph(U502i) VNW(pers,pron,obl,nadr,3p,mv) set morph(U503a) VNW(pers,pron,stan,nadr,2v,mv) set morph(U503b) VNW(pers,pron,stan,red,3,ev,onz) set morph(U501u) VNW(pers,pron,nomin,vol,3p,mv) set morph(U503c) VNW(pers,pron,stan,red,3,ev,fem) set morph(U501v) VNW(pers,pron,nomin,nadr,3p,mv) set morph(U503d) VNW(pers,pron,stan,red,3,mv) set morph(--) set morph(U535a) VNW(onbep,pron,stan,vol,3p,ev) set morph(U535b) VNW(onbep,pron,stan,vol,3o,ev) set morph(U504c) VNW(pers,pron,gen,vol,2,getal) set morph(U504e) VNW(pers,pron,gen,vol,3v,getal) set morph(U536a) VNW(onbep,pron,gen,vol,3p,ev) set morph(U504f) VNW(pers,pron,gen,vol,3p,mv) set morph(T801) VG(neven) set morph(T802) VG(onder) set morph(U505a) VNW(pr,pron,obl,vol,1,ev) set morph(T525a) VNW(aanw,pron,gen,vol,3m,ev) set morph(U505b) VNW(pr,pron,obl,nadr,1,ev) set morph(T525b) VNW(aanw,pron,gen,vol,3o,ev) set morph(U505c) VNW(pr,pron,obl,red,1,ev) set morph(U505d) VNW(pr,pron,obl,vol,1,mv) set morph(U505e) VNW(pr,pron,obl,nadr,1,mv) set morph(U537a) VNW(onbep,adv-pron,obl,vol,3o,getal) set morph(U505f) VNW(pr,pron,obl,red,2v,getal) set morph(U505g) VNW(pr,pron,obl,nadr,2v,getal) set morph(U505h) VNW(pr,pron,obl,vol,2,getal) set morph(U505i) VNW(pr,pron,obl,nadr,2,getal) set morph(U506a) VNW(refl,pron,obl,red,3,getal) set morph(U506b) VNW(refl,pron,obl,nadr,3,getal) set morph(U231) ADJ(nom,basis,zonder,getal-n) set morph(U232) ADJ(nom,basis,met-e,getal-n) set morph(U233) ADJ(nom,comp,met-e,getal-n) set morph(U538a) VNW(onbep,adv-pron,gen,red,3,getal) set morph(U234) ADJ(nom,sup,met-e,getal-n) set morph(U507a) VNW(recip,pron,obl,vol,persoon,mv) set morph(U539a) VNW(onbep,det,stan,prenom,zonder,evon) set morph(T201) ADJ(prenom,basis,zonder) set morph(U539b) VNW(onbep,det,stan,prenom,zonder,agr) set morph(T202) ADJ(prenom,basis,met-e,stan) set morph(U539c) VNW(onbep,det,stan,prenom,met-e,evz) set morph(T203) ADJ(prenom,basis,met-e,bijz) set morph(U539d) VNW(onbep,det,stan,prenom,met-e,mv) set morph(T204) ADJ(prenom,comp,zonder) set morph(U539e) VNW(onbep,det,stan,prenom,met-e,rest) set morph(T205) ADJ(prenom,comp,met-e,stan) set morph(U508a) VNW(recip,pron,gen,vol,persoon,mv) set morph(U539f) VNW(onbep,det,stan,prenom,met-e,agr) set morph(T206) ADJ(prenom,comp,met-e,bijz) set morph(T207) ADJ(prenom,sup,zonder) set morph(T208) ADJ(prenom,sup,met-e,stan) set morph(T210) ADJ(nom,basis,zonder,ev-n) set morph(T209) ADJ(prenom,sup,met-e,bijz) set morph(T211) ADJ(nom,basis,zonder,mv-n) set morph(T212) ADJ(nom,basis,met-e,ev-n,stan) set morph(T213) ADJ(nom,basis,met-e,ev-n,bijz) set morph(T214) ADJ(nom,basis,met-e,mv-n) set morph(T215) ADJ(nom,comp,zonder,ev-n) set morph(U509a) VNW(bez,det,stan,vol,1,ev,prenom,zonder,agr) set morph(T530a) VNW(aanw,det,dat,prenom,met-e,evmo) set morph(T216) ADJ(nom,comp,met-e,ev-n,stan) set morph(U509b) VNW(bez,det,stan,vol,1,ev,prenom,met-e,rest) set morph(U510b) VNW(bez,det,gen,vol,1,ev,prenom,met-e,rest3) set morph(T530b) VNW(aanw,det,dat,prenom,met-e,evf) set morph(T217) ADJ(nom,comp,met-e,ev-n,bijz) set morph(U509c) VNW(bez,det,stan,red,1,ev,prenom,zonder,agr) set morph(T218) ADJ(nom,comp,met-e,mv-n) set morph(U509d) VNW(bez,det,stan,vol,1,mv,prenom,zonder,evon) set morph(U510d) VNW(bez,det,gen,vol,1,mv,prenom,met-e,rest3) set morph(T220) ADJ(nom,sup,met-e,ev-n,stan) set morph(T219) ADJ(nom,sup,zonder,ev-n) set morph(U509e) VNW(bez,det,stan,vol,1,mv,prenom,met-e,rest) set morph(U510e) VNW(bez,det,gen,vol,2,getal,prenom,zonder,evmo) set morph(U542a) VNW(onbep,grad,stan,prenom,zonder,agr,basis) set morph(T221) ADJ(nom,sup,met-e,ev-n,bijz) set morph(U509f) VNW(bez,det,stan,vol,2,getal,prenom,zonder,agr) set morph(U510f) VNW(bez,det,gen,vol,2,getal,prenom,met-e,rest3) set morph(U542b) VNW(onbep,grad,stan,prenom,met-e,agr,basis) set morph(T222) ADJ(nom,sup,met-e,mv-n) set morph(U509g) VNW(bez,det,stan,vol,2,getal,prenom,met-e,rest) set morph(U510g) VNW(bez,det,gen,vol,2v,ev,prenom,met-e,rest3) set morph(U542c) VNW(onbep,grad,stan,prenom,met-e,mv,basis) set morph(T223) ADJ(postnom,basis,zonder) set morph(U509h) VNW(bez,det,stan,vol,2v,ev,prenom,zonder,agr) set morph(U510h) VNW(bez,det,gen,vol,3,ev,prenom,zonder,evmo) set morph(U542d) VNW(onbep,grad,stan,prenom,zonder,agr,comp) set morph(T224) ADJ(postnom,basis,met-s) set morph(U509i) VNW(bez,det,stan,red,2v,ev,prenom,zonder,agr) set morph(U510i) VNW(bez,det,gen,vol,3,ev,prenom,met-e,rest3) set morph(U542e) VNW(onbep,grad,stan,prenom,met-e,agr,sup) set morph(T225) ADJ(postnom,comp,zonder) set morph(U509j) VNW(bez,det,stan,nadr,2v,mv,prenom,zonder,agr) set morph(T226) ADJ(postnom,comp,met-s) set morph(U509k) VNW(bez,det,stan,vol,3,ev,prenom,zonder,agr) set morph(U510k) VNW(bez,det,gen,vol,3v,ev,prenom,met-e,rest3) set morph(T227) ADJ(vrij,basis,zonder) set morph(U509l) VNW(bez,det,stan,vol,3m,ev,prenom,met-e,rest) set morph(U510l) VNW(bez,det,gen,vol,3p,mv,prenom,zonder,evmo) # window setup proc windowsetup {} { global state fontfamilies frame .b frame .m frame .mbar -relief raised -bd 2 menubutton .mbar.file -text File -underline 0 -menu .mbar.file.menu menubutton .mbar.option -text Options -underline 0 -menu .mbar.option.menu menubutton .mbar.help -text Help -underline 0 -menu .mbar.help.menu pack .mbar.file .mbar.option -side left pack .mbar.help -side right menu .mbar.file.menu -tearoff 0 .mbar.file.menu add command -label "About..." -underline 0 -command aboutwindow .mbar.file.menu add command -label "Load..." -underline 0 -command getcgnfile .mbar.file.menu add command -label "Write Postscript" -underline 6 -command {write_ps .c .} .mbar.file.menu add separator .mbar.file.menu add command -label "Exit" -underline 1 -command {destroy .} menu .mbar.option.menu -tearoff 0 .mbar.option.menu add checkbutton -label "Display Morphological Tags" \ -variable displaymorph -command redisplay -underline 8 .mbar.option.menu add command -label "Zoom In" -underline 5 -command {zoomin} .mbar.option.menu add command -label "Zoom Out" -underline 5 -command {zoomout} .mbar.option.menu add cascade -label "Font Family" -underline 0 -menu .mbar.option.menu.font menu .mbar.option.menu.font -tearoff 0 foreach ff $fontfamilies { .mbar.option.menu.font add radiobutton -label [capitalize $ff] \ -variable fontfamily -value $ff -command redisplay } menu .mbar.help.menu -tearoff 0 .mbar.help.menu add command -label "On Portray" -underline 0 -command helpwindow text .b.comment -relief sunken -bd 2 -height 2 -width 60 \ -wrap word -state disabled entry .b.c -width 3 -relief flat -bd 2 -textvariable tempcurrent button .b.prev -text " < " -height 1 -command {prevsent 1} -state disabled button .b.next -text " > " -height 1 -command {nextsent 1} -state $state button .b.first -text "|<<" -height 1 -command firstsent button .b.last -text ">>|" -height 1 -command lastsent pack .b.last .b.next .b.prev .b.first -side right pack .b.c -side left -padx 2 pack .b.comment -side left -fill x -padx 2 pack .b -side bottom -fill x pack .m -side bottom -fill both -expand true pack .mbar -side bottom -fill x canvas .c -yscrollcommand [list .sy set] \ -xscrollcommand [list .sx set] scrollbar .sx -orient horizontal \ -command [list .c xview] scrollbar .sy -orient vertical \ -command [list .c yview] pack .sx -side bottom -fill x -in .m pack .sy -side right -fill y -in .m pack .c -side left -fill both -expand true -in .m } proc bindingsetup {} { global debug bind all {zoomout} bind all {zoomin} bind all {prevsent 1} bind all {nextsent 1} bind all {prevsent 5} bind all {nextsent 5} bind all {prevsent 10} bind all {nextsent 10} bind all {firstsent} bind all {lastsent} bind all {destroy .} bind all {getcgnfile} bind .b.c {updatecurrent} bind .c {focus .c} if {$debug == 1} { .c bind all { set curX [.c canvasx %x] set curY [.c canvasy %y] set tags [.c gettags current] set cp [lsearch $tags current] set tags [lreplace $tags $cp $cp] printcomment "$curX,$curY: $tags" } } } proc aboutwindow {} { if {[winfo exists .about]} { wm deiconify .about raise .about } else { toplevel .about wm title .about "About Portray" canvas .about.c -bd 4 .about.c configure -height 148 .about.c configure -width 177 label .about.txt -text "Portray 0.4" label .about.txt2 -wraplength 5.5c -justify left \ -font -*-times-medium-r-*--12* \ -text "Release: 03-02-2005\n(c) 2001-2005 Richard Moot\n\nEmail bug reports, comments or suggestions to:" label .about.elm -font -*-courier-medium-r-*--12-*-*-*-m-*\ -text "Richard.Moot@labri.fr" button .about.exit -text "Cancel" -command {destroy .about} pack .about.c .about.txt .about.txt2 .about.elm .about.exit -padx 2 -side top bind .about {destroy .about} } } proc helpwindow {} { if {[winfo exists .help]} { wm deiconify .help raise .help } else { toplevel .help wm title .help "Portray Help" text .help.txt -bd 2 -yscrollcommand ".help.scroll set" scrollbar .help.scroll -command ".help.txt yview" pack .help.scroll -side right -fill y pack .help.txt -side left .help.txt insert end "Portray is a small tool for displaying the syntactic annotation files of the Spoken Dutch Corpus\n\n" .help.txt configure -state disabled } } proc updatecurrent {} { global values current tempcurrent if {[regexp {^([0-9])+$} $tempcurrent] && [lsearch $values $tempcurrent] != -1} { set current $tempcurrent printsent 20 200 $current } else { set tempcurrent $current printsent 20 200 $current } } proc getcgnfile {} { global syndir values current set filename [tk_getOpenFile -initialdir $syndir \ -defaultextension .syn -title "Load Annotation File"\ -filetypes {{"Annotation Files" {.syn .out}} {"All Files" * }}] if {$filename != {}} { set syndir [file dirname $filename] set pattern [list [list 0 end]] set values [loadcgn $filename $pattern] set current [lindex $values 0] if {[llength $values] > 1} { .b.next configure -state normal } else { .b.next configure -state disabled } .b.prev configure -state disabled if {$current != {}} { printsent 20 200 $current } } } proc loadcgn {file pattern} { global comment sentence set f [open $file r] set sentno 0 set values {} # read the cgn output file and convert it to an array while {[gets $f line] >= 0} { # discard leading comments if {[regexp {^(%+)(.*)$} $line]} { putsdebug $line } elseif {[regexp {^#BOS ([0-9]+)(.*)$} $line x sentno]} { set sentence($sentno) {} if {[matches $sentno $pattern]} { set values [concat $values $sentno] # if sentence has a comment, put the comment in a # separate array if {[regexp {^(.*)(%+)(.*)$} $x y z v c]} { regsub -all \" $c \' c set comment($sentno) $c } else { set comment($sentno) {} } } else { unset sentence($sentno) } } elseif {[regexp {^#FORMAT ([0-9]+)(.*)$} $line x format y]} { putsdebug "Format: $format" } elseif {[regexp {^#EOS ([0-9]+)(.*)$} $line x line y]} { if [catch {set sentence($sentno)}] { putsdebug "Ignored: $line" } else { putsdebug "Processed: $line" } } else { if {[catch {set sentence($sentno)}]!= 1} { regsub -all (\t+) $line \t line set line [iso8859 $line] set list [split $line \t] set current $sentence($sentno) set l [llength $current] set sentence($sentno) [linsert $current $l $list] } } } close $f return $values } proc iso8859 {string} { regsub -all \ë\; $string ë string regsub -all \ï\; $string ï string regsub -all \ö\; $string ö string regsub -all \ü\; $string ü string regsub -all \é\; $string é string regsub -all \è\; $string è string regsub -all \à\: $string à string regsub -all \É\; $string É string regsub -all \È\; $string È string return $string } proc write_ps {canvas dir} { global xskip global yskip set box [$canvas bbox all] set x1 [expr [lindex $box 0]-($xskip/2)] set x2 [expr [lindex $box 2]+($xskip/2)] set y1 [expr [lindex $box 1]-($yskip/2)] set y2 [expr [lindex $box 3]+($yskip/2)] set width [expr $x2-$x1] set height [expr $y2-$y1] set filename [tk_getSaveFile -initialdir $dir \ -defaultextension .ps -title "Save as..." \ -filetypes {{"Postscript Files" {.ps}} {"All Files" * }}] if {$filename != {}} { $canvas postscript -rotate 1 -x $x1 -y $y1 \ -height $height -width $width -colormode gray -file $filename } } proc putsdebug {string} { global debug if {$debug == 1} { puts $string } } proc capitalize {list} { set cstring "" foreach i $list { set first [string toupper [string range $i 0 0]] set rest [string tolower [string range $i 1 end]] set cstring "$cstring $first$rest" } return $cstring } proc matches {num pattern} { foreach item $pattern { set min [lindex $item 0] set max [lindex $item 1] if {$max == "end" && $num >= $min} { return 1 } if {$num >= $min && $max >= $num} { return 1 } } return 0 } proc parse-pattern {string} { set list [split $string ,] for {set n 0} {$n < [llength $list]} {incr n} { # an integer is a valid pattern if {[regexp {^([0-9]+)$} [lindex $list $n] x item]} { set list [lreplace $list $n $n [list $item $item]] } elseif {[regexp {^-([0-9]+)$} [lindex $list $n] x item]} { set list [lreplace $list $n $n [list 0 $item]] } elseif {[regexp {^([0-9]+)-$} [lindex $list $n] x item]} { set list [lreplace $list $n $n [list $item end]] } elseif {[regexp {^([0-9]+)-([0-9]+)$} [lindex $list $n] x item1 item2]} { set list [lreplace $list $n $n [list $item1 $item2]] } else { error "Not a valid pattern!" } } return $list } proc getword {s} { lindex $s 0 } proc gettag {s} { lindex $s 1 } proc getmorph {s} { lindex $s 2 } proc getedge {s} { lindex $s 3 } proc getparent {s} { lindex $s 4 } proc getsecedges {s} { lrange $s 5 end } proc zoomin {} { global current if {$current != {}} { global font fontsize fontsizes fontfamily global xskip yskip yskipsmall set currentsizen [lsearch $fontsizes $fontsize] set max [expr [llength $fontsizes] -1] if {$currentsizen < $max} { incr currentsizen set fontsize [lindex $fontsizes $currentsizen] set font -adobe-$fontfamily-medium-r-*-*-$fontsize-*-*-*-*-*-*-* set xskip [expr $fontsize*2] set yskip [expr $fontsize*2] set yskipsmall [expr $fontsize*1] printsent 20 200 $current } if {$currentsizen == $max} { .mbar.option.menu entryconfigure 1 -state disabled } .mbar.option.menu entryconfigure 2 -state normal } } proc zoomout {} { global current if {$current != {}} { global font fontsize fontsizes fontfamily global xskip yskip yskipsmall set currentsizen [lsearch $fontsizes $fontsize] if {$currentsizen > 0} { incr currentsizen -1 set fontsize [lindex $fontsizes $currentsizen] set font -adobe-$fontfamily-medium-r-*-*-$fontsize-*-*-*-*-*-*-* set xskip [expr $fontsize*2] set yskip [expr $fontsize*2] set yskipsmall [expr $fontsize*1] printsent 20 200 $current } if {$currentsizen == 0} { .mbar.option.menu entryconfigure 2 -state disabled } .mbar.option.menu entryconfigure 1 -state normal } } proc redisplay {} { global current global font fontsize fontfamily set font -adobe-$fontfamily-medium-r-*-*-$fontsize-*-*-*-*-*-*-* printsent 20 200 $current } proc printvertex {x y label tags} { global font xskip vertex set text [.c create text $x $y -font $font -text [string toupper $label] -anchor sw -tags [list $tags]] set box [.c bbox $text] set x1 [lindex $box 0] set x2 [lindex $box 2] set y1 [lindex $box 1] set y2 [lindex $box 3] set sizex [expr (($x2-$x1)+2)*sqrt(2)] set sizex [expr ($sizex<$xskip)?$xskip:$sizex] set sizey [expr (($y2-$y1)+2)*sqrt(2)] set diffx [expr (($sizex-($x2-$x1))/2.0)+1] set diffy [expr -(($sizey-($y2-$y1))/2.0)] .c move $text $diffx $diffy set oval [.c create oval $x [expr $y-$sizey] [expr $x+$sizex] $y\ -tags [list oval$tags $tags]] if {$label == "--"} { .c itemconfigure $oval -outline "" .c delete $text } else { .c bind $text { set label [.c itemcget current -text] if [catch {set vertex($label)}] { printcomment "?" } else { printcomment $vertex($label) } } .c bind $text { printcurrentcomment } } return $oval } proc printedge {x y label tags} { global font edge edgelevel if {[lsearch $edgelevel $y]==-1} { set edgelevel [lsort -integer -decreasing [linsert $edgelevel end $y]] } set text [.c create text [expr $x+2] [expr $y-2] -font $font -text [string tolower $label] -anchor sw -tags [list $tags]] set box [.c bbox $text] set x1 [lindex $box 0] set x2 [lindex $box 2] set y1 [lindex $box 1] set y2 [lindex $box 3] .c create rectangle $x [expr $y1-2] [expr $x2+2] $y -tags [list $tags] .c bind $text { set label [.c itemcget current -text] if [catch {set edge($label)}] { printcomment "?" } else { printcomment $edge($label) } } .c bind $text { printcurrentcomment } set bbox [list $x [expr $y1-2] [expr $x2+2] $y] } proc printwordtext {x y label tags} { global font set text [.c create text $x $y -font $font -text $label -anchor sw -tags [list $tags]] set bbox [.c bbox $text] if {$label == "--"} { .c delete $text } return $bbox } proc printmorphtext {x y label tags} { global font morph set text [.c create text $x $y -font $font -text $label -anchor sw -tags [list $tags]] set bbox [.c bbox $text] if {$label == "--"} { .c delete $text } else { .c bind $text { set label [.c itemcget current -text] if [catch {set morph($label)}] { printcomment "?" } else { printcomment $morph($label) } } .c bind $text { printcurrentcomment } } return $bbox } proc printcurrentcomment {} { global current comment printcomment $comment($current) } proc printcomment {comment} { .b.comment configure -state normal .b.comment delete 1.0 end foreach i $comment { regsub -all \" $i \' i .b.comment insert end "[iso8859 $i] " } .b.comment configure -state disabled } proc printsent {x y sentnum} { global comment sentence edgelevel global xskip yskip set edgelevel {} if {$sentnum == {}} { return -1 } .b.c delete 0 end .b.c insert 0 $sentnum printcomment $comment($sentnum) .c delete all set list $sentence($sentnum) set list [preprocess_se $list] set end [lsearch -glob $list #*] if {$end == -1} { set end [llength $list] } printwordlist $x $y $list $end printparents $x $y $list $end portray_se set box [.c bbox all] set x1 [expr [lindex $box 0]-($xskip/2)] set x2 [expr [lindex $box 2]+($xskip/2)] set y1 [expr [lindex $box 1]-($yskip/2)] set y2 [expr [lindex $box 3]+($yskip/2)] .c configure -scrollregion [list $x1 $y1 $x2 $y2] } proc without_sec_edge {column} { global sec foreach x [array names sec] { foreach y $sec($x) { if {$y == $column} { return 0 } } } return 1 } proc preprocess_se {list} { global sec connectsp if {[info exists sec]} { unset sec } if {[info exists connectsp]} { unset connectsp } for {set num 0} {$num < [llength $list]} {incr num} { set i [lindex $list $num] set tag [gettag $i] set iparent [getparent $i] set edge [getedge $i] set morph [getmorph $i] set secedges [getsecedges $i] set itemword [getword $i] if {$secedges != {}} { set numse [expr [llength $secedges]/2] set simpleparent [getsimpleparent $secedges] if {$simpleparent != -1} { set actual [getactualitem $list $simpleparent] if {[regexp {^#([0-9]+)$} $itemword x parent]} { set x $parent } else { set x $actual } # set sse [expr [lsearch $list $i]+1] set sse [expr $actual+1] shift_array $sse $numse setsec $x $numse $sse set connectsp($sse) $actual # putsdebug "connectsp($sse) = $actual" # if the secondary daughter is itself a parent, # add the extra space for the secondary edges after # its rightmost daughter } elseif {[regexp {^#([0-9]+)$} $itemword x parent]} { set sse [findsibling $list $i $parent] shift_array $sse $numse setsec $parent $numse $sse } else { # otherwise add it immediately after the daughter # itself set sse [expr [lsearch $list $i]+1] shift_array $sse $numse setsec $num $numse $sse } # modify the current item so that it no longer has a # secondary edge specification set list [lreplace $list $num $num \ [list $itemword $tag $morph $edge $iparent]] # insert the secondary edges as new items for {set n [expr [llength $secedges]-2]} {$n>= 0} {incr n -2} { set se [lindex $secedges $n] set sp [lindex $secedges [expr $n+1]] set list [linsert $list $sse [list -- -- -- $se $sp]] } } } return $list } proc getsimpleparent {selist} { for {set i 1} {$i < [llength $selist]} {incr i +2} { set separent [lindex $selist $i] if {$separent < 500} { putsdebug "Simple parent: $separent" return $separent } } return -1 } proc getactualitem {wordlist item} { set actual [expr $item+1] for {set i 0} {$i <= [llength $wordlist]} {incr i} { set citem [lindex $wordlist $i] if {[getword $citem] != "--"} { incr actual -1 } if {$actual == 0} { # putsdebug "App: $item, Actual: $i" return $i } } } proc setsec {source max init} { global sec set temp "" for {set i $init} {$i < $init+$max} {incr i} { set temp "$temp $i" } set sec($source) $temp # putsdebug "sec($source) = $sec($source)" } proc shift_array {current shift} { global sec connectsp set arrayitems [array names sec] foreach i $arrayitems { if {$sec($i)>$current} { set sec($i) [expr $sec($i)+$shift] } if {$i >= $current && $i < 500} { set value $sec($i) unset sec($i) set j [expr $i+$shift] set sec($j) $value } } set arrayitems [array names connectsp] foreach i $arrayitems { if {$connectsp($i)>$current} { set connectsp($i) [expr $connectsp($i)+$shift] } if {$i >= $current && $i < 500} { set value $connectsp($i) unset connectsp($i) set j [expr $i+$shift] set connectsp($j) $value } } } proc portray_se {} { global sec putsdebug "Edges: [array names sec]" foreach i [array names sec] { connect_se $i $sec($i) } } proc connect_se {se splist} { global edgelevel yskip xskip secolor spcolor connectsp # putsdebug "Connectsp: [array names connectsp]" foreach sp $splist { # draw a connection from column $se to column $sp putsdebug "SE: $se SP: $sp" # get the bounding box of the oval at column $se and # the line at column $sp set box1 [.c bbox linec$sp] set box2 [.c bbox ovalc$se] # for the oval the vertical middle, the horizontal left # and right position and the top position are needed set ovalm [expr ([lindex $box2 1]+[lindex $box2 3])/2.0] set ovall [lindex $box2 0] set ovalr [lindex $box2 2] set ovalt [lindex $box2 1] # for the line the vertical middle, the top and the bottom # position are needed set linem [expr ([lindex $box1 0]+[lindex $box1 2])/2.0] set linet [expr [lindex $box1 1]+2] set lineb [lindex $box1 3] # delete the lines currently linking the edge label set topitems [.c find overlapping \ [lindex $box1 0] [expr [lindex $box1 3]-3.0*$yskip] \ [lindex $box1 2] [expr [lindex $box1 3]-2.5*$yskip]] set topline [lindex $topitems 0] set top [expr [lindex [.c bbox $topline] 1] + 2] set botitems [.c find overlapping \ [lindex $box1 0] [expr [lindex $box1 3]-1.0*$yskip] \ [lindex $box1 2] [expr [lindex $box1 3]-0.5*$yskip]] set botline [lindex $botitems 0] .c delete $topline .c delete $botline if {[expr abs($linet-$ovalt)] < $yskip} { set level [getlevel $ovalt $edgelevel] set arrow first putsdebug "SAME LEVEL!" } elseif {$linet <= $ovalt} { set level [getlevel $ovalt $edgelevel] set arrow none } else { set level [getlevel $linet $edgelevel] set arrow last putsdebug "INTERESTING EDGE!" } .c addtag tempedge overlapping \ [lindex $box1 0] [expr [lindex $box1 3]-2.5*$yskip] \ [lindex $box1 2] [expr [lindex $box1 3]-1.0*$yskip] set ebox [.c bbox tempedge] set bot [lindex $ebox 3] .c move tempedge 0 [expr ($level-$bot)-1] set ebox [.c bbox tempedge] if {[expr abs($linet-$ovalt)]< $yskip} { set ebot [expr [lindex $ebox 3]-1] set etop [lindex $ebox 1] set top [expr $etop - ($yskip/2)] if {$linem < [lindex $box2 0]} { set cxskip $xskip } else { set cxskip [expr -$xskip] } set line2 [expr $linem + $cxskip] .c create line $linem $top $line2 $top -fill $secolor .c create line $line2 $top $line2 $ovalm -fill $secolor } elseif {[catch {set connectsp($sp)}] != 1} { set simpleparent $connectsp($sp) set etop [expr [lindex $ebox 3]-1] set top $etop set ebot [lindex $ebox 1] set line2 $linem set box3 [.c bbox ovalc$simpleparent] set ovalm2 [expr ([lindex $box3 1]+[lindex $box3 3])/2.0] set ovalr2 [lindex $box3 2] .c create line $linem $etop $linem $ovalm2 -fill $spcolor .c create line $linem $ovalm2 $ovalr2 $ovalm2 -fill $spcolor } elseif {$linet <= $ovalt} { set ebot [expr [lindex $ebox 3]-1] set etop [lindex $ebox 1] set line2 $linem } else { set ebot [expr [lindex $ebox 1]+0] set etop [lindex $ebox 3] set line2 $linem } .c dtag tempedge .c create line $linem $top $linem $etop -fill $secolor .c create line $linem $ebot $linem $ovalm -fill $secolor -arrow $arrow if {$linem < [lindex $box2 0]} { .c create line $line2 $ovalm $ovall $ovalm -fill $secolor } else { .c create line $line2 $ovalm $ovalr $ovalm -fill $secolor } #.c create rectangle [lindex $box1 0] [expr [lindex $box1 3]-2.0*$yskip] \ # [lindex $box1 2] [expr [lindex $box1 3]-1.0*$yskip] -outline blue #.c create rectangle [lindex $box2 0] [lindex $box2 1] \ # [lindex $box2 2] [lindex $box2 3] -outline green } } proc findchildren {list parent} { set children {} for {set n 0} {$n < [llength $list]} {incr n} { set itemn [lindex $list $n] set itemword [getword $itemn] set itemparent [getparent $itemn] if {$itemparent == $parent} { if {[regexp {^#([0-9]+)$} $itemword x newparent]} { set children [concat $children [findchildren $list $newparent]] } else { set children [concat $children $n] } } } set children [lsort -integer -decreasing $children] return $children } proc findsibling {list item parent} { set children [findchildren $list $parent] return [expr [lindex $children 0]+1] } proc getlevel {item edgelevel} { global yskipsmall # putsdebug "Edgelevels: $edgelevel" for {set n 0} {$n < [llength $edgelevel]} {incr n} { set itemn [lindex $edgelevel $n] set cmp [expr $item-$itemn] # puts "Diff: $cmp" if {$cmp > $yskipsmall} { # putsdebug "Item: $item" # putsdebug "Result: $itemn" return $itemn } } return -1 } proc printwordlist {x y list end} { global xskip global height global top for {set n 0} {$n<$end} {incr n} { set temp [printword $x $y [lindex $list $n] c$n] set x [expr [lindex $temp 1]+$xskip] set top($n) [lindex $temp 2] } } proc printparents {x y list n} { global yskip for {set p $n} {$p < [llength $list]} {incr p} { set y [expr $y-$yskip] set list [printparent $x $y $list $p $n] } } proc findparent {list end} { if {[regexp {^#([0-9]+)$} [lindex [lindex $list $p] 0] dontcare parent]} { for {set p $n} {$p < [llength $list]} {incr p} { } } else { return -1 } } proc printparent {x y list p end} { global yskip global top set children {} set childrenn {} set miny 200 set parentitem [lindex $list $p] if {[regexp {^#([0-9]+)$} [lindex $parentitem 0] dontcare parent]} { for {set n 0} {$n < $end} {incr n} { set item [lindex $list $n] if {[getparent $item] == $parent} { set children [concat $children linec$n] set childrenn [concat $childrenn $n] } } if {$childrenn == {}} { putsdebug "Parent $parent has no children before $end!" } set cbegin [lindex $childrenn 0] set cend [lindex $childrenn [expr [llength $childrenn] -1]] for {set n $cbegin} {$n <= $cend} {incr n} { set cy $top($n) if {$cy<$miny} { set miny $cy } } set temp [printitem $x [expr $miny-$yskip] $parentitem c$parent] set oval [lindex $temp 0] set ypos [lindex $temp 1] set midnum [getfreechild $childrenn] align linec$midnum c$parent set list [lreplace $list $midnum $midnum $parentitem] set boxi [.c bbox $oval] set y1 [lindex $boxi 1] set y2 [lindex $boxi 3] set midy [expr ($y2+$y1)/2.0] set x1 [lindex $boxi 0] set x2 [lindex $boxi 2] foreach c $childrenn { set t $c set box [.c bbox linec$c] if {$box != ""} { set x [expr ([lindex $box 2]+[lindex $box 0])/2.0] set ly2 [lindex [.c bbox c$c] 1] if {$x >= $x1 && $x <= $x2} { .c create line $x $ly2 $x $y2 -tags [concat c$t linec$t] } elseif {$x < $x1} { .c create line $x $ly2 $x $midy -tags [concat c$t linec$t] .c create line $x $midy $x1 $midy -tags c$parent } elseif {$x > $x2} { .c create line $x $ly2 $x $midy -tags [concat c$t linec$t] .c create line $x $midy $x2 $midy -tags c$parent } } } for {set n [lindex $childrenn 0]} {$n <= [lindex $childrenn [expr [llength $childrenn] -1]]} {incr n} { set top($n) $ypos } .c addtag c$midnum withtag c$parent } return $list } proc getfreechild {list} { set mid [expr (([llength $list]+1)/2)-1] for {set x 0} {$x <= [expr [llength $list]/2]} {incr x} { set x1 [lindex $list [expr $mid+$x]] set x2 [lindex $list [expr $mid-$x]] if {$x2 != {} && [without_sec_edge $x2]} { return $x2 } if {$x1 !={} && [without_sec_edge $x1]} { return $x1 } } putsdebug "Couldn't find free child for $list!" } proc printitem {x y item tags} { global yskip global yskipsmall set tag [gettag $item] set edge [getedge $item] set oval [printvertex $x $y $tag [list $tags]] set boxv [.c bbox $oval] set y [expr [lindex $boxv 1]-$yskip] if {$edge != "--"} { set boxe [printedge $x $y $edge $tags] set y [expr [lindex $boxe 1]-$yskip] set ly1 [lindex $boxe 3] set ly2 [lindex $boxv 1] .c create line $x $ly1 $x $ly2 -tags [concat $tags line$tags] set top [lindex $boxe 1] } else { set top [lindex $boxv 1] } align $tags $tags return [list $oval $top] } proc printword {x y item tags} { global yskip global yskipsmall global displaymorph global fontsize set word [getword $item] set tag [gettag $item] set morph [getmorph $item] set edge [getedge $item] set boxw [printwordtext $x $y $word $tags] set y [expr [lindex $boxw 1]-$yskipsmall] if {$displaymorph != 0} { set boxm [printmorphtext $x $y $morph $tags] set y [expr [lindex $boxm 1]-$yskipsmall] } set oval [printvertex $x $y $tag [list $tags]] set boxv [.c bbox $oval] set y [expr [lindex $boxv 1]-$yskip] if {$edge != "--"} { set boxe [printedge $x $y $edge $tags] set y [expr [lindex $boxe 1]-$yskip] set ly1 [lindex $boxe 3] set ly2 [lindex $boxv 1] .c create line $x $ly1 $x $ly2 -tags [concat $tags line$tags] set ymax [lindex $boxe 1] } else { set ymax [lindex $boxv 1] } return [list $oval [align $tags $tags] $ymax] } # aligns all items in a canvas which have the same tag vertically proc align {ref tag} { set items {} foreach i $ref { set items [concat $items [.c find withtag $i]] } if {$items != {}} { set item [lindex $items 0] set minx [lindex [.c bbox $item] 0] set maxx [lindex [.c bbox $item] 2] foreach i $items { set right [lindex [.c bbox $i] 2] set left [lindex [.c bbox $i] 0] set maxx [expr ($right>$maxx)?$right:$maxx] set minx [expr ($left<$minx)?$left:$minx] } set items [.c find withtag $tag] foreach i $items { set right [lindex [.c bbox $i] 2] set left [lindex [.c bbox $i] 0] set diffx [expr (($left-$minx)+($maxx-$right))/2.0-($left-$minx)] .c move $i $diffx 0 } return $maxx } } proc prevsent {skip} { global values current set index [lsearch $values $current] if {[llength $values]>1} { .b.next configure -state normal } incr index -$skip if {$index < 0} { set index 0 } if {$index == 0} { .b.prev configure -state disabled } set current [lindex $values $index] printsent 20 200 $current } proc nextsent {skip} { global values current set index [lsearch $values $current] set max [expr [llength $values] - 1] if {$max < 0} { set max 0 } if {[llength $values]>1} { .b.prev configure -state normal } incr index $skip if {$index > $max} { set index $max } if {$index == $max} { .b.next configure -state disabled } set current [lindex $values $index] printsent 20 200 $current } proc firstsent {} { global values current set current [lindex $values 0] .b.prev configure -state disabled if {[llength $values]>1} { .b.next configure -state normal } printsent 20 200 $current } proc lastsent {} { global values current set current [lindex $values [expr [llength $values] -1]] .b.next configure -state disabled if {[llength $values]>1} { .b.prev configure -state normal } printsent 20 200 $current } proc continuous {list} { if {[llength $list] <1} { return 1 } regexp {^.*([0-9])+$} [lindex $list 0] dontcare current for {set n 1} {$n < [llength $list]} {incr n} { regexp {^.*([0-9])+$} [lindex $list $n] dontcare next if {[expr $current+1]!=$next} { return 0 } else { incr current } } return 1 } if {$argc > 0} { set file [lindex $argv 0] if {![file readable $file]} { set file {} } } else { set file {} } if {$argc > 1} { set pattern [parse-pattern [lindex $argv 1]] if {$pattern == {}} { set pattern [list [list 0 end]] } } else { set pattern {} } if {$file == {}} { set values {} } else { set values [loadcgn $file $pattern] } set current [lindex $values 0] if {[llength $values] >1} { set state normal } else { set state disabled } windowsetup bindingsetup if {[llength $values] > 0} { printsent 20 200 $current }