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

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

db4
Slava Pestov 2008-08-01 17:21:53 -05:00
parent 12590f6c1b 3073ab62d6
commit 8e58db1514
11 changed files with 62 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/help/stylesheet/stylesheet.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2006 Slava Pestov. ! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.styles namespaces ; USING: io.styles namespaces colors ;
IN: help.stylesheet IN: help.stylesheet
SYMBOL: default-span-style SYMBOL: default-span-style
@ -17,7 +17,7 @@ H{
SYMBOL: link-style SYMBOL: link-style
H{ H{
{ foreground { 0 0 0.3 1 } } { foreground T{ rgba f 0 0 0.3 1 } }
{ font-style bold } { font-style bold }
} link-style set-global } link-style set-global
@ -33,7 +33,7 @@ H{
{ font-size 18 } { font-size 18 }
{ font-style bold } { font-style bold }
{ wrap-margin 500 } { wrap-margin 500 }
{ page-color { 0.8 0.8 0.8 1 } } { page-color T{ rgba f 0.8 0.8 0.8 1 } }
{ border-width 5 } { border-width 5 }
} title-style set-global } title-style set-global
@ -58,12 +58,12 @@ SYMBOL: snippet-style
H{ H{
{ font "monospace" } { font "monospace" }
{ font-size 12 } { font-size 12 }
{ foreground { 0.1 0.1 0.4 1 } } { foreground T{ rgba f 0.1 0.1 0.4 1 } }
} snippet-style set-global } snippet-style set-global
SYMBOL: code-style SYMBOL: code-style
H{ H{
{ page-color { 0.8 0.8 0.8 0.5 } } { page-color T{ rgba f 0.8 0.8 0.8 0.5 } }
{ border-width 5 } { border-width 5 }
{ wrap-margin f } { wrap-margin f }
} code-style set-global } code-style set-global
@ -74,13 +74,13 @@ H{ { font-style bold } } input-style set-global
SYMBOL: url-style SYMBOL: url-style
H{ H{
{ font "monospace" } { font "monospace" }
{ foreground { 0.0 0.0 1.0 1.0 } } { foreground T{ rgba f 0.0 0.0 1.0 1.0 } }
} url-style set-global } url-style set-global
SYMBOL: warning-style SYMBOL: warning-style
H{ H{
{ page-color { 0.95 0.95 0.95 1 } } { page-color T{ rgba f 0.95 0.95 0.95 1 } }
{ border-color { 1 0 0 1 } } { border-color T{ rgba f 1 0 0 1 } }
{ border-width 5 } { border-width 5 }
{ wrap-margin 500 } { wrap-margin 500 }
} warning-style set-global } warning-style set-global
@ -93,7 +93,7 @@ H{
SYMBOL: table-style SYMBOL: table-style
H{ H{
{ table-gap { 5 5 } } { table-gap { 5 5 } }
{ table-border { 0.8 0.8 0.8 1.0 } } { table-border T{ rgba f 0.8 0.8 0.8 1.0 } }
} table-style set-global } table-style set-global
SYMBOL: list-style SYMBOL: list-style

6
basis/io/styles/styles.factor
View File

@ -1,6 +1,8 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: hashtables io ;
USING: hashtables io colors ;
IN: io.styles IN: io.styles
SYMBOL: plain SYMBOL: plain
@ -33,7 +35,7 @@ SYMBOL: table-border
: standard-table-style ( -- style ) : standard-table-style ( -- style )
H{ H{
{ table-gap { 5 5 } } { table-gap { 5 5 } }
{ table-border { 0.8 0.8 0.8 1.0 } } { table-border T{ rgba f 0.8 0.8 0.8 1.0 } }
} ; } ;
! Input history ! Input history

5
basis/listener/listener.factor
View File

@ -3,7 +3,8 @@
USING: arrays hashtables io kernel math math.parser memory USING: arrays hashtables io kernel math math.parser memory
namespaces parser lexer sequences strings io.styles namespaces parser lexer sequences strings io.styles
vectors words generic system combinators continuations debugger vectors words generic system combinators continuations debugger
definitions compiler.units accessors ; definitions compiler.units accessors colors ;
IN: listener IN: listener
SYMBOL: quit-flag SYMBOL: quit-flag
@ -41,7 +42,7 @@ M: object stream-read-quot
: prompt. ( -- ) : prompt. ( -- )
"( " in get " )" 3append "( " in get " )" 3append
H{ { background { 1 0.7 0.7 1 } } } format bl flush ; H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
SYMBOL: error-hook SYMBOL: error-hook

4
basis/prettyprint/backend/backend.factor
View File

@ -5,7 +5,7 @@ hashtables io assocs kernel math namespaces sequences strings
sbufs io.styles vectors words prettyprint.config sbufs io.styles vectors words prettyprint.config
prettyprint.sections quotations io io.files math.parser effects prettyprint.sections quotations io io.files math.parser effects
classes.tuple math.order classes.tuple.private classes classes.tuple math.order classes.tuple.private classes
combinators ; combinators colors ;
IN: prettyprint.backend IN: prettyprint.backend
GENERIC: pprint* ( obj -- ) GENERIC: pprint* ( obj -- )
@ -89,7 +89,7 @@ M: f pprint* drop \ f pprint-word ;
: string-style ( obj -- hash ) : string-style ( obj -- hash )
[ [
presented set presented set
{ 0.3 0.3 0.3 1.0 } foreground set T{ rgba f 0.3 0.3 0.3 1.0 } foreground set
] H{ } make-assoc ; ] H{ } make-assoc ;
: unparse-string ( str prefix suffix -- str ) : unparse-string ( str prefix suffix -- str )

1
extra/automata/ui/tags.txt Normal file
View File

@ -0,0 +1 @@
demos

74
extra/cfdg/cfdg.factor
View File

@ -3,40 +3,16 @@ USING: kernel alien.c-types combinators namespaces arrays
sequences sequences.lib namespaces.lib splitting sequences sequences.lib namespaces.lib splitting
math math.functions math.vectors math.trig math math.functions math.vectors math.trig
opengl.gl opengl.glu opengl ui ui.gadgets.slate opengl.gl opengl.glu opengl ui ui.gadgets.slate
vars vars colors self self.slots
random-weighted colors.hsv cfdg.gl ; random-weighted colors.hsv cfdg.gl accessors ;
IN: cfdg IN: cfdg
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! hsba { hue saturation brightness alpha } SELF-SLOTS: hsva
: <hsba> 4array ; : clear-color ( color -- ) set-clear-color GL_COLOR_BUFFER_BIT glClear ;
VAR: color
! ( -- val )
: hue>> 0 color> nth ;
: saturation>> 1 color> nth ;
: brightness>> 2 color> nth ;
: alpha>> 3 color> nth ;
! ( val -- )
: >>hue 0 color> set-nth ;
: >>saturation 1 color> set-nth ;
: >>brightness 2 color> set-nth ;
: >>alpha 3 color> set-nth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: hsva>rgba ( hsva -- rgba ) [ 3 head hsv>rgb ] [ peek ] bi suffix ;
: gl-set-hsba ( hsva -- ) hsva>rgba gl-color ;
: gl-clear-hsba ( hsva -- ) hsva>rgba gl-clear ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -50,18 +26,18 @@ VAR: color
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: hue ( num -- ) hue>> + 360 mod >>hue ; : hue ( num -- ) hue-> + 360 mod ->hue ;
: saturation ( num -- ) saturation>> swap adjust >>saturation ; : saturation ( num -- ) saturation-> swap adjust ->saturation ;
: brightness ( num -- ) brightness>> swap adjust >>brightness ; : brightness ( num -- ) value-> swap adjust ->value ;
: alpha ( num -- ) alpha>> swap adjust >>alpha ; : alpha ( num -- ) alpha-> swap adjust ->alpha ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: h hue ; : h ( num -- ) hue ;
: sat saturation ; : sat ( num -- ) saturation ;
: b brightness ; : b ( num -- ) brightness ;
: a alpha ; : a ( num -- ) alpha ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -69,9 +45,9 @@ VAR: color-stack
: init-color-stack ( -- ) V{ } clone >color-stack ; : init-color-stack ( -- ) V{ } clone >color-stack ;
: push-color ( -- ) color> color-stack> push color> clone >color ; : push-color ( -- ) self> color-stack> push self> clone >self ;
: pop-color ( -- ) color-stack> pop dup >color gl-set-hsba ; : pop-color ( -- ) color-stack> pop dup >self set-color ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -102,11 +78,11 @@ VAR: threshold
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: circle ( -- ) : circle ( -- )
color> gl-set-hsba self> set-color
gluNewQuadric dup 0 0.5 20 10 gluDisk gluDeleteQuadric ; gluNewQuadric dup 0 0.5 20 10 gluDisk gluDeleteQuadric ;
: triangle ( -- ) : triangle ( -- )
color> gl-set-hsba self> set-color
GL_POLYGON glBegin GL_POLYGON glBegin
0 0.577 glVertex2d 0 0.577 glVertex2d
0.5 -0.289 glVertex2d 0.5 -0.289 glVertex2d
@ -114,7 +90,7 @@ VAR: threshold
glEnd ; glEnd ;
: square ( -- ) : square ( -- )
color> gl-set-hsba self> set-color
GL_POLYGON glBegin GL_POLYGON glBegin
-0.5 0.5 glVertex2d -0.5 0.5 glVertex2d
0.5 0.5 glVertex2d 0.5 0.5 glVertex2d
@ -138,10 +114,10 @@ VAR: threshold
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: s size ; : s ( scale -- ) size ;
: s* size* ; : s* ( scale-x scale-y -- ) size* ;
: r rotate ; : r ( angle -- ) rotate ;
: f flip ; : f ( angle -- ) flip ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -162,12 +138,12 @@ VAR: threshold
VAR: background VAR: background
: set-initial-background ( -- ) { 0 0 1 1 } clone >color ; : set-initial-background ( -- ) T{ hsva f 0 0 1 1 } clone >self ;
: set-background ( -- ) : set-background ( -- )
set-initial-background set-initial-background
background> call background> call
color> gl-clear-hsba ; self> clear-color ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -177,7 +153,7 @@ VAR: viewport ! { left width bottom height }
VAR: start-shape VAR: start-shape
: set-initial-color ( -- ) { 0 0 0 1 } clone >color ; : set-initial-color ( -- ) T{ hsva f 0 0 0 1 } clone >self ;
: display ( -- ) : display ( -- )
@ -198,7 +174,7 @@ VAR: start-shape
set-initial-color set-initial-color
color> gl-set-hsba self> set-color
start-shape> call ; start-shape> call ;

4
extra/color-picker/color-picker.factor
View File

@ -4,7 +4,7 @@ USING: kernel math math.functions math.parser models
models.filter models.range models.compose sequences ui models.filter models.range models.compose sequences ui
ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
ui.gadgets.sliders ui.render math.geometry.rect accessors ui.gadgets.sliders ui.render math.geometry.rect accessors
ui.gadgets.grids ; ui.gadgets.grids colors ;
IN: color-picker IN: color-picker
! Simple example demonstrating the use of models. ! Simple example demonstrating the use of models.
@ -23,7 +23,7 @@ M: color-preview model-changed
swap model-value over set-gadget-interior relayout-1 ; swap model-value over set-gadget-interior relayout-1 ;
: <color-model> ( model -- model ) : <color-model> ( model -- model )
[ [ 256 /f ] map 1 suffix <solid> ] <filter> ; [ [ 256 /f ] map 1 suffix first4 rgba boa <solid> ] <filter> ;
: <color-sliders> ( -- model gadget ) : <color-sliders> ( -- model gadget )
3 [ 0 0 0 255 <range> ] replicate 3 [ 0 0 0 255 <range> ] replicate

2
extra/colors/colors.factor
View File

@ -27,8 +27,6 @@ M: hsva >rgba ( hsva -- rgba )
M: gray >rgba ( gray -- rgba ) [ gray>> 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 red>> ( color -- red ) >rgba red>> ;
M: color green>> ( color -- green ) >rgba green>> ; M: color green>> ( color -- green ) >rgba green>> ;
M: color blue>> ( color -- blue ) >rgba blue>> ; M: color blue>> ( color -- blue ) >rgba blue>> ;

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

@ -39,16 +39,15 @@ IN: golden-section
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: <golden-section> ( -- gadget )
<cartesian>
{ 600 600 } >>pdim
{ -400 400 } x-range
{ -400 400 } y-range
[ golden-section ] >>action ;
: golden-section-window ( -- ) : golden-section-window ( -- )
[ [ <golden-section> "Golden Section" open-window ] with-ui ;
<cartesian>
{ 600 600 } >>pdim
{ -400 400 } x-range
{ -400 400 } y-range
[ golden-section ] >>action
"Golden Section" open-window
]
with-ui ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

22
extra/processing/color/color.factor
View File

@ -1,22 +0,0 @@
USING: kernel sequences ;
IN: processing.color
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: rgba red green blue alpha ;
C: <rgba> rgba
: <rgb> ( r g b -- rgba ) 1 <rgba> ;
: <gray> ( gray -- rgba ) dup dup 1 <rgba> ;
: {rgb} ( seq -- rgba ) first3 <rgb> ;
! : hex>rgba ( hex -- rgba )
! : set-gl-color ( color -- )
! { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave glColor4d ;

13
extra/ui/gadgets/slate/slate.factor
View File

@ -96,18 +96,21 @@ M: slate draw-gadget* ( slate -- )
establish-coordinate-system establish-coordinate-system
GL_MODELVIEW glMatrixMode glLoadIdentity glPushMatrix GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity
setup-viewport setup-viewport
draw-slate draw-slate
GL_PROJECTION glMatrixMode glPopMatrix GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
GL_MODELVIEW glMatrixMode glPopMatrix GL_MODELVIEW glMatrixMode glPopMatrix glLoadIdentity
dup dup
find-world find-world
default-coordinate-system ! The world coordinate system is a little wacky:
dup { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
setup-viewport setup-viewport
drop drop
drop ; drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!