tkread


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

#!/usr/bin/tclsh
# Usage: tkread [-w]
#        -w rewrap lines
#
# TODO:
# - justify text (not simple; see http://wiki.tcl.tk/1774)
# - add a basic search function
# - add function to type 30g to scroll 30% through an article
# - if window width is small, reduce padx space
# - make scrolling using mouse work even when text area isn't hovered over (also note this sort of scrolling doesn't update the title); integrate the MouseWheel event with scroll. this *should* also fix the issue of dragging and then leaving the window, as the strange scrolling is likely caused by related default behaviour

set fontsize 20
set colour #333333
set inverted 0
set drag 0

package require Tk

proc rewrap {text} {
	set wrapped [regsub -all {\n([^\n])} $text { \1}]
	set spaced [regsub -all {  *} $wrapped { }]
	set better [regsub -all {\n *} $spaced "\n"]
	set better [regsub -all {\n} $better "\n\n"]
	return [regsub -all {\n\n\n} $better "\n"]
}

proc changeFontSize {change} {
	global fontsize
	set newsize [expr $fontsize $change]
	if {$newsize > 0} {
		set fontsize $newsize
		.t configure -font "Times $fontsize" -padx [expr $fontsize * 3] -spacing2 [expr [font metrics "Times $fontsize" -linespace] / 4]
	}
}

proc invertColours {} {
	global inverted colour
	if {$inverted} {
		set inverted 0
		.t configure -bg white -fg $colour
		. configure -bg #f8f8f5
	} else {
		set inverted 1
		.t configure -bg $colour -fg #eeeeee
		. configure -bg #222222
	}
}

proc scroll {dir amount} {
	.t yview scroll $dir $amount
	set percent [expr [lindex [.t yview] 1] * 100]
	set rough [regsub {\..*} $percent {}]
	wm title . "tkread $rough%"
}

proc doMotion {ypos} {
	global lasty
	if { $lasty != -1 } {
		scroll [expr $lasty - $ypos] pixels
	}
	set lasty $ypos
}

. configure -bg #f8f8f5
text .t -font "Times $fontsize" -wrap word -width 64 -padx [expr $fontsize * 3] -bg white -fg $colour -spacing2 [expr [font metrics "Times $fontsize" -linespace] / 4] -relief flat -inactiveselectbackground {} -cursor {}
pack .t -expand yes -fill y
set text [read stdin]
if { $::argc > 0 && [lindex $::argv 0] == "-w" } {
	set text [rewrap $text]
}
.t insert end $text
.t configure -state disabled ;# disable cursor

bind . <Up> {scroll -1 unit}
bind . <k> {scroll -1 unit}
bind . <Down> {scroll 1 unit}
bind . <j> {scroll 1 unit}
bind . <Prior> {scroll -1 page}
bind . <Shift-space> {scroll -1 page}
bind . <Left> {scroll -1 page}
bind . <b> {scroll -1 page}
bind . <K> {scroll -1 page}
bind . <Next> {scroll 1 page}
bind . <space> {scroll 1 page}
bind . <Right> {scroll 1 page}
bind . <J> {scroll 1 page}
bind . <Home> {.t yview moveto 0}
bind . <End> {.t yview moveto 1}
bind . <equal> {changeFontSize +5}
bind . <minus> {changeFontSize -5}
bind . <plus> {changeFontSize +1}
bind . <underscore> {changeFontSize -1}
bind . <v> {invertColours}
bind . <q> {exit}
bind . <ButtonPress-1> {set drag 1; set lasty -1}
bind . <ButtonRelease-1> {set drag 0}
bind . <Motion> {if {$drag} { doMotion %y } }