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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
namespace eval Colors { source "pi/Colors.tcl" }
proc ::getColor {color} {
if {[info exists Colors::$color]} { return [set Colors::$color] } \
else { return $Colors::white }
}
Start process "display" {
puts "Display pid: [pid]"
source pi/Gpu.tcl
Gpu::init
Gpu::ImageManager::imageManagerInit
# TODO: Share these functions through the database somehow,
# instead of keeping them in globals.
set ::rotate [Gpu::fn {vec2 v float a} vec2 {
float s = sin(a);
float c = cos(a);
mat2 m = mat2(c, s, -s, c);
return m * v;
}]
set ::cross2d [Gpu::fn {vec2 a vec2 b} float {
return a.x*b.y - a.y*b.x;
}]
# See https://www.shadertoy.com/view/lsBSDm
set ::invBilinear [Gpu::fn {vec2 p vec2 a vec2 b vec2 c vec2 d fn ::cross2d} vec2 {
vec2 res = vec2(-1.0);
vec2 e = b-a;
vec2 f = d-a;
vec2 g = a-b+c-d;
vec2 h = p-a;
float k2 = cross2d( g, f );
float k1 = cross2d( e, f ) + cross2d( h, g );
float k0 = cross2d( h, e );
// if edges are parallel, this is a linear equation
k2 /= k0; k1 /= k0; k0 = 1.0;
if( abs(k2)<0.001*abs(k0) )
{
res = vec2( (h.x*k1+f.x*k0)/(e.x*k1-g.x*k0), -k0/k1 );
}
// otherwise, it's a quadratic
else
{
float w = k1*k1 - 4.0*k0*k2;
if( w<0.0 ) return vec2(-1.0);
w = sqrt( w );
float ik2 = 0.5/k2;
float v = (-k1 - w)*ik2;
float u = (h.x - f.x*v)/(e.x + g.x*v);
if( u<0.0 || u>1.0 || v<0.0 || v>1.0 )
{
v = (-k1 + w)*ik2;
u = (h.x - f.x*v)/(e.x + g.x*v);
}
res = vec2( u, v );
}
return res;
}]
namespace eval Colors { source "pi/Colors.tcl" }
proc ::getColor {color} {
if {[info exists Colors::$color]} { return [set Colors::$color] } \
else { return $Colors::white }
}
Wish $::thisProcess receives statements like \
[list /someone/ wishes the GPU /...anything/]
Wish $::thisProcess shares statements like \
[list /someone/ claims the display time is /displayTime/]
Wish $::thisProcess shares statements like \
[list /someone/ has error /err/ with info /errorInfo/]
set ::pipelines [dict create]
When /wisher/ wishes the GPU compiles pipeline /name/ /source/ {
try {
dict set ::pipelines $name [Gpu::pipeline {*}$source]
} on error e {
puts stderr $::errorInfo
Say $wisher has error $e with info $::errorInfo
}
}
while true {
set ::displayList [dict create] ;# Keys are layer numbers; values are lists of commands
Step
foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with /...options/}] {
try {
set name [dict get $match name]
set pipeline [dict get $::pipelines [dict get $match name]]
set options [dict get $match options]
set layer [dict_getdef $options layer 0]
if {[dict exists $options instances]} {
set instances [dict get $options instances]
} else {
set instances [list [dict get $options arguments]]
}
foreach instance $instances {
dict lappend ::displayList $layer [list Gpu::draw $pipeline {*}$instance]
}
} on error e {
Say [dict get $match wisher] has error $e with info $::errorInfo
}
}
set renderTime [baretime {
Gpu::drawStart
foreach layer [lsort -real [dict keys $::displayList]] {
set layerDisplayList [dict get $::displayList $layer]
foreach displayCommand $layerDisplayList {
try { {*}$displayCommand } \
on error e { puts stderr $::errorInfo }
}
}
Gpu::drawEnd
}]
Commit { Claim the display time is "render $renderTime us ($::stepTime)" }
}
}
set ::displayTime none
When the display time is /displayTime/ {
set ::Display::displayTime $displayTime
set ::displayTime $displayTime
}
namespace eval ::Display {
variable displayTime none
variable WIDTH
variable HEIGHT
variable LAYER 0
if {$::isLaptop} {
set WIDTH 640; set HEIGHT 480
} else {
regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT
}
# TODO: Remove these / expel them to a shim page; these are only
# for backward compatibility now.
proc warnDeprecated {} {
upvar 2 this this
set func [lindex [info level -1] 0]
set w "$func was deprecated in Oct 2023; use GPU wishes/shaders"
Claim $this has warning $w with info $w
}
proc stroke {points width color} {
warnDeprecated
Wish to draw a stroke with points $points width $width color $color
}
proc circle {x y radius thickness color {filled false}} {
warnDeprecated
Wish to draw a circle with x $x y $y radius $radius thickness $thickness color $color filled $filled
}
proc text {x0 y0 scale text radians {font "PTSans-Regular"}} {
warnDeprecated
Wish to draw text with x $x0 y $y0 scale $scale text $text radians $radians font $font
}
proc fillTriangle {p0 p1 p2 color} {
warnDeprecated
Wish to draw a triangle with p0 $p0 p1 $p1 p2 $p2 color $color
}
proc fillQuad {p0 p1 p2 p3 color} {
warnDeprecated
Wish to draw a quad with p0 $p0 p1 $p1 p2 $p2 p3 $p3 color $color
}
proc fillPolygon {points color} {
warnDeprecated
Wish to draw a polygon with points $points color $color
}
proc image {x y im radians {scale 1.0}} {
warnDeprecated
Wish to draw an image with x $x y $y image $im radians $radians scale $scale
}
Claim the display Display has width $::Display::WIDTH height $::Display::HEIGHT
}
|
