/[webpac]/trunk/openisis/tcl/lp
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/openisis/tcl/lp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (hide annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years, 1 month ago) by dpavlin
Original Path: openisis/current/tcl/lp
File size: 5308 byte(s)
initial import of openisis 0.9.0 vendor drop

1 dpavlin 237 #!/opt/openisis/tcl/tkbuild/wish
2     #
3     # openisis - an open implementation of the ISIS database
4     # Version 0.8.x (microversion see file Version)
5     # Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org
6     #
7     # This library is free software; you can redistribute it and/or
8     # modify it under the terms of the GNU Lesser General Public
9     # License as published by the Free Software Foundation; either
10     # version 2.1 of the License, or (at your option) any later version.
11     #
12     # This library is distributed in the hope that it will be useful,
13     # but WITHOUT ANY WARRANTY; without even the implied warranty of
14     # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15     # Lesser General Public License for more details.
16     #
17     # You should have received a copy of the GNU Lesser General Public
18     # License along with this library; if not, write to the Free Software
19     # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20     #
21     # This software is dedicated to the memory of Eckart Dietrich.
22     #
23     # This software is inspired by (but contains no code of) the iAPI
24     # Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl.
25     # See iAPI.txt for what it contains.
26     #
27     # $Id: lp,v 1.6 2003/02/17 11:27:23 kripke Exp $
28     #
29     # lowerpoint :)
30     #
31     # usage: lp [db [encoding [ptSz]]]
32     # default encoding is cp850 ("DOS Latin1"), you may want iso8859-1 or utf8
33     # default font point size is 240, try 180
34     #
35     # consult documentation of your window manager
36     # on how to tell it to put no frames on this window
37     #
38    
39     openIsisInit
40     set dbname [expr {$argc ? [lindex $argv 0] : {db/cds/cds}}]
41     set enc [expr {1 < $argc ? [lindex $argv 1] : {cp850}}]
42     set pt [expr {2 < $argc ? [lindex $argv 2] : {240}}]
43     set db [openIsisOpen $dbname]
44     set max [$db maxrowid]
45     set cur 0
46     # puts "$db $dbname $max"
47    
48     # configure look
49     set sw [winfo screenwidth .]
50     set sh [winfo screenheight .]
51     set tw [expr $sw - 400]
52     set lh [expr $pt / 6] ;# line height
53     set fn "-*-new century schoolbook-medium-r-*-*-*-$pt-75-75-*-*-iso10646-1"
54     set dot img/isi.gif
55     set logo img/logo.gif
56     set cursor {@img/isi.cursor black}
57    
58    
59     proc show n {
60     global db cur max lh tw fn enc
61     switch -- $n \
62     + { if {$max == $cur} return; incr cur
63     } - { if {1 == $cur} return; incr cur -1
64     } default { if {$cur == $n} return; set cur $n
65     }
66     .c delete t
67     set y 100
68     set rec [$db read $cur]
69     if {"utf-8" != $enc} {set rec [encoding convertfrom $enc $rec]}
70     set f [lindex $rec 0]
71     regexp {([^\t]*)(\t(.*))?} [lindex $f 1] - text - next
72     set it [.c create text 150 $y \
73     -anchor nw -font $fn -width $tw -tags t -text $text]
74     if {"" != $next} {
75     set ny [expr [lindex [.c bbox $it] 3] + $lh/4]
76     set it [.c create text 210 $ny \
77     -anchor nw -font $fn -width $tw -tags t -fill darkgreen -text $next]
78     }
79     set ny [lindex [.c bbox t] 3]
80     .c lower [.c create rectangle 120 [expr $y-2] [expr 150+$tw] $ny \
81     -tags t -outline lightgrey -fill lightgrey]
82     set y [expr $ny + 2*$lh]
83     foreach f [lrange $rec 1 end] {
84     regexp {([^\t]*)(\t(.*))?} [lindex $f 1] - text - next
85     if [string match *.gif $text] {
86     regexp {(.*/)?(.*)} $text - - text
87     if ![catch {image create photo $text -file img/$text}] {
88     set it [.c create image 150 $y -anchor nw -tags t -image $text]
89     set y [expr [lindex [.c bbox $it] 3] + $lh]
90     continue
91     }
92     }
93     .c create image 120 $y -anchor nw -tags t -image dot
94     set it [.c create text 150 $y \
95     -anchor nw -font $fn -width $tw -tags t -text $text]
96     if {"" != $next} {
97     set y [expr [lindex [.c bbox $it] 3] + $lh/4]
98     set it [.c create text 210 $y \
99     -anchor nw -font $fn -width $tw -tags t -fill darkgreen -text $next]
100     }
101     set y [expr [lindex [.c bbox $it] 3] + $lh]
102     }
103     .c itemconfigure counter -text "http://openisis.org/ $cur / $max"
104     };# show
105    
106    
107     proc print {} {
108     # A4dj 595 842 24 50 571 818
109     # interior on Deskjet landscape is 768*547
110     # to keep 4x3 ratio use 728x546
111     .c postscript -rotate 1 -pagewidth 728 -file /tmp/lp.ps
112     };# print
113    
114     proc printall {} {
115     global cur max
116     set f [open /tmp/lp.ps w]
117     set o $cur
118     for {set i 1} {$i <= $max} {incr i} {
119     show $i
120     .c postscript -rotate 1 -pagewidth 728 -channel $f
121     }
122     close $f
123     show $o
124     };# printall
125    
126    
127     # create widgets
128    
129     canvas .c -width $sw -height $sh -bg white
130     catch {.c configure -cursor $cursor}
131     bind .c <Escape> exit
132     bind .c q exit
133     bind .c - {show -}
134     bind .c b {show -}
135     bind .c p print
136     bind .c P printall
137     bind .c <Up> {show -}
138     bind .c <Button-3> {show -}
139     bind .c <Home> {show 1}
140     bind .c <End> "show $max"
141     bind .c <KeyPress> {show +}
142     bind .c <Button-1> {show +}
143    
144     if [catch {image create photo logo -file $logo} err] {
145     puts stderr "error loading logo '$logo':\n\t$err"
146     } else {
147     .c create image [expr $sw - 150] 150 -tags logo -image logo
148     }
149     if [catch {image create photo dot -file $dot} err] {
150     # builtin
151     image create bitmap dot -data {
152     #define isi_width 16
153     #define isi_height 16
154     #define isi_x_hot 1
155     #define isi_y_hot 5
156     static unsigned char isi_bits[] = {
157     0x00, 0x00, 0x00, 0x18, 0x80, 0x25, 0xc0, 0x27, 0xe0, 0x47, 0xfe, 0x27,
158     0xe4, 0x27, 0xc4, 0x23, 0x08, 0x10, 0x10, 0x08, 0xe0, 0x07, 0xc0, 0x03,
159     0xc0, 0x03, 0xc0, 0x03, 0xe0, 0x07, 0x00, 0x00};
160     }
161     }
162     .c create text [expr $sw - 100] [expr $sh - 50] -tags counter -text 0
163    
164     show 1
165    
166     pack .c -expand 1 -fill both
167     focus .c
168     wm geometry . ${sw}x${sh}+0+0
169     # if [wm frame .] ...
170     # puts stderr "for real fullscreen experience tell your wm to not decorate me"

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26