/[webpac]/openisis/current/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

Contents of /openisis/current/tcl/lp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years ago) by dpavlin
File size: 5308 byte(s)
initial import of openisis 0.9.0 vendor drop

1 #!/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