steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix various UI bugs; use opengl-style colors

cvs
Slava Pestov 2005-10-28 19:37:28 +00:00
parent 8c27d62a03
commit d9fdb9d76d
12 changed files with 87 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.FACTOR.txt
View File

@ -1,7 +1,5 @@
0.79:
- sig11 on first startup
- fix initial font metrics being incorrect
- swap @{ and { syntax
- get stuff in examples dir running in the ui
- [ ... is annoying

2
contrib/httpd/html.factor
View File

@ -20,7 +20,7 @@ presentation sequences strings styles words ;
] "" make ;
: hex-color, ( triplet -- )
[ >hex 2 CHAR: 0 pad-left % ] each ;
[ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] each ;
: fg-css, ( color -- )
"color: #" % hex-color, "; " % ;

9
library/collections/sequences-epilogue.factor
View File

@ -17,6 +17,15 @@ sequences strings vectors words ;
IN: sequences
: first2 ( { x y } -- x y )
1 swap bounds-check nip first2-unsafe ; inline
: first3 ( { x y z } -- x y z )
2 swap bounds-check nip first3-unsafe ; inline
: first4 ( { x y z w } -- x y z w )
3 swap bounds-check nip first4-unsafe ; inline
M: object like drop ;
M: object empty? ( seq -- ? ) length 0 = ;

10
library/collections/sequences.factor
View File

@ -40,12 +40,6 @@ GENERIC: resize ( n seq -- seq )
: ?push ( elt seq/f -- seq )
[ 1 <vector> ] unless* [ push ] keep ;
: first2 ( { x y } -- x y )
dup first swap second ; inline
: first3 ( { x y z } -- x y z )
dup first over second rot third ; inline
: bounds-check? ( n seq -- ? )
over 0 >= [ length < ] [ 2drop f ] if ;
@ -73,3 +67,7 @@ M: object set-nth-unsafe set-nth ;
M: integer length ;
M: integer nth drop ;
M: integer nth-unsafe drop ;
: first2-unsafe [ 0 swap nth-unsafe ] keep 1 swap nth-unsafe ; inline
: first3-unsafe [ first2-unsafe ] keep 2 swap nth-unsafe ; inline
: first4-unsafe [ first3-unsafe ] keep 3 swap nth-unsafe ; inline

11
library/freetype/freetype-gl.factor
View File

@ -186,8 +186,9 @@ C: font ( handle -- font )
0 -rot [ char-width + ] each-with ;
: draw-string ( open-font string -- )
GL_MODELVIEW [
GL_TEXTURE_BIT [
[ char-sprite sprite-dlist glCallList ] each-with
] save-attribs
] do-matrix ;
GL_TEXTURE_2D glEnable
0 -rot [
char-sprite [ sprite-width + ] keep
sprite-dlist glCallList
] each-with neg 0 0 glTranslatef
GL_TEXTURE_2D glDisable ;

6
library/help/tutorial.factor
View File

@ -13,7 +13,7 @@ namespaces sdl sequences strings styles ;
: <underline> ( -- gadget )
<gadget>
<< gradient f @{ @{ 64 64 64 }@ @{ 255 255 255 }@ }@ >>
<< gradient f @{ @{ 0.25 0.25 0.25 1.0 }@ @{ 1.0 1.0 1.0 1.0 }@ }@ >>
over set-gadget-interior
@{ 0 10 0 }@ over set-gadget-dim
@{ 1 0 0 }@ over set-gadget-orientation ;
@ -28,13 +28,13 @@ M: string tutorial-line
}@ cond ;
: example-theme
<< solid f @{ 204 204 255 }@ >> swap set-gadget-interior ;
<< solid f @{ 0.8 0.8 1.0 1.0 }@ >> swap set-gadget-interior ;
M: general-list tutorial-line
car <input-button> dup example-theme ;
: page-theme
<< gradient f @{ @{ 204 204 255 }@ @{ 255 204 255 }@ }@ >>
<< gradient f @{ @{ 0.8 0.8 1.0 1.0 }@ @{ 1.0 0.8 1.0 1.0 }@ }@ >>
swap set-gadget-interior ;
: <page> ( list -- gadget )

39
library/opengl/opengl-utils.factor
View File

@ -3,9 +3,11 @@
IN: opengl
USING: alien errors kernel math namespaces opengl sdl sequences ;
: gl-color ( { r g b a } -- ) first4 glColor4d ; inline
: init-gl ( -- )
0.0 0.0 0.0 0.0 glClearColor
1.0 0.0 0.0 glColor3d
@{ 1.0 0.0 0.0 0.0 }@ gl-color
GL_COLOR_BUFFER_BIT glClear
GL_PROJECTION glMatrixMode
glLoadIdentity
@ -14,10 +16,10 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
0 0 width get height get glViewport
0 width get height get 0 gluOrtho2D
GL_SMOOTH glShadeModel
GL_TEXTURE_2D glEnable
GL_BLEND glEnable
GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
GL_SCISSOR_TEST glEnable ;
GL_SCISSOR_TEST glEnable
GL_MODELVIEW glMatrixMode ;
: gl-flags
SDL_OPENGL
@ -31,7 +33,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
init-surface ;
: with-gl-screen ( quot -- )
>r 0 gl-flags r> with-screen ;
>r 0 gl-flags r> with-screen ; inline
: gl-error ( -- )
glGetError dup 0 = [ drop ] [ gluErrorString throw ] if ;
@ -47,19 +49,15 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
: do-matrix ( mode quot -- )
swap glMatrixMode glPushMatrix call glPopMatrix ; inline
: gl-color ( { r g b } -- )
dup first 255 /f over second 255 /f rot third 255 /f
glColor3d ;
: gl-vertex first3 glVertex3d ; inline
: gl-vertex first3 glVertex3d ;
: top-left drop 0 0 glTexCoord2d @{ 0 0 0 }@ gl-vertex ; inline
: top-left drop 0 0 glTexCoord2d @{ 0 0 0 }@ gl-vertex ;
: top-right 1 0 glTexCoord2d @{ 1 0 0 }@ v* gl-vertex ; inline
: top-right 1 0 glTexCoord2d @{ 1 0 0 }@ v* gl-vertex ;
: bottom-left 0 1 glTexCoord2d @{ 0 1 0 }@ v* gl-vertex ; inline
: bottom-left 0 1 glTexCoord2d @{ 0 1 0 }@ v* gl-vertex ;
: bottom-right 1 1 glTexCoord2d gl-vertex ;
: bottom-right 1 1 glTexCoord2d gl-vertex ; inline
: four-sides ( dim -- )
dup top-left dup top-right dup bottom-right bottom-left ;
@ -151,16 +149,17 @@ C: sprite ( loc dim dim2 -- )
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameterf
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameterf ;
: gl-translate ( { x y z } -- ) first3 glTranslatef ;
: make-sprite-dlist ( sprite -- id )
GL_MODELVIEW [
GL_COMPILE [
GL_MODELVIEW [
dup sprite-loc first3 glTranslatef
GL_TEXTURE_2D over sprite-texture glBindTexture
init-texture
dup sprite-dim2 gl-fill-rect
] do-matrix
sprite-width 0 0 glTranslatef
dup sprite-loc gl-translate
GL_TEXTURE_2D over sprite-texture glBindTexture
init-texture
dup sprite-dim2 gl-fill-rect
dup sprite-dim @{ 1 0 0 }@ v*
swap sprite-loc v- gl-translate
] make-dlist
] do-matrix ;

18
library/styles.factor
View File

@ -2,15 +2,15 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: styles
! Colors are RGB triples.
: black @{ 0 0 0 }@ ;
: dark-gray @{ 64 64 64 }@ ;
: gray @{ 128 128 128 }@ ;
: light-gray @{ 192 192 192 }@ ;
: white @{ 255 255 255 }@ ;
: red @{ 255 0 0 }@ ;
: green @{ 0 255 0 }@ ;
: blue @{ 0 0 255 }@ ;
! Colors are RGBA quadruples
: black @{ 0.0 0.0 0.0 1.0 }@ ;
: dark-gray @{ 0.25 0.25 0.25 1.0 }@ ;
: gray @{ 0.5 0.5 0.5 1.0 }@ ;
: light-gray @{ 0.75 0.75 0.75 1.0 }@ ;
: white @{ 1.0 1.0 1.0 1.0 }@ ;
: red @{ 1.0 0.0 0.0 1.0 }@ ;
: green @{ 0.0 1.0 0.0 1.0 }@ ;
: blue @{ 0.0 0.0 1.0 1.0 }@ ;
SYMBOL: foreground ! Used for text and outline shapes.
SYMBOL: background ! Used for filled shapes.

18
library/ui/paint.factor
View File

@ -20,26 +20,22 @@ SYMBOL: clip
DEFER: draw-gadget
: (draw-gadget) ( gadget -- )
dup dup gadget-interior draw-interior
dup dup gadget-boundary draw-boundary
draw-gadget* ;
dup rect-loc translate [
gl-translate
dup dup gadget-interior draw-interior
dup dup gadget-boundary draw-boundary
draw-gadget*
] keep vneg gl-translate ;
: do-clip ( gadget -- )
>absolute clip [ rect-intersect dup ] change
dup rect-loc swap rect-dim gl-set-clip ;
: with-translation ( gadget quot -- | quot: gadget -- )
#! Note: origin variable is still changed after quot returns
GL_MODELVIEW [
>r dup rect-loc translate first3 glTranslated
r> call
] do-matrix ; inline
: draw-gadget ( gadget -- )
clip get over inside? [
[
dup do-clip
dup [ (draw-gadget) ] with-translation
dup (draw-gadget)
dup visible-children [ draw-gadget ] each
] with-scope
] when drop ;

49
library/ui/theme.factor
View File

@ -10,9 +10,9 @@ DEFER: set-label-font
IN: gadgets-theme
USING: arrays gadgets kernel sequences styles ;
: solid-black << solid f @{ 0 0 0 }@ >> ;
: solid-black << solid f @{ 0.0 0.0 0.0 1.0 }@ >> ;
: solid-white << solid f @{ 255 255 255 }@ >> ;
: solid-white << solid f @{ 1.0 1.0 1.0 1.0 }@ >> ;
: solid-interior solid-white swap set-gadget-interior ;
@ -20,30 +20,30 @@ USING: arrays gadgets kernel sequences styles ;
: plain-gradient
<< gradient f @{
@{ 240 240 240 }@
@{ 212 212 212 }@
@{ 212 212 212 }@
@{ 160 160 160 }@
@{ 0.94 0.94 0.94 1.0 }@
@{ 0.83 0.83 0.83 1.0 }@
@{ 0.83 0.83 0.83 1.0 }@
@{ 0.62 0.62 0.62 1.0 }@
}@ >> ;
: rollover-gradient
<< gradient f @{
@{ 255 255 255 }@
@{ 232 232 232 }@
@{ 232 232 232 }@
@{ 192 192 192 }@
@{ 1.0 1.0 1.0 1.0 }@
@{ 0.9 0.9 0.9 1.0 }@
@{ 0.9 0.9 0.9 1.0 }@
@{ 0.75 0.75 0.75 1.0 }@
}@ >> ;
: pressed-gradient
<< gradient f @{
@{ 192 192 192 }@
@{ 232 232 232 }@
@{ 232 232 232 }@
@{ 255 255 255 }@
@{ 0.75 0.75 0.75 1.0 }@
@{ 0.9 0.9 0.9 1.0 }@
@{ 0.9 0.9 0.9 1.0 }@
@{ 1.0 1.0 1.0 1.0 }@
}@ >> ;
: faint-boundary
<< solid f @{ 160 160 160 }@ >> swap set-gadget-boundary ;
<< solid f @{ 0.62 0.62 0.62 1.0 }@ >> swap set-gadget-boundary ;
: bevel-button-theme ( gadget -- )
plain-gradient rollover-gradient pressed-gradient
@ -55,33 +55,32 @@ USING: arrays gadgets kernel sequences styles ;
: roll-button-theme ( button -- )
f solid-black solid-black <button-paint> over set-gadget-boundary
f f << solid f @{ 236 230 232 }@ >> <button-paint> swap set-gadget-interior ;
f f << solid f @{ 0.92 0.9 0.9 1.0 }@ >> <button-paint> swap set-gadget-interior ;
: caret-theme ( caret -- )
<< solid f @{ 255 0 0 }@ >> swap set-gadget-interior ;
<< solid f @{ 1.0 0.0 0.0 1.0 }@ >> swap set-gadget-interior ;
: elevator-theme ( elevator -- )
<< gradient f @{
@{ 96 96 96 }@
@{ 112 112 112 }@
@{ 128 128 128 }@
@{ 0.37 0.37 0.37 1.0 }@
@{ 0.43 0.43 0.43 1.0 }@
@{ 0.5 0.5 0.5 1.0 }@
}@ >> swap set-gadget-interior ;
: reverse-video-theme ( gadget -- )
solid-black swap set-gadget-interior ;
: display-title-theme
<< solid f @{ 216 232 255 }@ >> swap set-gadget-interior ;
<< solid f @{ 0.84 0.9 1.0 1.0 }@ >> swap set-gadget-interior ;
: menu-theme ( menu -- )
dup solid-boundary
<< gradient f @{ @{ 216 216 216 }@ @{ 255 255 255 }@ }@ >>
swap set-gadget-interior ;
<< solid f @{ 0.9 0.9 0.9 0.9 }@ >> swap set-gadget-interior ;
: label-theme ( label -- )
@{ 0 0 0 }@ over set-label-color
@{ 0.0 0.0 0.0 1.0 }@ over set-label-color
@{ "Monospaced" plain 12 }@ swap set-label-font ;
: editor-theme ( editor -- )
@{ 0 0 0 }@ over set-label-color
@{ 0.0 0.0 0.0 1.0 }@ over set-label-color
@{ "Monospaced" bold 12 }@ swap set-label-font ;

10
library/ui/ui.factor
View File

@ -17,16 +17,13 @@ global [ first-time on ] bind
world get solid-interior
@{ 800 600 0 }@ world get set-gadget-dim
<hand> hand set
listener-application
first-time off
] when
] bind ;
: check-running
world get [
world-running?
[ "The UI is already running" throw ] when
] when* ;
world get world-running?
[ "The UI is already running" throw ] when ;
IN: shells
@ -35,5 +32,6 @@ IN: shells
#! dimensions.
[
init-world check-running
world get rect-dim first2 0 gl-flags [ run-world ] with-screen
world get rect-dim first2
[ listener-application run-world ] with-gl-screen
] with-freetype ;

2
library/ui/world.factor
View File

@ -99,7 +99,7 @@ M: motion-event handle-event ( event -- )
: world-step ( -- )
world get world-invalid >r layout-world r>
[ update-hand draw-world ] when ;
[ update-hand USE: test [ draw-world ] time ] when ;
: next-event ( -- event ? ) <event> dup SDL_PollEvent ;