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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ * IBM Corporation - initial implementation
\ ****************************************************************************/
\ included by pci-class_03.fs
( str len display_num ) \ name prefix
false value is-installed?
value display_num ( str len )
s" ,Display-" $cat 41 display_num + char-cat \ add ", Display-A" or "-B" to name ( str len )
encode-string s" name" property \ store as name property
s" display" device-type
\ screen-info is set by pci-class_03.fs contains output of get_vbe_info bios-snk call
CASE screen-info c@ \ ( display-type )
0 OF s" NONE" ENDOF \ No display
1 OF s" Analog" ENDOF
2 OF s" Digital" ENDOF
ENDCASE
encode-string s" display-type" property
screen-info 8 + l@ value mem-adr
screen-info 1 + w@ value width
screen-info 3 + w@ value height
screen-info c@ IF
\ if screen-info is not 0, we have some screen attached, add needed properties...
width encode-int s" width" property
height encode-int s" height" property
screen-info 5 + w@ encode-int s" linebytes" property
screen-info 7 + c@ encode-int s" depth" property
mem-adr encode-int s" address" property
\ the EDID property breaks the boot... so i leave it out for now,
\ maybe encode-bytes does s.th. wrong???
\ screen-info c + 80 encode-bytes s" EDID" property
s" ISO8859-1" encode-string s" character-set" property \ i hope this is ok...
THEN
\ words for installation/removal, needed by is-install/is-remove, see display.fs
: display-remove ( -- )
;
: display-install ( -- )
is-installed? NOT IF
mem-adr to frame-buffer-adr
default-font
set-font
width height width char-width / height char-height / ( width height #lines #cols )
fb8-install
true to is-installed?
THEN
;
\ as of OF 8bit Graphics Recommendation, these shall be implemented:
: draw-rectangle ( adr x y w h -- )
is-installed? IF
0 ?DO
4dup ( adr x y w adr x y w )
drop ( adr x y w adr x y )
i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x)
( adr x y w adr offs )
frame-buffer-adr + \ add to frame-buffer-adr ( adr x y w adr fb_adr )
1 pick 3 pick i * + swap 3 pick ( adr x y w adr adr_offs fb_adr w )
rmove \ copy line ( adr x y w adr )
drop ( adr x y w )
LOOP
4drop
ELSE
4drop drop
THEN
;
: fill-rectangle ( number x y w h -- )
is-installed? IF
0 ?DO
4dup ( number x y w number x y w )
drop ( number x y w number x y )
i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x)
( number x y w number offs )
frame-buffer-adr + \ add to frame-buffer-adr ( number x y w number adr )
2 pick 2 pick ( number x y w number adr w number )
rfill \ draw line ( number x y w number )
drop ( number x y w )
LOOP
4drop
ELSE
4drop drop
THEN
;
: read-rectangle ( adr x y w h -- )
is-installed? IF
0 ?DO
4dup ( adr x y w adr x y w )
drop ( adr x y w adr x y )
i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x)
( adr x y w adr offs )
frame-buffer-adr + \ add to frame-buffer-adr ( adr x y w adr fb_adr )
1 pick 3 pick i * + 3 pick ( adr x y w adr fb_adr adr_offs w )
rmove \ copy line ( adr x y w adr )
drop ( adr x y w )
LOOP
4drop
ELSE
4drop drop
THEN
;
: color! ( r g b number -- )
\ 3c8 is RAMDAC write mode select palette entry register
\ 3c9 is RAMDAC write mode write palette entry register ( 3 consecutive writes set new entry )
vga-device-node? 3c8 translate-address ( r g b number address )
swap 1 pick ( r g b address number address )
rb! \ write palette entry number ( r g b address )
1 + \ select next register (3c9)
dup 4 pick swap rb! \ write red ( r g b address )
dup 3 pick swap rb! \ write green ( r g b address )
dup 2 pick swap rb! \ write blue ( r g b address )
4drop
;
: color@ ( number -- r g b )
\ 3c7 is RAMDAC read mode select palette entry register
\ 3c9 is RAMDAC read mode read palette entry register ( 3 consecutive reads read entry )
vga-device-node? 3c7 translate-address ( number address )
swap 1 pick ( address number address )
rb! \ write palette entry number ( address )
2 + >r \ select next register (3c9) ( R: address )
r@ rb@ \ read red ( r R: address )
r@ rb@ \ read green ( r g R: address )
r@ rb@ \ write blue ( r g b R: address )
r> drop ( r g b )
;
: set-colors ( adr number #numbers -- )
\ 3c8 is RAMDAC write mode select palette entry register
\ 3c9 is RAMDAC write mode write palette entry register ( 3 consecutive writes set new entry )
\ since after writing 3 entries, the palette entry is automagically incremented,
\ we can just continue writing...
vga-device-node? 3c8 translate-address ( adr number #numbers )
dup 3 pick swap ( adr number #numbers address number address )
rb! \ write palette entry number ( adr number #numbers address )
1 + \ select next register (3c9)
-rot swap drop ( adr address #numbers )
-rot swap rot ( address adr #numbers )
0 ?DO
( address adr )
dup rb@ \ read red value from adr ( address adr r )
2 pick rb! \ write to register ( address adr )
1 + \ next adr
dup rb@ \ read green value from adr ( address adr g )
2 pick rb! \ write to register ( address adr )
1 + \ next adr
dup rb@ \ read blue value from adr ( address adr r )
2 pick rb! \ write to register ( address adr )
1 + \ next adr
LOOP
2drop
;
: get-colors ( adr number #numbers -- )
\ 3c7 is RAMDAC read mode select palette entry register
\ 3c9 is RAMDAC read mode read palette entry register ( 3 consecutive reads get entry )
\ since after reading 3 entries, the palette entry is automagically incremented,
\ we can just continue reading...
vga-device-node? 3c7 translate-address ( adr number #numbers )
dup 3 pick swap ( adr number #numbers address number address )
rb! \ write palette entry number ( adr number #numbers address )
2 + \ select next register (3c9)
-rot swap drop ( adr address #numbers )
-rot swap rot ( address adr #numbers )
0 ?DO
( address adr )
1 pick rb@ \ read red value from register ( address adr r )
1 pick rb! \ write to adr ( address adr )
1 + \ next adr
1 pick rb@ \ read green value from register ( address adr g )
1 pick rb! \ write to adr ( address adr )
1 + \ next adr
1 pick rb@ \ read blue value from register ( address adr b )
1 pick rb! \ write to adr ( address adr )
1 + \ next adr
LOOP
2drop
;
: dimensions ( -- width height )
width height
;
\ clear screen
mem-adr width height * 0 rfill
\ call is-install and is-remove
' display-install is-install
' display-remove is-remove
s" screen" find-alias 0= IF
\ no previous screen alias defined, define it...
s" screen" get-node node>path set-alias
ELSE
drop
THEN
|
