Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
fa472f2657
|
|
@ -0,0 +1,2 @@
|
|||
Ryan Murphy
|
||||
Doug Coleman
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
USING: help.syntax help.markup ;
|
||||
IN: editors.editpadpro
|
||||
|
||||
ARTICLE: "editors.editpadpro" "EditPad Pro support"
|
||||
"EditPadPro text editor integration on Windows. Be sure to put EditPadPro in your system path so that it will be found. Windows only." ;
|
||||
|
||||
ABOUT: "editors.editpadpro"
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
USING: definitions kernel parser words sequences math.parser
|
||||
namespaces editors io.launcher windows.shell32 io.files
|
||||
io.paths.windows strings unicode.case make ;
|
||||
IN: editors.editpadlite
|
||||
|
||||
: editpadlite-path ( -- path )
|
||||
\ editpadlite-path get-global [
|
||||
"JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: editpadlite ( file line -- )
|
||||
[
|
||||
editpadlite-path , drop ,
|
||||
] { } make run-detached drop ;
|
||||
|
||||
[ editpadlite ] edit-hook set-global
|
||||
|
|
@ -0,0 +1 @@
|
|||
EditPadLite editor integration
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
USING: help.syntax help.markup ;
|
||||
IN: editors.editpadpro
|
||||
|
||||
ARTICLE: "editpadpro" "EditPad Pro support"
|
||||
"Just load this module and you will be able to edit documentation with EditPadPro. Be sure to put EditPadPro in your system path so that it will be found. Windows only." ;
|
||||
ARTICLE: "editors.editpadpro" "EditPad Pro support"
|
||||
"EditPadPro text editor integration on Windows. Be sure to put EditPadPro in your system path so that it will be found. Windows only." ;
|
||||
|
||||
ABOUT: "editpadpro"
|
||||
ABOUT: "editors.editpadpro"
|
||||
|
|
|
|||
|
|
@ -1,17 +1,16 @@
|
|||
USING: definitions kernel parser words sequences math.parser
|
||||
namespaces editors io.launcher windows.shell32 io.files
|
||||
io.paths strings unicode.case make ;
|
||||
io.paths.windows strings unicode.case make ;
|
||||
IN: editors.editpadpro
|
||||
|
||||
: editpadpro-path
|
||||
: editpadpro-path ( -- path )
|
||||
\ editpadpro-path get-global [
|
||||
program-files "JGsoft" append-path
|
||||
t [ >lower "editpadpro.exe" tail? ] find-file
|
||||
"JGsoft" t [ >lower "editpadpro.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: editpadpro ( file line -- )
|
||||
[
|
||||
editpadpro-path , "/l" swap number>string append , ,
|
||||
editpadpro-path , number>string "/l" prepend , ,
|
||||
] { } make run-detached drop ;
|
||||
|
||||
[ editpadpro ] edit-hook set-global
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
USING: editors io.files io.launcher kernel math.parser
|
||||
namespaces sequences windows.shell32 make ;
|
||||
namespaces sequences windows.shell32 make io.paths.windows ;
|
||||
IN: editors.editplus
|
||||
|
||||
: editplus-path ( -- path )
|
||||
\ editplus-path get-global [
|
||||
program-files "\\EditPlus 2\\editplus.exe" append-path
|
||||
"EditPlus 2" t [ "editplus.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: editplus ( file line -- )
|
||||
|
|
|
|||
|
|
@ -1,11 +1,10 @@
|
|||
USING: editors hardware-info.windows io.files io.launcher
|
||||
kernel math.parser namespaces sequences windows.shell32
|
||||
make ;
|
||||
USING: editors io.files io.launcher kernel math.parser
|
||||
namespaces sequences windows.shell32 make io.paths.windows ;
|
||||
IN: editors.emeditor
|
||||
|
||||
: emeditor-path ( -- path )
|
||||
\ emeditor-path get-global [
|
||||
program-files "\\EmEditor\\EmEditor.exe" append-path
|
||||
"EmEditor" t [ "EmEditor.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: emeditor ( file line -- )
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
! Copyright (C) 2008 Kibleur Christophe.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: editors io.files io.launcher kernel math.parser
|
||||
namespaces sequences windows.shell32 make ;
|
||||
namespaces sequences windows.shell32 io.paths.windows make ;
|
||||
IN: editors.etexteditor
|
||||
|
||||
: etexteditor-path ( -- str )
|
||||
\ etexteditor-path get-global [
|
||||
program-files "e\\e.exe" append-path
|
||||
"e" t [ "e.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: etexteditor ( file line -- )
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
USING: editors.gvim io.files io.windows kernel namespaces
|
||||
sequences windows.shell32 io.paths system ;
|
||||
sequences windows.shell32 io.paths.windows system ;
|
||||
IN: editors.gvim.windows
|
||||
|
||||
M: windows gvim-path
|
||||
\ gvim-path get-global [
|
||||
program-files "vim" append-path
|
||||
t [ "gvim.exe" tail? ] find-file
|
||||
"vim" t [ "gvim.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
|
|
|||
|
|
@ -2,10 +2,10 @@ USING: editors io.files io.launcher kernel math.parser
|
|||
namespaces sequences windows.shell32 make ;
|
||||
IN: editors.notepad2
|
||||
|
||||
: notepad2-path ( -- str )
|
||||
: notepad2-path ( -- path )
|
||||
\ notepad2-path get-global [
|
||||
program-files "C:\\Windows\\system32\\notepad.exe" append-path
|
||||
] unless* ;
|
||||
"C:\\Windows\\system32\\notepad.exe"
|
||||
] unless* ;
|
||||
|
||||
: notepad2 ( file line -- )
|
||||
[
|
||||
|
|
@ -13,4 +13,4 @@ IN: editors.notepad2
|
|||
"/g" , number>string , ,
|
||||
] { } make run-detached drop ;
|
||||
|
||||
[ notepad2 ] edit-hook set-global
|
||||
[ notepad2 ] edit-hook set-global
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
USING: editors io.files io.launcher kernel math.parser
|
||||
namespaces sequences windows.shell32 make ;
|
||||
namespaces sequences io.paths.windows make ;
|
||||
IN: editors.notepadpp
|
||||
|
||||
: notepadpp-path
|
||||
: notepadpp-path ( -- path )
|
||||
\ notepadpp-path get-global [
|
||||
program-files "notepad++\\notepad++.exe" append-path
|
||||
"notepad++" t [ "notepad++.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: notepadpp ( file line -- )
|
||||
|
|
|
|||
|
|
@ -1,34 +1,25 @@
|
|||
! Basic SciTE integration for Factor.
|
||||
!
|
||||
! By Clemens F. Hofreither, 2007.
|
||||
! Copyright (C) 2007 Clemens F. Hofreither.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
! clemens.hofreither@gmx.net
|
||||
!
|
||||
! In your .factor-rc or .factor-boot-rc,
|
||||
! require this module and set the scite-path
|
||||
! variable to point to your executable,
|
||||
! if not on the path.
|
||||
!
|
||||
USING: io.files io.launcher kernel namespaces math
|
||||
math.parser editors sequences windows.shell32 make ;
|
||||
USING: io.files io.launcher kernel namespaces io.paths.windows
|
||||
math math.parser editors sequences make unicode.case ;
|
||||
IN: editors.scite
|
||||
|
||||
: scite-path ( -- path )
|
||||
\ scite-path get-global [
|
||||
program-files "ScITE Source Code Editor\\SciTE.exe" append-path
|
||||
dup exists? [
|
||||
drop program-files "wscite\\SciTE.exe" append-path
|
||||
] unless
|
||||
"Scintilla Text Editor" t
|
||||
[ >lower "scite.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: scite-command ( file line -- cmd )
|
||||
swap
|
||||
[
|
||||
scite-path ,
|
||||
,
|
||||
"-goto:" swap number>string append ,
|
||||
] { } make ;
|
||||
swap
|
||||
[
|
||||
scite-path ,
|
||||
,
|
||||
number>string "-goto:" prepend ,
|
||||
] { } make ;
|
||||
|
||||
: scite-location ( file line -- )
|
||||
scite-command run-detached drop ;
|
||||
scite-command run-detached drop ;
|
||||
|
||||
[ scite-location ] edit-hook set-global
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
SciTE editor integration
|
||||
Scintilla text editor (SciTE) integration
|
||||
|
|
|
|||
|
|
@ -1,15 +1,16 @@
|
|||
USING: editors io.files io.launcher kernel math.parser
|
||||
namespaces sequences windows.shell32 make ;
|
||||
namespaces sequences io.paths.windows make ;
|
||||
IN: editors.ted-notepad
|
||||
|
||||
: ted-notepad-path
|
||||
: ted-notepad-path ( -- path )
|
||||
\ ted-notepad-path get-global [
|
||||
program-files "\\TED Notepad\\TedNPad.exe" append-path
|
||||
"TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: ted-notepad ( file line -- )
|
||||
[
|
||||
ted-notepad-path , "/l" swap number>string append , ,
|
||||
ted-notepad-path ,
|
||||
number>string "/l" prepend , ,
|
||||
] { } make run-detached drop ;
|
||||
|
||||
[ ted-notepad ] edit-hook set-global
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
USING: definitions io.launcher kernel math math.parser parser
|
||||
namespaces prettyprint editors make ;
|
||||
|
||||
IN: editors.textedit
|
||||
|
||||
: textedit-location ( file line -- )
|
||||
|
|
@ -9,5 +8,3 @@ IN: editors.textedit
|
|||
try-process ;
|
||||
|
||||
[ textedit-location ] edit-hook set-global
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,10 @@
|
|||
USING: editors io.files io.launcher kernel math.parser
|
||||
namespaces sequences windows.shell32 wne ;
|
||||
namespaces sequences io.paths.windows make ;
|
||||
IN: editors.ultraedit
|
||||
|
||||
: ultraedit-path ( -- path )
|
||||
\ ultraedit-path get-global [
|
||||
program-files
|
||||
"IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path
|
||||
"IDM Computer Solutions" t [ "uedit32.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: ultraedit ( file line -- )
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
USING: editors hardware-info.windows io.launcher kernel
|
||||
math.parser namespaces sequences windows.shell32 io.files
|
||||
arrays ;
|
||||
USING: editors io.launcher kernel io.paths.windows
|
||||
math.parser namespaces sequences io.files arrays ;
|
||||
IN: editors.wordpad
|
||||
|
||||
: wordpad-path ( -- path )
|
||||
\ wordpad-path get [
|
||||
program-files "Windows NT\\Accessories\\wordpad.exe" append-path
|
||||
"Windows NT\\Accessories" t
|
||||
[ "wordpad.exe" tail? ] find-in-program-files
|
||||
] unless* ;
|
||||
|
||||
: wordpad ( file line -- )
|
||||
drop wordpad-path swap 2array dup . run-detached drop ;
|
||||
drop wordpad-path swap 2array run-detached drop ;
|
||||
|
||||
[ wordpad ] edit-hook set-global
|
||||
|
|
|
|||
|
|
@ -1,5 +0,0 @@
|
|||
USING: io.backend ;
|
||||
IN: io.files.unique.backend
|
||||
|
||||
HOOK: (make-unique-file) io-backend ( path -- )
|
||||
HOOK: temporary-path io-backend ( -- path )
|
||||
|
|
@ -2,12 +2,40 @@ USING: help.markup help.syntax io io.ports kernel math
|
|||
io.files.unique.private math.parser io.files ;
|
||||
IN: io.files.unique
|
||||
|
||||
HELP: temporary-path
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
}
|
||||
{ $description "A hook that returns the path of the temporary directory in a platform-specific way. Does not guarantee that path is writable by your user." } ;
|
||||
|
||||
HELP: touch-unique-file
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
}
|
||||
{ $description "Creates a unique file in a platform-specific way. The file is guaranteed not to exist and is openable by your user." } ;
|
||||
|
||||
HELP: unique-length
|
||||
{ $description "A symbol storing the number of random characters inserted between the prefix and suffix of a random file name." } ;
|
||||
|
||||
HELP: unique-retries
|
||||
{ $description "The number of times to try creating a unique file in case of a name collision. The odds of a name collision are extremely low with a sufficient " { $link unique-length } "." } ;
|
||||
|
||||
{ unique-length unique-retries } related-words
|
||||
|
||||
HELP: make-unique-file ( prefix suffix -- path )
|
||||
{ $values { "prefix" "a string" } { "suffix" "a string" }
|
||||
{ "path" "a pathname string" } }
|
||||
{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." }
|
||||
{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
|
||||
{ $see-also with-unique-file } ;
|
||||
{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
|
||||
|
||||
HELP: make-unique-file*
|
||||
{ $values
|
||||
{ "prefix" null } { "suffix" null }
|
||||
{ "path" "a pathname string" }
|
||||
}
|
||||
{ $description "Creates a file that is guaranteed not to exist in the directory in the " { $link current-directory } " variable. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } ;
|
||||
|
||||
{ make-unique-file make-unique-file* with-unique-file } related-words
|
||||
|
||||
HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
|
||||
{ $values { "prefix" "a string" } { "suffix" "a string" }
|
||||
|
|
@ -18,8 +46,7 @@ HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
|
|||
HELP: make-unique-directory ( -- path )
|
||||
{ $values { "path" "a pathname string" } }
|
||||
{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
|
||||
{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
|
||||
{ $see-also with-unique-directory } ;
|
||||
{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
|
||||
|
||||
HELP: with-unique-directory ( quot -- )
|
||||
{ $values { "quot" "a quotation" } }
|
||||
|
|
@ -30,6 +57,7 @@ ARTICLE: "io.files.unique" "Temporary files"
|
|||
"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl
|
||||
"Files:"
|
||||
{ $subsection make-unique-file }
|
||||
{ $subsection make-unique-file* }
|
||||
{ $subsection with-unique-file }
|
||||
"Directories:"
|
||||
{ $subsection make-unique-directory }
|
||||
|
|
|
|||
|
|
@ -1,11 +1,13 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.bitwise math.parser
|
||||
random sequences continuations namespaces
|
||||
io.files io arrays io.files.unique.backend system
|
||||
combinators vocabs.loader fry ;
|
||||
USING: kernel math math.bitwise math.parser random sequences
|
||||
continuations namespaces io.files io arrays system
|
||||
combinators vocabs.loader fry io.backend ;
|
||||
IN: io.files.unique
|
||||
|
||||
HOOK: touch-unique-file io-backend ( path -- )
|
||||
HOOK: temporary-path io-backend ( -- path )
|
||||
|
||||
SYMBOL: unique-length
|
||||
SYMBOL: unique-retries
|
||||
|
||||
|
|
@ -26,12 +28,17 @@ SYMBOL: unique-retries
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: (make-unique-file) ( path prefix suffix -- path )
|
||||
'[
|
||||
_ _ _ unique-length get random-name glue append-path
|
||||
dup touch-unique-file
|
||||
] unique-retries get retry ;
|
||||
|
||||
: make-unique-file ( prefix suffix -- path )
|
||||
temporary-path -rot
|
||||
[
|
||||
unique-length get random-name glue append-path
|
||||
dup (make-unique-file)
|
||||
] 3curry unique-retries get retry ;
|
||||
[ temporary-path ] 2dip (make-unique-file) ;
|
||||
|
||||
: make-unique-file* ( prefix suffix -- path )
|
||||
[ current-directory get ] 2dip (make-unique-file) ;
|
||||
|
||||
: with-unique-file ( prefix suffix quot: ( path -- ) -- )
|
||||
[ make-unique-file ] dip [ delete-file ] bi ; inline
|
||||
|
|
|
|||
|
|
@ -0,0 +1,11 @@
|
|||
USING: io.paths kernel tools.test io.files.unique sequences
|
||||
io.files namespaces sorting ;
|
||||
IN: io.paths.tests
|
||||
|
||||
[ t ] [
|
||||
[
|
||||
10 [ "io.paths.test" "gogogo" make-unique-file* ] replicate
|
||||
current-directory get t [ ] find-all-files
|
||||
] with-unique-directory
|
||||
[ natural-sort ] bi@ =
|
||||
] unit-test
|
||||
|
|
@ -1,11 +1,13 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.files kernel sequences accessors
|
||||
dlists deques arrays ;
|
||||
USING: accessors arrays deques dlists io.files
|
||||
kernel sequences system vocabs.loader fry continuations ;
|
||||
IN: io.paths
|
||||
|
||||
TUPLE: directory-iterator path bfs queue ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: qualified-directory ( path -- seq )
|
||||
dup directory-files [ append-path ] with map ;
|
||||
|
||||
|
|
@ -25,25 +27,32 @@ TUPLE: directory-iterator path bfs queue ;
|
|||
[ over push-directory next-file ] [ nip ] if
|
||||
] if ;
|
||||
|
||||
: iterate-directory ( iter quot -- obj )
|
||||
: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
|
||||
over next-file [
|
||||
over call
|
||||
[ 2drop ] [ iterate-directory ] if
|
||||
[ 2nip ] [ iterate-directory ] if*
|
||||
] [
|
||||
2drop f
|
||||
] if* ; inline recursive
|
||||
|
||||
: find-file ( path bfs? quot -- path/f )
|
||||
PRIVATE>
|
||||
|
||||
: find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
|
||||
[ <directory-iterator> ] dip
|
||||
[ keep and ] curry iterate-directory ; inline
|
||||
|
||||
: each-file ( path bfs? quot -- )
|
||||
: each-file ( path bfs? quot: ( obj -- ? ) -- )
|
||||
[ <directory-iterator> ] dip
|
||||
[ f ] compose iterate-directory drop ; inline
|
||||
|
||||
: find-all-files ( path bfs? quot -- paths )
|
||||
: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths )
|
||||
[ <directory-iterator> ] dip
|
||||
pusher [ [ f ] compose iterate-directory drop ] dip ; inline
|
||||
|
||||
: recursive-directory ( path bfs? -- paths )
|
||||
[ ] accumulator [ each-file ] dip ;
|
||||
|
||||
: find-in-directories ( directories bfs? quot -- path' )
|
||||
'[ _ _ find-file ] attempt-all ; inline
|
||||
|
||||
os windows? [ "io.paths.windows" require ] when
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays continuations fry io.files io.paths
|
||||
kernel windows.shell32 sequences ;
|
||||
IN: io.paths.windows
|
||||
|
||||
: program-files-directories ( -- array )
|
||||
program-files program-files-x86 2array ; inline
|
||||
|
||||
: find-in-program-files ( base-directory bfs? quot -- path )
|
||||
[
|
||||
[ program-files-directories ] dip '[ _ append-path ] map
|
||||
] 2dip find-in-directories ; inline
|
||||
|
|
@ -1,13 +1,13 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel io.ports io.unix.backend math.bitwise
|
||||
unix io.files.unique.backend system ;
|
||||
unix system io.files.unique ;
|
||||
IN: io.unix.files.unique
|
||||
|
||||
: open-unique-flags ( -- flags )
|
||||
{ O_RDWR O_CREAT O_EXCL } flags ;
|
||||
|
||||
M: unix (make-unique-file) ( path -- )
|
||||
M: unix touch-unique-file ( path -- )
|
||||
open-unique-flags file-mode open-file close-file ;
|
||||
|
||||
M: unix temporary-path ( -- path ) "/tmp" ;
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
USING: kernel system io.files.unique.backend
|
||||
windows.kernel32 io.windows io.windows.files io.ports windows
|
||||
destructors environment ;
|
||||
USING: kernel system windows.kernel32 io.windows
|
||||
io.windows.files io.ports windows destructors environment
|
||||
io.files.unique ;
|
||||
IN: io.windows.files.unique
|
||||
|
||||
M: windows (make-unique-file) ( path -- )
|
||||
M: windows touch-unique-file ( path -- )
|
||||
GENERIC_WRITE CREATE_NEW 0 open-file dispose ;
|
||||
|
||||
M: windows temporary-path ( -- path )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math kernel memoize tools.test parser
|
||||
USING: math kernel memoize tools.test parser generalizations
|
||||
prettyprint io.streams.string sequences eval ;
|
||||
IN: memoize.tests
|
||||
|
||||
|
|
@ -9,7 +9,7 @@ MEMO: fib ( m -- n )
|
|||
|
||||
[ 89 ] [ 10 fib ] unit-test
|
||||
|
||||
[ "USING: kernel math memoize ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) >r >r >r >r 1+ r> r> r> r> ;" eval ] must-fail
|
||||
[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" eval ] must-fail
|
||||
|
||||
MEMO: see-test ( a -- b ) reverse ;
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ SYMBOL: building-seq
|
|||
|
||||
: n, ( obj n -- ) get-building-seq push ;
|
||||
: n% ( seq n -- ) get-building-seq push-all ;
|
||||
: n# ( num n -- ) >r number>string r> n% ;
|
||||
: n# ( num n -- ) [ number>string ] dip n% ;
|
||||
|
||||
: 0, ( obj -- ) 0 n, ;
|
||||
: 0% ( seq -- ) 0 n% ;
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ IN: random.mersenne-twister.tests
|
|||
100 [ 100 random ] replicate ;
|
||||
|
||||
: test-rng ( seed quot -- )
|
||||
>r <mersenne-twister> r> with-random ;
|
||||
[ <mersenne-twister> ] dip with-random ;
|
||||
|
||||
[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -139,7 +139,7 @@ M: not-enough-characters summary ( obj -- str )
|
|||
|
||||
: expect ( ch -- )
|
||||
get-char 2dup = [ 2drop ] [
|
||||
>r 1string r> 1string expected
|
||||
[ 1string ] bi@ expected
|
||||
] if next ;
|
||||
|
||||
: expect-string ( string -- )
|
||||
|
|
@ -155,4 +155,4 @@ M: not-enough-characters summary ( obj -- str )
|
|||
swap [ init-parser call ] with-input-stream ; inline
|
||||
|
||||
: string-parse ( input quot -- )
|
||||
>r <string-reader> r> state-parse ; inline
|
||||
[ <string-reader> ] dip state-parse ; inline
|
||||
|
|
|
|||
|
|
@ -6,3 +6,6 @@ IN: tools.files.tests
|
|||
\ directory. must-infer
|
||||
|
||||
[ ] [ "" directory. ] unit-test
|
||||
|
||||
[ ]
|
||||
[ { device-name free-space used-space total-space percent-used } file-systems. ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,14 +1,15 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators io io.files kernel
|
||||
math.parser sequences system vocabs.loader calendar ;
|
||||
math.parser sequences system vocabs.loader calendar math
|
||||
symbols fry prettyprint ;
|
||||
IN: tools.files
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: ls-time ( timestamp -- string )
|
||||
[ hour>> ] [ minute>> ] bi
|
||||
[ number>string 2 CHAR: 0 pad-left ] bi@ ":" swap 3append ;
|
||||
[ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ;
|
||||
|
||||
: ls-timestamp ( timestamp -- string )
|
||||
[ month>> month-abbreviation ]
|
||||
|
|
@ -32,6 +33,34 @@ PRIVATE>
|
|||
: directory. ( path -- )
|
||||
[ (directory.) ] with-directory-files [ print ] each ;
|
||||
|
||||
SYMBOLS: device-name mount-point type
|
||||
available-space free-space used-space total-space
|
||||
percent-used percent-free ;
|
||||
|
||||
: percent ( real -- integer ) 100 * >integer ; inline
|
||||
|
||||
: file-system-spec ( file-system-info obj -- str )
|
||||
{
|
||||
{ device-name [ device-name>> ] }
|
||||
{ mount-point [ mount-point>> ] }
|
||||
{ type [ type>> ] }
|
||||
{ available-space [ available-space>> ] }
|
||||
{ free-space [ free-space>> ] }
|
||||
{ used-space [ used-space>> ] }
|
||||
{ total-space [ total-space>> ] }
|
||||
{ percent-used [
|
||||
[ used-space>> ] [ total-space>> ] bi dup 0 =
|
||||
[ 2drop 0 ] [ / percent ] if
|
||||
] }
|
||||
} case ;
|
||||
|
||||
: file-systems-info ( spec -- seq )
|
||||
file-systems swap '[ _ [ file-system-spec ] with map ] map ;
|
||||
|
||||
: file-systems. ( spec -- )
|
||||
[ file-systems-info ]
|
||||
[ [ unparse ] map ] bi prefix simple-table. ;
|
||||
|
||||
{
|
||||
{ [ os unix? ] [ "tools.files.unix" ] }
|
||||
{ [ os windows? ] [ "tools.files.windows" ] }
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
USING: arrays bunny.model bunny.cel-shaded continuations
|
||||
destructors kernel math multiline opengl opengl.shaders
|
||||
opengl.framebuffers opengl.gl opengl.demo-support
|
||||
opengl.capabilities sequences ui.gadgets combinators accessors ;
|
||||
opengl.framebuffers opengl.gl opengl.demo-support fry
|
||||
opengl.capabilities sequences ui.gadgets combinators accessors
|
||||
macros ;
|
||||
IN: bunny.outlined
|
||||
|
||||
STRING: outlined-pass1-fragment-shader-main-source
|
||||
|
|
@ -176,24 +177,30 @@ TUPLE: bunny-outlined
|
|||
} cleave
|
||||
] [ drop ] if ;
|
||||
|
||||
MACRO: (framebuffer-texture>>draw) ( iformat xformat setter -- )
|
||||
'[ _ _ (framebuffer-texture) [ @ drop ] keep ] ;
|
||||
|
||||
: (make-framebuffer-textures) ( draw dim -- draw color normal depth )
|
||||
{
|
||||
[ drop ]
|
||||
[ GL_RGBA16F_ARB GL_RGBA [ >>color-texture ] (framebuffer-texture>>draw) ]
|
||||
[ GL_RGBA16F_ARB GL_RGBA [ >>normal-texture ] (framebuffer-texture>>draw) ]
|
||||
[
|
||||
GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT
|
||||
[ >>depth-texture ] (framebuffer-texture>>draw)
|
||||
]
|
||||
} 2cleave ;
|
||||
|
||||
: remake-framebuffer ( draw -- )
|
||||
[ dispose-framebuffer ]
|
||||
[ dup gadget>> dim>>
|
||||
[ (make-framebuffer-textures) (make-framebuffer) >>framebuffer ]
|
||||
[ >>framebuffer-dim drop ] bi
|
||||
] bi ;
|
||||
|
||||
: remake-framebuffer-if-needed ( draw -- )
|
||||
dup [ gadget>> dim>> ] [ framebuffer-dim>> ] bi =
|
||||
[ drop ] [
|
||||
[ dispose-framebuffer ] [ dup ] [ gadget>> dim>> ] tri {
|
||||
[
|
||||
GL_RGBA16F_ARB GL_RGBA (framebuffer-texture)
|
||||
[ >>color-texture drop ] keep
|
||||
] [
|
||||
GL_RGBA16F_ARB GL_RGBA (framebuffer-texture)
|
||||
[ >>normal-texture drop ] keep
|
||||
] [
|
||||
GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT (framebuffer-texture)
|
||||
[ >>depth-texture drop ] keep
|
||||
]
|
||||
} 2cleave
|
||||
[ (make-framebuffer) >>framebuffer ] [ >>framebuffer-dim ] bi
|
||||
drop
|
||||
] if ;
|
||||
[ drop ] [ remake-framebuffer ] if ;
|
||||
|
||||
: clear-framebuffer ( -- )
|
||||
GL_COLOR_ATTACHMENT0_EXT glDrawBuffer
|
||||
|
|
|
|||
|
|
@ -116,18 +116,9 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
|
|||
[ dip ] curry swap 1quotation [ keep ] curry compose
|
||||
] { } assoc>map concat compose ;
|
||||
|
||||
: either ( object first second -- ? )
|
||||
>r keep swap [ r> drop ] [ r> call ] ?if ; inline
|
||||
|
||||
: 2quot-with ( obj seq quot1 quot2 -- seq quot1 quot2 )
|
||||
>r pick >r with r> r> swapd with ;
|
||||
|
||||
: or? ( obj quot1 quot2 -- ? )
|
||||
[ keep ] dip rot [ 2nip ] [ call ] if* ; inline
|
||||
|
||||
: and? ( obj quot1 quot2 -- ? )
|
||||
[ keep ] dip rot [ call ] [ 2drop f ] if ; inline
|
||||
|
||||
MACRO: multikeep ( word out-indexes -- ... )
|
||||
[
|
||||
dup >r [ \ npick \ >r 3array % ] each
|
||||
|
|
|
|||
|
|
@ -44,11 +44,13 @@ SYMBOL: def-hash-keys
|
|||
|
||||
: trivial-defs
|
||||
{
|
||||
[ drop ] [ 2array ]
|
||||
[ bitand ]
|
||||
|
||||
[ . ]
|
||||
[ get ]
|
||||
[ t ] [ f ]
|
||||
[ { } ]
|
||||
[ drop ] ! because of declare
|
||||
[ drop f ]
|
||||
[ "cdecl" ]
|
||||
[ first ] [ second ] [ third ] [ fourth ]
|
||||
|
|
@ -80,6 +82,12 @@ def-hash get-global [ drop empty? not ] assoc-filter
|
|||
! Remove trivial defs
|
||||
[ drop trivial-defs member? not ] assoc-filter
|
||||
|
||||
! Remove numbers only defs
|
||||
[ drop [ number? ] all? not ] assoc-filter
|
||||
|
||||
! Remove curry only defs
|
||||
[ drop [ \ curry = ] all? not ] assoc-filter
|
||||
|
||||
! Remove tag defs
|
||||
[
|
||||
drop {
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ IN: opengl.demo-support
|
|||
|
||||
: FOV 2.0 sqrt 1+ ; inline
|
||||
: MOUSE-MOTION-SCALE 0.5 ; inline
|
||||
: KEY-ROTATE-STEP 1.0 ; inline
|
||||
: KEY-ROTATE-STEP 10.0 ; inline
|
||||
|
||||
SYMBOL: last-drag-loc
|
||||
|
||||
|
|
|
|||
|
|
@ -1,47 +0,0 @@
|
|||
|
||||
USING: kernel arrays sequences math math.order qualified
|
||||
sequences.lib circular processing ui newfx processing.shapes ;
|
||||
|
||||
IN: processing.gallery.trails
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Example 33-15 from the Processing book
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: point-list ( n -- seq ) [ drop 0 0 2array ] map <circular> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: dot ( pos percent -- ) 1 swap - 25 * 5 max circle ;
|
||||
|
||||
: step ( seq -- )
|
||||
|
||||
no-stroke
|
||||
{ 1 0.4 } fill
|
||||
|
||||
0 background
|
||||
|
||||
mouse push-circular
|
||||
[ dot ]
|
||||
each-percent ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: go* ( -- )
|
||||
|
||||
500 500 size*
|
||||
|
||||
[
|
||||
100 point-list
|
||||
[ step ]
|
||||
curry
|
||||
draw
|
||||
] setup
|
||||
|
||||
run ;
|
||||
|
||||
: go ( -- ) [ go* ] with-ui ;
|
||||
|
||||
MAIN: go
|
||||
|
|
@ -113,7 +113,7 @@ main()
|
|||
TUPLE: spheres-gadget < demo-gadget
|
||||
plane-program solid-sphere-program texture-sphere-program
|
||||
reflection-framebuffer reflection-depthbuffer
|
||||
reflection-texture ;
|
||||
reflection-texture initialized? ;
|
||||
|
||||
: <spheres-gadget> ( -- gadget )
|
||||
20.0 10.0 20.0 spheres-gadget new-demo-gadget ;
|
||||
|
|
@ -182,9 +182,11 @@ M: spheres-gadget graft* ( gadget -- )
|
|||
(make-reflection-texture) >>reflection-texture
|
||||
(make-reflection-depthbuffer) [ >>reflection-depthbuffer ] keep
|
||||
(make-reflection-framebuffer) >>reflection-framebuffer
|
||||
t >>initialized?
|
||||
drop ;
|
||||
|
||||
M: spheres-gadget ungraft* ( gadget -- )
|
||||
f >>initialized?
|
||||
dup find-gl-context
|
||||
{
|
||||
[ reflection-framebuffer>> [ delete-framebuffer ] when* ]
|
||||
|
|
@ -238,9 +240,8 @@ M: spheres-gadget pref-dim* ( gadget -- dim )
|
|||
] bi ;
|
||||
|
||||
: reflection-frustum ( gadget -- -x x -y y near far )
|
||||
[ near-plane ] [ far-plane ] bi [
|
||||
drop dup [ -+ ] bi@
|
||||
] 2keep ;
|
||||
[ near-plane ] [ far-plane ] bi
|
||||
[ drop dup [ -+ ] bi@ ] 2keep ;
|
||||
|
||||
: (reflection-face) ( gadget face -- )
|
||||
swap reflection-texture>> >r >r
|
||||
|
|
@ -280,7 +281,7 @@ M: spheres-gadget pref-dim* ( gadget -- dim )
|
|||
[ dim>> 0 0 rot first2 glViewport ]
|
||||
} cleave ] with-framebuffer ;
|
||||
|
||||
M: spheres-gadget draw-gadget* ( gadget -- )
|
||||
: (draw-gadget) ( gadget -- )
|
||||
GL_DEPTH_TEST glEnable
|
||||
GL_SCISSOR_TEST glDisable
|
||||
0.15 0.15 1.0 1.0 glClearColor {
|
||||
|
|
@ -297,6 +298,9 @@ M: spheres-gadget draw-gadget* ( gadget -- )
|
|||
]
|
||||
} cleave ;
|
||||
|
||||
M: spheres-gadget draw-gadget* ( gadget -- )
|
||||
dup initialized?>> [ (draw-gadget) ] [ drop ] if ;
|
||||
|
||||
: spheres-window ( -- )
|
||||
[ <spheres-gadget> "Spheres" open-window ] with-ui ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,96 @@
|
|||
|
||||
USING: kernel accessors locals namespaces sequences sequences.lib threads
|
||||
math math.order math.vectors
|
||||
calendar
|
||||
colors opengl ui ui.gadgets ui.gestures ui.render
|
||||
circular
|
||||
processing.shapes ;
|
||||
|
||||
IN: trails
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Example 33-15 from the Processing book
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Return the mouse location relative to the current gadget
|
||||
|
||||
: mouse ( -- point ) hand-loc get hand-gadget get screen-loc v- ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: point-list ( n -- seq ) [ drop { 0 0 } ] map <circular> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ;
|
||||
|
||||
: dot ( pos percent -- ) percent->radius circle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: <trails-gadget> < gadget paused points ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: iterate-system ( GADGET -- )
|
||||
|
||||
! Add a valid point if the mouse is in the gadget
|
||||
! Otherwise, add an "invisible" point
|
||||
|
||||
hand-gadget get GADGET =
|
||||
[ mouse GADGET points>> push-circular ]
|
||||
[ { -10 -10 } GADGET points>> push-circular ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: start-trails-thread ( GADGET -- )
|
||||
GADGET f >>paused drop
|
||||
[
|
||||
[
|
||||
GADGET paused>>
|
||||
[ f ]
|
||||
[ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ]
|
||||
if
|
||||
]
|
||||
loop
|
||||
]
|
||||
in-thread ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M:: <trails-gadget> draw-gadget* ( GADGET -- )
|
||||
origin get
|
||||
[
|
||||
T{ rgba f 1 1 1 0.4 } \ fill-color set ! White, with some transparency
|
||||
T{ rgba f 0 0 0 0 } \ stroke-color set ! no stroke
|
||||
|
||||
black gl-clear
|
||||
|
||||
GADGET points>> [ dot ] each-percent
|
||||
]
|
||||
with-translation ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: trails-gadget ( -- <trails-gadget> )
|
||||
|
||||
<trails-gadget> new-gadget
|
||||
|
||||
300 point-list >>points
|
||||
|
||||
t >>clipped?
|
||||
|
||||
dup start-trails-thread ;
|
||||
|
||||
: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
MAIN: trails-window
|
||||
Loading…
Reference in New Issue