Merge branch 'master' of git://factorcode.org/git/factor into c-type-words

db4
Joe Groff 2009-09-15 15:19:22 -05:00
commit 95ba6a4c05
12 changed files with 60 additions and 22 deletions

View File

@ -11,23 +11,23 @@ IN: colors.constants
[ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
[ blank? ] trim-head { { CHAR: \s CHAR: - } } substitute swap ;
: parse-rgb.txt ( lines -- assoc )
: parse-colors ( lines -- assoc )
[ "!" head? not ] filter
[ 11 cut [ " \t" split harvest ] dip suffix ] map
[ parse-color ] H{ } map>assoc ;
MEMO: rgb.txt ( -- assoc )
MEMO: colors ( -- assoc )
"resource:basis/colors/constants/rgb.txt"
"resource:basis/colors/constants/factor-colors.txt"
[ utf8 file-lines parse-rgb.txt ] bi@ assoc-union ;
[ utf8 file-lines parse-colors ] bi@ assoc-union ;
PRIVATE>
: named-colors ( -- keys ) rgb.txt keys ;
: named-colors ( -- keys ) colors keys ;
ERROR: no-such-color name ;
: named-color ( name -- color )
dup rgb.txt at [ ] [ no-such-color ] ?if ;
dup colors at [ ] [ no-such-color ] ?if ;
SYNTAX: COLOR: scan named-color parsed ;

View File

@ -1,6 +1,6 @@
! Factor UI theme colors
243 242 234 FactorLightLightTan
227 226 219 FactorLightTan
243 242 234 FactorLightTan
227 226 219 FactorTan
172 167 147 FactorDarkTan
81 91 105 FactorLightSlateBlue
55 62 72 FactorDarkSlateBlue

View File

@ -129,6 +129,7 @@ IN: compiler.cfg.intrinsics
{ math.libm:ftanh [ drop "tanh" emit-unary-float-function ] }
{ math.libm:fexp [ drop "exp" emit-unary-float-function ] }
{ math.libm:flog [ drop "log" emit-unary-float-function ] }
{ math.libm:flog10 [ drop "log10" emit-unary-float-function ] }
{ math.libm:fpow [ drop "pow" emit-binary-float-function ] }
{ math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
{ math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: colors colors.constants io.styles literals namespaces ;
USING: colors colors.constants io.styles namespaces ;
IN: help.stylesheet
SYMBOL: default-span-style
@ -34,7 +34,7 @@ H{
{ font-style bold }
{ wrap-margin 500 }
{ foreground COLOR: gray20 }
{ page-color COLOR: FactorLightLightTan }
{ page-color COLOR: FactorLightTan }
{ inset { 5 5 } }
} title-style set-global
@ -42,7 +42,7 @@ SYMBOL: help-path-style
H{
{ font-size 10 }
{ table-gap { 5 5 } }
{ table-border $ transparent }
{ table-border COLOR: FactorLightTan }
} help-path-style set-global
SYMBOL: heading-style
@ -75,7 +75,7 @@ H{
SYMBOL: code-style
H{
{ page-color COLOR: FactorLightLightTan }
{ page-color COLOR: FactorLightTan }
{ inset { 5 5 } }
{ wrap-margin f }
} code-style set-global
@ -113,7 +113,7 @@ H{
SYMBOL: table-style
H{
{ table-gap { 5 5 } }
{ table-border COLOR: FactorLightTan }
{ table-border COLOR: FactorTan }
} table-style set-global
SYMBOL: list-style

View File

@ -227,6 +227,18 @@ C: <vocab-author> vocab-author
] bi
] unless-empty ;
: vocab-is-not-loaded ( vocab -- )
"Not loaded" $heading
"You must first load this vocabulary to browse its documentation and words."
print-element vocab-name "USE: " prepend 1array $code ;
: describe-words ( vocab -- )
{
{ [ dup vocab ] [ words $words ] }
{ [ dup find-vocab-root ] [ vocab-is-not-loaded ] }
[ drop ]
} cond ;
: words. ( vocab -- )
last-element off
[ require ] [ words $words ] bi nl ;
@ -243,7 +255,7 @@ C: <vocab-author> vocab-author
first {
[ describe-help ]
[ describe-metadata ]
[ words $words ]
[ describe-words ]
[ describe-files ]
[ describe-children ]
} cleave ;

View File

@ -33,6 +33,12 @@ IN: math.functions.tests
[ 0.0 ] [ 1.0 log ] unit-test
[ 1.0 ] [ e log ] unit-test
[ 0.0 ] [ 1.0 log10 ] unit-test
[ 1.0 ] [ 10.0 log10 ] unit-test
[ 2.0 ] [ 100.0 log10 ] unit-test
[ 3.0 ] [ 1000.0 log10 ] unit-test
[ 4.0 ] [ 10000.0 log10 ] unit-test
[ t ] [ 1 exp e 1.e-10 ~ ] unit-test
[ t ] [ 1.0 exp e 1.e-10 ~ ] unit-test
[ t ] [ -1 exp e * 1.0 1.e-10 ~ ] unit-test

View File

@ -173,7 +173,11 @@ M: float log1+ dup -1.0 >= [ flog1+ ] [ 1.0 + 0.0 rect> log ] if ; inline
: 10^ ( x -- y ) 10 swap ^ ; inline
: log10 ( x -- y ) log 10 log / ; inline
GENERIC: log10 ( x -- y ) foldable
M: real log10 >float flog10 ; inline
M: complex log10 log 10 log / ; inline
GENERIC: cos ( x -- y ) foldable

View File

@ -39,6 +39,9 @@ IN: math.libm
: flog ( x -- y )
"double" "libm" "log" { "double" } alien-invoke ;
: flog10 ( x -- y )
"double" "libm" "log10" { "double" } alien-invoke ;
: fpow ( x y -- z )
"double" "libm" "pow" { "double" "double" } alien-invoke ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic assocs io kernel math
namespaces sequences strings io.styles vectors words
namespaces sequences strings vectors words
continuations ;
IN: prettyprint.config

View File

@ -88,7 +88,7 @@ PRIVATE>
"at the top of the source file:" print nl
] with-style
{
{ page-color COLOR: FactorLightLightTan }
{ page-color COLOR: FactorLightTan }
{ border-color COLOR: FactorDarkTan }
{ inset { 5 5 } }
} [ manifest get pprint-manifest ] with-nesting

View File

@ -1,9 +1,10 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel xml arrays math generic http.client
combinators hashtables namespaces io base64 sequences strings
calendar xml.data xml.writer xml.traversal assocs math.parser
debugger calendar.format math.order xml.syntax ;
USING: accessors arrays assocs base64 calendar calendar.format
combinators debugger generic hashtables http http.client
http.client.private io io.encodings.string io.encodings.utf8
kernel math math.order math.parser namespaces sequences strings
xml xml.data xml.syntax xml.traversal xml.writer ;
IN: xml-rpc
! * Sending RPC requests
@ -174,9 +175,20 @@ TAG: array xml>item
] [ "Bad main tag name" server-error ] if
] if ;
<PRIVATE
: xml-post-data ( xml -- post-data )
xml>string utf8 encode "text/xml" <post-data> swap >>data ;
: rpc-post-request ( xml url -- request )
[ send-rpc xml-post-data ] [ "POST" <client-request> ] bi*
swap >>post-data ;
PRIVATE>
: post-rpc ( rpc url -- rpc )
! This needs to do something in the event of an error
[ send-rpc ] dip http-post nip string>xml receive-rpc ;
rpc-post-request http-request nip string>xml receive-rpc ;
: invoke-method ( params method url -- response )
[ swap <rpc-method> ] dip post-rpc ;

View File

@ -1,5 +1,5 @@
include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-netbsd.o
CFLAGS += -export-dynamic
LIBPATH = -L/usr/X11R6/lib -Wl,-rpath,/usr/X11R6/lib -L/usr/pkg/lib -Wl,-rpath,/usr/pkg/lib
LIBPATH = -L/usr/X11R7/lib -Wl,-rpath,/usr/X11R7/lib -L/usr/pkg/lib -Wl,-rpath,/usr/pkg/lib
LIBS = -lm -lssl -lcrypto $(X11_UI_LIBS)