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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-07-29 07:30:06 -05:00
parent eaebe352cc ba61e15689
commit 44f9bc3369
19 changed files with 109 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/boids/ui/ui.factor
View File

@ -41,7 +41,7 @@ IN: boids.ui
: draw-boids ( -- ) boids> [ draw-boid ] each ;
: boid-color ( -- color ) { 1.0 0 0 0.3 } ;
: boid-color ( -- color ) T{ rgba f 1.0 0 0 0.3 } ;
: display ( -- )
boid-color >fill-color

5
extra/bubble-chamber/particle/hadron/hadron.factor
View File

@ -1,9 +1,8 @@
USING: kernel random math math.constants math.points accessors multi-methods
processing processing.shapes
processing.color
bubble-chamber.common
bubble-chamber.particle ;
bubble-chamber.particle colors ;
IN: bubble-chamber.particle.hadron
@ -26,7 +25,7 @@ METHOD: collide { hadron }
[ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
0 1 0 <rgb> >>myc
0 1 0 1 rgba boa >>myc
drop ;

2
extra/bubble-chamber/particle/muon/colors/colors.factor
View File

@ -1,7 +1,7 @@
USING: kernel sequences math math.constants math.order accessors
processing
processing.color ;
colors ;
IN: bubble-chamber.particle.muon.colors

8
extra/bubble-chamber/particle/particle.factor
View File

@ -1,8 +1,8 @@
USING: kernel sequences combinators
math math.vectors math.functions multi-methods
accessors combinators.cleave processing processing.color
bubble-chamber.common ;
accessors combinators.cleave processing
bubble-chamber.common colors ;
IN: bubble-chamber.particle
@ -28,8 +28,8 @@ TUPLE: particle pos vel speed speed-d theta theta-d theta-dd myc mya ;
0 >>theta-d
0 >>theta-dd
0 0 0 1 <rgba> >>myc
0 0 0 1 <rgba> >>mya ;
0 0 0 1 rgba boa >>myc
0 0 0 1 rgba boa >>mya ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

53
extra/colors/colors.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2003, 2007 Slava Pestov.
! Copyright (C) 2003, 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel combinators sequences arrays
classes.tuple multi-methods accessors colors.hsv ;
USING: kernel combinators sequences arrays classes.tuple accessors colors.hsv ;
IN: colors
@ -14,40 +13,38 @@ TUPLE: rgba < color red green blue alpha ;
TUPLE: hsva < color hue saturation value alpha ;
TUPLE: grey < color grey alpha ;
TUPLE: gray < color gray alpha ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GENERIC: >rgba ( object -- rgba )
METHOD: >rgba { rgba } ;
M: rgba >rgba ( rgba -- rgba ) ;
METHOD: >rgba { hsva }
M: hsva >rgba ( hsva -- rgba )
{ [ hue>> ] [ saturation>> ] [ value>> ] [ alpha>> ] } cleave 4array
[ hsv>rgb ] [ peek ] bi suffix first4 rgba boa ;
METHOD: >rgba { grey } [ grey>> dup dup ] [ alpha>> ] bi rgba boa ;
M: gray >rgba ( gray -- rgba ) [ gray>> dup dup ] [ alpha>> ] bi rgba boa ;
M: array >rgba ( array -- rgba ) first4 rgba boa ;
M: color red>> ( color -- red ) >rgba red>> ;
M: color green>> ( color -- green ) >rgba green>> ;
M: color blue>> ( color -- blue ) >rgba blue>> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USE: syntax
M: color red>> >rgba red>> ;
M: color green>> >rgba green>> ;
M: color blue>> >rgba blue>> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: black { 0.0 0.0 0.0 1.0 } ;
: blue { 0.0 0.0 1.0 1.0 } ;
: cyan { 0 0.941 0.941 1 } ;
: gray { 0.6 0.6 0.6 1.0 } ;
: green { 0.0 1.0 0.0 1.0 } ;
: light-gray { 0.95 0.95 0.95 0.95 } ;
: light-purple { 0.8 0.8 1.0 1.0 } ;
: magenta { 0.941 0 0.941 1 } ;
: orange { 0.941 0.627 0 1 } ;
: purple { 0.627 0 0.941 1 } ;
: red { 1.0 0.0 0.0 1.0 } ;
: white { 1.0 1.0 1.0 1.0 } ;
: yellow { 1.0 1.0 0.0 1.0 } ;
: black T{ rgba f 0.0 0.0 0.0 1.0 } ;
: blue T{ rgba f 0.0 0.0 1.0 1.0 } ;
: cyan T{ rgba f 0 0.941 0.941 1 } ;
: gray T{ rgba f 0.6 0.6 0.6 1.0 } ;
: green T{ rgba f 0.0 1.0 0.0 1.0 } ;
: light-gray T{ rgba f 0.95 0.95 0.95 0.95 } ;
: light-purple T{ rgba f 0.8 0.8 1.0 1.0 } ;
: magenta T{ rgba f 0.941 0 0.941 1 } ;
: orange T{ rgba f 0.941 0.627 0 1 } ;
: purple T{ rgba f 0.627 0 0.941 1 } ;
: red T{ rgba f 1.0 0.0 0.0 1.0 } ;
: white T{ rgba f 1.0 1.0 1.0 1.0 } ;
: yellow T{ rgba f 1.0 1.0 0.0 1.0 } ;

2
extra/golden-section/golden-section.factor
View File

@ -27,7 +27,7 @@ IN: golden-section
: radius ( i -- radius ) pi * 720 / sin 10 * ;
: color ( i -- i ) dup 360.0 / dup 0.25 1 4array >fill-color ;
: color ( i -- i ) dup 360.0 / dup 0.25 1 rgba boa >fill-color ;
: line-width ( i -- i ) dup radius 0.5 * 1 max glLineWidth ;

16
extra/opengl/opengl.factor
View File

@ -16,7 +16,7 @@ IN: opengl
: fix-coordinates ( point1 point2 -- x1 y2 x2 y2 )
[ first2 [ >fixnum ] bi@ ] bi@ ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-color ( color -- ) first4 glColor4d ; inline
@ -26,15 +26,13 @@ IN: opengl
: gl-clear ( color -- )
gl-clear-color GL_COLOR_BUFFER_BIT glClear ;
: color>raw ( object -- 4array )
>rgba
{ [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave
4array ;
: set-color ( object -- ) color>raw first4 glColor4d ;
: set-clear-color ( object -- ) color>raw first4 glClearColor ;
: color>raw ( object -- r g b a )
>rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ;
: set-color ( object -- ) color>raw glColor4d ;
: set-clear-color ( object -- ) color>raw glClearColor ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-error ( -- )
glGetError dup zero? [
@ -126,7 +124,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
GL_QUAD_STRIP [
swap >r prepare-gradient r>
[ length dup 1- v/n ] keep [
>r >r 2dup r> r> gl-color v*n
>r >r 2dup r> r> set-color v*n
dup gl-vertex v+ gl-vertex
] 2each 2drop
] do-state ;

25
extra/processing/processing.factor
View File

@ -9,9 +9,9 @@ USING: kernel namespaces threads combinators sequences arrays
combinators.lib
combinators.cleave
rewrite-closures fry accessors newfx
processing.color
processing.gadget math.geometry.rect
processing.shapes ;
processing.shapes
colors ;
IN: processing
@ -39,27 +39,32 @@ IN: processing
GENERIC: canonical-color-value ( obj -- color )
METHOD: canonical-color-value { number } dup dup 1 4array ;
METHOD: canonical-color-value { number } dup dup 1 rgba boa ;
METHOD: canonical-color-value { array }
dup length
{
{ 2 [ first2 >r dup dup r> 4array ] }
{ 3 [ 1 suffix ] }
{ 4 [ ] }
{ 2 [ first2 >r dup dup r> rgba boa ] }
{ 3 [ first3 1 rgba boa ] }
{ 4 [ first4 rgba boa ] }
}
case ;
METHOD: canonical-color-value { rgba }
{ [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ;
! METHOD: canonical-color-value { rgba }
! { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ;
METHOD: canonical-color-value { color } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fill ( value -- ) canonical-color-value >fill-color ;
: stroke ( value -- ) canonical-color-value >stroke-color ;
: no-fill ( -- ) 0 fill-color> set-fourth ;
: no-stroke ( -- ) 0 stroke-color> set-fourth ;
! : no-fill ( -- ) 0 fill-color> set-fourth ;
! : no-stroke ( -- ) 0 stroke-color> set-fourth ;
: no-fill ( -- ) fill-color> 0 >>alpha drop ;
: no-stroke ( -- ) stroke-color> 0 >>alpha drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

14
extra/processing/shapes/shapes.factor
View File

@ -3,7 +3,7 @@ USING: kernel namespaces arrays sequences grouping
alien.c-types
math math.vectors math.geometry.rect
opengl.gl opengl.glu opengl generalizations vars
combinators.cleave ;
combinators.cleave colors ;
IN: processing.shapes
@ -12,20 +12,20 @@ IN: processing.shapes
VAR: fill-color
VAR: stroke-color
{ 0 0 0 1 } stroke-color set-global
{ 1 1 1 1 } fill-color set-global
T{ rgba f 0 0 0 1 } stroke-color set-global
T{ rgba f 1 1 1 1 } fill-color set-global
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fill-mode ( -- )
GL_FRONT_AND_BACK GL_FILL glPolygonMode
fill-color> gl-color ;
fill-color> set-color ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: stroke-mode ( -- )
GL_FRONT_AND_BACK GL_LINE glPolygonMode
stroke-color> gl-color ;
stroke-color> set-color ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -101,8 +101,8 @@ VAR: stroke-color
: ellipse ( center dim -- )
GL_FRONT_AND_BACK GL_FILL glPolygonMode
[ stroke-color> gl-color gl-ellipse ]
[ fill-color> gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
[ stroke-color> set-color gl-ellipse ]
[ fill-color> set-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

13
extra/slides/slides.factor
View File

@ -23,14 +23,14 @@ IN: slides
H{
{ font "monospace" }
{ font-size 36 }
{ page-color { 0.4 0.4 0.4 0.3 } }
{ page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
}
}
{ snippet-style
H{
{ font "monospace" }
{ font-size 36 }
{ foreground { 0.1 0.1 0.4 1 } }
{ foreground T{ rgba f 0.1 0.1 0.4 1 } }
}
}
{ table-content-style
@ -48,14 +48,19 @@ IN: slides
: $divider ( -- )
[
<gadget>
T{ gradient f { { 0.25 0.25 0.25 1.0 } { 1.0 1.0 1.0 0.0 } } } >>interior
T{ gradient f
{
T{ rgba f 0.25 0.25 0.25 1.0 }
T{ rgba f 1.0 1.0 1.0 0.0 }
}
} >>interior
{ 800 10 } >>dim
{ 1 0 } >>orientation
gadget.
] ($block) ;
: page-theme ( gadget -- )
T{ gradient f { { 0.8 0.8 1.0 1.0 } { 0.8 1.0 1.0 1.0 } } }
T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } }
swap set-gadget-interior ;
: <page> ( list -- gadget )

6
extra/ui/gadgets/buttons/buttons.factor
View File

@ -106,7 +106,7 @@ TUPLE: checkmark-paint color ;
C: <checkmark-paint> checkmark-paint
M: checkmark-paint draw-interior
checkmark-paint-color gl-color
checkmark-paint-color set-color
origin get [
rect-dim
{ 0 0 } over gl-line
@ -152,11 +152,11 @@ TUPLE: radio-paint color ;
C: <radio-paint> radio-paint
M: radio-paint draw-interior
radio-paint-color gl-color
radio-paint-color set-color
origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ;
M: radio-paint draw-boundary
radio-paint-color gl-color
radio-paint-color set-color
origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ;
: radio-knob-theme ( gadget -- )

6
extra/ui/gadgets/editors/editors.factor
View File

@ -129,7 +129,7 @@ M: editor ungraft*
: draw-caret ( -- )
editor get editor-focused? [
editor get
dup editor-caret-color gl-color
dup editor-caret-color set-color
dup caret-loc origin get v+
swap caret-dim over v+
[ { 0.5 -0.5 } v+ ] bi@ gl-line
@ -173,7 +173,7 @@ M: editor ungraft*
: draw-lines ( -- )
\ first-visible-line get [
editor get dup editor-color gl-color
editor get dup editor-color set-color
dup visible-lines
[ draw-line 1 translate-lines ] with each
] with-editor-translation ;
@ -192,7 +192,7 @@ M: editor ungraft*
(draw-selection) ;
: draw-selection ( -- )
editor get editor-selection-color gl-color
editor get editor-selection-color set-color
editor get selection-start/end
over first [
2dup [

2
extra/ui/gadgets/grid-lines/grid-lines.factor
View File

@ -25,7 +25,7 @@ SYMBOL: grid-dim
M: grid-lines draw-boundary
origin get [
-0.5 -0.5 0.0 glTranslated
grid-lines-color gl-color [
grid-lines-color set-color [
dup grid set
dup rect-dim half-gap v- grid-dim set
compute-grid

4
extra/ui/gadgets/labelled/labelled.factor
View File

@ -31,8 +31,8 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
: title-theme ( gadget -- )
{ 1 0 } over set-gadget-orientation
T{ gradient f {
{ 0.65 0.65 1.0 1.0 }
{ 0.65 0.45 1.0 1.0 }
T{ rgba f 0.65 0.65 1.0 1.0 }
T{ rgba f 0.65 0.45 1.0 1.0 }
} } swap set-gadget-interior ;
: <title-label> ( text -- label ) <label> dup title-theme ;

2
extra/ui/gadgets/labels/labels.factor
View File

@ -35,7 +35,7 @@ M: label pref-dim*
[ font>> open-font ] [ text>> ] bi text-dim ;
M: label draw-gadget*
[ color>> gl-color ]
[ color>> set-color ]
[ [ font>> ] [ text>> ] bi origin get draw-text ] bi ;
M: label gadget-text* label-string % ;

7
extra/ui/gadgets/lists/lists.factor
View File

@ -4,13 +4,14 @@ USING: accessors ui.commands ui.gestures ui.render ui.gadgets
ui.gadgets.labels ui.gadgets.scrollers
kernel sequences models opengl math math.order namespaces
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs
math.vectors classes.tuple math.geometry.rect ;
math.vectors classes.tuple math.geometry.rect colors ;
IN: ui.gadgets.lists
TUPLE: list < pack index presenter color hook ;
: list-theme ( list -- list )
{ 0.8 0.8 1.0 1.0 } >>color ; inline
T{ rgba f 0.8 0.8 1.0 1.0 } >>color ; inline
: <list> ( hook presenter model -- gadget )
list new-gadget
@ -56,7 +57,7 @@ M: list model-changed
M: list draw-gadget*
origin get [
dup list-color gl-color
dup list-color set-color
selected-rect [ rect-extent gl-fill-rect ] when*
] with-translation ;

2
extra/ui/gadgets/panes/panes.factor
View File

@ -68,7 +68,7 @@ M: node draw-selection ( loc node -- )
M: pane draw-gadget*
dup gadget-selection? [
dup pane-selection-color gl-color
dup pane-selection-color set-color
origin get over rect-loc v- swap selected-children
[ draw-selection ] with each
] [

38
extra/ui/gadgets/theme/theme.factor
View File

@ -18,41 +18,41 @@ IN: ui.gadgets.theme
: plain-gradient
T{ gradient f {
{ 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 }
T{ rgba f 0.94 0.94 0.94 1.0 }
T{ rgba f 0.83 0.83 0.83 1.0 }
T{ rgba f 0.83 0.83 0.83 1.0 }
T{ rgba f 0.62 0.62 0.62 1.0 }
} } ;
: rollover-gradient
T{ gradient f {
{ 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 }
T{ rgba f 1.0 1.0 1.0 1.0 }
T{ rgba f 0.9 0.9 0.9 1.0 }
T{ rgba f 0.9 0.9 0.9 1.0 }
T{ rgba f 0.75 0.75 0.75 1.0 }
} } ;
: pressed-gradient
T{ gradient f {
{ 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 }
T{ rgba f 0.75 0.75 0.75 1.0 }
T{ rgba f 0.9 0.9 0.9 1.0 }
T{ rgba f 0.9 0.9 0.9 1.0 }
T{ rgba f 1.0 1.0 1.0 1.0 }
} } ;
: selected-gradient
T{ gradient f {
{ 0.65 0.65 0.65 1.0 }
{ 0.8 0.8 0.8 1.0 }
{ 0.8 0.8 0.8 1.0 }
{ 1.0 1.0 1.0 1.0 }
T{ rgba f 0.65 0.65 0.65 1.0 }
T{ rgba f 0.8 0.8 0.8 1.0 }
T{ rgba f 0.8 0.8 0.8 1.0 }
T{ rgba f 1.0 1.0 1.0 1.0 }
} } ;
: lowered-gradient
T{ gradient f {
{ 0.37 0.37 0.37 1.0 }
{ 0.43 0.43 0.43 1.0 }
{ 0.5 0.5 0.5 1.0 }
T{ rgba f 0.37 0.37 0.37 1.0 }
T{ rgba f 0.43 0.43 0.43 1.0 }
T{ rgba f 0.5 0.5 0.5 1.0 }
} } ;
: sans-serif-font { "sans-serif" plain 12 } ;

6
extra/ui/render/render.factor
View File

@ -35,7 +35,7 @@ SYMBOL: viewport-translation
init-clip
! white gl-clear is broken w.r.t window resizing
! Linux/PPC Radeon 9200
white gl-color
white set-color
clip get rect-extent gl-fill-rect ;
GENERIC: draw-gadget* ( gadget -- )
@ -95,7 +95,7 @@ C: <solid> solid
! Solid pen
: (solid) ( gadget paint -- loc dim )
solid-color gl-color rect-dim >r origin get dup r> v+ ;
solid-color set-color rect-dim >r origin get dup r> v+ ;
M: solid draw-interior (solid) gl-fill-rect ;
@ -121,7 +121,7 @@ C: <polygon> polygon
: draw-polygon ( polygon quot -- )
origin get [
>r dup polygon-color gl-color polygon-points r> call
>r dup polygon-color set-color polygon-points r> call
] with-translation ; inline
M: polygon draw-boundary